C CMICRI SOURCE PV 17/12/08 21:16:06 9660 C MICROI SOURCE AM 00/12/13 21:40:38 4045 SUBROUTINE CMICRI (WRK52,WRK53,WRK54,NVARI,Iecou) * * modele d'endommagement microplan isotrope couple a la plasticite * C. La Borderie + S. Fichant Oct. 95 * routines utilisees: * micro1: plasticite nadai * IDECAL=3 DANS LE CAS ISO IDECAL=8 DANS LE CAS ANISO * jacob3: diagonalisation: * attention jacob3 modifie la matrice a diagonaliser!! * prodt et prodt2 * attention prodt2 ne fonctionne qu'avec la matrice des V. P. !! * IMPLICIT INTEGER(I-N) C IMPLICIT REAL*8(A-H,O-Z) INTEGER NSTRS1,NVARI,ICARA,MFR1 INTEGER ISTRS,I,J REAL*8 YOUNG,XNU,EPSD0,BT,LAMB,DEUXMU,ALFA,MP,BT1 REAL*8 DOM,SIGAN(6),TRSIG,TRSIG33,DEF33(3,3),EPSIPP(3),VECP(3,3) REAL*8 D1,DEFPT(6),DEFTOT(6),EPSITOP(3),EPSE1,EPSE REAL*8 SIGPP(3),SIGPM(3),SIG33(3,3),SIG33P(3,3),SIG33M(3,3) REAL*8 LAMBDAP,LAMBDAM INTEGER IDECAL * -INC PPARAM -INC CCOPTIO -INC DECHE * SEGMENT IECOU * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK, INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7, C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK, 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16, C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND, 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24, C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT, 3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA, C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA, 4 icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38, C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA, 5 icow39,icow40,icow41,icow42,icow43,icow44 C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME INTEGER icow45,icow46,icow47,icow48,icow49,icow50, . icow51,icow52,icow53,icow54,icow55,icow56 . icow57,icow58 ENDSEGMENT SEGMENT WRKK1 REAL*8 DEFELA(NSTRS1) ENDSEGMENT * * on recupere les variable materielles * YOUNG=XMAT(1) XNU=XMAT(2) EPSD0=XMAT(5) BT=XMAT(6) MP=XMAT(8) BT1=(1.D0-(YOUNG/(YOUNG+MP))) ALFA=XMAT(9) DEUXMU=YOUNG/(1.D0+XNU) LAMB=XNU*DEUXMU/(1.D0-2.D0*XNU) * * recuperation des variables internes d'endommagement * DOM=VAR0(3) * DOM=0.D0 SEGINI WRKK1 * * on ecoule plastiquement sur la contrainte effective * IDECAL=3 nstrbi=nstrs1 * PRINT*,'ON ECOULE' CALL CMICR1(WRK52,WRK53,WRK54,NSTRbi,NVARI,IDECAL, & .FALSE.,DEFPT,EPSE1,EPSE) nstrs1=nstrbi IF (KERRE .NE. 0) THEN print*,'on n''a pas converge dans micro1' CALL CMICR1(WRK52,WRK53,WRK54,NSTRbi,NVARI,IDECAL, & .FALSE.,DEFPT,EPSE1,EPSE) SEGSUP WRKK1 RETURN ENDIF * * on ecoule en endommagement sur les deformations elastiques * * * calcul des deformations elastiques * TRSIG=0.D0 * print*,'-----sigf------' * print*,sigf(1),sigf(2),sigf(3) DO ISTRS=1,3 TRSIG=TRSIG+SIGF(ISTRS) END DO DO ISTRS=1,3 DEFELA(ISTRS)=( (1.D0+XNU)*SIGF(ISTRS)-XNU*TRSIG)/YOUNG DEFTOT(ISTRS)=DEFELA(ISTRS)+DEFPT(ISTRS) END DO * print*,'-----defela------' * print*,defela(1),defela(2),defela(3) * print*,'-----defpt------' * print*,defpt(1),defpt(2),defpt(3) DO ISTRS=4,NSTRS1 DEFELA(ISTRS)= (1.D0+XNU)*SIGF(ISTRS)/YOUNG DEFTOT(ISTRS)=DEFELA(ISTRS)+DEFPT(ISTRS) END DO * * on met les deformations sous forme de matrice 3x3 * pour calculer les valeurs propres * CALL ENDOCA (DEFELA,DEF33,1) * print*,'deformations elastiques dans rpg(3x3)' * print*,def33 * print*,'prodt defrdpe' CALL JACOB3 (DEF33,3,EPSIPP,VECP) * print*,'deformations principales' * print*,(epsipp(i),i=1,3) * * PAREIL POUR DEFTOTAL CALL ENDOCA (DEFTOT,DEF33,1) CALL JACOB3 (DEF33,3,EPSITOP,VECP) * print*,'deformations TOTAL principales' * print*,(epsitop(i),i=1,3) * on calcule l'endommagement resultant * * print*,'BT=',BT,'EPSD0=',EPSD0,'EPSIPP(1)',EPSIPP(1) IF ( (EPSIPP(1)) .GT. (EPSD0) ) THEN * IF ( EPSITOP(1) .GT. (EPSD0) ) THEN * PRINT*,'OUI On calcul l endommagement' * PRINT*,'EPSIPP(1)/BT1',EPSIPP(1)/BT1 * PRINT*,'EPSITOP(1)',EPSITOP(1) * PRINT*,'BT1',BT1 D1=1.D0-(((EPSD0)/EPSIPP(1))*EXP(BT*(EPSD0- EPSIPP(1)))) * D1=1.D0-EPSD0/EPSIPP(1)*EXP(BT*(EPSD0 - (EPSIPP(1)+EPSE1))) * D1=1.D0-EXP(-BT*(EPSE)) * D1=0.D0 ELSE D1=0.D0 END IF * PRINT*,'D1=',D1 * PRINT*,'EPSIPP(1)=',EPSIPP(1) * PRINT*,'EPSE1=',EPSE1 * PRINT*,'EPSE',EPSE * * * et on en l'endommagement final * IF(d1.gt.dom)then dom=d1 endif * print*,'DOM=',DOM * * on separe les contraintes effectives en + et - dans rpsigma * CALL ENDOCA (SIGF,SIG33,1) CALL JACOB3 (SIG33,3,SIGPP,VECP) * print*,'contraintes ppales' * print*,sigpp DO I=1,3 IF (SIGPP(I) .LT. 0.D0)THEN SIGPM(I)=SIGPP(I) SIGPP(I)=0.D0 ELSE SIGPM(I)=0.D0 END IF END DO CALL PRODT2(SIG33P,SIGPP,VECP,3) CALL PRODT2(SIG33M,SIGPM,VECP,3) * print*,'contraintes dans rpg' * print*,sig33p * print*,sig33m * LAMBDAP=1.D0-DOM LAMBDAM=1.D0-DOM**ALFA SIG33(1,1)=LAMBDAP*SIG33P(1,1)+LAMBDAM*SIG33M(1,1) SIG33(1,2)=LAMBDAP*SIG33P(1,2)+LAMBDAM*SIG33M(1,2) SIG33(1,3)=LAMBDAP*SIG33P(1,3)+LAMBDAM*SIG33M(1,3) SIG33(2,1)=SIG33(1,2) SIG33(2,2)=LAMBDAP*SIG33P(2,2)+LAMBDAM*SIG33M(2,2) SIG33(2,3)=LAMBDAP*SIG33P(2,3)+LAMBDAM*SIG33M(2,3) SIG33(3,1)=SIG33(1,3) SIG33(3,2)=SIG33(2,3) SIG33(3,3)=LAMBDAP*SIG33P(3,3)+LAMBDAM*SIG33M(3,3) * * Modif Mohammed calcul des def total DO ISTRS=1,3 TRSIG33=SIG33(1,1)+SIG33(2,2)+sig33(3,3) END DO DEFTOT(1)=( (1.D0+XNU)*SIG33(1,1)-XNU*TRSIG33)/YOUNG * print*,'sig33',sig33(1,1),sig33(2,2),sig33(3,3) * print*,'Lambdam',dom**alfa * print*,deftot(1) * * on rend les contraintes et les variables internes finales * SIGAN(1)=SIGF(1)-SIG33(1,1) SIGF(1)=SIG33(1,1) VARF(3)=MAX(DOM,0.d0) * VARF(3)=DEFELA(1) SIGAN(2)=SIGF(2)-SIG33(2,2) SIGF(2)=SIG33(2,2) SIGAN(3)=SIGF(3)-SIG33(3,3) SIGF(3)=SIG33(3,3) SIGAN(4)=SIGF(4)-SIG33(1,2) SIGF(4)=SIG33(1,2) IF(IFOUR.GE.1.OR.IFOUR.LE.-3) THEN SIGAN(5)=SIGF(5)-SIG33(1,3) SIGF(5)=SIG33(1,3) SIGAN(6)=SIGF(6)-SIG33(2,3) SIGF(6)=SIG33(2,3) ELSE SIGAN(5)=0.D0 SIGAN(6)=0.D0 END IF DO ISTRS=1,6 VARF(ISTRS+3)=SIGAN(ISTRS) END DO * print*,'sigf',sigf(1),sigf(2),sigf(3) * print*,'sigf',sigf(4),sigf(5),sigf(6) * print*,'sigan',sigan(1),sigan(2),sigan(3) * print*,'sigan',sigan(4),sigan(5),sigan(6) SEGSUP WRKK1 RETURN END