1 : C T2C1DP SOURCE CHAT 05/01/13 03:29:45 5004 2 : SUBROUTINE T2C1DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H2,RDP,ADP,HDP, 3 : 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPPLDP,ALPHA,KERRE) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : -INC CCOPTIO 7 : DIMENSION SIG(3),DSIG(3),SGG(3),DSGG(3),SFG(3),DSFG(3), 8 : 1 A(3),B(3),IDAM(3),EPC(3),SSI(3),SI(3),EPC1(3),SG1(3), 9 : 1 SG2(3),EC1(3),EC2(3),AT(4),BT(2),EPDP(3),EPPLDP(3),TENS(3) 10 : ITER=0 11 : Y=YOUN/(1.D0-ANU*ANU) 12 : DO 5 ITYP=1,3 13 : EPPLDP(ITYP)=0.D0 14 : 5 EPDP(ITYP)=0.D0 15 : XT=0.D0 16 : IF(IIMPI.EQ.9) WRITE(IOIMP,9999) 17 : 9999 FORMAT(1X,'T2C1DP TRIPLAGE TRACTION 2 COMP 1 DRUCKER',/) 18 : 9998 FORMAT(1X,'T2C1DP ',I4,'ITERATIONS INTERNES',/) 19 : C 20 : C------------------------------------------------ 21 : C TRIPLAGE TRACTION 2 COMPRESSION 1 DRUCKER 22 : C------------------------------------------------ 23 : C---------------------------------------------- 24 : C DEFINITION D UNE CONTRAINTE DE REFERENCE 25 : C SI RMAX DU DRUCKER INFERIEURE A CETTE VALEUR 26 : C ALORS SIGMA=0 27 : C---------------------------------------------- 28 : C 29 : RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP))) 30 : SIREF=1.E-6*YOUN 31 : C 32 : C-------------------------------------------------- 33 : C CAS OU LE RAYON DU DRUCKER EST INFERIEUR 34 : C A UNE VALEUR DE REFERENCE 35 : C-------------------------------------------------- 36 : C 37 : IF(SIREF.GT.RMAX) THEN 38 : DO 10 ITYP=1,3 39 : 10 SIG(ITYP)=SIG(ITYP)+DSIG(ITYP) 40 : RDP=0.D0 41 : HDP=0.D0 42 : ADP=0.D0 42 : CALL NORME(SIG,DL3) 43 : DL3=DL3/YOUN*10.D0 44 : XLAM3=XLAM3+DL3 44 : CALL CPHOIN(SIG,EPPLDP,YOUN,ANU) 45 : DO 20 ITYP=1,3 46 : IDAM(ITYP)=0 47 : DSIG(ITYP)=0.D0 48 : 20 SIG(ITYP)=0.D0 49 : IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER 50 : RETURN 51 : ENDIF 52 : C----------------------------------------------- 53 : C ON SE PLACE DANS LE REPERE DE FISSURATION 54 : C----------------------------------------------- 55 : C 55 : CALL CHREP(SIG,SFG,ANG) 55 : CALL CHREP(DSIG,DSFG,ANG) 56 : C 57 : C----------------------------------------------------- 58 : C ESTIMATION DU PAS D'INCREMENT DE CONTRAINTES 59 : C----------------------------------------------------- 60 : C 60 : CALL SIJ(SFG,SI,SIETOI) 60 : CALL EPSDP(SI,SIETOI,ADP,EPC) 60 : CALL CPHOMO(EPC,SSI,YOUN,ANU,ALPHA) 60 : CALL SCAL(EPC,SSI,VAL) 61 : VAL=VAL-HDP 62 : IF(VAL.LT.0.D0) THEN 63 : KERRE=459 64 : RETURN 65 : ENDIF 65 : CALL SCAL(SSI,DSFG,VAL) 65 : CALL NORME(DSFG,VA1) 65 : CALL NORME(SSI,VA2) 66 : IF(VA1.EQ.0.D0) THEN 67 : IDAM(1)=0 68 : IDAM(2)=0 69 : IDAM(3)=0 70 : RETURN 71 : ENDIF 72 : RMIN=MIN((RDP/1.73),(RDP/(1.D0+2.D0*ADP))) 73 : X=VAL/VA1/VA2 74 : IF(X.GE.1.D0) THEN 75 : X=1.D0 76 : GOTO 25 77 : ENDIF 78 : X=1.D0/SQRT(1.0001D0-X*X)*RMIN/VA1/8.D0 79 : IF(X.GT.1.D0) X=1.D0 80 : C 81 : C---------------------------------------------------------- 82 : C ON ECOULE ET ON REGARDE LA VARIATION DE NORMALE 83 : C---------------------------------------------------------- 84 : C 85 : C 86 : C--------------------------------------- 87 : C RESOLUTION DU SYSTEME EN DL3 88 : C--------------------------------------- 89 : 25 X=X/2.D0 90 : EC1(1)=1.D0 91 : EC1(2)=0.D0 92 : EC1(3)=0.D0 93 : EC2(1)=0.D0 94 : EC2(2)=1.D0 95 : EC2(3)=0.D0 95 : CALL CPHOOB(EC1,SG1,YOUN,ANU) 95 : CALL CPHOOB(EC2,SG2,YOUN,ANU) 96 : 51 X=X*2.D0 97 : 52 RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP))) 98 : ITER=ITER+1 99 : 653 IF(ITER.GT.200) THEN 100 : KERRE=460 101 : RETURN 102 : ENDIF 103 : IF(SIREF.GT.RMAX) THEN 104 : RDP=0.D0 105 : ADP=0.D0 106 : HDP=0.D0 107 : DO 60 ITYP=1,3 108 : 60 SFG(ITYP)=SFG(ITYP)+(1.D0-XT)*DSFG(ITYP) 108 : CALL NORME(SFG,DL3) 109 : DL3=DL3/YOUN*10.D0 110 : XLAM3=XLAM3+DL3 110 : CALL CPHOIN(SFG,EPPLDP,YOUN,ANU) 111 : DO 70 ITYP=1,3 112 : 70 EPDP(ITYP)=EPDP(ITYP)+EPPLDP(ITYP) 112 : CALL CHREP(EPDP,EPPLDP,-ANG) 113 : DO 80 ITYP=1,3 114 : IDAM(ITYP)=0 115 : DSIG(ITYP)=0.D0 116 : 80 SIG(ITYP)=0.D0 117 : IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER 118 : RETURN 119 : ENDIF 120 : IF((XT+X).GT.1.D0) X=1.D0-XT 120 : CALL SIJ(SFG,SI,SIETOI) 120 : CALL EPSDP(SI,SIETOI,ADP,EPC) 120 : CALL CPHOMO(EPC,SSI,YOUN,ANU,ALPHA) 120 : CALL SCAL(EPC,SSI,VAL) 121 : VAL=VAL-HDP 122 : IF(VAL.LT.0.D0) THEN 123 : KERRE=459 124 : RETURN 125 : ENDIF 126 : C 127 : 90 ITER=ITER+1 128 : IF(ITER.GT.201) GOTO 653 129 : IDAM(1)=-1 130 : AT(1)=Y 131 : AT(4)=Y-H2 132 : AT(2)=Y*ANU 133 : AT(3)=AT(2) 134 : DO 95 ITYP=1,3 135 : 95 DSGG(ITYP)=X*DSFG(ITYP) 136 : BT(1)=SFG(1)+DSGG(1) 137 : BT(2)=SFG(2)+DSGG(2)-RT2 137 : CALL SYLIN2(AT,BT,DL11,DL21) 138 : BT(1)=-SSI(1) 139 : BT(2)=-SSI(2) 139 : CALL SYLIN2(AT,BT,DL12,DL22) 140 : DO 100 ITYP=1,3 141 : A(ITYP)=SFG(ITYP)+DSGG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP) 142 : 100 B(ITYP)=-DL12*SG1(ITYP)-DL22*SG2(ITYP)-SSI(ITYP) 142 : CALL DLAMDP(A,B,DL3,RDP,ADP,HDP,ITEST) 143 : IF(ITEST.EQ.1) THEN 144 : X=X/2.D0 145 : GOTO 90 146 : ENDIF 147 : DL1=DL11+DL3*DL12 148 : DL2=DL21+DL3*DL22 149 : DO 105 ITYP=1,3 150 : SGG(ITYP)=SFG(ITYP)-DL1*SG1(ITYP)-DL2*SG2(ITYP) 151 : 105 SGG(ITYP)=SGG(ITYP)-DL3*SSI(ITYP)+X*DSFG(ITYP) 152 : IF(DL1.GT.1.D-10) IDAM(1)=0 153 : IF(DL2.LT.-1.D-10) IDAM(2)=0 154 : IF(DL3.LT.-1.D-10) IDAM(3)=0 155 : IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0.OR.IDAM(3).EQ.0) THEN 156 : DL1=0.D0 157 : DL2=0.D0 158 : DL3=0.D0 159 : X=0.D0 160 : GOTO 2000 161 : ENDIF 162 : C 163 : C------------------------------------------------------- 164 : C ON VERIFIE SI LA NORMALE DU DRUCKER VARIE PEU 165 : C------------------------------------------------------- 166 : C 166 : CALL SIJ(SGG,SI,SIETOI) 166 : CALL EPSDP(SI,SIETOI,ADP,EPC1) 166 : CALL SCAL(EPC,EPC1,VAL) 166 : CALL NORME(EPC,VA1) 166 : CALL NORME(EPC1,VA2) 167 : CO=VAL/VA1/VA2 168 : IF(CO.LT.0.99) THEN 169 : X=X/2.D0 170 : GOTO 90 171 : ENDIF 172 : RD=RDP-HDP*DL3 173 : RMAX=MAX((RD/1.73),(RD/(1.D0-2.D0*ADP))) 174 : IF(RMAX.LT.SIREF) THEN 175 : RDP=0.D0 176 : GOTO 52 177 : ENDIF 178 : C 179 : C------------------------------------------------- 180 : C CAS OU LA TRACTION PASSE EN DESSOUS DE 0 181 : C------------------------------------------------- 182 : C 183 : IF((RT2-H2*DL2).GE.-1.E-10) GOTO 200 184 : C 185 : IF(H2.EQ.0.D0) H2=1.D0 186 : DL2=RT2/H2 187 : AT(1)=-DSFG(1) 188 : AT(3)=-DSFG(2) 189 : AT(2)=Y 190 : AT(4)=Y*ANU 191 : BT(1)=SFG(1)-DL2*SG2(1) 192 : BT(2)=SFG(2)-DL2*SG2(2) 192 : CALL SYLIN2(AT,BT,X1,DL11) 193 : BT(1)=-SSI(1) 194 : BT(2)=-SSI(2) 194 : CALL SYLIN2(AT,BT,X2,DL12) 195 : DO 110 ITYP=1,3 196 : A(ITYP)=SFG(ITYP)+X1*DSFG(ITYP)-DL11*SG1(ITYP)-DL2*SG2(ITYP) 197 : 110 B(ITYP)=X2*DSFG(ITYP)-DL12*SG1(ITYP)-SSI(ITYP) 197 : CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST) 198 : DO 111 ITYP=1,3 199 : SGG(ITYP)=A(ITYP)+DL31*B(ITYP) 200 : 111 DSGG(ITYP)=A(ITYP)+DL32*B(ITYP) 200 : CALL SIJ(SGG,SI,SIETOI) 200 : CALL EPSDP(SI,SIETOI,ADP,EPC1) 200 : CALL SCAL(EPC,EPC1,VAL) 200 : CALL NORME(EPC,VA1) 200 : CALL NORME(EPC1,VA2) 201 : CO1=VAL/VA1/VA2 201 : CALL SIJ(DSGG,SI,SIETOI) 201 : CALL EPSDP(SI,SIETOI,ADP,EPC1) 201 : CALL SCAL(EPC,EPC1,VAL) 201 : CALL NORME(EPC,VA1) 201 : CALL NORME(EPC1,VA2) 202 : CO2=VAL/VA1/VA2 203 : XIN1=X1+X2*DL31 204 : XIN2=X1+X2*DL32 205 : DLIN1=DL11+DL31*DL12 206 : DLIN2=DL11+DL32*DL12 207 : IF(XIN1.GT.-1.E-10.AND.DLIN1.LT.1.E-10.AND.XIN1.LE.X 208 : 1 .AND.CO1.GT.0.9) THEN 209 : DL3=DL31 210 : X=XIN1 211 : DL1=DLIN1 212 : GOTO 200 213 : ENDIF 214 : IF(XIN2.GT.-1.E-10.AND.DLIN2.LT.1.E-10.AND.XIN2.LE.X 215 : 1 .AND.CO2.GT.0.9) THEN 216 : DL3=DL32 217 : X=XIN2 218 : DL1=DLIN2 219 : GOTO 200 220 : ENDIF 221 : IF(IIMPI.EQ.9) WRITE(IOIMP,10101) 222 : 10101 FORMAT(1X,'ERREUR DANS T2C1DP TRAC',/) 223 : DL3=DL31 224 : X=XIN1 225 : DL1=DLIN1 226 : 200 IF((XLAM1+DL1).GE.0.D0) GOTO 300 227 : C 228 : C------------------------------------------------- 229 : C CAS OU LA FISSURE 1 EST TOTALEMENT FERME 230 : C------------------------------------------------- 231 : C 232 : C 233 : IDAM(1)=0 234 : DL1=-XLAM1 235 : AT(1)=-DSFG(1) 236 : AT(3)=-DSFG(2) 237 : AT(4)=Y-H2 238 : AT(2)=Y*ANU 239 : BT(1)=SFG(1)-DL1*SG1(1) 240 : BT(2)=SFG(2)-DL1*SG1(2)-RT2 240 : CALL SYLIN2(AT,BT,X1,DL21) 241 : BT(1)=-SSI(1) 242 : BT(2)=-SSI(2) 242 : CALL SYLIN2(AT,BT,X2,DL22) 243 : DO 210 ITYP=1,3 244 : A(ITYP)=SFG(ITYP)+X1*DSFG(ITYP)-DL21*SG2(ITYP)-DL1*SG1(ITYP) 245 : 210 B(ITYP)=X2*DSFG(ITYP)-DL22*SG2(ITYP)-SSI(ITYP) 245 : CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST) 246 : DO 211 ITYP=1,3 247 : SGG(ITYP)=A(ITYP)+DL31*B(ITYP) 248 : 211 DSGG(ITYP)=A(ITYP)+DL32*B(ITYP) 248 : CALL SIJ(SGG,SI,SIETOI) 248 : CALL EPSDP(SI,SIETOI,ADP,EPC1) 248 : CALL SCAL(EPC,EPC1,VAL) 248 : CALL NORME(EPC,VA1) 248 : CALL NORME(EPC1,VA2) 249 : CO1=VAL/VA1/VA2 249 : CALL SIJ(DSGG,SI,SIETOI) 249 : CALL EPSDP(SI,SIETOI,ADP,EPC1) 249 : CALL SCAL(EPC,EPC1,VAL) 249 : CALL NORME(EPC,VA1) 249 : CALL NORME(EPC1,VA2) 250 : CO2=VAL/VA1/VA2 251 : XIN1=X1+X2*DL31 252 : XIN2=X1+X2*DL32 253 : DLIN1=DL21+DL31*DL22 254 : DLIN2=DL21+DL32*DL22 255 : IF(XIN1.GT.-1.E-10.AND.DLIN1.GT.-1.E-10.AND.XIN1.LE.X 256 : 1 .AND.CO1.GT.0.9) THEN 257 : DL3=DL31 258 : X=XIN1 259 : DL2=DLIN1 260 : GOTO 300 261 : ENDIF 262 : IF(XIN2.GT.-1.E-10.AND.DLIN2.GT.-1.E-10.AND.XIN2.LE.X 263 : 1 .AND.CO2.GT.0.9) THEN 264 : DL3=DL32 265 : X=XIN2 266 : DL2=DLIN2 267 : GOTO 300 268 : ENDIF 269 : IF(IIMPI.EQ.9) WRITE(IOIMP,20202) 270 : 20202 FORMAT(1X,'ERREUR DANS T2C1DP FERM',/) 271 : DL3=DL31 272 : X=XIN1 273 : DL2=DLIN1 274 : 300 DO 310 ITYP=1,3 275 : SGG(ITYP)=SFG(ITYP)-DL1*SG1(ITYP)-DL2*SG2(ITYP) 276 : 310 SGG(ITYP)=SGG(ITYP)-DL3*SSI(ITYP)+X*DSFG(ITYP) 277 : RDP=RDP-DL3*HDP 278 : RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP))) 279 : IF(RMAX.LT.SIREF) THEN 280 : RDP=0.D0 281 : GOTO 52 282 : ENDIF 283 : XT=XT+X 284 : DO 330 ITYP=1,3 285 : EPDP(ITYP)=EPDP(ITYP)+DL3*EPC(ITYP) 286 : 330 SFG(ITYP)=SGG(ITYP) 287 : XLAM1=XLAM1+DL1 288 : XLAM2=XLAM2+DL2 289 : XLAM3=XLAM3+DL3 290 : RT2=RT2-H2*DL2 291 : IF(RT2.LT.1.E-10) THEN 292 : H2=0.D0 293 : RT2=0.D0 294 : ENDIF 295 : IF(XLAM1.LT.1.E-10) THEN 296 : IDAM(1)=0 297 : XLAM1=0.D0 298 : ENDIF 299 : IF(IDAM(1).EQ.0) THEN 300 : XLAM1=0.D0 301 : C 302 : DO 340 ITYP=1,3 303 : DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP) 304 : 340 TENS(ITYP)=SFG(ITYP)+DSFG(ITYP) 305 : GAMTR1=10.D0 306 : GAMTR2=10.D0 307 : GAMCO2=10.D0 308 : C 309 : GAMDP=10.D0 309 : CALL CTRAF(TENS(1),RT1,VCTR1) 309 : CALL CTRAF(TENS(2),RT2,VCTR2) 309 : CALL CCOAF(TENS(2),XLAM2,VCCO2) 310 : C 310 : CALL CDP(TENS,ADP,RDP,VCDP) 310 : IF(VCTR1.GT.0.D0) CALL GAMTAF(SFG(1),DSFG(1),RT1,GAMTR1) 310 : IF(VCTR2.GT.0.D0) CALL GAMTAF(SFG(2),DSFG(2),RT2,GAMTR2) 310 : IF(VCCO2.GT.0.D0) CALL GAMCAF(SFG(2),DSFG(2),GAMCO2) 311 : C 311 : IF(VCDP.GT.0.D0) CALL GDP(SFG,DSFG,RDP,ADP,GAMDP) 312 : IDAM(1)=0 313 : IDAM(2)=0 314 : IDAM(3)=0 315 : GAM=MIN(GAMTR1,GAMTR2,GAMCO2,GAMDP) 316 : IF(GAM.GE.1.D0) THEN 317 : DO 341 ITYP=1,3 318 : SFG(ITYP)=SFG(ITYP)+DSFG(ITYP) 319 : 341 DSIG(ITYP)=0.D0 319 : CALL CHREP(SFG,SIG,-ANG) 319 : CALL CHREP(EPDP,EPPLDP,-ANG) 320 : IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER 321 : RETURN 322 : ENDIF 323 : IF(ABS(GAM-GAMTR1).LE.1.E-10) IDAM(1)=1 324 : IF(ABS(GAM-GAMCO2).LE.1.E-10) IDAM(2)=-1 325 : IF(ABS(GAM-GAMTR2).LE.1.E-10) IDAM(2)=1 326 : C 327 : IF(ABS(GAM-GAMDP).LE.1.E-10) IDAM(3)=1 328 : DO 342 ITYP=1,3 329 : SFG(ITYP)=SFG(ITYP)-GAM*DSFG(ITYP) 330 : 342 DSFG(ITYP)=(1.D0-GAM)*DSFG(ITYP) 330 : CALL CHREP(SFG,SIG,-ANG) 330 : CALL CHREP(DSFG,DSIG,-ANG) 330 : CALL CHREP(EPDP,EPPLDP,-ANG) 331 : IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER 332 : RETURN 333 : ENDIF 334 : C=1.D0-1.D-10 335 : IF(XT.GE.C) THEN 336 : DO 350 ITYP=1,3 337 : IDAM(ITYP)=0 338 : 350 DSIG(ITYP)=0.D0 338 : CALL CHREP(SFG,SIG,-ANG) 338 : CALL CHREP(EPDP,EPPLDP,-ANG) 339 : IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER 340 : RETURN 341 : ENDIF 342 : GOTO 51 343 : 2000 CONTINUE 343 : CALL CHREP(SFG,SIG,-ANG) 344 : DO 2010 ITYP=1,3 345 : 2010 DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP) 345 : CALL CHREP(DSFG,DSIG,-ANG) 345 : CALL CHREP(EPDP,EPPLDP,-ANG) 346 : IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER 347 : RETURN 348 : END 349 :
© Cast3M 2003 - All rights reserved.
Disclaimer