Télécharger la plaquette Cast3M


fr en

Télécharger mazars.eso

Retour à la liste

Numérotation des lignes : 

mazars

  1. C MAZARS    SOURCE    CHAT      05/01/13    01:38:20     5004
  2.       SUBROUTINE MAZARS (WRK0,WRK1,WRKK2,WRK5,NSTRS,NVARI,
  3.      1                   NMATT,ISTEP,ICARA,JDIM,IFOUR2)
  4. C
  5. C
  6. C     variables en entree
  7. C
  8. C
  9. C     WRK0     pointeur sur un segment deformation au pas precedent
  10. C
  11. C     WRK1     pointeur sur un segment increment de deformation
  12. C
  13. C     WRKK2     pointeur sur un segment variables internes au pas precedent
  14. C
  15. C     WRK5      pointeur sur un segment de deformations inelastiques
  16. C
  17. C     XMATER     constantes du materiau
  18. C
  19. C     NSTRS      nombre de composantes dans les vecteurs des contraintes
  20. C                                        et les vecteurs des deformations
  21. C
  22. C     NVARI      nombre de variables internes (doit etre egal a 2)
  23. C
  24. C     NMATT      nombre de constantes du materiau
  25. C
  26. C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
  27. C                ISTEP=0 -----> calcul local
  28. C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
  29. C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
  30. C                               a partir des seuils moyennes
  31. C
  32. C Modif L.Bode - 14/10/92
  33. C Nouveaux parametres en entree
  34. C     JDIM       Dimension de travail
  35. C                ( Coques JDIM =2 , Massifs JDIM = IDIM )
  36. C     IFOUR2     Type de formulation
  37. C                ( Coques IFOUR2 = -2 => contraintes planes ,
  38. C                  Massifs IFOUR2 = IFOUR)
  39. C
  40. C     variables en sortie
  41. C
  42. C     VARINF      variables internes finales
  43. C
  44. C     SIGMAF      contraintes finales
  45. C
  46. C     C. LA BORDERIE MARS 1992
  47. C     declaration des variables
  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.       SEGMENT WRK0
  56.         REAL*8 XMAT(NMATT)
  57.       ENDSEGMENT
  58. *
  59.       SEGMENT WRK1
  60.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  61.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  62.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  63.       ENDSEGMENT
  64.       SEGMENT WRKK2
  65.          REAL*8 EPSILI(NSTRS),DSIGT(NSTRS)
  66.       ENDSEGMENT
  67. C Modif L.Bode - 14/10/92
  68.       SEGMENT WRK3
  69.         REAL*8 EPSILO(NSTRS)
  70.       ENDSEGMENT
  71. C Definition dynamique de EPSILO
  72. C Fin modif L.Bode
  73.       SEGMENT WRK5
  74.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  75.       ENDSEGMENT
  76.       CHARACTER*8 CMATE
  77.       INTEGER NSTRS,NVARI,NMATT,ISTEP
  78.       REAL*8 EPS33(3,3),EPSIPP(3),EPSILT(3),VALP33(3,3)
  79.       REAL*8 SIGP(3),SIGPT(3),SIGPC(3),TRSIGT,TRSIGC
  80.       REAL*8 YOUN,XNU,EPSD0,ACOM,BCOM,ATRA,BTRA,BETA
  81.       INTEGER ISTRS,JSTRS,KCAS,IRTD
  82.       REAL*8 XZERO,UN,DEUX,XPETIT
  83.       REAL*8 DINI,D,DT,DC,EPSTIL,EPSTIM,ALFAT,ALFAC,GAMMA
  84.       PARAMETER (XZERO=0.D0 , UN=1.D0 , DEUX=2.D0, XPETIT=1.D-12)
  85.  
  86. C
  87. C
  88. C     recuperation des variables initiales dans les tableaux
  89. C
  90. C
  91.       N=NSTRS
  92.       CMATE = 'ISOTROPE'
  93.       YOUN = XMAT(1)
  94.       XNU  = XMAT(2)
  95.       EPSD0= XMAT(5)
  96.       ACOM = XMAT(6)
  97.       BCOM = XMAT(7)
  98.       ATRA = XMAT(8)
  99.       BTRA = XMAT(9)
  100.       BETA = XMAT(10)
  101.       DINI = VAR0(2)
  102.  
  103. C
  104. C     calcul des seuils
  105. C
  106. C
  107. C        calcul de la deformation totale
  108. C
  109.       SEGINI WRK3
  110.       DO 100 ISTRS=1,NSTRS
  111.          EPSILO(ISTRS)=EPSILI(ISTRS)+DEPST(ISTRS)
  112. 100   CONTINUE
  113. C
  114. C        calcul des deformations principales
  115. C
  116. C
  117. C        on reecrit les deformations sous forme matricielle
  118. C
  119. C Modif L.Bode - 14/10/92
  120. C Rajout de IFOUR2 en argument de ENDOCA
  121. *      print*,'on appelle ENDOCB'
  122.       CALL ENDOCB (EPSILO,EPS33,2,IFOUR2)
  123. *      print*,'apres endocb'
  124. C Fin modif L.Bode
  125. C
  126. C        et on diagonalise
  127. C
  128. C Modif L.Bode - 14/10/92
  129. C Pour les elts Coques, on travaille en contraintes planes => JDIM =2
  130. C Pour les elts Massifs JDIM =IDIM
  131. *      print*,'avant JACOB3'
  132.       CALL JACOB3 (EPS33,JDIM,EPSIPP,VALP33)
  133. *      print*,'apres JACOB3'
  134. C Fin modif L.Bode
  135.       IF (ISTEP .EQ. 0 .OR. ISTEP.EQ.2) THEN
  136. C
  137. C       on calcule la matrice de hooke et les contraintes ppales
  138. C
  139.          CMATE = 'ISOTROPE'
  140.          KCAS=1
  141. C Modif L.Bode - 14/10/92
  142. C IFOUR --> IFOUR2 dans appel DOHMAS
  143. *         print*,'avant dohmas'
  144.          CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRS,KCAS,DDHOOK,IRTD)
  145. *         print*,'apres dohmas'
  146. C Fin modif L.Bode
  147.          DO 200 ISTRS=1,3
  148.             SIGP(ISTRS)= XZERO
  149.             DO 210 JSTRS=1,3
  150.                SIGP(ISTRS)=SIGP(ISTRS)+DDHOOK(ISTRS,JSTRS)*EPSIPP(JSTRS)
  151. 210         CONTINUE
  152. 200      CONTINUE
  153.       END IF
  154. C
  155. C        on complete la deformation dans le cas des contraintes planes
  156. C
  157. C Modif L.Bode - 14/10/92
  158. C IFOUR remplace par IFOUR2
  159.       IF (IFOUR2.EQ. -2) THEN
  160.          EPSIPP(3)= -(EPSIPP(1) + EPSIPP(2))*XNU / (UN-XNU)
  161.       END IF
  162. C Fin modif L.Bode
  163. C
  164. C        on calcule le epsilontild
  165. C
  166.       EPSTIL=MAX( XZERO , EPSIPP(1) )**2 +
  167.      1       MAX( XZERO , EPSIPP(2) )**2 +
  168.      2       MAX( XZERO , EPSIPP(3) )**2
  169.       EPSTIL=SQRT (EPSTIL)
  170.  
  171.       IF (ISTEP .EQ. 0) THEN
  172.          EPSTIM=EPSTIL
  173.          VARF(1)=EPSTIL
  174.       ELSE IF (ISTEP .EQ. 1) THEN
  175.          VARF(2)=DINI
  176.          VARF(1)=EPSTIL
  177.       ELSE IF (ISTEP .EQ. 2) THEN
  178.          EPSTIM=VAR0(1)
  179.          VARF(1)=EPSTIM
  180.       ELSE
  181.          PRINT*,'DANS MAZARS ISTEP = 0,1,2 ET PAS ',ISTEP
  182.       END IF
  183.       IF ( (ISTEP .EQ. 0) .OR. (ISTEP .EQ. 2)) THEN
  184. C
  185. C      on calcule l'endommagement et les contraintes
  186. C
  187. C
  188. C        on calcule ALFAT ALFAC DT et DC puis D
  189. C        dans le cas ou le seuil initial est depasse
  190. C
  191.          IF ( EPSTIM .GT. EPSD0) THEN
  192. C
  193. C      calcul de l'endommagement
  194. C
  195. C
  196. C        on calcule le signe des contraintes elastiques
  197. C
  198.             DO 300 ISTRS=1,3
  199.                IF (SIGP(ISTRS).LT. XZERO) THEN
  200.                   SIGPC(ISTRS)=SIGP(ISTRS)
  201.                   SIGPT(ISTRS)=XZERO
  202.                ELSE
  203.                   SIGPT(ISTRS)=SIGP(ISTRS)
  204.                   SIGPC(ISTRS)=XZERO
  205.                END IF
  206. 300         CONTINUE
  207.             TRSIGT=SIGPT(1)+SIGPT(2)+SIGPT(3)
  208.             TRSIGC=SIGPC(1)+SIGPC(2)+SIGPC(3)
  209. C
  210. C        on calcule les deformations dues aux contraintes positives
  211. C
  212.             DO 400 ISTRS=1,3
  213.                EPSILT(ISTRS)=(SIGPT(ISTRS)*(UN+XNU)-TRSIGT*XNU)/YOUN
  214. 400         CONTINUE
  215. C
  216. C        on en deduit ALFAT et ALFAC
  217. C
  218.             ALFAT = MAX(XZERO,EPSIPP(1))*EPSILT(1) +
  219.      1              MAX(XZERO,EPSIPP(2))*EPSILT(2) +
  220.      2              MAX(XZERO,EPSIPP(3))*EPSILT(3)
  221.             ALFAT = ALFAT/(EPSTIL*EPSTIL)
  222.             ALFAC = UN - ALFAT
  223. C
  224. C       modification pour la bi ou tricompression
  225. C
  226.             IF (TRSIGC.LT. -XPETIT .AND. TRSIGT.LT.XPETIT) THEN
  227.                GAMMA=SIGPC(1)*SIGPC(1)+SIGPC(2)*SIGPC(2)+
  228.      1                                 SIGPC(3)*SIGPC(3)
  229.                GAMMA=-SQRT(GAMMA)/TRSIGC
  230.                EPSTIM=EPSTIM*GAMMA
  231.             END IF
  232. C
  233. C        amelioration de la reponse en cisaillement pour beta > 1.
  234. C
  235.             IF (BETA .GT. UN) THEN
  236.                IF ( ALFAT .GT. XPETIT ) THEN
  237.                   ALFAT=ALFAT**BETA
  238.                END IF
  239.                IF ( ALFAC .GT. XPETIT ) THEN
  240.                   ALFAC=ALFAC**BETA
  241.                END IF
  242.             END IF
  243.  
  244. C
  245. C        on calcule DT et DC puis D
  246. C        dans le cas ou le seuil initial est depasse
  247. C
  248. C        on est oblige de verifier car on a pu multiplier par gamma
  249. C
  250.             IF (EPSTIM .GT. EPSD0) THEN
  251.                DT=UN - EPSD0*(UN-ATRA)/EPSTIM -
  252.      1            ATRA*EXP(-BTRA*(EPSTIM-EPSD0))
  253.                DC=UN - EPSD0*(UN-ACOM)/EPSTIM -
  254.      1            ACOM*EXP(-BCOM*(EPSTIM-EPSD0))
  255.             ELSE
  256.                DT=XZERO
  257.                DC=XZERO
  258.             END IF
  259.             D = ALFAT*DT + ALFAC*DC
  260. C
  261. C           on borne la valeur de D a 0.99999
  262. C
  263.             D=MIN ( D , UN-1.D-05 )
  264.          ELSE
  265.             D=XZERO
  266.          END IF
  267. C
  268. C           on teste la croissance de D
  269. C
  270.          D=MAX ( D , DINI )
  271. C
  272. C           on le stocke dans les variables internes finales
  273. C
  274.          VARF(2)= D
  275. C
  276. C           on calcule les contraintes finales
  277. C
  278.          CALL MATVE1 (DDHOOK,EPSILO,NSTRS,NSTRS,SIGF,2)
  279.          DO 500 ISTRS=1,NSTRS
  280.             SIGF(ISTRS)=SIGF(ISTRS)*(UN-D)
  281. 500      CONTINUE
  282. C
  283. C         et les deformations inelastiques finales
  284. C
  285.          DO 600 ISTRS=1,NSTRS
  286.             EPINF(ISTRS)=EPSILO(ISTRS)*D
  287. 600      CONTINUE
  288.  
  289.       END IF
  290.       SEGSUP WRK3
  291.       RETURN
  292.       END
  293.  
  294.  
  295.  
  296.  

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