Download ottose.eso

Back to the list

   1 : C OTTOSE    SOURCE    CHAT      05/01/13    02:07:49     5004           
   2 :       SUBROUTINE OTTOSE(MATEPL,SIG0,NSTRS,DEPST,VAR0,XMAT,IVAL,NCOMAT,
   3 :      &                  XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR,KERRE,
   4 :      &                  IB,IGAU)
   5 : C                                                                               
   6 : C ==================================================================            
   7 : C CE SOUS-PROGRAMME EST APPELE DANS "ECOUL2".                                    
   8 : C IL PREPARE L'INTEGRATION DE LA LOI DE OTTOSEN
   9 : C DE TYPE RETOUR RADIAL
  10 : C
  11 : C                                                                               
  12 : C ENTREES:                                                                      
  13 : C -------                                                                       
  14 : C NSTRS        = NBR. DE COMPOSANTES DES CONTR. OU DES DEFORM.                  
  15 : C SIG0(NSTRS)  = CONTR. AU DEBUT DU PAS D'INTEGRATION                           
  16 : C DEPST(NSTRS) = INCREMENT DES DEFORM. TOTALES  
  17 : C NVARI        = NBR. DE VARIABLES INTERNES                                     
  18 : C VAR0(NVARI)  = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION               
  19 : C                           
  20 : C NCOMAT       = NBR. DE CARACTERISTIQUES MECANIQUES DU MATERIAU
  21 : C IVAL(NCOMAT) = INDICE DES COMPOSANTES DE MATERIAU                
  22 : C XMAT(NCOMAT) = CARACTERISTIQUES MECANIQUES DU MATERIAU                        
  23 : C MFR          = INDICE DE LA FORMULATION MECANIQUE; SEULEMENT                  
  24 : C                MASSIF OU COQUE POUR LES MATERIAUX ENDOMMAGEABLES              
  25 : C ICARA        = NBR. DE CARACT. GEOMETRIQUES DES ELEMENTS FINIS                
  26 : C XCAR(ICARA)  = CARACT. GEOMETRIQUES DES ELEMENTS FINIS                                                               
  27 : C                                                                               
  28 : C SORTIES:                                                                      
  29 : C -------                                                                       
  30 : C SIGF(NSTRS)= CONTR. A LA FIN DU PAS D'INTEGRATION                             
  31 : C VARF(NVARI)= VARIABLES INTERNES A LA FIN DU PAS D'INTEGRATION                 
  32 : C DEFP(NSTRS)= INCREMENT DES DEFORM. PLASTIQUES A LA FIN DU PAS                 
  33 : C              D'INTEGRATION                                                    
  34 : C KERRE      = INDICE QUI REGIT LES ERREURS                                     
  35 : C            = 99 SI LA FORMULATION MECANIQUE N'EST PAS DISPONIBLE              
  36 : C                 POUR LE MODELE CONSIDERE OU S'IL Y A INCOMPATIBILITE          
  37 : C                 ENTRE MFR ET IFOUR       
  38 : C                                     
  39 : C ==================================================================
  40 : C       ICI IL FAUT PROGRAMMER EN FORTRAN PUR
  41 : C ===================================================================            
  42 : C
  43 :       IMPLICIT INTEGER(I-N)
  44 :       IMPLICIT REAL*8(A-H,O-Z)
  45 : -INC CCOPTIO
  46 : -INC CCREEL
  47 : C 
  48 :       PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
  49 : C
  50 :       DIMENSION SIG0(*),DEPST(*),VAR0(*),XMAT(*),XCAR(*),SIGF(*),               
  51 :      &          IVAL(*),VARF(*),DEFP(*) 
  52 : C
  53 :       DIMENSION SIGMA0(6),DSIGMA(6),DDEF0(6),DDEFP0(6),SIGF0(6)
  54 : C
  55 :       DIMENSION SIGMA(6),DDEF(6),DDEFP(6),SIGMAF(6),DDEFPT(6)
  56 : C
  57 :       DIMENSION WMAX(3),SMAX(7),W(3),WMAX0(3),SMAX0(6),W0(3),
  58 :      &    GFTR(3),GS(3),XLTR(3),XCOMP(18),XINVL(3),WRUPT(3),
  59 :      &    VF(3),XVF(3,3),VF1(3),VF2(3),VF3(3),VCA1(3),VCA2(3),VCA3(3),
  60 :      &    BILIN(3),SBILI(3)
  61 : C
  62 :       DIMENSION TAIL(6),P(6)
  63 :       DIMENSION IRESU(20)
  64 : C
  65 :       DIMENSION D(18)
  66 :       DIMENSION WREOUV(3),PENTE(3)
  67 : C 
  68 : C*******************************************************************
  69 : C
  70 :       JEBOUC=0
  71 :       IIMPI0=IIMPI
  72 : *
  73 : *      PROVISOIRE
  74 : *
  75 : *       IF(IIMPI.EQ.1042.AND.IB.EQ.11.AND.IGAU.EQ.4) THEN
  76 : *       IIMPI=42
  77 : *       ENDIF
  78 : *
  79 : 
  80 : *
  81 : 2020  JEBOUC=JEBOUC+1
  82 :       KERRE=0
  82 :       CALL ZDANUL(SMAX,7)
  83 : C
  84 : C===================================================================
  85 : C           TEST DE COMPATIBILITE CALCUL/FORMULATION 
  86 : C===================================================================
  87 : C
  88 : C------UNIQUEMENT EN MASSIF OU EN COQUES MINCES
  89 : C        PAS DE FORMULATION DE FOURIER-----------
  90 : C
  91 :       IF ((MFR.NE.1.AND.MFR.NE.3.AND.MFR.NE.9)
  92 :      .    .OR.IFOUR.EQ.1) THEN
  93 :          KERRE=99
  94 :          GO TO 9999
  95 :       ENDIF
  96 : C
  97 : C===================================================================
  98 : C  INITIALISATION DES VARIABLES INTERNES ET DES CARACTERISTIQUES
  99 : C===================================================================
 100 : C
 101 : C
 102 : C###################################################################
 103 : C===================================================================
 104 : C           INITIALISATION DES CARACTERISTIQUES
 105 : C===================================================================
 106 : C###################################################################
 107 : C
 108 : C   Les 2 eres valeurs de Xmat_OBLIGATOIRES sont reservees pour des MOOBL
 109 : C   Les 2 eres valeurs de Xmat_FACULTATIF sont reservees pour des MOFAC
 110 : C    et la 3 eme en cas de contraintes planes (DIM3)
 111 : C           
 112 :       YOUN=XMAT(1)
 113 :       XNU =XMAT(2)
 114 :       G   = UNDEMI*YOUN/(UN+XNU)
 115 :       PRECIE=1.D-10
 116 :       PRECIZ=YOUN*PRECIE
 117 :       IF (IFOMOD.EQ.2.AND.MFR.EQ.1) THEN
 118 :         NOBL=16
 119 :       ELSE 
 120 :         NOBL=11
 121 :         IF(MFR.EQ.1.AND.IFOUR.EQ.-2)  THEN 
 122 :           NOBL=12
 123 :         ENDIF
 124 :       ENDIF
 125 : *
 126 : *   modif pour le modèle ceramique
 127 :       IF(MATEPL.EQ.65) NOBL = NOBL + 6 
 128 : *   modif pour le modele maxott
 129 :       IF(MATEPL.EQ.106) NOBL = NOBL + 9 
 130 : *   modif pour le modele UO2_DCN
 131 :       IF(MATEPL.EQ.108) NOBL = NOBL + 23
 132 : *+DC
 133 : * à cause de VISQ...
 134 :       NOBL = NOBL + 1
 135 : C      
 136 : C===================================================
 137 : C----------------TRACTION SIMPLE--------------------
 138 : C===================================================
 139 : C
 140 :       XDLTR=XMAT(2+NOBL)
 141 :       DEFOTR=1.2D-4
 142 :       IF (IVAL(2+NOBL).EQ.0) XDLTR=YOUN*DEFOTR
 143 :       XDGFTR=XMAT(1+NOBL)
 144 :       IF (IVAL(1+NOBL).EQ.0) XDGFTR=XDLTR*3.9D-5
 145 :       BTR=XMAT(6+NOBL)
 146 :       IF (IVAL(6+NOBL).EQ.0) BTR=0.2D0
 147 : *
 148 : *     PETIT TEST SUR BTR
 149 : *
 150 :       BTR=MIN(BTR,UN)
 151 : 
 152 :       XDWRUP=XMAT(8+NOBL)
 153 :       XDBILI=XMAT(9+NOBL)
 154 : C
 155 : C__________________________________________________________
 156 : C             en defo planes ou axis
 157 : C   les caracteristiques dans la direction normale au plan
 158 : C           sont traitees particulierement
 159 : C----------------------------------------------------------
 160 : C
 161 :       XDEPSR=0.D0
 162 :       IF (IFOUR.EQ.0.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
 163 :          XDEPSR=XMAT(10+NOBL)
 164 :          IF (IVAL(10+NOBL).EQ.0) XDEPSR=TROIS*XDLTR/YOUN
 165 :       ENDIF 
 166 : C
 167 : C===================================================
 168 : C------------------CISAILLEMENT---------------------
 169 : C===================================================
 170 : C
 171 :       XDGS=XMAT(5+NOBL)
 172 :       IF (IVAL(5+NOBL).EQ.0) XDGS=YOUN*1.8D-4
 173 : C------------------------------------------------
 174 : C         la resistance au cisaillement
 175 : C      est la meme pour toutes les fissures
 176 : C------------------------------------------------
 177 :       XGS=XDGS
 178 : C
 179 : C===================================================
 180 : C----------------COMPRESSION SIMPLE-----------------
 181 : C===================================================
 182 : C
 183 :       GFCS=XMAT(3+NOBL)
 184 :       XLCS=XMAT(4+NOBL)
 185 :       IF (IVAL(4+NOBL).EQ.0) XLCS=1.D10*XDLTR
 186 :       BCS=XMAT(7+NOBL)
 187 :       IF (IVAL(7+NOBL).EQ.0) BCS=0.2D0
 188 : C
 189 : C###################################################################
 190 : C===================================================================
 191 : C            INITIALISATION DES VARIABLES INTERNES
 192 : C===================================================================
 193 : C###################################################################
 194 : C
 195 :       IF(MATEPL.EQ.65.OR.MATEPL.EQ.108) THEN 
 196 :         VARF(NVARI) = XZER
 197 :       ENDIF
 198 : C======================================
 199 : C---------CAS TRIDIMENSIONNEL MASSIF---
 200 : C======================================
 201 : C
 202 : C            NVARI=20    cf. IDVAR6
 203 : C
 204 :       IF (IFOUR.EQ.2.AND.MFR.EQ.1) THEN
 205 :          DO 10 IC=1,3
 206 :             ICN=IC+NOBL
 207 :             WMAX(IC)=VAR0(IC+1)
 208 :             W(IC)=VAR0(IC+4)
 209 :             GFTR(IC)=XMAT(ICN+9)
 210 :             IF (GFTR(IC).EQ.XZER) GFTR(IC)=XDGFTR
 211 :             GS(IC)=XMAT(ICN+12)
 212 :             IF (GS(IC).EQ.XZER) GS(IC)=XDGS
 213 :             XLTR(IC)=XMAT(ICN+15)
 214 :             IF (XLTR(IC).EQ.XZER) XLTR(IC)=XDLTR
 215 :             XCOMP(IC)=XMAT(ICN+18)
 216 :             XCOMP(IC+3)=XMAT(ICN+21)
 217 :             VF1(IC)=VAR0(IC+7)
 218 :             VF2(IC)=VAR0(IC+10)
 219 :             VF3(IC)=VAR0(IC+13)
 220 :             XINVL(IC)=VAR0(IC+16)
 221 :             WRUPT(IC)=XMAT(ICN+24)
 222 :             BILIN(IC)=XMAT(ICN+27)
 223 :             IF (BILIN(IC).EQ.XZER.OR.WRUPT(IC).EQ.XZER) THEN
 224 :                IF(XDBILI.EQ.XZER.OR.XDWRUP.EQ.XZER) THEN
 225 :                   WRUPT(IC)=DEUX*GFTR(IC)/XLTR(IC)
 226 :                   BILIN(IC)=XZER
 227 :                   SBILI(IC)=XLTR(IC)
 228 :                ELSE
 229 :                   WRUPT(IC)=XDWRUP
 230 :                   BILIN(IC)=XDBILI
 231 :                   SBILI(IC)=(DEUX*GFTR(IC)-XLTR(IC)*XDBILI)/XDWRUP
 232 :                ENDIF
 233 :             ELSE
 234 :                SBILI(IC)=(DEUX*GFTR(IC)-XLTR(IC)*BILIN(IC))/WRUPT(IC)
 235 :             ENDIF
 236 :   10     CONTINUE
 237 :          XLAMC=VAR0(20)
 238 :       ENDIF
 239 : C
 240 : C======================================
 241 : C-----------CAS CONT PLANE-------------
 242 : C---- OU TRIDIM COQUES MINCES ---------
 243 : C======================================
 244 : C
 245 : C            NVARI=12    cf. IDVAR6
 246 : C
 247 :       IF (IFOUR.EQ.-2.OR.
 248 :      .   (IFOUR.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9))) THEN
 249 :          DO 11 IC=1,2
 250 :             ICN=IC+NOBL
 251 :             WMAX(IC+1)=VAR0(IC+1)
 252 :             W(IC+1)=VAR0(IC+3)
 253 :             GFTR(IC+1)=XMAT(ICN+9)
 254 :             IF (GFTR(IC+1).EQ.XZER) GFTR(IC+1)=XDGFTR
 255 :             GS(IC+1)=XMAT(ICN+11)
 256 :             IF (GS(IC+1).EQ.XZER) GS(IC+1)=XDGS
 257 :             XLTR(IC+1)=XMAT(ICN+13)
 258 :             IF (XLTR(IC+1).EQ.XZER) XLTR(IC+1)=XDLTR
 259 :             XCOMP(IC)=XMAT(ICN+15)
 260 :             XCOMP(IC+3)=XMAT(ICN+18)
 261 :             VF2(IC)=VAR0(IC+5)
 262 :             VF3(IC)=VAR0(IC+7)
 263 :             XINVL(IC+1)=VAR0(IC+9)
 264 :             WRUPT(IC+1)=XMAT(ICN+21)
 265 :             BILIN(IC+1)=XMAT(ICN+23)
 266 :             IF (BILIN(IC+1).EQ.XZER.OR.WRUPT(IC+1).EQ.XZER) THEN
 267 :                IF(XDBILI.EQ.XZER.OR.XDWRUP.EQ.XZER) THEN
 268 :                   WRUPT(IC+1)=DEUX*GFTR(IC+1)/XLTR(IC+1)
 269 :                   BILIN(IC+1)=XZER
 270 :                   SBILI(IC+1)=XLTR(IC+1)
 271 :                ELSE
 272 :                   WRUPT(IC+1)=XDWRUP
 273 :                   BILIN(IC+1)=XDBILI
 274 :                   SBILI(IC+1)=(DEUX*GFTR(IC+1)-XLTR(IC+1)*XDBILI)
 275 :      &                         /XDWRUP
 276 :                ENDIF
 277 :             ELSE
 278 :                SBILI(IC+1)=(DEUX*GFTR(IC+1)-XLTR(IC+1)*BILIN(IC+1))
 279 :      &                      /WRUPT(IC+1)
 280 :             ENDIF
 281 :   11     CONTINUE
 282 :          XCOMP(3)=XMAT(NOBL+18)
 283 :          XCOMP(6)=XMAT(NOBL+21)
 284 :          XLAMC=VAR0(12)
 285 : C
 286 : C------------------------------------------------------------
 287 : C  La direction normale au plan est une direction principale
 288 : C         elle est definie par VF1 et indice par 1
 289 : C------------------------------------------------------------
 290 : C
 291 :             WMAX(1)=XZER
 292 :             W(1)=XZER
 293 :             GFTR(1)=XDGFTR
 294 :             GS(1)=XDGS
 295 :             XLTR(1)=XDLTR
 296 :             VF1(1)=XZER
 297 :             VF1(2)=XZER
 298 :             VF1(3)=UN
 299 :             XINVL(1)=XZER
 300 :             VF2(3)=XZER
 301 :             VF3(3)=XZER
 302 :             WRUPT(1)=DEUX*GFTR(1)/XLTR(1)
 303 :             BILIN(1)=XZER
 304 :             SBILI(1)=XLTR(1)
 305 :       ENDIF
 306 : C
 307 : C===========================================
 308 : C-----------CAS DEFO PLANE/AXIS-------------
 309 : C===========================================
 310 : C
 311 : C            NVARI=15    cf. IDVARI
 312 : C
 313 :       IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-3.OR.IFOUR.EQ.0) THEN
 314 :          DO 12 IC=1,2
 315 :             ICN=IC+NOBL
 316 :             WMAX(IC+1)=VAR0(IC+1)
 317 :             W(IC+1)=VAR0(IC+4)
 318 :             GFTR(IC+1)=XMAT(ICN+10)
 319 :             IF (GFTR(IC+1).EQ.XZER) GFTR(IC+1)=XDGFTR
 320 :             GS(IC+1)=XMAT(ICN+13)
 321 :             IF (GS(IC+1).EQ.XZER) GS(IC+1)=XDGS
 322 :             XLTR(IC+1)=XMAT(ICN+16)
 323 :             IF (XLTR(IC+1).EQ.XZER) XLTR(IC+1)=XDLTR
 324 :             XCOMP(IC)=XMAT(ICN+19)
 325 :             XCOMP(IC+3)=XMAT(ICN+22)
 326 :             VF2(IC)=VAR0(IC+7)
 327 :             VF3(IC)=VAR0(IC+9)
 328 :             XINVL(IC+1)=VAR0(IC+11)
 329 :             WRUPT(IC+1)=XMAT(ICN+25)
 330 :             BILIN(IC+1)=XMAT(ICN+27)
 331 :             IF (BILIN(IC+1).EQ.XZER.OR.WRUPT(IC+1).EQ.XZER) THEN
 332 :                IF(XDBILI.EQ.XZER.OR.XDWRUP.EQ.XZER) THEN
 333 :                   WRUPT(IC+1)=DEUX*GFTR(IC+1)/XLTR(IC+1)
 334 :                   BILIN(IC+1)=XZER
 335 :                   SBILI(IC+1)=XLTR(IC+1)
 336 :                ELSE
 337 :                   WRUPT(IC+1)=XDWRUP
 338 :                   BILIN(IC+1)=XDBILI
 339 :                   SBILI(IC+1)=(DEUX*GFTR(IC+1)-XLTR(IC+1)*XDBILI)
 340 :      &                         /XDWRUP
 341 :                ENDIF
 342 :             ELSE
 343 :                SBILI(IC+1)=(DEUX*GFTR(IC+1)-XLTR(IC+1)*BILIN(IC+1))
 344 :      &                      /WRUPT(IC+1)
 345 :             ENDIF
 346 :   12     CONTINUE
 347 :          XCOMP(3)=XMAT(NOBL+22)
 348 :          XCOMP(6)=XMAT(NOBL+25)
 349 :          XLAMC=VAR0(15)
 350 : C
 351 : C------------------------------------------------------------
 352 : C  La direction normale au plan est une direction principale
 353 : C         elle est definie par VF1 et indice par 1
 354 : C------------------------------------------------------------
 355 : C
 356 :             WMAX(1)=VAR0(4)
 357 :             W(1)=VAR0(7)
 358 :             XLTR(1)=XMAT(NOBL+19)
 359 :             IF (XLTR(1).EQ.XZER) XLTR(1)=XDLTR
 360 :             EPSR=XDEPSR
 361 :             GS(1)=XMAT(NOBL+16)
 362 :             IF (GS(1).EQ.XZER) GS(1)=XDGS
 363 :             XINVL(1)=VAR0(14)
 364 :             WRUPT(1)=EPSR
 365 :             BILIN(1)=XMAT(NOBL+30)
 366 :             GFTR(1)=XMAT(NOBL+13)
 367 :             IF (BILIN(1).EQ.XZER.OR.GFTR(1).EQ.XZER) THEN           
 368 : *
 369 : *  MLR : ICI ON NE PEUT PAS FAIRE MIEUX CAR ON VEUT
 370 : *        DES DEFORMATIONS DANS LA DIRECTION ETUDIEE
 371 : *
 372 :                IF (GFTR(1).EQ.XZER) GFTR(1)=UNDEMI*XLTR(1)*EPSR
 373 :                BILIN(1)=XZER
 374 :                SBILI(1)=XLTR(1)
 375 :             ELSE
 376 :                SBILI(1)=(DEUX*GFTR(1)-XLTR(1)*BILIN(1))/WRUPT(1)
 377 :             ENDIF
 378 : C
 379 :             VF1(1)=XZER
 380 :             VF1(2)=XZER
 381 :             VF1(3)=UN
 382 : C
 383 :             VF2(3)=XZER
 384 :             VF3(3)=XZER
 385 :       ENDIF
 386 : *
 387 : 
 388 :       IZOB=0
 389 : ************************************
 390 : 
 391 :       IF(IZOB.EQ.0) THEN
 392 : *************************************
 393 : *     CAS 1
 394 : *
 395 : *
 396 : *    VALEURS PAR DEFAUT POUR LES PARAMETRES DE COMPRESSION
 397 : *
 398 : *   XCOMP(1) : EPCM
 399 :       IF(XCOMP(1).EQ.XZER)  XCOMP(1)=(4.D0*XLCS)/(3.D0*YOUN)
 400 : *   XCOMP(2) : EPCU
 401 :       IF(XCOMP(2).EQ.XZER)  XCOMP(2)=5.D0*XCOMP(1)
 402 : *   XCOMP(3) : LCBI
 403 :       IF(XCOMP(3).EQ.XZER)  XCOMP(3)=1.15D0*XLCS
 404 : *   XCOMP(4) : XK2
 405 :       IF(XCOMP(4).EQ.XZER)  XCOMP(4)=0.985D0
 406 : *   XCOMP(5) : XGB
 407 :       IF(XCOMP(5).EQ.XZER)  XCOMP(5)=1.75D0
 408 : *   XCOMP(6) : XPA
 409 :       IF(XCOMP(6).EQ.XZER)  XCOMP(6)=1.D0
 410 : 
 411 : *
 412 : *   ICI ON COMPLETE LES XCOMP ET ON FAIT DES TESTS
 413 : *
 414 :       XCOMP(7)=XLCS
 415 :       IF(XCOMP(4).GT.UN) THEN
 416 :           PRINT *,' K2 =',XCOMP(4)
 417 :           KERRE=67
 418 :           RETURN
 419 :       ENDIF
 420 : *
 421 :       AK2=ACOS(XCOMP(4))
 422 :       XCC=COS((XPI-AK2)/TROIS)
 423 :       XCT=COS(AK2/TROIS)
 424 :       RORO=XCOMP(3)/XLCS
 425 :       IF(RORO.EQ.XCT/XCC) THEN
 426 :           PRINT *,' RO =',RORO,' CC=',XCC,' CT=',XCT
 427 :           KERRE=67
 428 :           RETURN
 429 :       ENDIF
 430 : *
 431 :       XTRA=XCC*(RORO*RORO-UN)/RORO/(DEUX*XCC-XCT)
 432 :       IF(XCOMP(5).LE.XTRA) THEN
 433 :           PRINT *,' XGB=',XCOMP(5),' XTRA=',XTRA
 434 :           KERRE=67
 435 :           RETURN
 436 :       ENDIF
 437 : *
 438 :       XK1=UN+DEUX*RORO*XCOMP(5)-RORO*RORO*(XCOMP(5)+UN)
 439 :       XK1=XK1*SQRT(TROIS)/RORO/(XCT-RORO*XCC)
 440 :       XCOMP(8)=XK1
 441 : *
 442 :       XGA=(UN+XCOMP(5))*RORO*XCT-(UN+DEUX*RORO*XCOMP(5))*XCC
 443 :       XGA=XGA*TROIS/RORO/(XCT-RORO*XCC)
 444 :       IF(XGA.LE.XZER.OR.XGA.GE.TROIS) THEN
 445 :           PRINT *,' XGA=',XGA
 446 :           KERRE=67
 447 :           RETURN
 448 :       ENDIF
 449 :       XCOMP(9)=XGA
 450 : *
 451 :       XGB=XCOMP(5)
 452 :       XPA=XCOMP(6)
 453 :       AL =(UN+XGB*(UN+XPA) -XGA/TROIS/TROIS)/(4.D0*XGA/9.D0)
 454 :       BE=UNDEMI*(8.D0*XGA/9.D0 - XGB*(UN+XPA))/(4.D0*XGA/9.D0)
 455 :       GAMA=SQRT(AL+BE*BE)
 456 :       DELT=(GAMA-BE)/(GAMA+BE)
 457 :       XCOMP(10)=AL
 458 :       XCOMP(11)=BE
 459 :       XCOMP(12)=GAMA
 460 :       XCOMP(13)=DELT
 461 :       XMU1=8.D0*XGA*GAMA/9.D0/XCOMP(1)
 462 :       XCOMP(14)=XMU1
 463 : *
 464 :       DELTAP=XCOMP(2)-XCOMP(1)
 465 :       XLCMAX=XCOMP(1)*9.D0/(8.D0*XGA*GAMA)
 466 :       XLCMAX=XLCMAX*LOG((GAMA+UN-BE)/(GAMA-UN+BE)/DELT)
 467 :       XCOMP(15)=XLCMAX
 468 : 
 469 :       A2=SQRT(1.5D0/XGA + 0.5D0)
 470 :       XMU2=4.D0*A2*XGA/TROIS/DELTAP
 471 :       XCOMP(16)=A2
 472 :       XCOMP(17)=XMU2
 473 :       XLCULT=XLCMAX+LOG((A2+UN)/(A2-UN))/XMU2
 474 :       XCOMP(18)=XLCULT
 475 : 
 476 :       ENDIF
 477 : *************************************
 478 : * FIN DU CAS 1
 479 : *************************************
 480 : *
 481 : 
 482 : 
 483 : ************************************
 484 : 
 485 :       IF(IZOB.EQ.1) THEN
 486 : *************************************
 487 : *     CAS 2
 488 : *
 489 : *
 490 : *    VALEURS PAR DEFAUT POUR LES PARAMETRES DE COMPRESSION
 491 : *
 492 : *   XCOMP(1) : EPCM
 493 :       IF(XCOMP(1).EQ.XZER)  XCOMP(1)=(4.D0*XLCS)/(3.D0*YOUN)
 494 : *   XCOMP(2) : EPCU
 495 :       IF(XCOMP(2).EQ.XZER)  XCOMP(2)=5.D0*XCOMP(1)
 496 : *   XCOMP(3) : LCBI
 497 :       IF(XCOMP(3).EQ.XZER)  XCOMP(3)=1.16D0*XLCS
 498 : *   XCOMP(4) : XK2  ( REPS)
 499 :       IF(XCOMP(4).EQ.XZER)  XCOMP(4)=1.1D0
 500 : *   XCOMP(5) : XGB
 501 :       IF(XCOMP(5).EQ.XZER)  XCOMP(5)=1.75D0
 502 : *   XCOMP(6) : XPA   ( A0)
 503 :       IF(XCOMP(6).EQ.XZER)  XCOMP(6)=1.583D0
 504 : *
 505 : *   ZZZZ  CETTE VALEUR DE 1.583 EST A GENERALISER
 506 : *
 507 : 
 508 : 
 509 : 
 510 : *
 511 : *   ICI ON COMPLETE LES XCOMP ET ON FAIT DES TESTS
 512 : *
 513 :       XCOMP(7)=XLCS
 514 : *
 515 :       RORO=XCOMP(3)/XLCS
 516 :       REPS=XCOMP(4)
 517 : *
 518 : *
 519 :       AA=XCOMP(6)/3.D0
 520 :       AA=(AA+SQRT(AA*AA+12.D0))/6.D0
 521 :       XCOMP(8)=AA
 522 : *
 523 :       C0=3.D0*AA*(2.D0*REPS-RORO)**2
 524 :       C0=(C0+XCOMP(6)*(1.D0-REPS)/3.D0)*9.D0/AA**2
 525 :       C0=C0/(6.D0*AA*(2.D0*RORO**3-REPS)
 526 :      &   +XCOMP(6)*(REPS-4.D0*RORO**2)/3.D0)
 527 :       XCOMP(9)=C0
 528 : *
 529 :       FAC=2.D0/(1.D0+AA*AA*C0/9.D0)/(6.D0*AA-XCOMP(6)/3.D0)
 530 :       XLCMAX=XCOMP(1)*FAC
 531 :       XCOMP(10)=FAC
 532 : 
 533 : 
 534 : 
 535 :       ENDIF
 536 : *************************************
 537 : * FIN DU CAS 2
 538 : *************************************
 539 : *
 540 : 
 541 : *
 542 : C
 543 : C              CALCUL DE SMAX
 544 : C
 545 :       DO IC=1,3
 545 :         CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,SBILI,W,WMAX,
 546 :      &              SMAX,PENTE,IC)
 547 :       ENDDO
 548 : C
 549 : C
 550 : C#######################################
 551 : C=======================================
 552 : C---------PARAMETRES DE TAILLE----------
 553 : C=======================================
 554 : C#######################################
 555 : C
 556 :       IF (MATEPL.EQ.108) NTAIL=27
 557 :       IF (MATEPL.NE.108) NTAIL=2
 558 :       IF (IFOUR.EQ.2.AND.MFR.EQ.1) THEN
 559 : C
 560 : C-----------TRIDIM MASSIF------------------
 561 : C
 562 :          DO 15 IC=1,6
 563 :             TAIL(IC)=XMAT(IC+NTAIL)
 564 :             P(IC)=XMAT(IC+NTAIL+6)
 565 :   15     CONTINUE
 566 : 
 567 :       ELSE
 568 : C
 569 : C------AXIS/DEF/CONT PLANES/COQUES MINCES---------
 570 : C
 571 : 
 572 :          TAIL(1)=XMAT(1+NTAIL)
 573 :          TAIL(2)=XMAT(2+NTAIL)
 574 :          TAIL(3)=XMAT(4+NTAIL)
 575 :          TAIL(4)=XMAT(3+NTAIL)
 576 :          TAIL(5)=XZER
 577 :          TAIL(6)=XZER
 578 :          P(1)=XMAT(5+NTAIL)
 579 :          P(2)=XMAT(6+NTAIL)
 580 :          P(3)=UN
 581 :          P(4)=XMAT(7+NTAIL)
 582 :          P(5)=XZER
 583 :          P(6)=XZER
 584 :       ENDIF
 585 : C
 586 : C
 587 : C    IMPRESSION DES DONNEES MATERIAU ,TAILLE  ET VARIABLES INTERNES
 588 : C    --------------------------------------------------------------
 589 : C
 590 :       IF(IIMPI.EQ.42) THEN
 591 :         WRITE(IOIMP,77000) IB,IGAU
 592 : 77000   FORMAT(////////2X,' IB=',I4,2X,'IGAU=',I3//)
 593 :       ENDIF
 594 :       IF(IIMPI.EQ.42) THEN
 595 :         WRITE(IOIMP,77001) YOUN,XNU,XDLTR,XDGFTR,BTR,XDEPSR,XDGS,
 596 :      .                     XDWRUP,XDBILI,GFCS,XLCS
 597 : 77001   FORMAT(///2X,' YUNG=',1PE12.5,2X,'XNU=',1PE12.5/
 598 :      .    2X,'LTR=',1PE12.5,2X,'GF=',1PE12.5,2X,'BETA=',1PE12.5/
 599 :      .    2X,'EPSR=',1PE12.5,2X,'GS=',1PE12.5,2X,'WRUP=',1PE12.5/
 600 :      .    2X,'BILI=',1PE12.5,2X,'GC=',1PE12.5,2X,'LCS=',1PE12.5///)
 601 : *
 602 :         WRITE(IOIMP,77002) (WMAX(I),I=1,3),(SMAX(I),I=1,3)
 603 : 77002   FORMAT('0  WMAX '/3(1X,1PE12.5)/
 604 :      .         2X,'SMAX'/3(1X,1PE12.5)/)
 605 : *
 606 :         WRITE(IOIMP,77003) (W(I),I=1,3),(GFTR(I),I=1,3)
 607 : 77003   FORMAT('0  W    '/3(1X,1PE12.5)/
 608 :      .         2X,'GFTR'/3(1X,1PE12.5)/)
 609 : *
 610 :         WRITE(IOIMP,77004) (GS(I),I=1,3),(XLTR(I),I=1,3)
 611 : 77004   FORMAT('0  GS   '/3(1X,1PE12.5)/
 612 :      .         2X,'XLTR'/3(1X,1PE12.5)/)
 613 : *
 614 :         WRITE(IOIMP,77005) (VF1(I),I=1,3),(VF2(I),I=1,3)
 615 : 77005   FORMAT('0  VF1  '/3(1X,1PE12.5)/
 616 :      .         2X,'VF2  '/3(1X,1PE12.5)/)
 617 : *
 618 :         WRITE(IOIMP,77006) (VF3(I),I=1,3),(XINVL(I),I=1,3)
 619 : 77006   FORMAT('0  VF3  '/3(1X,1PE12.5)/
 620 :      .         2X,'XINVL'/3(1X,1PE12.5)/)
 621 : *
 622 :         WRITE(IOIMP,77007) (WRUPT(I),I=1,3),(BILIN(I),I=1,3)
 623 : 77007   FORMAT('0  WRUPT'/3(1X,1PE12.5)/
 624 :      .         2X,'BILIN'/3(1X,1PE12.5)/)
 625 : *
 626 :         WRITE(IOIMP,77008) (SBILI(I),I=1,3)
 627 : 77008   FORMAT('0  SBILI'/3(1X,1PE12.5)/)
 628 : *
 629 :         WRITE(IOIMP,77009) (TAIL(I),I=1,6),(P(I),I=1,6)
 630 : 77009   FORMAT('0  TAIL '/6(1X,1PE12.5)/
 631 :      .         2X,'P    '/6(1X,1PE12.5)/)
 632 : *
 633 :         WRITE(IOIMP,77090) (XCOMP(I),I=1,18)
 634 : 77090   FORMAT('0  XCOMP'/6(1X,1PE12.5)/)
 635 :         WRITE(IOIMP,77091) XLAMC
 636 : 77091   FORMAT('0  XLAMC = ',1PE12.5/)
 637 : *
 638 :         WRITE(IOIMP,17009) (SIG0(I),I=1,NSTRS)
 639 : 17009   FORMAT('0  SIG0 EN ENTREE '/8(1X,1PE12.5)/)
 640 :         WRITE(IOIMP,18009) (DEPST(I),I=1,NSTRS)
 641 : 18009   FORMAT('0  DEPST EN ENTREE '/8(1X,1PE12.5)/)
 642 :       ENDIF
 643 : C
 644 : C========================================================================     
 645 : C       ADAPTATION DE L'OPTION DE CALCUL VERS LE 3D MASSIF 
 646 : C                     DE SIG0 A SIGMA0
 647 : C
 648 : C************************************************************************
 649 : C                        A T T E N T I O N
 650 : C
 651 : C       DANS LA SUITE ON TRAVAILLE SUR EPSXY AU LIEU DE GAMXY  !!!!
 652 : C
 653 : C************************************************************************
 654 : C
 655 : C========================================================================
 656 : C
 657 :         IF (IFOUR.EQ.2.AND.MFR.EQ.1) THEN
 658 : C 
 659 : C-----------------------MASSIF 3D----NSTRS=6-----------------------------
 660 : C
 661 :           DO 20 IC=1,6
 662 :             SIGMA0(IC)=SIG0(IC)
 663 :             IF(IC.LE.3) THEN
 664 :               DSIGMA(IC)=DEPST(IC)
 665 :             ELSE
 666 :               DSIGMA(IC)=DEPST(IC)*UNDEMI
 667 :             ENDIF
 668 :   20      CONTINUE
 669 : C
 670 :         ELSEIF (IFOUR.NE.2.AND.MFR.EQ.1) THEN
 671 : C
 672 : C-----CALCUL AXISYMETRQUE/DEF PLANES/CONT PLANES/DEF PLANES GENER.-------
 673 : C
 674 :           DO 30 IC=1,4
 675 :             SIGMA0(IC)=SIG0(IC)
 676 :             IF(IC.LE.3) THEN
 677 :               DSIGMA(IC)=DEPST(IC)
 678 :             ELSE
 679 :               DSIGMA(IC)=DEPST(IC)*UNDEMI
 680 :             ENDIF
 681 :   30      CONTINUE       
 682 :           SIGMA0(5)=XZER
 683 :           SIGMA0(6)=XZER
 684 :           DSIGMA(5)=XZER
 685 :           DSIGMA(6)=XZER
 686 : C
 687 :         ELSEIF (IFOUR.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
 688 : C
 689 : C-----CALCUL TRIDIM COQUES MINCES -------
 690 : C     ON NE PREND QUE LA PARTIE MEMBRANE
 691 : C
 692 :           EPAI=XCAR(1)
 693 :           SIGMA0(1)=SIG0(1)/EPAI
 694 :           SIGMA0(2)=SIG0(2)/EPAI
 695 :           SIGMA0(3)=0.D0
 696 :           SIGMA0(4)=SIG0(3)/EPAI
 697 :           DSIGMA(1)=DEPST(1)
 698 :           DSIGMA(2)=DEPST(2)
 699 :           DSIGMA(3)=0.D0
 700 :           DSIGMA(4)=DEPST(3)*UNDEMI
 701 :           SIGMA0(5)=XZER
 702 :           SIGMA0(6)=XZER
 703 :           DSIGMA(5)=XZER
 704 :           DSIGMA(6)=XZER
 705 :         ENDIF
 706 : C
 707 : C########################################################################
 708 : C========================================================================
 709 : C     CALCUL DES PARAMETRES POUR UN MATERIAU PRE-FISSURE
 710 : C========================================================================
 711 : C########################################################################
 712 : C
 713 :       XNF1=VF1(1)*VF1(1)+VF1(2)*VF1(2)+VF1(3)*VF1(3)
 714 :       XNF2=VF2(1)*VF2(1)+VF2(2)*VF2(2)+VF2(3)*VF2(3)
 715 :       XNF3=VF3(1)*VF3(1)+VF3(2)*VF3(2)+VF3(3)*VF3(3)
 716 : C
 717 : C========================================================================
 718 : C    CALCUL DES PARAMETRES DE TAILLE POUR UN MATERIAU PRE-FISSURE
 719 : C========================================================================
 720 : C
 721 : C---on calcule la parametre de taille si la fissure est ouverte--
 722 : C---------------et le parametre de taille nul--------------------
 723 : C
 724 :       IF (XNF1.NE.XZER.AND.W(1).NE.XZER.AND.XINVL(1).EQ.XZER) THEN
 725 : C
 726 : C------------FISSURE 1 OUVERTE---------------
 727 : C
 728 :          XL1=TAIL(1)*VF1(1)*VF1(1)+TAIL(2)*VF1(2)*VF1(2)
 729 :          XL1=XL1+TAIL(3)*VF1(3)*VF1(3)+DEUX*TAIL(4)*VF1(2)*VF1(1)
 730 :          XL1=XL1+DEUX*TAIL(5)*VF1(1)*VF1(3)
 731 :          XL1=XL1+DEUX*TAIL(6)*VF1(2)*VF1(3)
 732 :          P1=P(1)*VF1(1)*VF1(1)+P(2)*VF1(2)*VF1(2)+P(3)*VF1(3)*VF1(3)
 733 :          P1=P1+DEUX*P(4)*VF1(2)*VF1(1)+DEUX*P(5)*VF1(1)*VF1(3)
 734 :          P1=P1+DEUX*P(6)*VF1(2)*VF1(3)
 735 :          SMAX(1)=XLTR(1)
 736 :          WMAX(1)=W(1)
 737 :          IF (XL1.NE.XZER) THEN
 738 :             XINVL(1)=ABS(P1/XL1)
 739 :             IF (XINVL(1).LE
 740 :      &          .((UN+XNU)*XLTR(1)*XLTR(1)/(DEUX*GFTR(1)*YOUN))) THEN
 741 :                KERRE=61
 742 :                GO TO 2021
 743 :             ENDIF
 744 :          ELSE
 745 :             XINVL(1)=UN
 746 :          ENDIF
 747 :       ENDIF
 748 : C
 749 : C---------FISSURE 2 OUVERTE-----------
 750 : C
 751 :       IF (XNF2.NE.XZER.AND.W(2).NE.XZER.AND.XINVL(2).EQ.XZER) THEN
 752 :          XL2=TAIL(1)*VF2(1)*VF2(1)+TAIL(2)*VF2(2)*VF2(2)
 753 :          XL2=XL2+TAIL(3)*VF2(3)*VF2(3)+DEUX*TAIL(4)*VF2(2)*VF2(1)
 754 :          XL2=XL2+DEUX*TAIL(5)*VF2(1)*VF2(3)
 755 :          XL2=XL2+DEUX*TAIL(6)*VF2(2)*VF2(3)
 756 :          P2=P(1)*VF2(1)*VF2(1)+P(2)*VF2(2)*VF2(2)+P(3)*VF2(3)*VF2(3)
 757 :          P2=P2+DEUX*P(4)*VF2(2)*VF2(1)+DEUX*P(5)*VF2(1)*VF2(3)
 758 :          P2=P2+DEUX*P(6)*VF2(2)*VF2(3)
 759 :          SMAX(2)=XLTR(2)
 760 :          WMAX(2)=W(2)
 761 :          IF (XL2.NE.XZER) THEN
 762 :             XINVL(2)=ABS(P2/XL2)
 763 :             IF (XINVL(2).LE
 764 :      &          .((UN+XNU)*XLTR(2)*XLTR(2)/(DEUX*GFTR(2)*YOUN))) THEN
 765 :                KERRE=61
 766 :                GO TO 2021
 767 :             ENDIF
 768 :          ELSE
 769 :             XINVL(2)=UN
 770 :          ENDIF
 771 :       ENDIF               
 772 : C
 773 : C---------FISSURE 3 OUVERTE-----------
 774 : C
 775 :       IF (XNF3.NE.XZER.AND.W(3).NE.XZER.AND.XINVL(3).EQ.XZER) THEN
 776 :          XL3=TAIL(1)*VF3(1)*VF3(1)+TAIL(2)*VF3(2)*VF3(2)
 777 :          XL3=XL3+TAIL(3)*VF3(3)*VF3(3)+DEUX*TAIL(4)*VF3(2)*VF3(1)
 778 :          XL3=XL3+DEUX*TAIL(5)*VF3(1)*VF3(3)
 779 :          XL3=XL3+DEUX*TAIL(6)*VF3(2)*VF3(3)
 780 :          P3=P(1)*VF3(1)*VF3(1)+P(2)*VF3(2)*VF3(2)+P(3)*VF3(3)*VF3(3)
 781 :          P3=P3+DEUX*P(4)*VF3(2)*VF3(1)+DEUX*P(5)*VF3(1)*VF3(3)
 782 :          P3=P3+DEUX*P(6)*VF3(2)*VF3(3)
 783 :          SMAX(3)=XLTR(3)
 784 :          WMAX(3)=W(3)
 785 :          IF (XL3.NE.XZER) THEN
 786 :             XINVL(3)=ABS(P3/XL3)
 787 :             IF (XINVL(3).LE
 788 :      &          .((UN+XNU)*XLTR(3)*XLTR(3)/(DEUX*GFTR(3)*YOUN))) THEN
 789 :                KERRE=61
 790 :                GO TO 2021
 791 :             ENDIF
 792 :          ELSE
 793 :             XINVL(3)=UN
 794 :          ENDIF
 795 :       ENDIF  
 796 : C
 797 : C======================================================================
 798 : C                 CALCUL DU NOMBRE DE FISSURE
 799 : C======================================================================
 800 : C
 801 :       NFISSU=0
 802 :       IF (XINVL(1).NE.XZER) NFISSU=NFISSU+1
 803 :       IF (XINVL(2).NE.XZER) NFISSU=NFISSU+1
 804 :       IF (XINVL(3).NE.XZER) NFISSU=NFISSU+1
 805 : C
 806 : C================================================================
 807 : C             CALCUL DU NOMBRE DE DIRECTION IMPOSEE
 808 : C         qui ne sont pas des directions de fissuration
 809 : C================================================================
 810 : C
 811 :       NVF=0
 812 :       IF (XNF1.NE.XZER.AND.XINVL(1).EQ.XZER) NVF=NVF+1
 813 :       IF (XNF2.NE.XZER.AND.XINVL(2).EQ.XZER) NVF=NVF+1
 814 :       IF (XNF3.NE.XZER.AND.XINVL(3).EQ.XZER) NVF=NVF+1
 815 : C
 816 : C--remarque : en 2D NVF la direction (0 0 1) est toujours imposee--
 817 : C
 818 : C========================================================================
 819 : C-------------test la consistance des vecteurs VF1 VF2 VF3---------------
 820 : C          VF1 VF2 et VF3 sont dans l ordre d apparition 1 2 3
 821 : C========================================================================
 822 : C
 823 :       IF (XNF1.EQ.XZER.AND.(XNF2+XNF3).NE.XZER) THEN
 824 :          KERRE=66
 825 :          GO TO 2021
 826 :       ENDIF
 827 : C
 828 :       IF (XNF2.EQ.XZER.AND.XNF3.NE.XZER) THEN
 829 :          KERRE=66
 830 :          GO TO 2021
 831 :       ENDIF
 832 : C
 833 :       PRDT=VF1(1)*VF2(1)+VF1(2)*VF2(2)+VF1(3)*VF2(3)
 834 :       PRDT=PRDT+VF1(1)*VF3(1)+VF1(2)*VF3(2)+VF1(3)*VF3(3)
 835 :       PRDT=PRDT+VF2(1)*VF3(1)+VF2(2)*VF3(2)+VF2(3)*VF3(3)
 836 :       PRDT=ABS(PRDT)
 837 : C
 838 :       IF (PRDT.GE.1D-3) THEN
 839 :          KERRE=67
 840 :          GO TO 2021
 841 :       ENDIF
 842 : C
 843 : C########################################################################
 844 : C========================================================================
 845 : C          INCREMENT DE DEFORMATION 
 846 : C========================================================================
 847 : C########################################################################
 848 : C
 849 :       IF (IFOUR.EQ.-2.OR.
 850 :      .   (IFOUR.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9))) THEN
 851 : C
 852 : C----------------CONT PLANES---------------
 853 : C--------- OU TRIDIM COQUES MINCES  -------
 854 : C
 855 :         DO  33 I=1,4
 856 :            DDEF0(I)=DSIGMA(I)
 857 :   33    CONTINUE
 858 :         DDEF0(5)=XZER
 859 :         DDEF0(6)=XZER
 860 :       ELSE
 861 : C
 862 : C-------------3D  MASSIF / DEFO PLANES-------------
 863 : C
 864 :         DO  34 I=1,6
 865 :            DDEF0(I)=DSIGMA(I)
 866 :  34     CONTINUE
 867 :       ENDIF
 868 : C
 869 : C
 870 : C    IMPRESSION DES INCREMENTS DE DEFORMATION ET ETAT INITIAL
 871 : C    --------------------------------------------------------
 872 : C
 873 :       IF(IIMPI.EQ.42) THEN
 874 :         WRITE(IOIMP,77010) (SIGMA0(I),I=1,6)
 875 : 77010   FORMAT('0  SIGMA0 EN REPERE GENERAL '/6(1X,1PE12.5)/)
 876 : *
 877 :         WRITE(IOIMP,77011) (DDEF0(I),I=1,6)
 878 : 77011   FORMAT('0  DDEF0 EN REPERE GENERAL '/6(1X,1PE12.5)/)
 879 : *
 880 :         WRITE(IOIMP,77012) NFISSU,NVF,(XINVL(I),I=1,3)
 881 : 77012   FORMAT('0  NFISSU=',I3,2X,'NVF=',I3/
 882 :      .         '0  XINVL '/3(1X,1PE12.5)/)
 883 :       ENDIF
 884 : C
 885 : C
 886 : C
 887 : C########################################################################
 888 : C========================================================================
 889 : C
 890 : C          LES CHOSES SERIEUSES COMMENCENT : ITERATIONS INTERNES
 891 : C
 892 : C========================================================================
 893 : C########################################################################
 894 : C
 895 : C========================================================================
 896 : C      INITIALISATION DES VARIABLES GLOBALES AUX ITERATIONS INTERNES
 897 : C========================================================================
 898 : C
 899 :         PSOM=0.D0
 900 :         DO  334 I=1,6
 901 :            PSOM=PSOM+ABS(DDEF0(I))
 902 : 334     CONTINUE
 903 :         PSOM=PSOM/(3.D0*DEFOTR)
 904 : *  MLR  22/11/96
 905 :         PSOM=MIN(PSOM,1.D6)
 906 : *
 907 : *  AM 30/04/96   ON MODULE LA PRECISION SELON LA VALEUR DE PSOM
 908 : *
 909 : *      PRECIS = MIN (1.D-4,1.D-4/PSOM)
 910 : *      EPSILO = MIN (1.D-2,1.D-2/PSOM)
 911 :       EPSIL2 = MIN (1.D-4,1.D-4/PSOM)
 912 :       TAURES=UN
 913 :       ITER=0
 914 :       DO 25 I=1,6
 915 :         DDEFPT(I)=XZER
 916 :  25   CONTINUE
 917 : C
 918 : C========================================================================
 919 : C              LABEL DE DEBUT DES ITERATIONS INTERNES
 920 : C========================================================================
 921 : C
 922 :   31  CONTINUE
 923 : C
 924 :       ITER=ITER+1
 925 : C
 926 :           IF(IIMPI.EQ.42) THEN
 927 :             WRITE(IOIMP,77015) ITER,TAURES
 928 : 77015       FORMAT(//////2X,'  >>>>>>>>> ITERATION INTERNE ',
 929 :      &             I3,2X,'TAURES=',1PE12.5/)
 930 :             WRITE(IOIMP,77615) XNF1,XNF2,XNF3
 931 : 77615       FORMAT(/2X,'XNF1 =',1PE12.5,2X,'XNF2 =',1PE12.5,
 932 :      &              2X,'XNF3 =',1PE12.5/)
 933 :           ENDIF
 934 : C
 935 :       IF (ITER.GE.25) THEN
 936 : C------non convergence des iterations internes------
 937 :          KERRE=62
 938 :          GO TO 2021
 939 :       ENDIF
 940 : C
 941 : C
 942 : C========================================================================
 943 : C     INITIALISATION DES VARIABLES POUR GESTION DES SOUS ITERATIONS
 944 : C========================================================================
 945 : C---nous prenons en compte la totalite du reste de l increment de def---
 946 : C------------IRESU garde en memoire la derniere non linearite----------
 947 : C------------prise en compte lors des sous iterations internes----------
 948 : C
 949 : C
 950 :       TAU=UN
 951 : C  
 952 :       DO IC=1,3
 953 :          W0(IC)=W(IC)
 954 :          WMAX0(IC)=WMAX(IC)
 955 :       ENDDO
 956 :       DO IC=1,6
 957 :          SMAX0(IC)=SMAX(IC)
 958 :       ENDDO
 959 : *
 960 :       IF(IIMPI.EQ.42) THEN
 961 :         WRITE(IOIMP,73032) (W0(I),I=1,3),(WMAX0(I),I=1,3)
 962 : 73032   FORMAT('   W0 '/3(1X,1PE12.5)/' WMAX0 '/3(1X,1PE12.5)/)
 963 : *
 964 :         WRITE(IOIMP,73630) (SMAX0(I),I=1,3)
 965 : 73630   FORMAT('  SMAX0'/3(1X,1PE12.5)/)
 966 : *
 967 :         WRITE(IOIMP,73034) (WRUPT(I),I=1,3),(XINVL(I),I=1,3)
 968 : 73034   FORMAT('  WRUPT'/3(1X,1PE12.5)/'  XINVL'/3(1X,1PE12.5)/)
 969 :         WRITE(IOIMP,73934) XNF1, XNF2,XNF3
 970 : 73934   FORMAT(/// 2X, 'XNF1 XNF2 XNF3 = ',3(1X,1PE12.5)/)
 971 :       ENDIF
 972 : C
 973 : C
 974 : C========================================================================
 975 : C                        REPERE DE CALCUL
 976 : C========================================================================
 977 : C
 978 : C
 979 :       IF (XNF1.NE.XZER) THEN
 980 : C
 981 : C------------DIRECTION 1 IMPOSEE---------------
 982 : C
 983 :          VCA1(1)=VF1(1)
 984 :          VCA1(2)=VF1(2)
 985 :          VCA1(3)=VF1(3)
 986 :          IF (XNF3.NE.XZER) THEN
 987 : C
 988 : C---------DIRECTION 1 2 3 IMPOSEES-----------
 989 : C
 990 :             VCA2(1)=VF2(1)
 991 :             VCA2(2)=VF2(2)
 992 :             VCA2(3)=VF2(3)
 993 :             VCA3(1)=VF3(1)
 994 :             VCA3(2)=VF3(2)
 995 :             VCA3(3)=VF3(3)
 996 :          ELSEIF (XNF2.NE.XZER) THEN
 997 : C
 998 : C----------DIRECTION 1 ET 2 IMPOSEES------------
 999 : C
1000 :              VCA2(1)=VF2(1)
1001 :              VCA2(2)=VF2(2)
1002 :              VCA2(3)=VF2(3)
1003 :              VCA3(1)=VF1(2)*VF2(3)-VF1(3)*VF2(2)
1004 :              VCA3(2)=VF1(3)*VF2(1)-VF1(1)*VF2(3)
1005 :              VCA3(3)=VF1(1)*VF2(2)-VF1(2)*VF2(1)
1006 :              SMAX(3)=XLTR(3)
1007 :          ELSE
1008 : C
1009 : C-------------UNIQUEMENT LA DIRECTION 1 IMPOSEE--------------
1010 : C
1011 :              IF (VCA1(2).NE.XZER.OR.VCA1(3).NE.XZER) THEN
1012 :                VCA2(1)=XZER
1013 :                VCA2(2)=-VCA1(3)
1014 :                VCA2(3)=VCA1(2)
1015 :                XVCA=SQRT(VCA2(1)*VCA2(1)+VCA2(2)*VCA2(2)
1016 :      .                  +VCA2(3)*VCA2(3))
1017 :                VCA2(1)=VCA2(1)/XVCA
1018 :                VCA2(2)=VCA2(2)/XVCA
1019 :                VCA2(3)=VCA2(3)/XVCA
1020 :              ELSE
1021 :                VCA2(1)=XZER
1022 :                VCA2(2)=UN
1023 :                VCA2(3)=XZER
1024 :              ENDIF
1025 :              VCA3(1)=VF1(2)*VCA2(3)-VF1(3)*VCA2(2)
1026 :              VCA3(2)=VF1(3)*VCA2(1)-VF1(1)*VCA2(3)
1027 :              VCA3(3)=VF1(1)*VCA2(2)-VF1(2)*VCA2(1)
1028 :              SMAX(2)=XLTR(2)
1029 :              SMAX(3)=XLTR(3)
1030 :          ENDIF
1031 :       ELSE
1032 : C
1033 : C------------PAS DE DIRECTION IMPOSEE----------
1034 : C
1035 :         VCA1(1)=UN
1036 :         VCA1(2)=XZER
1037 :         VCA1(3)=XZER
1038 :         VCA2(1)=XZER
1039 :         VCA2(2)=UN
1040 :         VCA2(3)=XZER
1041 :         VCA3(1)=XZER
1042 :         VCA3(2)=XZER
1043 :         VCA3(3)=UN
1044 :         SMAX(1)=XLTR(1)
1045 :         SMAX(2)=XLTR(2)
1046 :         SMAX(3)=XLTR(3)
1047 :       ENDIF       
1048 : C
1049 : C========================================================================
1050 : C                      CALCUL DE DDEF0 ET SIGMA0
1051 : C                       DANS LE REPERE DE CALCUL
1052 : C                    RESULTAT NOTE : DDEF ET SIGMA
1053 : C========================================================================
1054 : C
1055 :       LECAS=1
1055 :       CALL OTTROT(SIGMA0,DDEF0,SIGMA,DDEF,VCA1,VCA2,VCA3,LECAS)
1056 : C
1057 :         IF(IIMPI.EQ.42) THEN
1058 :           WRITE(IOIMP,70016) (VCA1(I),I=1,3),(VCA2(I),I=1,3),
1059 :      &                       (VCA3(I),I=1,3)
1060 : 70016     FORMAT(2X,'VECTEUR VCA1 ',3(1X,1PE12.5)/
1061 :      &           2X,'VECTEUR VCA2 ',3(1X,1PE12.5)/
1062 :      &           2X,'VECTEUR VCA3 ',3(1X,1PE12.5)//)
1063 : *
1064 :           WRITE(IOIMP,77016) (SIGMA(I),I=1,6)
1065 : 77016     FORMAT(2X,'SIGMA0 EN REPERE CALCUL '/6(1X,1PE12.5)/)
1066 : *
1067 :           WRITE(IOIMP,77017) (DDEF(I),I=1,6)
1068 : 77017     FORMAT(2X,'DDEF0 EN REPERE CALCUL '/6(1X,1PE12.5)/)
1069 : *
1070 :           WRITE(IOIMP,73017) PRECIZ
1071 : 73017     FORMAT(2X,'PRECIZ = ',1PE12.5/)
1072 :           WRITE(IOIMP,77417) (SMAX(I),I=1,3)
1073 : 77417     FORMAT(2X,'  SMAX  ',3(1X,1PE12.5)//)
1074 :         ENDIF
1075 : C
1076 : C------------------------------------------------------------------------
1077 : C
1078 : C           VERIFICATIONS SUR L'ETAT INITIAL
1079 : C ZZZZ  A COMPLETER
1080 : C------------------------------------------------------------------------
1081 : C
1082 :             ICAZ=1
1082 :             CALL OTTEST(XINVL,W0,WMAX0,SMAX,SIGMA,XLTR,PRECIZ,
1083 :      &       BTR,WRUPT,IB,IGAU,ICAZ,KERRE)
1084 :             IF(KERRE.EQ.70) GO TO 2021
1085 : 
1086 : C
1087 : C
1088 : C========================================================================
1089 : C           LABEL DE DEBUT DES SOUS ITERATIONS INTERNES
1090 : C
1091 : C   CES SOUS-ITERATIONS DOIVENT REDUIRE L INCREMENT DE DEF DE MANIERE
1092 : C          A ANNULER TOUTES LES NON LINEARITES EVENTUELLES
1093 : C========================================================================
1094 : C
1094 :       CALL IANUL(IRESU,20)
1095 : *
1096 :       DO IC=1,3
1097 :          W(IC)=W0(IC)
1098 :          WMAX(IC)=WMAX0(IC)
1099 :          SMAX(IC)=SMAX0(IC)
1100 :       ENDDO
1101 : C
1102 : C========================================================================
1103 : C
1104 : C---------------------------ECOULEMENT-----------------------------------
1105 : C
1106 : C========================================================================
1107 : C
1107 :       CALL OTTOCA(SIGMA,DDEF,W,WMAX,XLAMC,
1108 :      &            SMAX,WRUPT,BILIN,SBILI,XLTR,XLCS,XINVL,
1109 :      &            WREOUV,YOUN,XNU,GFTR,GFCS,G,GS,BTR,XCOMP,
1110 :      &            NFISSU,NVF,XVF,TAU,IRESU,NRESU,
1111 :      &            SIGMAF,DDEFP,PRECIE,PRECIZ,MFR,KERRE)
1112 :       IF (KERRE.NE.0)  THEN
1113 :          PRINT *,'IB=',IB,'  IGAU=',IGAU
1114 :          GO TO 2021
1115 :       ENDIF
1116 : 
1117 : 
1118 : *
1119 :         IF(IIMPI.EQ.42) THEN
1120 :           WRITE(IOIMP,77031)
1121 : 77031     FORMAT('   SORTIE D OTTOCA  ' /)
1122 : *
1123 :           WRITE(IOIMP,77032) (W(I),I=1,3),(WMAX(I),I=1,3)
1124 : 77032     FORMAT('   W '/3(1X,1PE12.5)/' WMAX  '/3(1X,1PE12.5)/)
1125 : *
1126 :           WRITE(IOIMP,75630) (SMAX(I),I=1,3)
1127 : 75630     FORMAT('  SMAX'/3(1X,1PE12.5)/)
1128 : *
1129 :           WRITE(IOIMP,75631) NFISSU,NVF,NRESU,XLAMC
1130 : 75631     FORMAT('  NFISSU = ',I3,2X,'NVF = ',I3,2X,'NRESU=',I3/
1131 :      &      2X,'XLAMC=',1PE12.5//)
1132 :           WRITE(IOIMP,75632) (IRESU(I),I=1,NRESU)
1133 : 75632     FORMAT('  IRESU  = ',10I4/)
1134 :           WRITE(IOIMP,75633) ((XVF(I,J),I=1,3),J=1,3)
1135 : 75633     FORMAT('  TABLEAU XVF '/(3(1X,1PE12.5)/))
1136 :         ENDIF
1137 : *
1138 : C
1139 : C
1140 : C========================================================================
1141 : C            CALCUL DU RESTE DE L'INCREMENT DE DEFORMATION
1142 : C            ET MISE A JOUR DES VARIABLES INTERNES
1143 : C========================================================================
1144 : C
1145 : *
1146 :         TAURES=(UN-TAU)*TAURES
1147 : C
1148 :         IF(IIMPI.EQ.42) THEN
1149 :            WRITE(IOIMP,77039) TAU,TAURES
1150 : 77039      FORMAT(//2X,'VALEUR DE L INCREMENT ECOULEE  ' /
1151 :      &           /2X,' TAU = ',1PE12.5,2X,'TAURES=',1PE12.5/)
1152 :         ENDIF
1153 : *
1154 : *ZZZZZZZZZZZZZZZZ
1155 : *  EVENTUELLEMENT TESTER L'EGALITE DE TAU A 0. AUSSI
1156 : *ZZZZZZZZZZZZZZZZ
1157 : 
1158 :         IF(TAU.LT.0.D0) THEN
1159 :            WRITE(IOIMP,70069)
1160 : 70069      FORMAT(////2X,'###########  TAU NEGATIF ###########'////)
1161 :            KERRE=72
1162 :            GO TO 2021
1163 :         ENDIF
1164 : C
1165 : C---------------------------------------------------------------------
1166 : C       TEST SUR IRESU
1167 : C---------------------------------------------------------------------
1168 : C
1169 :         IF(NRESU.GT.1) THEN
1170 :           DO 43 IR=1,NRESU
1171 :              JRESU=IRESU(IR)
1172 :              DO 44 KR=1,NRESU
1173 :                 KRESU=IRESU(KR)
1174 :                 IF(KR.NE.IR.AND.JRESU.EQ.KRESU) THEN
1175 :                    WRITE(IOIMP,20069)
1176 : 20069              FORMAT(////2X,
1177 :      &     '###########  2 IRESU IDENTIQUES  ###########'////)
1178 :                    KERRE=73
1179 :                    GO TO 2021
1180 :                 ENDIF
1181 :  44         CONTINUE
1182 :  43       CONTINUE
1183 :         ENDIF
1184 : 
1185 : C
1186 : C
1187 : C========================================================================     
1188 : C
1189 : C-------------PRISE EN COMPTE DE LA NOUVELLE NON LINEARITE---------------
1190 : C
1191 : C========================================================================     
1192 : C
1193 : C
1194 :         DO 55 IR=1,NRESU
1195 :            JRESU=IRESU(IR)
1196 : *
1197 :            IF(IIMPI.EQ.42) THEN
1198 :               WRITE(IOIMP,74401) JRESU
1199 : 74401         FORMAT(/2X,'MISE A JOUR POUR JRESU = ',I4/)
1200 :            ENDIF
1201 : 
1202 : C
1203 : C-----------------FISSURATION---------------
1204 : C
1205 :         IF (JRESU.GE.1.AND.JRESU.LE.3) THEN
1206 : C
1207 :            NFISSU=NFISSU+1
1208 : C
1209 : C----------CALCUL DE VF , XINVL , SMAX DANS LE REPERE GLOBAL-------------
1210 : C
1211 :            XVFN=XVF(1,JRESU)**2 + XVF(2,JRESU)**2
1212 :      &        + XVF(3,JRESU)**2
1213 :            IF(XVFN.EQ.XZER) THEN
1214 :                WRITE(IOIMP,77027)    JRESU
1215 : 77027          FORMAT(2X,' ********  PB AVEC UN VECTEUR XVF !!!!  ' /
1216 :      &         2X,' DIRECTION = ',I3//)
1217 :                KERRE=70
1218 :                GO TO 2021
1219 :            ENDIF
1220 : *
1221 : *
1222 :            VF(1)=VCA1(1)*XVF(1,JRESU)+VCA2(1)*XVF(2,JRESU)
1223 :      &          +VCA3(1)*XVF(3,JRESU)
1224 :            VF(2)=VCA1(2)*XVF(1,JRESU)+VCA2(2)*XVF(2,JRESU)
1225 :      &          +VCA3(2)*XVF(3,JRESU)
1226 :            VF(3)=VCA1(3)*XVF(1,JRESU)+VCA2(3)*XVF(2,JRESU)
1227 :      &          +VCA3(3)*XVF(3,JRESU)
1228 :            XNF=VF(1)*VF(1)+VF(2)*VF(2)+VF(3)*VF(3)
1229 :            XL=TAIL(1)*VF(1)*VF(1)+TAIL(2)*VF(2)*VF(2)
1230 :            XL=XL+TAIL(3)*VF(3)*VF(3)+DEUX*TAIL(4)*VF(2)*VF(1)
1231 :            XL=XL+DEUX*TAIL(5)*VF(1)*VF(3)
1232 :            XL=XL+DEUX*TAIL(6)*VF(2)*VF(3)
1233 :            PASS=P(1)*VF(1)*VF(1)+P(2)*VF(2)*VF(2)+P(3)*VF(3)*VF(3)
1234 :            PASS=PASS+DEUX*P(4)*VF(2)*VF(1)+DEUX*P(5)*VF(1)*VF(3)
1235 :            PASS=PASS+DEUX*P(6)*VF(2)*VF(3)
1236 :            IF (XL.NE.XZER) THEN
1237 :               XTAILLE=ABS(PASS/XL)
1238 :               IF (XTAILLE.LE.((UN+XNU)*XLTR(JRESU)*XLTR(JRESU)
1239 :      &          /(DEUX*GFTR(JRESU)*YOUN))) THEN
1240 :                  KERRE=61
1241 :                  GO TO 2021
1242 :               ENDIF
1243 :            ELSE
1244 :               XTAILLE=UN
1245 :            ENDIF
1246 : C
1247 : *********  SMAX(JRESU) =XLTR(JRESU)
1248 : *********  WMAX(JRESU) =W(JRESU)
1249 :            XINVL(JRESU)=XTAILLE
1250 : C
1251 : C    MISE A JOUR DES DIRECTIONS DE FISSURE DANS LES VARIABLES INTERNES
1252 : C
1253 : C----------------------------------------
1254 : C         MATERIAU NON FISSURE
1255 : C----------------------------------------
1256 : C
1257 :            IF (NFISSU.EQ.1) THEN
1258 :               IF (NVF.EQ.0) THEN
1259 :                  VF1(1)=VF(1)
1260 :                  VF1(2)=VF(2)
1261 :                  VF1(3)=VF(3)
1262 :                  XNF1=XNF
1263 :                  GOTO 55
1264 :               ENDIF
1265 :               IF (NVF.EQ.1.AND.JRESU.EQ.1) THEN
1266 :                  NVF=NVF-1
1267 :                  GOTO 55
1268 :               ENDIF
1269 :               IF (NVF.EQ.1.AND.JRESU.NE.1) THEN
1270 :                  VF2(1)=VF(1)
1271 :                  VF2(2)=VF(2)
1272 :                  VF2(3)=VF(3)
1273 :                  XNF2=XNF
1274 :                  GOTO 55
1275 :               ENDIF
1276 :               IF (NVF.EQ.2.AND.JRESU.EQ.3) THEN
1277 :                  VF3(1)=VF(1)
1278 :                  VF3(2)=VF(2)
1279 :                  VF3(3)=VF(3)
1280 :                  XNF3=XNF
1281 :                  GOTO 55
1282 :               ENDIF
1283 :               IF (NVF.EQ.2.AND.JRESU.NE.3) THEN
1284 :                  NVF=NVF-1
1285 :                  GOTO 55
1286 :               ENDIF
1287 :               IF (NVF.EQ.3) THEN
1288 :                  NVF=NVF-1
1289 :                  GOTO 55
1290 :               ENDIF
1291 :            ENDIF
1292 : C
1293 : C------------------------------------------
1294 : C      UNE FISSURE AU PREALABLE
1295 : C------------------------------------------
1296 : C
1297 :            IF (NFISSU.EQ.2) THEN
1298 :               IF (NVF.EQ.0) THEN
1299 :                  VF2(1)=VF(1)
1300 :                  VF2(2)=VF(2)
1301 :                  VF2(3)=VF(3)
1302 :                  XNF2=XNF
1303 :                  GOTO 55
1304 :               ENDIF
1305 :               IF (NVF.EQ.1.AND.JRESU.EQ.3) THEN
1306 :                  VF3(1)=VF(1)
1307 :                  VF3(2)=VF(2)
1308 :                  VF3(3)=VF(3)
1309 :                  XNF3=XNF
1310 :                  GOTO 55
1311 :               ENDIF
1312 :               IF (NVF.EQ.1.AND.JRESU.NE.3) THEN
1313 :                  NVF=NVF-1
1314 :                  GOTO 55
1315 :               ENDIF
1316 :               IF (NVF.EQ.2) THEN
1317 :                  NVF=NVF-1
1318 :                  GOTO 55
1319 :               ENDIF
1320 :            ENDIF
1321 : C
1322 : C------------------------------------------
1323 : C   DEUX FISSURES PRE EXISTANTES
1324 : C------------------------------------------
1325 : C
1326 :            IF (NFISSU.EQ.3) THEN
1327 :               IF (NVF.EQ.1) THEN
1328 :                  NVF=0
1329 :                  GOTO 55
1330 :               ENDIF
1331 :               IF (JRESU.EQ.1) THEN
1332 :                  VF1(1)=VF(1)
1333 :                  VF1(2)=VF(2)
1334 :                  VF1(3)=VF(3)
1335 :                  XNF1=XNF
1336 :                  GOTO 55
1337 :               ENDIF
1338 :               IF (JRESU.EQ.2) THEN
1339 :                  VF2(1)=VF(1)
1340 :                  VF2(2)=VF(2)
1341 :                  VF2(3)=VF(3)
1342 :                  XNF2=XNF
1343 :                  GOTO 55
1344 :               ENDIF
1345 :               IF (JRESU.EQ.3) THEN
1346 :                  VF3(1)=VF(1)
1347 :                  VF3(2)=VF(2)
1348 :                  VF3(3)=VF(3)
1349 :                  XNF3=XNF
1350 :                  GOTO 55
1351 :               ENDIF
1352 :            ENDIF
1353 :         ENDIF
1354 : C
1355 : C#################################################################
1356 : C     TRAITEMENT DES AUTRES NON LINEARITES POSSIBLES
1357 : C#################################################################
1358 : C
1359 : C-------------------RUPTURE-----------------
1360 : C
1361 : C       IF (JRESU.GE.4.AND.JRESU.LE.6) THEN
1362 : C          WMAX(JRESU-3)=WRUPT(JRESU-3)
1363 : C          SMAX(JRESU-3)=XZER
1364 : C          W(JRESU-3)=WMAX(JRESU-3)
1365 : C          GOTO 55
1366 : C       ENDIF
1367 : C
1368 : C------------------BETON FIBRE--------------
1369 : C
1370 : C       IF (JRESU.GE.7.AND.JRESU.LE.9) THEN
1371 : C           WMAX(JRESU-6)=BILIN(JRESU-6)
1372 : C           SMAX(JRESU-6)=SBILI(JRESU-6)
1373 : C           W(JRESU-6)=WMAX(JRESU-6)
1374 : C           GOTO 55
1375 : C       ENDIF
1376 : C
1377 : C------------------OUVERTURE----------------
1378 : C
1379 : C       IF (JRESU.GE.10.AND.JRESU.LE.12) THEN
1380 : C          WMAX(JRESU-9)=WMAX0(JRESU-9)
1381 : C          SMAX(JRESU-9)=SMAX0(JRESU-9)
1382 : CC         W(JRESU-9)=WMAX(JRESU-9)
1383 : CC         GOTO 55
1384 : C       ENDIF
1385 : C
1386 : C-----------------COMPRESSION---------------
1387 : C
1388 : C       IF (JRESU.GE.13.AND.JRESU.LE.15) THEN
1389 : C  MLR 13/12/94
1390 : C          W(JRESU-12)=BTR*MIN(WMAX0(JRESU-12),WRUPT(JRESU-12))
1391 : C  MLR 16/4/98
1392 : C          SIGMAF(JRESU-12)=XZER
1393 : C          GOTO 55
1394 : CC      ENDIF
1395 : C
1396 : C-----------------REOUVERTURE---------------
1397 : C
1398 : C       IF (JRESU.GE.16.AND.JRESU.LE.18) THEN
1399 : *  MLR 13/12/94
1400 : C          W(JRESU-15)=BTR*MIN(WMAX0(JRESU-15),WRUPT(JRESU-15))
1401 : C          SIGMAF(JRESU-15)=XZER
1402 : C          GOTO 55
1403 : C       ENDIF
1404 : C
1405 : C
1406 : C
1407 : C========================================================================
1408 : C                   FIN DU TEST DE CONSISTANCE
1409 : C========================================================================
1410 : C
1411 : 
1412 :   55  CONTINUE
1413 : 
1414 : C
1415 : C   QUELQUES TESTS SUPPLEMENTAIRES
1416 : C
1417 : 
1418 :         IF(IIMPI.EQ.42) THEN
1419 :           WRITE(IOIMP,77441) (SMAX(I),I=1,3)
1420 : 77441     FORMAT('0  SMAX   '/3(1X,1PE12.5)/)
1421 :         ENDIF
1422 : 
1423 : *
1424 : * AFFINAGE DE WMAX ( CF TEST OTTOFU )
1425 : * MLR  8/7/98
1426 : 
1427 :         DO I=1,3
1428 :             IF(ABS(WMAX(I)-WRUPT(I)).LT.WRUPT(I)*PRECIE) THEN
1429 :                 WMAX(I)=WRUPT(I)
1430 :             ENDIF
1431 :         ENDDO
1432 : *
1433 :         ICAZ=2
1433 :         CALL OTTEST(XINVL,W,WMAX,SMAX,SIGMAF,XLTR,PRECIZ,
1434 :      &              BTR,WRUPT,IB,IGAU,ICAZ,KERRE)
1435 :         IF(KERRE.EQ.70) GO TO 2021
1436 : *
1437 :       DO 202 I=1,3
1438 :         IF(WMAX(I).GE.WRUPT(I)) THEN
1439 :           IF(W(I).GE.WREOUV(I)) THEN
1440 :             IF(SIGMAF(I).GT.0.D0) THEN
1441 :               IF(SIGMAF(I).GT.PRECIZ*10.D0) THEN
1442 :                 WRITE(IOIMP,77202) SIGMAF(I)
1443 : 77202           FORMAT(2X,' ********  SIGMA TROP FORT = ',1PE12.5/)
1444 :               ENDIF
1445 :               SIGMAF(I)=0.D0
1446 :             ENDIF
1447 :           ENDIF
1448 : *  MLR 22/11/96
1449 :           IF(DDEFP(I).GT.0.D0) THEN
1450 :              IF(DABS(SIGMAF(I)).LT.PRECIZ) SIGMAF(I)=0.D0
1451 :           ENDIF
1452 :         ENDIF
1453 : 202   CONTINUE
1454 : 
1455 : *
1456 : C
1457 : C
1458 : C=======================================================================
1459 : C            CALCUL DE SIGMAF ET DDEFP DANS LE REPERE GLOBAL
1460 : C                    RESULTAT NOTE : SIGF0 ET DDEFP0
1461 : C=======================================================================
1462 : C
1463 :       LECAS=2
1463 :       CALL OTTROT(SIGMAF,DDEFP,SIGF0,DDEFP0,VCA1,VCA2,VCA3,LECAS)
1464 : C
1465 :         IF(IIMPI.EQ.42) THEN
1466 :           WRITE(IOIMP,77040) (SIGF0(I),I=1,6)
1467 : 77040     FORMAT('0  SIGF EN REPERE GLOBAL '/6(1X,1PE12.5)/)
1468 : *
1469 :           WRITE(IOIMP,77041) (DDEFP0(I),I=1,6)
1470 : 77041     FORMAT('0  DDEFP EN REPERE GLOBAL '/6(1X,1PE12.5)/)
1471 :         ENDIF
1472 : C
1473 : C
1474 : C========================================================================
1475 : C   MISE A JOUR DE L ETAT DU MATERIAU POUR UN NOUVEL INCREMENT INTERNE
1476 : C========================================================================
1477 : C
1478 :       DO 54 IC=1,6
1479 :          SIGMA0(IC)=SIGF0(IC)
1480 :          DDEF0(IC)=(UN-TAU)*DDEF0(IC)
1481 :          DDEFPT(IC)=DDEFPT(IC)+DDEFP0(IC)
1482 :   54  CONTINUE
1483 : C
1484 : C
1485 : C========================================================================
1486 : C            TEST L ADMISSIBILITE DU DERNIER ECOULEMENT
1487 : C========================================================================
1488 : C
1489 : C    AM  30/04/96  REMPLACEMENT DE EPSILO PAR EPSIL2
1490 : C
1491 :       IF (TAURES.GT.EPSIL2) GOTO 31
1492 : C
1493 : C########################################################################
1494 : C========================================================================
1495 : C
1496 : C      C EST FINI, LES DEF PLASTIQUES SONT DONNEES PAR      :  DDEFPT
1497 : C                  LES CONTRAINTES FINALES SONT DONNEES PAR :  SIGMA0
1498 : C
1499 : C========================================================================
1500 : C########################################################################
1501 : C
1502 : C------------------------------------------------------------------------
1503 : 
1504 : *
1505 : 
1506 :       DO 658 I=1,3
1507 :          IF(XINVL(I).NE.0.D0) THEN
1508 :            WREOUV(I)=BTR*MIN(WMAX(I),WRUPT(I))
1509 :            IF(W(I).LT.WREOUV(I)-1.D-10*WRUPT(I))  THEN
1510 :            WRITE(IOIMP,67676) I,W(I),WMAX(I)
1511 : 67676      FORMAT(2X,'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' /
1512 :      &     4X,'ATTENTION FINALE I=',I4,2X,'W=',1PE12.5,2X,
1513 :      &                       'WMAX=',1PE12.5/
1514 :      &            2X,'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$'/)
1515 :           ENDIF
1516 :           ENDIF
1517 : 
1518 : 658   CONTINUE
1519 : 
1520 : C------------------------------------------------------------------------
1521 : C
1522 : C########################################################################
1523 : C========================================================================
1524 : C                 MISE A JOUR DES VARIABLES INTERNES
1525 : C========================================================================
1526 : C########################################################################
1527 : C
1528 : C============================================
1529 : C-------CAS TRIDIMENSIONNEL MASSIF-----------
1530 : C============================================
1531 : C
1532 : C            NVARI=20    cf. IDVAR6
1533 : C
1534 :       IF (IFOUR.EQ.2.AND.MFR.EQ.1) THEN
1535 :          DO 60 IC=1,3
1536 :             VARF(IC+1) =WMAX(IC)
1537 :             VARF(IC+4) =W(IC)
1538 :             VARF(IC+7) =VF1(IC)
1539 :             VARF(IC+10)=VF2(IC)
1540 :             VARF(IC+13)=VF3(IC)
1541 :             VARF(IC+16)=XINVL(IC)
1542 :  60      CONTINUE
1543 : *
1544 :             VARF(20)=XLAMC
1545 : *
1546 : C DANS LE CAS DU MODELE CERAMIQUE ON NE TOUCHE PAS AUX VARIABLES
1547 : C INTERNES CORRESPONDANT AU FLUAGE
1548 :          IF (MATEPL.EQ.65) THEN
1549 :             DO 160 I=21,NVARI
1550 :                VARF(I)=VAR0(I)
1551 : 160         CONTINUE
1552 :          ENDIF
1553 : C DANS LE CAS DU MODELE UO2_DCN ON NE TOUCHE PAS AUX VARIABLES
1554 : C INTERNES CORRESPONDANT AU FLUAGE
1555 :          IF (MATEPL.EQ.108) THEN
1556 :             VARF(NVARI-2)=VAR0(NVARI-2)
1557 :             VARF(NVARI-1)=VAR0(NVARI-1)
1558 :             VARF(NVARI)=VAR0(NVARI)
1559 :          ENDIF
1560 : *
1561 :       ENDIF
1562 : C
1563 : C============================================
1564 : C-------------CAS CONT PLANE-----------------
1565 : C---------OU TRIDIM COQUES MINCES -----------
1566 : C============================================
1567 : C
1568 : C            NVARI=12    cf. IDVAR6
1569 : C
1570 :       IF (IFOUR.EQ.-2.OR.
1571 :      .    (IFOUR.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)))THEN
1572 :          DO 62 IC=1,2
1573 :             VARF(IC+1) =WMAX(IC+1)
1574 :             VARF(IC+3) =W(IC+1)
1575 :             VARF(IC+5) =VF2(IC)
1576 :             VARF(IC+7) =VF3(IC)
1577 :             VARF(IC+9) =XINVL(IC+1)
1578 :  62      CONTINUE
1579 : *
1580 :          VARF(12)=XLAMC
1581 : *
1582 : C DANS LE CAS DU MODELE CERAMIQUE ON NE TOUCHE PAS AUX VARIABLES
1583 : C INTERNES CORRESPONDANT AU FLUAGE
1584 :          IF (MATEPL.EQ.65) THEN
1585 :             DO 162 I=13,NVARI
1586 :                VARF(I)=VAR0(I)
1587 : 162         CONTINUE
1588 :          ENDIF
1589 : C DANS LE CAS DU MODELE UO2_DCN ON NE TOUCHE PAS AUX VARIABLES
1590 : C INTERNES CORRESPONDANT AU FLUAGE
1591 :          IF (MATEPL.EQ.108) THEN
1592 :             VARF(NVARI-2)=VAR0(NVARI-2)
1593 :             VARF(NVARI-1)=VAR0(NVARI-1)
1594 :             VARF(NVARI)=VAR0(NVARI)
1595 :          ENDIF
1596 : *
1597 :       ENDIF
1598 : C
1599 : C============================================
1600 : C-----------CAS DEFO PLANE/AXIS--------------
1601 : C============================================
1602 : C
1603 : C            NVARI=15    cf. IDVAR6
1604 : C
1605 :       IF (IFOUR.EQ.0.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
1606 :          DO 64 IC=1,2
1607 :             VARF(IC+1) =WMAX(IC+1)
1608 :             VARF(IC+4) =W(IC+1)
1609 :             VARF(IC+7) =VF2(IC)
1610 :             VARF(IC+9) =VF3(IC)
1611 :             VARF(IC+11)=XINVL(IC+1)
1612 :  64      CONTINUE
1613 :          VARF(4) =WMAX(1)
1614 :          VARF(7) =W(1)
1615 :          VARF(14)=XINVL(1)
1616 :          VARF(15)=XLAMC
1617 : *
1618 : C DANS LE CAS DU MODELE CERAMIQUE ON NE TOUCHE PAS AUX VARIABLES
1619 : C INTERNES CORRESPONDANT AU FLUAGE
1620 :          IF (MATEPL.EQ.65) THEN
1621 :             DO 164 I=16,NVARI
1622 :                VARF(I)=VAR0(I)
1623 : 164         CONTINUE
1624 :          ENDIF
1625 : C DANS LE CAS DU MODELE UO2_DCN ON NE TOUCHE PAS AUX VARIABLES
1626 : C INTERNES CORRESPONDANT AU FLUAGE
1627 :          IF (MATEPL.EQ.108) THEN
1628 :             VARF(NVARI-2)=VAR0(NVARI-2)
1629 :             VARF(NVARI-1)=VAR0(NVARI-1)
1630 :             VARF(NVARI)=VAR0(NVARI)
1631 :          ENDIF
1632 : *
1633 :       ENDIF
1634 : C
1635 :       VARF(1)=W(1)+W(2)+W(3)
1636 : C
1637 : C========================================================================
1638 : C---------PASSAGE A L'OPTION DE CALCUL POUR LES CONTRAINTES--------------
1639 : C======================================================================== 
1640 : C
1641 :       IF (IFOUR.EQ.2.AND.MFR.EQ.1) THEN
1642 : C
1643 : C----------MASSIF 3D----------------
1644 : C
1645 :         DO 70 I=1,6
1646 :           SIGF(I)=SIGMA0(I)
1647 :           IF(I.LE.3) THEN
1648 :             DEFP(I)=DDEFPT(I)
1649 :           ELSE
1650 :             DEFP(I)=DDEFPT(I)*DEUX
1651 :           ENDIF
1652 :  70     CONTINUE
1653 :       ELSE IF (IFOUR.NE.2.AND.MFR.EQ.1) THEN
1654 : C
1655 : C---AXISYMETRQUE/DEF/CONT PLANES----
1656 : C
1657 :         DO 80 I=1,4
1658 :           SIGF(I)=SIGMA0(I)
1659 :           IF(I.LE.3) THEN
1660 :             DEFP(I)=DDEFPT(I)
1661 :           ELSE
1662 :             DEFP(I)=DDEFPT(I)*DEUX
1663 :           ENDIF
1664 :  80     CONTINUE 
1665 :         IF (ABS(SIGMA0(5)).GT.(YOUN*1.D-15).OR.
1666 :      &      ABS(SIGMA0(6)).GT.(YOUN*1.D-15)) THEN
1667 : C
1668 : C             SMRT OU SMTZ NON NULLES APRES ECOULEMENT
1669 : C
1670 :            KERRE=68
1671 :            GO TO 2021
1672 :         ENDIF
1673 : C
1674 :         ELSEIF (IFOUR.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
1675 : C
1676 : C-----CALCUL TRIDIM COQUES MINCES -------
1677 : C
1678 : C     ON MET A JOUR DE FACON NON LINEAIRE LA PARTIE MEMBRANE
1679 : C     ET DE FACON LINEAIRE, LES PARTIES FLEXION ET EFFORTS
1680 : C     TRANCHANTS LE CAS ECHEANT
1681 : C
1682 :           FAC=(EPAI**3)/12.D0
1683 :           AUX =FAC*YOUN/(UN-XNU*XNU)
1684 :           AUX1=FAC*YOUN*UNDEMI/(UN+XNU)
1685 :           SIGF(1)=SIGMA0(1)*EPAI
1686 :           SIGF(2)=SIGMA0(2)*EPAI
1687 :           SIGF(3)=SIGMA0(4)*EPAI
1688 :           SIGF(4)=SIG0(4)+AUX*(DEPST(4)+XNU*DEPST(5))
1689 :           SIGF(5)=SIG0(5)+AUX*(DEPST(5)+XNU*DEPST(4))
1690 :           SIGF(6)=SIG0(6)+AUX1*DEPST(6)
1691 :           DEFP(1)=DDEFPT(1)
1692 :           DEFP(2)=DDEFPT(2)
1693 :           DEFP(3)=DDEFPT(4)
1694 :           DEFP(4)=0.D0
1695 :           DEFP(5)=0.D0
1696 :           DEFP(6)=0.D0
1697 :           IF(MFR.EQ.9) THEN
1698 :             XK=1.2D0
1699 :             AUX2=EPAI*YOUN*UNDEMI/(UN+XNU)/XK
1700 :             SIGF(7)=SIG0(7)+AUX2*DEPST(7)
1701 :             SIGF(8)=SIG0(8)+AUX2*DEPST(8)
1702 :             DEFP(7)=0.D0
1703 : 
1704 :             DEFP(8)=0.D0
1705 :           ENDIF
1706 :       ENDIF
1707 : C
1708 :         IF(IIMPI.EQ.42) THEN
1709 :           WRITE(IOIMP,77051) (SIGF(I),I=1,NSTRS)
1710 : 77051     FORMAT('0  SIGF  '/8(1X,1PE12.5)/)
1711 : *
1712 :           WRITE(IOIMP,77052) (DEFP(I),I=1,NSTRS)
1713 : 77052     FORMAT('0  DEFP  '/8(1X,1PE12.5)/)
1714 :         ENDIF
1715 : C
1716 :  2021 CONTINUE
1717 :       IF(KERRE.EQ.0) GO TO 9999
1718 : C
1719 :       IF(JEBOUC.EQ.1.AND.IIMPI.EQ.1042) THEN
1720 :         IIMPI=42
1721 :         WRITE(IOIMP,70901) IB,IGAU
1722 : 70901   FORMAT(2X,'>>>>>>>>   OTTOSEN  IB=',I7,2X,'IGAU=',I3/)
1723 :         GO TO 2020
1724 :       ENDIF
1725 : C
1726 : 9999  CONTINUE
1727 :       IIMPI=IIMPI0
1728 : 
1729 :       IF(KERRE.NE.0.AND.IIMPI.EQ.42) THEN
1730 :           WRITE(IOIMP,70902) IB,IGAU
1731 : 70902     FORMAT(2X,'SORTIE OTTOSEN '////)
1732 :       ENDIF
1733 : C
1734 :       RETURN
1735 :       END     
1736 :  
1737 :   
1738 :  
1739 :  

© Cast3M 2003 - All rights reserved.
Disclaimer