Télécharger la plaquette Cast3M


fr en

Télécharger cmicri.eso

Retour à la liste

Numérotation des lignes : 

cmicri

  1. C CMICRI    SOURCE    PV        17/12/08    21:16:06     9660           
  2. C MICROI    SOURCE    AM        00/12/13    21:40:38     4045
  3.       SUBROUTINE CMICRI (WRK52,WRK53,WRK54,NVARI,Iecou)
  4. *
  5. *   modele d'endommagement microplan isotrope couple a la plasticite
  6. *   C. La Borderie + S. Fichant Oct. 95
  7. *   routines utilisees:
  8. *   micro1: plasticite nadai
  9. *            IDECAL=3 DANS LE CAS ISO IDECAL=8 DANS LE CAS ANISO
  10. *   jacob3: diagonalisation:
  11. *            attention jacob3 modifie la matrice a diagonaliser!!
  12. *   prodt et prodt2
  13. *   attention prodt2 ne fonctionne qu'avec la matrice des V. P. !!
  14. *
  15.       IMPLICIT INTEGER(I-N)
  16. C      IMPLICIT REAL*8(A-H,O-Z)
  17.       INTEGER NSTRS1,NVARI,ICARA,MFR1
  18.       INTEGER ISTRS,I,J
  19.       REAL*8 YOUNG,XNU,EPSD0,BT,LAMB,DEUXMU,ALFA,MP,BT1
  20.       REAL*8 DOM,SIGAN(6),TRSIG,TRSIG33,DEF33(3,3),EPSIPP(3),VECP(3,3)
  21.       REAL*8 D1,DEFPT(6),DEFTOT(6),EPSITOP(3),EPSE1,EPSE
  22.       REAL*8 SIGPP(3),SIGPM(3),SIG33(3,3),SIG33P(3,3),SIG33M(3,3)
  23.       REAL*8 LAMBDAP,LAMBDAM
  24.       INTEGER IDECAL
  25. *
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC DECHE
  30. *
  31.  
  32.       SEGMENT IECOU
  33. *      COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  34.        INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  35. C      INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM,  NYKK,
  36.      1  icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  37. C    .  NYALF1,NYBET1,NYR,  NYA,   NYRHO,NSIGY,  NNKX,  NYKX,  IND,
  38.      2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  39. C    .  NSOM,  NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT,  NCXMAT,
  40.      3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
  41. C    .  LTRAC, MFR,  IELE,  NHRM,   NBNN, NBELEM,ICARA,
  42.      4  icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38,
  43. C    .  LW2,   NDEF,  NSTRSS,MFR1,  NBGMAT,NELMAT,MSOUPA,
  44.      5  icow39,icow40,icow41,icow42,icow43,icow44
  45. C    .  NUMAT1,LENDO, NBBB,  NNVARI,KERR1, MELEME
  46.         INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  47.      .          icow51,icow52,icow53,icow54,icow55,icow56
  48.      .          icow57,icow58
  49.       ENDSEGMENT
  50.  
  51.  
  52.       SEGMENT WRKK1
  53.         REAL*8 DEFELA(NSTRS1)
  54.       ENDSEGMENT
  55. *
  56. *   on recupere les variable materielles
  57. *
  58.       YOUNG=XMAT(1)
  59.       XNU=XMAT(2)
  60.       EPSD0=XMAT(5)
  61.       BT=XMAT(6)
  62.       MP=XMAT(8)
  63.       BT1=(1.D0-(YOUNG/(YOUNG+MP)))
  64.       ALFA=XMAT(9)
  65.       DEUXMU=YOUNG/(1.D0+XNU)
  66.       LAMB=XNU*DEUXMU/(1.D0-2.D0*XNU)
  67. *
  68. *     recuperation des variables internes d'endommagement
  69. *
  70.       DOM=VAR0(3)
  71. *      DOM=0.D0
  72.       SEGINI WRKK1
  73. *
  74. *     on ecoule plastiquement sur la contrainte effective
  75. *
  76.         IDECAL=3
  77.        nstrbi=nstrs1
  78. *               PRINT*,'ON ECOULE'
  79.        CALL CMICR1(WRK52,WRK53,WRK54,NSTRbi,NVARI,IDECAL,
  80.      &             .FALSE.,DEFPT,EPSE1,EPSE)
  81.        nstrs1=nstrbi
  82.         IF (KERRE .NE. 0) THEN
  83.            print*,'on n''a pas converge dans micro1'
  84.        CALL CMICR1(WRK52,WRK53,WRK54,NSTRbi,NVARI,IDECAL,
  85.      &             .FALSE.,DEFPT,EPSE1,EPSE)
  86.            SEGSUP WRKK1
  87.            RETURN
  88.         ENDIF
  89. *
  90. *     on ecoule en endommagement sur les deformations elastiques
  91. *
  92. *
  93. *     calcul des deformations elastiques
  94. *
  95.          TRSIG=0.D0
  96. *      print*,'-----sigf------'
  97. *      print*,sigf(1),sigf(2),sigf(3)
  98.          DO ISTRS=1,3
  99.             TRSIG=TRSIG+SIGF(ISTRS)
  100.          END DO
  101.          DO ISTRS=1,3
  102.            DEFELA(ISTRS)=( (1.D0+XNU)*SIGF(ISTRS)-XNU*TRSIG)/YOUNG
  103.            DEFTOT(ISTRS)=DEFELA(ISTRS)+DEFPT(ISTRS)
  104.          END DO
  105. *      print*,'-----defela------'
  106. *      print*,defela(1),defela(2),defela(3)
  107. *      print*,'-----defpt------'
  108. *      print*,defpt(1),defpt(2),defpt(3)
  109.          DO ISTRS=4,NSTRS1
  110.            DEFELA(ISTRS)= (1.D0+XNU)*SIGF(ISTRS)/YOUNG
  111.            DEFTOT(ISTRS)=DEFELA(ISTRS)+DEFPT(ISTRS)
  112.          END DO
  113. *
  114. *     on met les deformations sous forme de matrice 3x3
  115. *     pour calculer les valeurs propres
  116. *
  117.          CALL ENDOCA (DEFELA,DEF33,1)
  118. *         print*,'deformations elastiques dans rpg(3x3)'
  119. *         print*,def33
  120. *      print*,'prodt defrdpe'
  121.          CALL JACOB3 (DEF33,3,EPSIPP,VECP)
  122. *         print*,'deformations principales'
  123. *         print*,(epsipp(i),i=1,3)
  124. *
  125. *      PAREIL POUR DEFTOTAL
  126.  
  127.          CALL ENDOCA (DEFTOT,DEF33,1)
  128.          CALL JACOB3 (DEF33,3,EPSITOP,VECP)
  129. *         print*,'deformations TOTAL principales'
  130. *         print*,(epsitop(i),i=1,3)
  131.  
  132.  
  133. *     on calcule l'endommagement resultant
  134. *
  135. *         print*,'BT=',BT,'EPSD0=',EPSD0,'EPSIPP(1)',EPSIPP(1)
  136.          IF ( (EPSIPP(1)) .GT. (EPSD0) ) THEN
  137. *         IF ( EPSITOP(1) .GT. (EPSD0) ) THEN
  138. *       PRINT*,'OUI On calcul l endommagement'
  139. *       PRINT*,'EPSIPP(1)/BT1',EPSIPP(1)/BT1
  140. *       PRINT*,'EPSITOP(1)',EPSITOP(1)
  141. *        PRINT*,'BT1',BT1
  142.       D1=1.D0-(((EPSD0)/EPSIPP(1))*EXP(BT*(EPSD0- EPSIPP(1))))
  143. *          D1=1.D0-EPSD0/EPSIPP(1)*EXP(BT*(EPSD0 - (EPSIPP(1)+EPSE1)))
  144. *           D1=1.D0-EXP(-BT*(EPSE))
  145. *               D1=0.D0
  146.          ELSE
  147.            D1=0.D0
  148.          END IF
  149. *         PRINT*,'D1=',D1
  150. *         PRINT*,'EPSIPP(1)=',EPSIPP(1)
  151. *         PRINT*,'EPSE1=',EPSE1
  152. *         PRINT*,'EPSE',EPSE
  153. *
  154. *
  155. *     et on en l'endommagement final
  156. *
  157.          IF(d1.gt.dom)then
  158.             dom=d1
  159.          endif
  160. *         print*,'DOM=',DOM
  161. *
  162. *     on separe les contraintes effectives en + et - dans rpsigma
  163. *
  164.          CALL ENDOCA (SIGF,SIG33,1)
  165.          CALL JACOB3 (SIG33,3,SIGPP,VECP)
  166. *         print*,'contraintes ppales'
  167. *         print*,sigpp
  168.          DO I=1,3
  169.            IF (SIGPP(I) .LT. 0.D0)THEN
  170.               SIGPM(I)=SIGPP(I)
  171.               SIGPP(I)=0.D0
  172.            ELSE
  173.               SIGPM(I)=0.D0
  174.            END IF
  175.          END DO
  176.          CALL PRODT2(SIG33P,SIGPP,VECP,3)
  177.          CALL PRODT2(SIG33M,SIGPM,VECP,3)
  178. *         print*,'contraintes dans rpg'
  179. *         print*,sig33p
  180. *         print*,sig33m
  181. *
  182.        LAMBDAP=1.D0-DOM
  183.        LAMBDAM=1.D0-DOM**ALFA
  184.        SIG33(1,1)=LAMBDAP*SIG33P(1,1)+LAMBDAM*SIG33M(1,1)
  185.        SIG33(1,2)=LAMBDAP*SIG33P(1,2)+LAMBDAM*SIG33M(1,2)
  186.        SIG33(1,3)=LAMBDAP*SIG33P(1,3)+LAMBDAM*SIG33M(1,3)
  187.        SIG33(2,1)=SIG33(1,2)
  188.        SIG33(2,2)=LAMBDAP*SIG33P(2,2)+LAMBDAM*SIG33M(2,2)
  189.        SIG33(2,3)=LAMBDAP*SIG33P(2,3)+LAMBDAM*SIG33M(2,3)
  190.        SIG33(3,1)=SIG33(1,3)
  191.        SIG33(3,2)=SIG33(2,3)
  192.        SIG33(3,3)=LAMBDAP*SIG33P(3,3)+LAMBDAM*SIG33M(3,3)
  193. *
  194. *         Modif Mohammed calcul des def total
  195.          DO ISTRS=1,3
  196.             TRSIG33=SIG33(1,1)+SIG33(2,2)+sig33(3,3)
  197.          END DO
  198.            DEFTOT(1)=( (1.D0+XNU)*SIG33(1,1)-XNU*TRSIG33)/YOUNG
  199. *       print*,'sig33',sig33(1,1),sig33(2,2),sig33(3,3)
  200. *       print*,'Lambdam',dom**alfa
  201. *      print*,deftot(1)
  202. *
  203.  
  204. *     on rend les contraintes et les variables internes finales
  205. *
  206.       SIGAN(1)=SIGF(1)-SIG33(1,1)
  207.       SIGF(1)=SIG33(1,1)
  208.       VARF(3)=MAX(DOM,0.d0)
  209. *      VARF(3)=DEFELA(1)
  210.       SIGAN(2)=SIGF(2)-SIG33(2,2)
  211.       SIGF(2)=SIG33(2,2)
  212.       SIGAN(3)=SIGF(3)-SIG33(3,3)
  213.       SIGF(3)=SIG33(3,3)
  214.       SIGAN(4)=SIGF(4)-SIG33(1,2)
  215.       SIGF(4)=SIG33(1,2)
  216.       IF(IFOUR.GE.1.OR.IFOUR.LE.-3) THEN
  217.         SIGAN(5)=SIGF(5)-SIG33(1,3)
  218.         SIGF(5)=SIG33(1,3)
  219.         SIGAN(6)=SIGF(6)-SIG33(2,3)
  220.         SIGF(6)=SIG33(2,3)
  221.       ELSE
  222.         SIGAN(5)=0.D0
  223.         SIGAN(6)=0.D0
  224.       END IF
  225.       DO ISTRS=1,6
  226.          VARF(ISTRS+3)=SIGAN(ISTRS)
  227.       END DO
  228. *      print*,'sigf',sigf(1),sigf(2),sigf(3)
  229. *      print*,'sigf',sigf(4),sigf(5),sigf(6)
  230. *      print*,'sigan',sigan(1),sigan(2),sigan(3)
  231. *      print*,'sigan',sigan(4),sigan(5),sigan(6)
  232.       SEGSUP WRKK1
  233.       RETURN
  234.       END
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  

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