Télécharger la plaquette Cast3M


fr en

Télécharger ottose.eso

Retour à la liste

Numérotation des lignes : 

ottose

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

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