Télécharger la plaquette Cast3M


fr en

Télécharger uo2oto.eso

Retour à la liste

Numérotation des lignes : 

uo2oto

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

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