1 : C BONE SOURCE CHAT 05/01/12 21:42:05 5004 2 : SUBROUTINE BONE(SIGR,SIGF,DSTRN,IPLA,IFISU,SIG1,SIG2 3 : A ,NSTRS,D,D1,IFOUB,SIGP,EPST,SIR,SIRL,ENDO 4 : B ,ITHHER,T0,TF,BETJEF,VISCO,BETFLU 5 : B ,NECH0,NECH1,NECH2,NECH3) 6 : C 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : DIMENSION SIGR(4),DSIGT(4),SIGF(4),S1(4),DSTRN(4),SIGT(4) 10 : DIMENSION EPSR(9),S2(4),V2(4),V1(4) 11 : DIMENSION S(6),SI1(6),EPST(4),SIGRV(4) 12 : DIMENSION ST0(6),V02(4),SI0(6),V01(4),SIGP(4) 13 : DIMENSION SIGIST(4),EXU(9),CODU(9,9),COD(8),TZU(19) 14 : DIMENSION STRNI(9),SOM(9),DEFMAX(9),DDSTRN(9) 15 : DIMENSION H(4,4),DSTFL(4),S3(4) 16 : DIMENSION DEP(4,4),D1(4,4),D(4,4),SIRL(8,4),SIR(9,4) 17 : DIMENSION DEPE(4,4),DH(4,4),HI(4,4),CODL(8,8) 18 : * 19 : SEGMENT BETJEF 20 : REAL*8 AA,BETA,RB,ALPHA,EX,XNU,GFC,GFT,CAR,ETA,TDEF, 21 : & TCON,DPSTF1,DPSTF2,TETA,PDT,TP00 22 : INTEGER ICT,ICC,IMOD,IVIS,ITER, 23 : & ISIM,IBB,IGAU,IZON 24 : ENDSEGMENT 25 : SEGMENT VISCO 26 : REAL*8 DPSTV1,DPSTV2,SIGV1,SIGV2,ENDV 27 : ENDSEGMENT 28 : SEGMENT BETFLU 29 : REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2, 30 : & TP0,TZER 31 : INTEGER ITYPE,IMD,NBRC,NCOE,NTZERO,NTPS,IFOR 32 : ENDSEGMENT 33 : SEGMENT NECH0 34 : REAL*8 DT,DC,ALFG,S0,ENDO 35 : ENDSEGMENT 36 : SEGMENT NECH1 37 : REAL*8 DLMT 38 : ENDSEGMENT 39 : SEGMENT NECH2 40 : REAL*8 ATR,GTR,ALPH0 41 : ENDSEGMENT 42 : SEGMENT NECH3 43 : REAL*8 RBT,ALFAT,YOUNT,GFCT,GFTT,ALPH 44 : ENDSEGMENT 45 : C 46 : TAU1=0.05 47 : NTPS=18 48 : NTZERO=18 49 : NCOE=8 50 : MC=NBRC+1 51 : NC=NCOE+1 52 : C 53 : C-------------------------------------------------------------------------- 54 : C ************************************************************ 55 : C * APPLICATION DES CRITERES DE PLASTICITE ET FISSURATION * 56 : C * CRITERE BETON * 57 : C * * 58 : C * IFISU=INDICE DE FISSURATION * 59 : C * =0 PAS DE FISSURE * 60 : C * =1 UNE FISSURE * 61 : C * =2 RUINE DANS DIRECTION DE TRACTION * 62 : C * * 63 : C * IPLA =INDICE DE PLASTICITE * 64 : C * =0 ELASTIQUE * 65 : C * =1 ECROUISSAGE POSITIF * 66 : C * =2 RUPTURE PAR COMPRESSION DANS 1 DIRECTION * 67 : C * * 68 : C * * 69 : C * * 70 : C ************************************************************ 71 : C--------------------------------------------------------------------- 72 : 73 : AA = 1.D0/3.D0 73 : CALL ZERO(DSIGT,4,1) 73 : CALL ZERO(SIGT,4,1) 73 : CALL ZERO(SIGIST,4,1) 73 : CALL ZERO(SIGRV,4,1) 73 : CALL ZERO(CODU,9,9) 73 : CALL ZERO(CODL,8,8) 73 : CALL ZERO(COD,8,1) 73 : CALL ZERO(S1,4,1) 73 : CALL ZERO(S2,4,1) 73 : CALL ZERO(V1,4,1) 73 : CALL ZERO(V2,4,1) 73 : CALL ZERO(D,4,4) 73 : CALL ZERO(DEP,4,4) 73 : CALL ZERO(H,4,4) 73 : CALL ZERO(HI,4,4) 74 : DAM = 0.D0 75 : C 76 : C ****************** INITIALISATION POUR VISCOPLASTIQUE *************** 77 : C 78 : IF (IVIS.EQ.1.OR.IVIS.EQ.4) THEN 79 : DO 5 I=1,NSTRS 80 : SIGRV(I)= SIGR(I) 81 : 5 CONTINUE 82 : ENDIF 83 : IF ((IVIS.EQ.1.AND.(IPLA.GT.0.OR.IFISU.GT.0)).OR. 84 : & (IVIS.EQ.4.AND.(IPLA.GT.0.OR.IFISU.GT.0))) THEN 85 : C 86 : DO 6 I=1,NSTRS 87 : SIGR(I)= SIGP(I) 88 : 6 CONTINUE 89 : ENDIF 90 : DO 7 I=1,NSTRS 91 : SIGR(I)= SIGR(I)/(1.D0-ENDO) 92 : 7 CONTINUE 93 : C 94 : C ****************** INITIALISATION POUR VISCOELASTIQUE *************** 95 : C 96 : IF (IVIS.EQ.2) THEN 97 : SEL1=0.D0 98 : SEL2=0.D0 99 : EX=0.D0 100 : TPS1 = TP0 101 : TPS2 = TP0+PDT 102 : ENDIF 103 : C 103 : CALL INFICH(CODU,CODL,COD,BETJEF,BETFLU) 103 : CALL MODBET(TPS1,TPS2,SEL1,SEL2,EXU,EXUL,EX,CODU,CODL 104 : & ,COD,BETJEF,BETFLU) 105 : C WRITE(*,*)'EX=',EX,'a T=',TPS2 106 : IF (IFOR.EQ.1) THEN 106 : CALL CALIS1(SIGIST,NSTRS,DSTRN,IFOUB,SIR,CODU,CODL, 107 : & COD,BETJEF,BETFLU) 108 : ENDIF 109 : IF (IFOR.EQ.2) THEN 109 : CALL CALIS2(SIGIST,NSTRS,DSTRN,IFOUB,SIRL,CODU,CODL, 110 : & COD,BETJEF,BETFLU) 111 : ENDIF 112 : C 113 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 114 : C INITIALISATION DE L'ENDOMMAGEMENT 115 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 116 : IF(IVIS.EQ.3.OR.IVIS.EQ.4) THEN 117 : IF((IFISU.EQ.0.D0).AND.(IPLA.EQ.0.D0))THEN 118 : ENDO=0.D0 119 : DO 300 I =1, NSTRS 120 : STRNI(I)=0.D0 121 : 300 CONTINUE 122 : ENDIF 123 : C 124 : DO 400 I=1, NSTRS 125 : SOM(I)=SOM(I)+DSTRN(I) 126 : DEFMAX(I)=MAX(DABS(SOM(I)),DABS(STRNI(I))) 127 : DDSTRN(I)=DABS(SOM(I))-DABS(DEFMAX(I)) 128 : 400 CONTINUE 129 : 130 : C 131 : DO 500 I=1, NSTRS 132 : STRNI(I)=DEFMAX(I) 133 : 500 CONTINUE 134 : C 135 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 136 : C TEST SUR LE TYPE DE CHARGEMENT 137 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 138 : C 139 : DO 200 I=1,NSTRS 140 : IF (DDSTRN(I).LT.0.D0) THEN 141 : DSTRN(I)=(1.D0-ENDO)*DSTRN(I) 142 : ENDIF 143 : 200 CONTINUE 144 : C 145 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 146 : C CALCUL DE LA MATRICE D'INTERACTION THERMO-MECA [H] 147 : C ET INVERSE DE [H] 148 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 149 : C 149 : CALL INTERF(ITHHER,T0,TF,NSTRS,H,BETJEF,NECH2) 150 : C 151 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 152 : C CALCUL DE LA DEFORMATION D'INTERACTION 153 : C THERMO-MECA [DSTFL]AU PAS N 154 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 155 : C 155 : CALL TRANSI(ITHHER,T0,TF,NSTRS,HI,BETJEF,NECH2) 156 : C 157 : DO 250 I=1,NSTRS 158 : DSTFL(I)=0.D0 159 : DO 250 J=1,NSTRS 160 : DSTFL(I)=DSTFL(I)+HI(I,J)*SIGF(J) 161 : 250 CONTINUE 162 : C 163 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 164 : C CALCUL DE LA DEFORMATION DU TIRE ELASTIQUE 165 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 166 : C 167 : DO 260 I=1,NSTRS 168 : DSTRN(I)=DSTRN(I)-DSTFL(I) 169 : 260 CONTINUE 170 : C 171 : C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 172 : C 172 : CALL INVMA2(H,NSTRS,ISING) 173 : ENDIF 174 : C 175 : C ************************** CAS CONTRAINTE PLANE ********************* 176 : C 177 : IF (IFOUB.EQ.-2) THEN 178 : IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN 178 : CALL CREMAT(DH,EX,XNU,3,IFOUB) 178 : CALL PRODMM(H,DH,DEP,NSTRS,NSTRS,NSTRS) 179 : ELSE 179 : CALL CREMAT(DEP,EX,XNU,3,IFOUB) 180 : ENDIF 181 : IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN 181 : CALL PROMA2(DEP,DSTRN,3,DSIGT) 182 : DO 2 I=1,NSTRS 183 : SIGT(I)=SIGR(I)+DSIGT(I)+SIGIST(I) 184 : 2 CONTINUE 185 : ENDIF 186 : IF (IMOD.EQ.2.OR.IMOD.EQ.4) THEN 187 : WRITE(*,*)'ATTENTION IMOD=2 ou 4 -> DEFORMATIONS PLANES' 188 : STOP 189 : ENDIF 190 : ENDIF 191 : C 192 : C ***** CAS DEFORMATION PLANE ou AXISYMETRIQUE *************** 193 : C 194 : IF (IFOUB.EQ.-1.OR.IFOUB.EQ.0) THEN 195 : IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN 195 : CALL CREMAT(DH,EX,XNU,4,IFOUB) 195 : CALL PRODMM(H,DH,DEP,NSTRS,NSTRS,NSTRS) 196 : ELSE 196 : CALL CREMAT(DEP,EX,XNU,4,IFOUB) 197 : ENDIF 197 : CALL PROMA2(DEP,DSTRN,4,DSIGT) 198 : DO 3 I=1,NSTRS 199 : SIGT(I)=SIGR(I)+DSIGT(I)+SIGIST(I) 200 : 3 CONTINUE 201 : IF (IMOD.EQ.1.OR.IMOD.EQ.3) THEN 202 : WRITE(*,*)'ATTENTION IMOD=1 ou 3 -> CONTRAINTES PLANES' 203 : STOP 204 : ENDIF 205 : ENDIF 206 : C 207 : C ************************ Normalisation ********************* 208 : C 209 : DO 1 I=1,NSTRS 210 : IF(DABS(SIGR(I)).LT.1.D-6) SIGR(I)=0.D0 211 : IF(DABS(SIGT(I)).LT.1.D-6) SIGT(I)=0.D0 212 : 1 CONTINUE 213 : C--------------------------------------------------------------------- 214 : DO 11 I=1,NSTRS 215 : S1(I)=SIGT(I) 216 : 11 CONTINUE 216 : CALL PRINC(S1,V1,NSTRS) 217 : C 218 : C **************** TEST DU TYPE DE SOLLICITATION ********************* 219 : C 220 : IZON=1 221 : IF(V1(1).LT.0.D0.AND.V1(2).LT.0.D0) IZON=0 222 : IF(V1(1).GE.0.D0.AND.V1(2).GE.0.D0) IZON=2 223 : C--------------------------------------------------------------------- 224 : C IF (IFISU.NE.0) GOTO 15 225 : IF (IZON.EQ.0) GOTO 30 226 : IF (IZON.EQ.1.OR.IZON.EQ.2) GOTO 15 227 : C 228 : C ******************** COMPORTEMENT DE TRACTION ********************** 229 : C 230 : 15 CONTINUE 231 : C ##################################### 232 : C * POINT DEJA FISSURE * 233 : C * COMPORTEMENT PLASTIQUE * 234 : C ##################################### 235 : C 236 : IF(IFISU.NE.0) THEN 237 : IF(IZON.EQ.2) THEN 237 : CALL BEHAV1(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA, 238 : A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP, 239 : A BETJEF,VISCO,NECH0,NECH1) 240 : GOTO 40 241 : ENDIF 242 : IF(IZON.EQ.1) THEN 242 : CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA, 243 : A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP, 244 : A BETJEF,VISCO,NECH0,NECH1) 245 : GOTO 40 246 : ENDIF 247 : IF(IZON.EQ.0) THEN 248 : WRITE(*,*)'Dans elasbet un point deja fissure est teste en 249 : *bicompression' 250 : WRITE(*,*)'Element num:',IBB ,'au point de Gauss num:',IGAU 251 : STOP 252 : ENDIF 253 : ENDIF 254 : C--------------------------------------------------------------------- 255 : C ##################################### 256 : C * POINT FISSURE 1ER FOIS * 257 : C * COMPORTEMENT PLASTIQUE * 258 : C ##################################### 259 : C 260 : Ft=ALPHA*RB 261 : IF(V1(1).GT.Ft) THEN 262 : IF(IZON.EQ.2) THEN 262 : CALL BEHAV1(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA, 263 : A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP, 264 : A BETJEF,VISCO,NECH0,NECH1) 265 : GOTO 40 266 : ENDIF 267 : IF(IZON.EQ.1) THEN 267 : CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA, 268 : A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP, 269 : A BETJEF,VISCO,NECH0,NECH1) 270 : GOTO 40 271 : ENDIF 272 : ENDIF 273 : IF(IZON.EQ.1.AND.IPLA.EQ.0) THEN 274 : IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN 274 : CALL CRIVON(S1,SEQ,NSTRS,BETJEF) 275 : ENDIF 276 : IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN 276 : CALL CRIDRU(S1,SEQ,NSTRS,BETJEF) 277 : ENDIF 278 : FCRI=SEQ-RB*AA 279 : IF(FCRI.GT.0.D0) THEN 279 : CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA, 280 : A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP, 281 : A BETJEF,VISCO,NECH0,NECH1) 282 : GOTO 40 283 : ENDIF 284 : ENDIF 285 : IF(IZON.EQ.1.AND.IPLA.GE.1) THEN 286 : IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN 286 : CALL CRIVON(S1,SEQ,NSTRS,BETJEF) 287 : ENDIF 288 : IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN 288 : CALL CRIDRU(S1,SEQ,NSTRS,BETJEF) 289 : ENDIF 290 : FCRI=SEQ-SIG2 291 : IF(FCRI.GT.0.D0) THEN 291 : CALL BEHAV3(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA, 292 : A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP, 293 : A BETJEF,VISCO,NECH0,NECH1) 294 : GOTO 40 295 : ENDIF 296 : ENDIF 297 : GOTO 40 298 : C 299 : C *************** COMPORTEMENT DE BICOMPRESSION ********************** 300 : C 301 : 30 CONTINUE 302 : C--------------------------------------------------------------------- 303 : IF(IMOD.EQ.1.OR.IMOD.EQ.2) THEN 303 : CALL CRIVON(S1,SEQ,NSTRS,BETJEF) 304 : ENDIF 305 : IF(IMOD.EQ.3.OR.IMOD.EQ.4) THEN 305 : CALL CRIDRU(S1,SEQ,NSTRS,BETJEF) 306 : ENDIF 307 : FCRI=SEQ-RB*AA 308 : IF (FCRI.GT.0.D0.OR.IPLA.NE.0) THEN 308 : CALL BEHAV2(SIGR,DSTRN,DPSTF1,DPSTF2,IPLA, 309 : A SIG1,SIG2,IFISU,S1,DSIGT,NSTRS,IFOUB,DEP,SIGRV,SIGP, 310 : A BETJEF,VISCO,NECH0,NECH1) 311 : GOTO 40 312 : ENDIF 313 : C--------------------------------------------------------------------- 314 : 40 CONTINUE 315 : C--------------------------------------------------------------------- 316 : C 317 : IF (IVIS.EQ.3.OR.IVIS.EQ.4) THEN 318 : IF(IVIS.EQ.3) THEN 318 : CALL REELLE(S1,DEP,DPSTF1,DPSTF2,DEPE,S2,DAM, 319 : & NSTRS,IFISU,IPLA,BETJEF,NECH0,NECH1) 320 : ENDO = DAM 321 : DO 98 I=1,NSTRS 322 : S1(I)= S2(I) 323 : 98 CONTINUE 324 : ENDIF 325 : IF(IVIS.EQ.4.AND.(IPLA.GT.0.OR.IFISU.GT.0)) THEN 325 : CALL REELLE(S1,DEP,DPSTF1,DPSTF2,DEPE,SIGP,DAM, 326 : & NSTRS,IFISU,IPLA,BETJEF,NECH0,NECH1) 327 : ENDO = DAM 327 : CALL VISPL1(SIGP,DSIGT,NSTRS,S2,SIGRV,DSTRN, 328 : & DPSTF1,DPSTF2,BETJEF,VISCO,NECH0,NECH1) 329 : DO 99 I=1,NSTRS 330 : S1(I)= S2(I) 331 : 99 CONTINUE 332 : ENDIF 333 : ENDIF 334 : C 335 : C MODIF DEP ET CONTRAINTES 336 : C 337 : DO 121 I=1,NSTRS 338 : DO 121 J=1,NSTRS 339 : D(I,J)=DEP(I,J) 340 : 121 CONTINUE 341 : C--------------------------------------------------------------------- 342 : 50 CONTINUE 343 : C--------------------------------------------------------------------- 344 : DO 42 I=1,NSTRS 345 : C IF(DABS(S1(I)).LT.1.D-6) S1(I)=0.D0 346 : SIGF(I)= S1(I) 347 : C WRITE(*,*)'SIGF(',I,')=',SIGF(I) 348 : 42 CONTINUE 349 : C 350 : C 351 : 70 FORMAT (4(1X,E12.5)) 352 : RETURN 353 : END 354 : 355 : 356 : 357 :
© Cast3M 2003 - All rights reserved.
Disclaimer