1 : C MICROI SOURCE CHAT 05/01/13 01:45:04 5004 2 : SUBROUTINE MICROI (WRK0,WRK1,NSTRS,NVARI,NMATT, 3 : & ICARA,KERRE,MFR1,IFOURB) 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 NSTRS,NVARI,NMATT,ICARA,KERRE,MFR1,IFOURB 18 : INTEGER ISTRS,I,J 19 : REAL*8 YOUNG,XNU,EPSD0,BT,LAMB,DEUXMU,ALFA 20 : REAL*8 DOM,SIGAN(6),TRSIG,DEF33(3,3),EPSIPP(3),VECP(3,3) 21 : REAL*8 D1 22 : REAL*8 SIGPP(3),SIGPM(3),SIG33(3,3),SIG33P(3,3),SIG33M(3,3) 23 : REAL*8 LAMBDAP,LAMBDAM 24 : REAL*8 DSIGT(6) 25 : INTEGER IDECAL 26 : * 27 : -INC CCOPTIO 28 : * 29 : SEGMENT WRK0 30 : REAL*8 XMAT(NMATT) 31 : ENDSEGMENT 32 : * 33 : SEGMENT WRK1 34 : REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS) 35 : REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI) 36 : REAL*8 DEFP(NSTRS),XCAR(ICARA) 37 : ENDSEGMENT 38 : SEGMENT WRKK1 39 : REAL*8 DEFELA(NSTRS) 40 : ENDSEGMENT 41 : * 42 : * on recupere les variable materielles 43 : * 44 : YOUNG=XMAT(1) 45 : XNU=XMAT(2) 46 : EPSD0=XMAT(5) 47 : BT=XMAT(6) 48 : ALFA=XMAT(9) 49 : DEUXMU=YOUNG/(1.D0+XNU) 50 : LAMB=XNU*DEUXMU/(1.D0-2.D0*XNU) 51 : * 52 : * recuperation des variables internes d'endommagement 53 : * 54 : DOM=VAR0(3) 55 : SEGINI WRKK1 56 : * 57 : * on ecoule plastiquement sur la contrainte effective 58 : * 59 : IDECAL=3 59 : CALL MICRO1(WRK0,NMATT,WRK1,NSTRS,DSIGT, 60 : 1 NVARI,IDECAL,KERRE,.false.) 61 : IF (KERRE .NE. 0) THEN 62 : print*,'on n''a pas converge dans micro1' 62 : CALL MICRO1(WRK0,NMATT,WRK1,NSTRS,DSIGT, 63 : 1 NVARI,IDECAL,KERRE,.true.) 64 : SEGSUP WRKK1 65 : RETURN 66 : ENDIF 67 : * 68 : * on ecoule en endommagement sur les deformations elastiques 69 : * 70 : * 71 : * calcul des deformations elastiques 72 : * 73 : TRSIG=0.D0 74 : * print*,'-----sigf------' 75 : * print*,sigf(1),sigf(2),sigf(3) 76 : DO ISTRS=1,3 77 : TRSIG=TRSIG+SIGF(ISTRS) 78 : END DO 79 : DO ISTRS=1,3 80 : DEFELA(ISTRS)=( (1.D0+XNU)*SIGF(ISTRS)-XNU*TRSIG)/YOUNG 81 : END DO 82 : * print*,'-----defela------' 83 : * print*,defela(1),defela(2),defela(3) 84 : DO ISTRS=4,NSTRS 85 : DEFELA(ISTRS)= (1.D0+XNU)*SIGF(ISTRS)/YOUNG 86 : END DO 87 : * 88 : * on met les deformations sous forme de matrice 3x3 89 : * pour calculer les valeurs propres 90 : * 90 : CALL ENDOCA (DEFELA,DEF33,1) 91 : * print*,'deformations elastiques dans rpg(3x3)' 92 : * print*,def33 93 : * print*,'prodt defrdpe' 93 : CALL JACOB3 (DEF33,3,EPSIPP,VECP) 94 : * print*,'deformations principales' 95 : * print*,(epsipp(i),i=1,3) 96 : * 97 : * on calcule l'endommagement resultant 98 : * 99 : * print*,'BT=',BT,'EPSD0=',EPSD0,'EPSIPP(1)',EPSIPP(1) 100 : IF (EPSIPP(1) .GT. EPSD0) THEN 101 : D1=1.D0-EPSD0/EPSIPP(1)*DEXP(BT*( EPSD0 - EPSIPP(1))) 102 : ELSE 103 : D1=0.D0 104 : END IF 105 : * PRINT*,'D1=',D1 106 : * 107 : * 108 : * et on en l'endommagement final 109 : * 110 : IF(d1.gt.dom)then 111 : dom=d1 112 : endif 113 : * print*,'DOM=',DOM 114 : * 115 : * on separe les contraintes effectives en + et - dans rpsigma 116 : * 116 : CALL ENDOCA (SIGF,SIG33,1) 116 : CALL JACOB3 (SIG33,3,SIGPP,VECP) 117 : * print*,'contraintes ppales' 118 : * print*,sigpp 119 : DO I=1,3 120 : IF (SIGPP(I) .LT. 0.D0)THEN 121 : SIGPM(I)=SIGPP(I) 122 : SIGPP(I)=0.D0 123 : ELSE 124 : SIGPM(I)=0.D0 125 : END IF 126 : END DO 126 : CALL PRODT2(SIG33P,SIGPP,VECP,3) 126 : CALL PRODT2(SIG33M,SIGPM,VECP,3) 127 : * print*,'contraintes dans rpg' 128 : * print*,sig33p 129 : * print*,sig33m 130 : * 131 : LAMBDAP=1.D0-DOM 132 : LAMBDAM=1.D0-DOM**ALFA 133 : SIG33(1,1)=LAMBDAP*SIG33P(1,1)+LAMBDAM*SIG33M(1,1) 134 : SIG33(1,2)=LAMBDAP*SIG33P(1,2)+LAMBDAM*SIG33M(1,2) 135 : SIG33(1,3)=LAMBDAP*SIG33P(1,3)+LAMBDAM*SIG33M(1,3) 136 : SIG33(2,1)=SIG33(1,2) 137 : SIG33(2,2)=LAMBDAP*SIG33P(2,2)+LAMBDAM*SIG33M(2,2) 138 : SIG33(2,3)=LAMBDAP*SIG33P(2,3)+LAMBDAM*SIG33M(2,3) 139 : SIG33(3,1)=SIG33(1,3) 140 : SIG33(3,2)=SIG33(2,3) 141 : SIG33(3,3)=LAMBDAP*SIG33P(3,3)+LAMBDAM*SIG33M(3,3) 142 : * print*,'contraintes dans RPD' 143 : * print*,sig33p 144 : * print*,'sig33p(1,2)',sig33p(1,2) 145 : * print*,'dsigt',dsigt(1),dsigt(2),dsigt(3) 146 : * print*,'dsigt',dsigt(4),dsigt(5),dsigt(6) 147 : * print*,'sigf',sigf(1),sigf(2),sigf(3) 148 : * print*,'sigf',sigf(4),sigf(5),sigf(6) 149 : * 150 : 151 : * on rend les contraintes et les variables internes finales 152 : * 153 : SIGAN(1)=SIGF(1)-SIG33(1,1) 154 : SIGF(1)=SIG33(1,1) 155 : VARF(3)=MAX (DOM,0.d0) 156 : SIGAN(2)=SIGF(2)-SIG33(2,2) 157 : SIGF(2)=SIG33(2,2) 158 : SIGAN(3)=SIGF(3)-SIG33(3,3) 159 : SIGF(3)=SIG33(3,3) 160 : SIGAN(4)=SIGF(4)-SIG33(1,2) 161 : SIGF(4)=SIG33(1,2) 162 : IF(IFOUR.GE.1.OR.IFOUR.LE.-3) THEN 163 : SIGAN(5)=SIGF(5)-SIG33(1,3) 164 : SIGF(5)=SIG33(1,3) 165 : SIGAN(6)=SIGF(6)-SIG33(2,3) 166 : SIGF(6)=SIG33(2,3) 167 : ELSE 168 : SIGAN(5)=0.D0 169 : SIGAN(6)=0.D0 170 : END IF 171 : DO ISTRS=1,6 172 : VARF(ISTRS+3)=SIGAN(ISTRS) 173 : END DO 174 : * print*,'sigf',sigf(1),sigf(2),sigf(3) 175 : * print*,'sigf',sigf(4),sigf(5),sigf(6) 176 : * print*,'sigan',sigan(1),sigan(2),sigan(3) 177 : * print*,'sigan',sigan(4),sigan(5),sigan(6) 178 : SEGSUP WRKK1 179 : RETURN 180 : END 181 : 182 : 183 :
© Cast3M 2003 - All rights reserved.
Disclaimer