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