Télécharger la plaquette Cast3M


fr en

Télécharger cmicro.eso

Retour à la liste

Numérotation des lignes : 

cmicro

  1. C CMICRO    SOURCE    PV        17/12/08    21:16:07     9660           
  2. C MICROP    SOURCE    AM        00/12/13    21:40:52     4045
  3.       SUBROUTINE CMICRO (WRK52,WRK53,WRK54,NVARI,Iecou)
  4. *
  5. *   modele d'endommagement microplan 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 NVARI,ICARA,MFR1
  18.       INTEGER ISTRS,I,J
  19.       REAL*8 YOUNG,XNU,EPSD0,BT,LAMB,DEUXMU,ALFA
  20.       REAL*8 DOM(6),SIGAN(6),TRSIG,DEF33(3,3),EPSIPP(3),VECP(3,3)
  21.       REAL*8 DEFPT(6),DEFTOT(6),EPSITOP(3),EPSE1,EPSE
  22.       REAL*8 VECPT(3,3),DOM33(3,3),DEFRPDE(3,3),DOMRPDE(3,3)
  23.       REAL*8 D1,D2,D3,DOM3(3)
  24.       REAL*8 SIGPP(3),SIGPM(3),SIG33(3,3),SIG33P(3,3),SIG33M(3,3)
  25.       REAL*8 S33PRD(3,3),S33MRD(3,3)
  26.       REAL*8 LAMBDAP(6), LAMBDAM(6)
  27.       LOGICAL COMP
  28.       INTEGER IDECAL
  29. *
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC DECHE
  34. *
  35.  
  36.       SEGMENT IECOU
  37. *      COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  38.        INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  39. C      INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM,  NYKK,
  40.      1  icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  41. C    .  NYALF1,NYBET1,NYR,  NYA,   NYRHO,NSIGY,  NNKX,  NYKX,  IND,
  42.      2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  43. C    .  NSOM,  NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT,  NCXMAT,
  44.      3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
  45. C    .  LTRAC, MFR,  IELE,  NHRM,   NBNN, NBELEM,ICARA,
  46.      4  icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38,
  47. C    .  LW2,   NDEF,  NSTRSS,MFR1,  NBGMAT,NELMAT,MSOUPA,
  48.      5  icow39,icow40,icow41,icow42,icow43,icow44
  49. C    .  NUMAT1,LENDO, NBBB,  NNVARI,KERR1, MELEME
  50.         INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  51.      .          icow51,icow52,icow53,icow54,icow55,icow56
  52.      .          icow57,icow58
  53.       ENDSEGMENT
  54.  
  55.  
  56.       SEGMENT WRKK1
  57.         REAL*8 DEFELA(NSTRS1)
  58.         REAL*8 DDEFEL(NSTRS1)
  59.       ENDSEGMENT
  60. *
  61. *   on recupere les variable materielles
  62. *
  63.       YOUNG=XMAT(1)
  64.       XNU=XMAT(2)
  65.       EPSD0=XMAT(5)
  66.       BT=XMAT(6)
  67.       ALFA=XMAT(9)
  68.       DEUXMU=YOUNG/(1.D0+XNU)
  69.       LAMB=XNU*DEUXMU/(1.D0-2.D0*XNU)
  70. *      print*,'dans microp'
  71. *
  72. *     recuperation des variables internes d'endommagement
  73. *
  74.       DO ISTRS=1,NSTRS1
  75.         DOM(ISTRS)=VAR0(2+ISTRS)
  76.       END DO
  77.       SEGINI WRKK1
  78. *
  79. *     on ecoule plastiquement sur la contrainte effective
  80. *
  81.       IDECAL=8
  82. *      print*,'appel a micro1'
  83.       nstrbi=nstrs1
  84.       CALL CMICR1(wrk52,wrk53,wrk54,NSTRbi,NVARI,IDECAL,
  85.      &      .false.,DEFPT,EPSE1,EPSE)
  86.       nstrs1=nstrbi
  87.       IF (KERRE .NE. 0) THEN
  88.            print*,'on n''a pas converge dans micro1'
  89.  
  90.       CALL CMICR1(wrk52,wrk53,wrk54,NSTRbi,NVARI,IDECAL,
  91.      &      .true.,DEFPT,EPSE1,EPSE)
  92.          SEGSUP WRKK1
  93.          RETURN
  94.       ENDIF
  95. *
  96. *     on ecoule en endommagement sur les deformations elastiques
  97. *
  98. *      print*,'apres micro1'
  99. *
  100. *     calcul de l'increment deformations elastiques DDEFEL
  101. *     1) on calcule l'increment de deformations totales avec
  102. *        l'increment de contraintes elastique DSIGT
  103. *     2) on retranche l'increment de deformations plastiques DEFP
  104. *
  105.         TRSIG=0.D0
  106.         DO ISTRS=1,3
  107.           TRSIG=TRSIG+DSIGT(ISTRS)
  108.         END DO
  109.         DO ISTRS=1,3
  110.           DDEFEL(ISTRS)=( (1.D0+XNU)*DSIGT(ISTRS)-XNU*TRSIG)/YOUNG
  111.      1                 - DEFP(ISTRS)
  112.         END DO
  113.         DO ISTRS=4,NSTRS1
  114.           DDEFEL(ISTRS)= (1.D0+XNU)*DSIGT(ISTRS)/YOUNG
  115.      1                 - 0.5d0*DEFP(ISTRS)
  116.         END DO
  117. *
  118. *      on diagonalise l'increment de deformations elastiques:
  119. *      1) on met sous forme 3x3 avec endoca
  120. *      2) on diagonalise avec jacob3
  121. *
  122. *       print*,'incr de def el dans rpg'
  123. *       print*,ddefel
  124. *       print*,'avant endoca ddefl'
  125.          CALL ENDOCA (DDEFEL,DEF33,1)
  126. *       print*,'apres endoca ddefl'
  127.          CALL JACOB3 (DEF33,IDIM,EPSIPP,VECP)
  128. *       print*,'apres jacob3 def33'
  129. *       print*,'incr deformations principales'
  130. *       print*,epsipp
  131. *
  132. *     calcul des deformations elastiques
  133. *
  134.          TRSIG=0.D0
  135. *      print*,'-----sigf------'
  136. *      print*,sigf(1),sigf(2),sigf(3)
  137.          DO ISTRS=1,3
  138.             TRSIG=TRSIG+SIGF(ISTRS)
  139.          END DO
  140.          DO ISTRS=1,3
  141.            DEFELA(ISTRS)=( (1.D0+XNU)*SIGF(ISTRS)-XNU*TRSIG)/YOUNG
  142.          END DO
  143. *      print*,'-----defela------'
  144. *      print*,defela(1),defela(2),defela(3)
  145.          DO ISTRS=4,NSTRS1
  146.            DEFELA(ISTRS)= (1.D0+XNU)*SIGF(ISTRS)/YOUNG
  147.          END DO
  148. *         print*,'deformations elastiques dans rpg'
  149. *         print*,defela
  150. *
  151. *     on met les deformations sous forme de matrice 3x3
  152. *     puis on ecrit la matrice dans le repere de depsilon:DEFRPDE
  153. *
  154.          CALL ENDOCA (DEFELA,DEF33,1)
  155. *         print*,'deformations elastiques dans rpg(3x3)'
  156. *         print*,def33
  157.          CALL PRODT (DEFRPDE,DEF33,VECP,3,3)
  158. *          print*,'def elast dans rpddeps'
  159. *         print*,defrpde
  160. *
  161. *     on calcule l'endommagement resultant
  162. *
  163.          IF (DEFRPDE(1,1) .GT. EPSD0) THEN
  164.            D1=1.D0-EPSD0/DEFRPDE(1,1)*EXP(BT*( EPSD0 - DEFRPDE(1,1)))
  165.          ELSE
  166.            D1=0.D0
  167.          END IF
  168.          IF (DEFRPDE(2,2) .GT. EPSD0) THEN
  169.            D2=1.D0-EPSD0/DEFRPDE(2,2)*EXP(BT*( EPSD0 - DEFRPDE(2,2)))
  170.          ELSE
  171.            D2=0.D0
  172.          END IF
  173.          IF (DEFRPDE(3,3) .GT. EPSD0) THEN
  174.            D3=1.D0-EPSD0/DEFRPDE(3,3)*EXP(BT*( EPSD0 - DEFRPDE(3,3)))
  175.          ELSE
  176.            D3=0.D0
  177.          END IF
  178. *      print*,defrpde(1,1),epsd0,D1
  179. *      print*,defrpde(2,2),epsd0,D2
  180. *      print*,defrpde(3,3),epsd0,D3
  181. *
  182. *     on met l'endommagement initial dans le meme repere
  183. *
  184.          CALL ENDOCA(DOM,DOM33,1)
  185. *      print*,'prodt DOMRPDE'
  186.          CALL PRODT (DOMRPDE,DOM33,VECP,3,3)
  187. *       print*,'endommagement initial dans rpddeps'
  188. *       print*,domrpde
  189. *
  190. *     et on en deduit l'increment d'endommagement dans RPDE
  191. *
  192.          IF(d1.gt.domrpde(1,1))then
  193.             domrpde(1,1)=d1
  194.          endif
  195.          IF(d2.gt.domrpde(2,2))then
  196.             domrpde(2,2)=d2
  197.          endif
  198.          IF(d3.gt.domrpde(3,3))then
  199.             domrpde(3,3)=d3
  200.          endif
  201. *       print*,'endommagement final dans rpddeps'
  202. *       print*,domrpde
  203. *
  204. *     on remet D dans RPG
  205. *
  206.       DO I=1,3
  207.         DO J=1,3
  208.            VECPT(I,J)=VECP(J,I)
  209.         END DO
  210.       END DO
  211.       call prodt(DOM33,DOMRPDE,VECPT,3,3)
  212. *       print*,'endommagement final dans rpg'
  213. *       print*,dom33
  214.  
  215. *
  216. *     on separe les contraintes effectives en + et - dans rpsigma
  217. *
  218.          CALL ENDOCA (SIGF,SIG33,1)
  219.          CALL JACOB3 (SIG33,3,SIGPP,VECP)
  220. *         print*,'contraintes ppales'
  221. *         print*,sigpp
  222.          DO I=1,3
  223.            IF (SIGPP(I) .LT. 0.D0)THEN
  224.               SIGPM(I)=SIGPP(I)
  225.               SIGPP(I)=0.D0
  226.            ELSE
  227.               SIGPM(I)=0.D0
  228.            END IF
  229.          END DO
  230.          CALL PRODT2(SIG33P,SIGPP,VECP,3)
  231.          CALL PRODT2(SIG33M,SIGPM,VECP,3)
  232. *         print*,'contraintes dans rpg'
  233. *         print*,sig33p
  234. *         print*,sig33m
  235. *
  236. *      on met le tout dans le repere ppal d'endo
  237. *      attention jacob3 modifie la matrice fournie
  238. *       --> on passe une copie
  239.          DO I=1,3
  240.            DO J=1,3
  241.              SIG33(I,J)=DOM33(I,J)
  242.            END DO
  243.          END DO
  244.          CALL JACOB3(SIG33,3,DOM3,VECP)
  245. *         print*,'endom dans rpd'
  246. *         print*,dom3
  247. **************
  248. *  A REVOIR  EN ATENDANT MIEUX ON BORNE LES VALEURS PROPRES DE D ENTRE 0. ET 1.*
  249. **************
  250.          DO I=1,3
  251.            DOM3(I)=MAX(DOM3(I),0.D0)
  252.            DOM3(I)=MIN(DOM3(I),1.D0-1.d-6)
  253.          END DO
  254.          CALL PRODT2 (DOM33,DOM3,VECP,3)
  255. **************
  256. *  FIN A REVOIR
  257. **************
  258. *      print*,'dom3=',dom3
  259. *      print*,'dom33=',dom33
  260.          CALL PRODT (S33PRD,SIG33P,VECP,3,3)
  261.          CALL PRODT (S33MRD,SIG33M,VECP,3,3)
  262.  
  263. *      print*,'s33prd',s33prd(3,3)
  264. *      print*,'s33mrd',s33mrd(3,3)
  265. *      print*,'callambdap'
  266.          COMP=.FALSE.
  267.          CALL CLMBDA(DOM3(1),DOM3(2),DOM3(3),LAMBDAP,YOUNG,XNU,ALFA,
  268.      1                                                            COMP)
  269.          COMP=.TRUE.
  270.          CALL CLMBDA(DOM3(1),DOM3(2),DOM3(3),LAMBDAM,YOUNG,XNU,ALFA,
  271.      1                                                            COMP)
  272. *       print*,'apres callambdap'
  273.        SIG33P(1,1)=LAMBDAP(1)*S33PRD(1,1)+LAMBDAM(1)*S33MRD(1,1)
  274.        SIG33P(1,2)=LAMBDAP(4)*S33PRD(1,2)+LAMBDAM(4)*S33MRD(1,2)
  275.        SIG33P(1,3)=LAMBDAP(5)*S33PRD(1,3)+LAMBDAM(5)*S33MRD(1,3)
  276.        SIG33P(2,1)=SIG33P(1,2)
  277.        SIG33P(2,2)=LAMBDAP(2)*S33PRD(2,2)+LAMBDAM(2)*S33MRD(2,2)
  278.        SIG33P(2,3)=LAMBDAP(6)*S33PRD(2,3)+LAMBDAM(6)*S33MRD(2,3)
  279.        SIG33P(3,1)=SIG33P(1,3)
  280.        SIG33P(3,2)=SIG33P(2,3)
  281.        SIG33P(3,3)=LAMBDAP(3)*S33PRD(3,3)+LAMBDAM(3)*S33MRD(3,3)
  282. *       print*,'contraintes dans RPD'
  283. *       print*,sig33p
  284. *       print*,'sig33p(1,2)',sig33p(1,2)
  285. *      print*,'dsigt',dsigt(1),dsigt(2),dsigt(3)
  286. *      print*,'dsigt',dsigt(4),dsigt(5),dsigt(6)
  287. *      print*,'sigf',sigf(1),sigf(2),sigf(3)
  288. *      print*,'sigf',sigf(4),sigf(5),sigf(6)
  289. *
  290. *     on remet le tout dans le repere global
  291. *
  292. *      print*,'matrice des vect proprs'
  293. *      print*,vecp
  294.       DO I=1,3
  295.         DO J=1,3
  296.            VECPT(I,J)=VECP(J,I)
  297.         END DO
  298.       END DO
  299.       CALL PRODT (SIG33,SIG33P,VECPT,3,3)
  300. *      print*,'contraintes dans rpg'
  301. *      print*,sig33
  302. *
  303. *     on rend les contraintes et les variables internes finales
  304. *
  305.       SIGAN(1)=SIGF(1)-SIG33(1,1)
  306.       SIGF(1)=SIG33(1,1)
  307.       VARF(3)=MAX(DOM33(1,1),0.d0)
  308.       SIGAN(2)=SIGF(2)-SIG33(2,2)
  309.       SIGF(2)=SIG33(2,2)
  310.       VARF(4)=MAX(DOM33(2,2),0.d0)
  311.       SIGAN(3)=SIGF(3)-SIG33(3,3)
  312.       SIGF(3)=SIG33(3,3)
  313.       VARF(5)=MAX(DOM33(3,3),0.d0)
  314.       SIGAN(4)=SIGF(4)-SIG33(1,2)
  315.       SIGF(4)=SIG33(1,2)
  316.       VARF(6)=MAX(DOM33(1,2),0.d0)
  317.       VARF(7)=MAX(DOM33(1,3),0.d0)
  318.       VARF(8)=MAX(DOM33(2,3),0.d0)
  319.       IF(IFOUR.GE.1.OR.IFOUR.LE.-3) THEN
  320.         SIGAN(5)=SIGF(5)-SIG33(1,3)
  321.         SIGF(5)=SIG33(1,3)
  322.         SIGAN(6)=SIGF(6)-SIG33(2,3)
  323.         SIGF(6)=SIG33(2,3)
  324.       ELSE
  325.         SIGAN(5)=0.D0
  326.         SIGAN(6)=0.D0
  327.       END IF
  328.       DO ISTRS=1,6
  329.          VARF(ISTRS+8)=SIGAN(ISTRS)
  330.       END DO
  331. *      print*,'sigf',sigf(1),sigf(2),sigf(3)
  332. *      print*,'sigf',sigf(4),sigf(5),sigf(6)
  333. *      print*,'sigan',sigan(1),sigan(2),sigan(3)
  334. *      print*,'sigan',sigan(4),sigan(5),sigan(6)
  335.       SEGSUP WRKK1
  336.       RETURN
  337.       END
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  

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