Download rotatj.eso

Back to the list

   1 : C ROTATJ    SOURCE    CHAT      05/01/13    03:05:17     5004           
   2 :       SUBROUTINE ROTATJ(WRK0,WRK1,KERRE)
   3 : C     
   4 : C  Rotating Crack model avec 2 directions de fissuration
   5 : C  D. Combescure 24/08/95 ELSA-Ispra
   6 : C     
   7 : C ENTREES:
   8 : C -------
   9 : C WRK0:
  10 : C     XMAT    = CARACTERISTIQUES MECANIQUES DU MATERIAU
  11 : C     
  12 : C WRK1:
  13 : C     SIG0    = CONTRAINTES AU DEBUT DU PAS D'INTEGRATION
  14 : C     DEPST   = INCREMENT DES DEFORMATIONS TOTALES
  15 : C     VAR0    = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION
  16 : C     
  17 : C     variables en sortie
  18 : C     
  19 : C     VARF      variables internes finales dans WRK0
  20 : C     
  21 : C     SIGF      contraintes finales dans WRK0
  22 :       IMPLICIT INTEGER(I-N)
  23 :       IMPLICIT REAL*8(A-H,O-Z)
  24 : -INC CCREEL
  25 :       SEGMENT WRK0
  26 :       REAL*8 XMAT(NMATT)
  27 :       ENDSEGMENT
  28 : *     
  29 :       SEGMENT WRK1
  30 :       REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  31 :       REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  32 :       REAL*8 DEFP(NSTRS),XCAR(ICARA)
  33 :       ENDSEGMENT
  34 :       DIMENSION DEFI(4),DINC(4), DAM(2),XXX(2)
  35 :       DIMENSION EPSN(2), EPS(2), EPSX(2), EPSP(2),SIGP(2),SIGM(2)
  36 :       DIMENSION CCCC(2,2),XX(2),FF(2),NMEC(2),IMEC(2)
  37 :       DIMENSION T(3,3)
  38 : C     
  39 :       PARAMETER (UN=1.D0,UNDEMI=0.5D0,EPSILO=1.D-5)
  40 :       KERRE=0
  41 : C===============================================================
  42 : C   LECTURE DES CARACTERISTIQUES MAT. ET DES VAR. INT.
  43 : C===============================================================
  44 : C Materiau --> 5-Resistance en traction
  45 : C              6-Deformation a la rupture
  46 : C              7-Resistance residuelle
  47 : C              8-Coef. de refermeture de la fissure
  48 : C--------------------------------------------------------------
  49 :       YOUN = XMAT(1)
  50 :       XNU  = XMAT(2)
  51 :       XFTR = XMAT(5)
  52 :       EPSR = XMAT(6)
  53 :       XFRE = XMAT(7)
  54 :       BETA = XMAT(8)
  55 :       XHH1 = (XFRE - XFTR)/EPSR
  56 : C--------------------------------------------------------------
  57 : C Variables internes->1 et 2- cos et sin de l'angle
  58 : C                     3 et 4- "Deformation" maximale de la fissure
  59 : C                     5 et 6- Deformations principales
  60 : C                     7     - Cas pour le calcul de Kta
  61 : C--------------------------------------------------------------
  62 :       CPHI = VAR0(1) + UN
  63 :       SPHI = VAR0(2)
  64 :       EPS(1) = VAR0(3)
  65 :       EPS(2) = VAR0(4)
  66 :       EPSN(1) = VAR0(5)
  67 :       EPSN(2) = VAR0(6)
  68 : C     
  69 : C  Remplissage de la matrice de transformation
  70 : C   (Ecrite pour le tenseur des contraintes et des deformations)
  71 :       T(1,1) = CPHI**2
  72 :       T(1,2) = SPHI**2
  73 :       T(1,3) = -2.D0*SPHI*CPHI
  74 :       T(2,1) = T(1,2)
  75 :       T(2,2) = T(1,1)
  76 :       T(2,3) = -T(1,3)
  77 :       T(3,1) = SPHI*CPHI
  78 :       T(3,2) = -SPHI*CPHI
  79 :       T(3,3) = (CPHI**2) - (SPHI**2)
  80 : C     
  81 : C================================================================
  82 : C   CALCUL DES DEFORMATIONS TOTALES ET PASSAGE DANS LE REPERE PRINCIPAL
  83 : C================================================================
  84 :       DEFI(1) = T(1,1)*EPSN(1) + T(1,2)*EPSN(2)
  85 :       DEFI(2) = T(2,1)*EPSN(1) + T(2,2)*EPSN(2)
  86 :       DEFI(4) = -(T(3,1)*EPSN(1) + T(3,2)*EPSN(2))
  87 :       DEFI(1) = DEFI(1) + DEPST(1)
  88 :       DEFI(2) = DEFI(2) + DEPST(2)
  89 :       DEFI(4) = DEFI(4) + DEPST(4)/2
  90 : C Passage dans le nouveau repere principal
  91 :       DINC(1) = T(1,1)*DEFI(1) + T(1,2)*DEFI(2)
  92 :      &     +T(1,3)*DEFI(4)
  93 :       DINC(2) = T(2,1)*DEFI(1) + T(2,2)*DEFI(2)
  94 :      &     +T(2,3)*DEFI(4)
  95 :       DINC(4) = T(3,1)*DEFI(1)  +T(3,2)*DEFI(2)
  96 :      &     + T(3,3)*DEFI(4)
  97 : C     
  98 :       IF (ABS(DINC(2) - DINC(1)).GT.(EPSILO*ABS(DINC(4)))) THEN
  99 :          TG2PHI = -2.D0*DINC(4)/(DINC(1) - DINC(2))
 100 :          XDPHI = UNDEMI*ATAN(TG2PHI)
 101 :          CDPHI = COS(XDPHI)
 102 :          SDPHI = SIN(XDPHI)
 103 :       ELSE
 104 :          XDPHI = SIGN ((XPI/4.D0), DINC(4)*(DINC(1)-DINC(2)))
 105 :          CDPHI = SQRT(2.D0)/2.D0
 106 :          SDPHI = SIGN (CDPHI, DINC(4)*(DINC(1)-DINC(2)))
 107 :       ENDIF
 108 : C     
 109 :       CPHIF = CPHI*CDPHI - SPHI*SDPHI
 110 :       SPHIF = CPHI*SDPHI + SPHI*CDPHI
 111 :       T(1,1) = CPHIF**2
 112 :       T(1,2) = SPHIF**2
 113 :       T(1,3) = -2.D0*SPHIF*CPHIF
 114 :       T(2,1) = T(1,2)
 115 :       T(2,2) = T(1,1)
 116 :       T(2,3) = -T(1,3)
 117 :       T(3,1) = SPHIF*CPHIF
 118 :       T(3,2) = -SPHIF*CPHIF
 119 :       T(3,3) = (CPHIF**2) - (SPHIF**2)
 120 : C     
 121 :       EPSN(1) = T(1,1)*DEFI(1) + T(1,2)*DEFI(2) + T(1,3)*DEFI(4)
 122 :       EPSN(2) = T(2,1)*DEFI(1) + T(2,2)*DEFI(2) + T(2,3)*DEFI(4)
 123 :       XTEST = T(3,1)*DEFI(1)+T(3,2)*DEFI(2) + T(3,3)*DEFI(4)
 124 :       XTEST = XTEST / (UN + ABS(EPSN(1)) + ABS(EPSN(2)))
 125 :       IF (ABS(XTEST).GT.(1.D-10)) THEN
 126 :          WRITE(6,*)'CONPRI : hell and damnation!'
 127 :       ENDIF
 128 : C     
 129 : C================================================================
 130 : C   ECRITURE DE LA LOI DANS LE REPERE PRINCIPAL
 131 : C================================================================
 132 : C     
 133 : C  Calcul des variables d'endommagement et des limites elastiques
 134 :  10   CONTINUE
 135 :       DO I=1,2
 136 :          IF (EPS(I).LE.EPSR) THEN
 137 :             SIGM(I) = XFTR - (XFTR - XFRE)*EPS(I)/EPSR
 138 :             EPSP(I) = BETA*EPS(I)
 139 :             XXX(I) = UN + YOUN*(UN - BETA)*EPS(I)/SIGM(I)
 140 :          ELSE
 141 :             SIGM(I) = XFRE
 142 :             EPSP(I) = BETA*EPSR
 143 :             XXX(I) = UN + YOUN*(UN - BETA)*EPSR/XFRE
 144 :      &           + YOUN*(EPS(I) - EPSR)/XFRE
 145 :          ENDIF
 146 :          DAM(I) = UN
 147 :          XXX(I) = UN/XXX(I)
 148 :       ENDDO
 149 : C  Calcul des contraintes principales
 150 :  500  CONTINUE
 151 :       CCCC(1,1) = UN/(YOUN*DAM(1))
 152 :       CCCC(1,2) = -XNU/YOUN
 153 :       CCCC(2,1) = -XNU/YOUN
 154 :       CCCC(2,2) = UN/(YOUN*DAM(2))
 155 :       FF(1) = EPSN(1) - EPSP(1)
 156 :       FF(2) = EPSN(2) - EPSP(2)
 156 :       CALL RESOLU(CCCC, FF , XX,KERRE)
 157 :       SIGP(1) = XX(1)
 158 :       SIGP(2) = XX(2)
 159 : C  "Endommagement" si necessaire
 160 :       IF (((SIGP(1).GT.XZERO).AND.(DAM(1).NE.XXX(1)))
 161 :      &     .OR.((SIGP(2).GT.XZERO).AND.(DAM(2).NE.XXX(2)))) THEN
 162 :          IF (((SIGP(1).GT.XZERO).AND.(DAM(1).NE.XXX(1)))
 163 :      &        .AND.((SIGP(2).GT.XZERO).AND.(DAM(2).NE.XXX(2)))) THEN
 164 :             IF (SIGP(1).GT.SIGP(2)) THEN
 165 :                DAM(1) = XXX(1)
 166 :             ELSE
 167 :                DAM(2) = XXX(2)
 168 :             ENDIF
 169 :          ELSE
 170 :             IF ((SIGP(1).GT.XZERO).AND.(DAM(1).NE.XXX(1)))  THEN
 171 :                DAM(1) = XXX(1)
 172 :             ELSE IF ((SIGP(2).GT.XZERO).AND.(DAM(2).NE.XXX(2))) THEN
 173 :                DAM(2) = XXX(2)
 174 :             ENDIF
 175 :          ENDIF
 176 :          GOTO 500
 177 :       ENDIF
 178 :       IF (((SIGP(1).LT.XZERO).AND.(DAM(1).NE.UN))
 179 :      &     .OR.((SIGP(2).LT.XZERO).AND.(DAM(2).NE.UN))) THEN
 180 :          IF ((SIGP(1).LT.XZERO).AND.(DAM(1).NE.UN)) THEN
 181 :             DAM(1) = UN
 182 :          ELSE
 183 :             DAM(2) = UN
 184 :          ENDIF
 185 :          GOTO 500
 186 :       ENDIF
 187 : C  "Ecoulement" si necessaire
 188 :       NMEC(1) = 0
 189 :       NMEC(2) = 0
 190 :       IF (SIGP(1).GT.SIGM(1)) NMEC(1) = 1
 191 :       IF (SIGP(2).GT.SIGM(2)) NMEC(2) = 1
 192 :       NNMEC = NMEC(1) + NMEC(2)
 193 : C     
 194 :       IF (NNMEC.EQ.0) THEN
 195 :          IF ((DAM(1).EQ.UN).AND.(DAM(2).EQ.UN)) THEN
 196 :             ICAS = 1
 197 :          ELSE
 198 :             IF ((DAM(1).NE.UN).AND.(DAM(2).EQ.UN)) THEN
 199 :                ICAS = 11
 200 :             ELSE
 201 :                IF ((DAM(1).EQ.UN).AND.(DAM(2).NE.UN)) THEN
 202 :                   ICAS = 12
 203 :                ELSE
 204 :                   ICAS = 13
 205 :                ENDIF
 206 :             ENDIF
 207 :          ENDIF
 208 :          GOTO 9999
 209 :       ELSE
 210 :          IF (NNMEC.EQ.1) THEN
 211 :             IF (NMEC(1).EQ.1) THEN
 212 :                IMEC(1) = 1
 213 :                IMEC(2) = 2
 214 :             ELSE
 215 :                IMEC(1) = 2
 216 :                IMEC(2) = 1
 217 :             ENDIF
 218 :             GOTO 1000
 219 :          ELSE
 220 :             IF (SIGP(1).GE.SIGP(2)) THEN
 221 :                IMEC(1) = 1
 222 :                IMEC(2) = 2
 223 :             ELSE
 224 :                IMEC(1) = 2
 225 :                IMEC(2) = 1
 226 :             ENDIF
 227 :             GOTO 1000
 228 :          ENDIF
 229 :       ENDIF
 230 : C Ecoulement 1 direction
 231 :  1000 CONTINUE
 232 :       IF (EPS(IMEC(1)).LE.EPSR) THEN
 233 :          GOTO 1010
 234 :       ELSE
 235 :          GOTO 1020
 236 :       ENDIF
 237 : C Cas avant rupture totale
 238 :  1010 CONTINUE
 239 :       CCCC(1,1) = UN/YOUN + UN/XHH1
 240 :       CCCC(1,2) = -XNU/YOUN
 241 :       CCCC(2,1) = -XNU/YOUN
 242 :       CCCC(2,2) = UN/(DAM(IMEC(2))*YOUN)
 243 :       FF(1) = EPSN(IMEC(1)) + XFTR/XHH1
 244 :       FF(2) = EPSN(IMEC(2)) - EPSP(IMEC(2))
 244 :       CALL RESOLU(CCCC, FF , XX,KERRE)
 245 :       EPSX(1) = EPSN(IMEC(1)) - XX(1)/YOUN + (XNU/YOUN)*XX(2)
 246 :       IF (EPSX(1).LT.XZERO) THEN
 247 :          CONTINUE
 248 :          GOTO 9999
 249 :       ENDIF
 250 :       IF (EPSX(1).GT.EPSR) THEN
 251 :          GOTO 1020
 252 :       ENDIF
 253 :       IF (XX(2).GT.SIGM(IMEC(2))) THEN
 254 :          GOTO 2000
 255 :       ENDIF
 256 :       SIGP(IMEC(1)) = XX(1)
 257 :       SIGP(IMEC(2)) = XX(2)
 258 :       EPS(IMEC(1)) = EPSX(1)
 259 :       EPSP(IMEC(1)) = BETA*EPS(IMEC(1))
 260 :       IF (IMEC(1).EQ.1) THEN
 261 :          ICAS = 2
 262 :       ELSE
 263 :          ICAS = 3
 264 :       ENDIF
 265 :       GOTO 9999
 266 : C Cas apres ouverture totale
 267 :  1020 CONTINUE
 268 :       XX(1) = XFRE
 269 :       XX(2) = YOUN*DAM(IMEC(2))*(EPSN(IMEC(2)) - EPSP(IMEC(2)))
 270 :      &     + XNU*DAM(IMEC(2))*XFRE
 271 :       IF (XX(2).GT.SIGM(IMEC(2))) THEN
 272 :          GOTO 2000
 273 :       ELSE
 274 :          SIGP(IMEC(1)) = XX(1)
 275 :          SIGP(IMEC(2)) = XX(2)
 276 :          EPS(IMEC(1)) = EPSN(IMEC(1)) - XX(1)/YOUN + (XNU/YOUN)*XX(2)
 277 :          EPSP(IMEC(1)) = BETA*EPSR
 278 :          IF (IMEC(1).EQ.1) THEN
 279 :             ICAS = 2
 280 :          ELSE
 281 :             ICAS = 3
 282 :          ENDIF
 283 :          GOTO 9999
 284 :       ENDIF
 285 : C Cas 2 directions
 286 :  2000 CONTINUE
 287 :       IF ((EPS(1).LE.EPSR).AND.(EPS(2).LE.EPSR)) THEN
 288 :          GOTO 2010
 289 :       ELSE
 290 :          IF ((EPS(1).GT.EPSR).AND.(EPS(2).LE.EPSR)) THEN
 291 :             IMEC(1) = 1
 292 :             IMEC(2) = 2
 293 :             GOTO 2020
 294 :          ELSE
 295 :             IF ((EPS(2).GT.EPSR).AND.(EPS(1).LE.EPSR)) THEN
 296 :                IMEC(1) = 2
 297 :                IMEC(2) = 1
 298 :                GOTO 2020
 299 :             ELSE
 300 :                IF ((EPS(1).GT.EPSR).AND.(EPS(2).GT.EPSR)) THEN
 301 :                   GOTO 2030
 302 :                ENDIF
 303 :             ENDIF
 304 :          ENDIF
 305 :       ENDIF
 306 : C Cas 2 directions avant rupture
 307 :  2010 CONTINUE
 308 :       CCCC(1,1) = UN/XHH1 + UN/YOUN
 309 :       CCCC(1,2) = -XNU/YOUN
 310 :       CCCC(2,2) = UN/XHH1 + UN/YOUN
 311 :       CCCC(2,1) = -XNU/YOUN
 312 :       FF(1) = EPSN(1) + XFTR/XHH1
 313 :       FF(2) = EPSN(2) + XFTR/XHH1
 313 :       CALL RESOLU(CCCC,FF,XX,KERRE)
 314 :       EPSX(1) = EPSN(1) - XX(1)/YOUN + (XNU/YOUN)*XX(2)
 315 :       EPSX(2) = EPSN(2) - XX(2)/YOUN + (XNU/YOUN)*XX(1)
 316 :       IF ((EPSX(1).GT.EPSR).OR.(EPSX(2).GT.EPSR)) THEN
 317 :          IF ((EPSX(1).GT.EPSR).AND.(EPSX(2).LE.EPSR)) THEN
 318 :             IMEC(1) = 1
 319 :             IMEC(2) = 2
 320 :          ELSE
 321 :             IF ((EPSX(2).GT.EPSR).AND.(EPSX(1).LE.EPSR)) THEN
 322 :                IMEC(1) = 2
 323 :                IMEC(2) = 1
 324 :             ELSE
 325 :                IF ((EPSX(1).GT.EPSR).AND.(EPSX(2).GT.EPSR)) THEN
 326 :                   IF (EPSX(1).GT.EPSX(2)) THEN
 327 :                      IMEC(1) = 1
 328 :                      IMEC(2) = 2
 329 :                   ELSE
 330 :                      IMEC(1) = 2
 331 :                      IMEC(2) = 1
 332 :                   ENDIF
 333 :                ENDIF
 334 :             ENDIF
 335 :          ENDIF
 336 :          GOTO 2020
 337 :       ELSE
 338 :          SIGP(1) = XX(1)
 339 :          SIGP(2) = XX(2)
 340 :          EPS(1)  = EPSX(1)
 341 :          EPS(2)  = EPSX(2)
 342 :          EPSP(1) = BETA*EPS(1)
 343 :          EPSP(2) = BETA*EPS(2)
 344 :       ENDIF
 345 :       ICAS = 4
 346 :       GOTO 9999
 347 : C Cas 1 direction apres rupture
 348 :  2020 CONTINUE
 349 :       XX(1) = XFRE
 350 :       XX(2) = (EPSN(IMEC(2)) + XNU*XFRE/YOUN + XFTR/XHH1)/
 351 :      &     (UN/XHH1 + UN/YOUN)
 352 :       EPSX(1) = EPSN(IMEC(1)) + (XNU/YOUN)*XX(2) - XX(1)/YOUN
 353 :       EPSX(2) = EPSN(IMEC(2)) + (XNU/YOUN)*XX(1) - XX(2)/YOUN
 354 :       IF (EPSX(2).GT.EPSR) THEN
 355 :          GOTO 2030
 356 :       ELSE
 357 :          SIGP(IMEC(1)) = XX(1)
 358 :          SIGP(IMEC(2)) = XX(2)
 359 :          EPS(IMEC(1)) = EPSX(1)
 360 :          EPS(IMEC(2)) = EPSX(2)
 361 :          EPSP(IMEC(1)) = BETA*EPSR
 362 :          EPSP(IMEC(2)) = BETA*EPS(IMEC(2))
 363 :          ICAS = 4
 364 :          GOTO 9999
 365 :       ENDIF
 366 : C Cas 2 directions apres rupture
 367 :  2030 CONTINUE
 368 :       SIGP(1) = XFRE
 369 :       SIGP(2) = XFRE
 370 :       EPS(1) = EPSN(1) - ((UN - XNU)/YOUN)*XFRE
 371 :       EPS(2) = EPSN(2) - ((UN - XNU)/YOUN)*XFRE
 372 :       EPSP(1) = BETA*EPSR
 373 :       EPSP(2) = BETA*EPSR
 374 :       ICAS = 4
 375 :       GOTO 9999
 376 : C================================================================
 377 : C   PASSAGE DANS LE REPERE FIXE
 378 : C===============================================================
 379 :  9999 CONTINUE
 380 :       VARF(1) = CPHIF - UN
 381 :       VARF(2) = SPHIF
 382 :       VARF(3) = EPS(1)
 383 :       VARF(4) = EPS(2)
 384 :       VARF(5) = EPSN(1)
 385 :       VARF(6) = EPSN(2)
 386 :       VARF(7) = ICAS
 387 :       SIGF(1) = T(1,1)*SIGP(1) + T(1,2)*SIGP(2)
 388 :       SIGF(2) = T(2,1)*SIGP(1) + T(2,2)*SIGP(2)
 389 :       SIGF(3) = XZERO
 390 :       SIGF(4) = -T(3,1)*SIGP(1) - T(3,2)*SIGP(2)
 391 :       DEFP(1) = T(1,1)*EPSP(1) + T(1,2)*EPSP(2)
 392 :       DEFP(2) = T(2,1)*EPSP(1) + T(2,2)*EPSP(2)
 393 :       DEFP(3) = XZERO
 394 :       DEFP(4) = -2.D0*(T(3,1)*EPSP(1) + T(3,2)*EPSP(2))
 395 :       RETURN
 396 :       END
 397 : 
 398 : 
 399 : 
 400 :  
 401 :  
 402 :  

© Cast3M 2003 - All rights reserved.
Disclaimer