1 : C T2C1 SOURCE CHAT 05/01/13 03:29:51 5004 2 : SUBROUTINE T2C1(SIG,DSIG,YOUN,ANU,RT2,H2,RDP,ADP, 3 : 1 XLAM1,XLAM2,IDAM,ANG) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : -INC CCOPTIO 7 : DIMENSION SIG(3),DSIG(3),SFC(3),DSFC(3),TSFC(3),SFG(3),DSFG(3), 8 : 1 EPC(3),A(4),B(2),IDAM(3),EPC1(3),EPC2(3),SG(3),DSG(3),SG1(3), 9 : 1 SG2(3),TENS(3) 10 : Y=YOUN/(1.D0-ANU*ANU) 11 : IF(RT2.LT.1.E-10) THEN 12 : H2=0.D0 13 : RT2=0.D0 14 : ENDIF 15 : C 16 : C------------------------------------------ 17 : C TRACTION DANS LA DIRECTION 2 | 18 : C COMPRESSION DANS LA DIRECTION 1 | 19 : C------------------------------------------ 20 : C 21 : C------------------------------------------------- 22 : C ON SE PLACE DANS LE REPERE DE FISSURATION | 23 : C------------------------------------------------- 24 : C 24 : CALL CHREP(SIG,SFG,ANG) 24 : CALL CHREP(DSIG,DSFG,ANG) 25 : IF(IIMPI.EQ.9) WRITE(IOIMP,9999) 26 : 9999 FORMAT(1X,'T2C1 COUPLAGE TRACTION 2 COMP 1',/) 27 : C 28 : C------------------------------------------ 29 : C OBTENTION DU SYSTEME EN DL1 DL2 30 : C------------------------------------------ 31 : C 32 : 1 B(1)=DSFG(1)+SFG(1) 33 : B(2)=-RT2+DSFG(2)+SFG(2) 34 : A(1)=Y 35 : A(4)=Y-H2 36 : A(2)=ANU*Y 37 : A(3)=A(2) 37 : CALL SYLIN2(A,B,DL1,DL2) 38 : C 39 : C----------------------------------------- 40 : C CAS DES FAUX COUPLAGES 41 : C----------------------------------------- 42 : C 43 : IF(DL2.LT.-1.E-10) IDAM(2)=0 44 : IF(DL1.GT.1.E-10) IDAM(1)=0 45 : IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0) THEN 45 : CALL CHREP(SFG,SIG,-ANG) 45 : CALL CHREP(DSFG,DSIG,-ANG) 46 : RETURN 47 : ENDIF 48 : C 49 : C----------------------------------------------- 50 : C CAS OU LA LIMITE EN TRACTION ATTEINT 0 | 51 : C----------------------------------------------- 52 : C 53 : IF((RT2-H2*DL2).GE.-1.E-10) GOTO 1000 54 : DL2=RT2/H2 55 : A(1)=DSFG(1) 56 : A(3)=DSFG(2) 57 : A(2)=-Y 58 : A(4)=-Y*ANU 59 : DET=A(1)*A(4)-A(2)*A(3) 60 : IF(DET.EQ.0.D0) THEN 61 : X=0.D0 62 : DL1=(SFG(2)-Y*DL2)/Y/ANU 63 : IF(DL1.GT.0.D0) DL1=0.D0 64 : GOTO 5 65 : ENDIF 66 : B(1)=-SFG(1)+ANU*Y*DL2 67 : B(2)=-SFG(2)+Y*DL2 67 : CALL SYLIN2(A,B,X,DL1) 68 : 5 EPC(1)=DL1 69 : EPC(2)=DL2 70 : EPC(3)=0.D0 70 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 71 : DO 10 ITYP=1,3 72 : DSFC(ITYP)=(1.D0-X)*DSFG(ITYP) 73 : 10 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP) 74 : IF(DL1.LT.-XLAM1) GOTO 1001 74 : CALL CDP(SFC,ADP,RDP,VCDP) 75 : IF(VCDP.GT.0.D0) GOTO 3000 76 : RT2=0.D0 77 : H2=0.D0 78 : XLAM1=XLAM1+DL1 79 : XLAM2=XLAM2+DL2 80 : DO 20 ITYP=1,3 81 : DSFG(ITYP)=DSFC(ITYP) 82 : 20 SFG(ITYP)=SFC(ITYP) 83 : GOTO 1 84 : C 85 : C----------------------------------------------- 86 : C CAS OU ON FERME TOTALEMENT LA FISSURE 2 87 : C----------------------------------------------- 88 : C 89 : 1000 IF(DL1.GE.-XLAM1) GOTO 2000 90 : 1001 DL1=-XLAM1 91 : B(1)=-SFG(1)+DL1*Y 92 : B(2)=RT2-SFG(2)+DL1*ANU*Y 93 : A(2)=-Y*ANU 94 : A(1)=DSFG(1) 95 : A(4)=-Y+H2 96 : A(3)=DSFG(2) 97 : DET=A(1)*A(4)-A(2)*A(3) 98 : IF(DET.EQ.0.D0) THEN 99 : X=0.D0 100 : DL2=(SFG(2)-RT2-DL1*ANU*Y)/(Y-H2) 101 : IF(DL2.LT.0.D0) DL2=0.D0 102 : GOTO 1005 103 : ENDIF 103 : CALL SYLIN2(A,B,X,DL2) 104 : 1005 CONTINUE 105 : EPC(1)=DL1 106 : EPC(2)=DL2 107 : EPC(3)=0.D0 107 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 108 : DO 1010 ITYP=1,3 109 : SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP) 110 : DSFC(ITYP)=(1.D0-X)*DSFG(ITYP) 111 : 1010 TSFC(ITYP)=DSFG(ITYP)+SFG(ITYP) 112 : VCDP=-1.D0 112 : IF(X.GT.1.E-10) CALL CDP(SFC,ADP,RDP,VCDP) 113 : IF(VCDP.GT.0.D0) GOTO 3000 114 : RT2=RT2-H2*DL2 115 : IF(RT2.LE.1.E-10) THEN 116 : H2=0.D0 117 : RT2=0.D0 118 : ENDIF 119 : XLAM1=0.D0 120 : XLAM2=XLAM2+DL2 121 : IDAM(1)=0 122 : GAMCO=10.D0 123 : GAMTR=10.D0 124 : GAMDP=10.D0 125 : IDAM(2)=0 126 : IDAM(3)=0 126 : CALL CDP(TSFC,ADP,RDP,VCDP) 126 : IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFC,RDP,ADP,GAMDP) 126 : CALL CTRAF(TSFC(2),RT2,VCTR2) 126 : IF(VCTR2.GT.0.D0) CALL GAMTAF(SFC(2),DSFC(2),RT2,GAMTR) 126 : CALL CCOAF(TSFC(2),XLAM2,VCCO2) 126 : IF(VCCO2.GT.0.D0) CALL GAMCAF(SFC(2),DSFC(2),GAMCO) 127 : GAM=MIN(GAMDP,GAMTR,GAMCO) 128 : IF(GAM.GE.1.D0) THEN 129 : GAM=1.D0 130 : GOTO 1020 131 : ENDIF 132 : IF(ABS(GAM-GAMCO).LE.1.E-10) IDAM(2)=-1 133 : IF(ABS(GAM-GAMTR).LE.1.E-10) IDAM(2)=1 134 : IF(ABS(GAM-GAMDP).LE.1.E-10) IDAM(3)=1 135 : 1020 DO 1030 ITYP=1,3 136 : SFG(ITYP)=SFC(ITYP)+GAM*DSFC(ITYP) 137 : 1030 DSFG(ITYP)=DSFC(ITYP)*(1.D0-GAM) 137 : CALL CHREP(SFG,SIG,-ANG) 137 : CALL CHREP(DSFG,DSIG,-ANG) 138 : RETURN 139 : 2000 CONTINUE 140 : EPC(1)=DL1 141 : EPC(2)=DL2 142 : EPC(3)=0.D0 142 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 143 : DO 2010 ITYP=1,3 144 : 2010 SFC(ITYP)=DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) 144 : CALL CDP(SFC,ADP,RDP,VCDP) 145 : IF(VCDP.GT.0.D0) GOTO 3000 146 : C 147 : C------------------------------------------------ 148 : C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE 149 : C PENDANT L 'ECOULEMENT (SINON 3000) 150 : C------------------------------------------------ 151 : C 152 : RT2=RT2-H2*DL2 153 : IF(RT2.LE.1.E-10) THEN 154 : H2=0.D0 155 : RT2=0.D0 156 : ENDIF 157 : XLAM1=XLAM1+DL1 158 : XLAM2=XLAM2+DL2 159 : IDAM(1)=0 160 : IDAM(2)=0 161 : IDAM(3)=0 161 : CALL CHREP(SFC,SIG,-ANG) 162 : DO 2020 ITYP=1,3 163 : 2020 DSIG(ITYP)=0.D0 164 : RETURN 165 : 3000 CONTINUE 166 : EPC1(1)=1.D0 167 : EPC1(2)=0.D0 168 : EPC1(3)=0.D0 169 : EPC2(2)=1.D0 170 : EPC2(1)=0.D0 171 : EPC2(3)=0.D0 171 : CALL CPHOOB(EPC1,SG1,YOUN,ANU) 171 : CALL CPHOOB(EPC2,SG2,YOUN,ANU) 172 : B(1)=SFG(1) 173 : B(2)=SFG(2)-RT2 174 : A(1)=Y 175 : A(4)=Y-H2 176 : A(2)=ANU*Y 177 : A(3)=A(2) 177 : CALL SYLIN2(A,B,DL11,DL21) 178 : B(1)=DSFG(1) 179 : B(2)=DSFG(2) 179 : CALL SYLIN2(A,B,DL12,DL22) 180 : DO 3010 ITYP=1,3 181 : SG(ITYP)=SFG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP) 182 : 3010 DSG(ITYP)=DSFG(ITYP)-DL12*SG1(ITYP)-DL22*SG2(ITYP) 182 : CALL XDP(SG,DSG,RDP,ADP,X,ITEST) 183 : IF(ITEST.EQ.1) THEN 184 : IDAM(1)=-1 185 : IDAM(2)=1 186 : IDAM(3)=1 186 : CALL CHREP(SFG,SIG,-ANG) 186 : CALL CHREP(DSFG,DSIG,-ANG) 187 : RETURN 188 : ENDIF 189 : DL1=DL11+X*DL12 190 : DL2=DL21+X*DL22 191 : IDAM(1)=-1 192 : RT2=RT2-H2*DL2 193 : IF(RT2.LE.1.E-10) THEN 194 : H2=0.D0 195 : RT2=0.D0 196 : ENDIF 197 : XLAM1=XLAM1+DL1 198 : XLAM2=XLAM2+DL2 199 : IDAM(1)=-1 200 : IDAM(2)=1 201 : IDAM(3)=1 202 : IF(XLAM1.LT.1.E-8) THEN 203 : XLAM1=0.D0 204 : IDAM(1)=0 205 : ENDIF 206 : EPC(1)=DL1 207 : EPC(2)=DL2 208 : EPC(3)=0.D0 208 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 209 : DO 3020 ITYP=1,3 210 : SFG(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) 211 : 3020 DSFG(ITYP)=(1.D0-X)*DSFG(ITYP) 211 : CALL CHREP(DSFG,DSIG,-ANG) 211 : CALL CHREP(SFG,SIG,-ANG) 212 : RETURN 213 : END 214 :
© Cast3M 2003 - All rights reserved.
Disclaimer