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