1 : C C1C2 SOURCE CHAT 05/01/12 21:44:44 5004 2 : SUBROUTINE C1C2(SIG,DSIG,YOUN,ANU,RT1,RT2,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 : C 12 : C-------------------------------------------------------- 13 : C FERMETURE DES FISSURES DANS LES DEUX DIRECTIONS | 14 : C-------------------------------------------------------- 15 : C 16 : C------------------------------------------------- 17 : C ON SE PLACE DANS LE REPERE DE FISSURATION 18 : C------------------------------------------------- 19 : C 20 : IF(IIMPI.EQ.9) WRITE(IOIMP,9999) 21 : 9999 FORMAT(1X,'C1C2 COUPLAGE COMP 1 COMP 2',/) 22 : IC1=0 23 : IC2=0 23 : CALL CHREP(SIG,SFG,ANG) 23 : CALL CHREP(DSIG,DSFG,ANG) 24 : C 25 : C------------------------------------------ 26 : C OBTENTION DU SYSTEME EN DL1 DL2 27 : C------------------------------------------ 28 : C 29 : B(1)=DSFG(1)+SFG(1) 30 : B(2)=DSFG(2)+SFG(2) 31 : A(1)=Y 32 : A(4)=Y 33 : A(2)=ANU*Y 34 : A(3)=A(2) 34 : CALL SYLIN2(A,B,DL1,DL2) 35 : C 36 : C----------------------------------------------- 37 : C CAS DES FAUX COUPLAGES DL1 OU DL2 POSITIF 38 : C----------------------------------------------- 39 : C 40 : IF(DL1.GT.1.E-10) IDAM(1)=0 41 : IF(DL2.GT.1.E-10) IDAM(2)=0 42 : IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0) RETURN 43 : IF(DL1.LT.-XLAM1) IC1=1 44 : IF(DL2.LT.-XLAM2) IC2=1 45 : C 46 : C----------------------------------------------- 47 : C CAS OU ON FERME TOTALEMENT LA FISSURE 1 48 : C----------------------------------------------- 49 : C 50 : IF(DL1.LT.-XLAM1) GOTO 1000 51 : C 52 : C----------------------------------------------- 53 : C CAS OU ON FERME TOTALEMENT LA FISSURE 2 54 : C----------------------------------------------- 55 : C 56 : IF(DL2.LT.-XLAM2) GOTO 2000 57 : C 58 : C------------------------------------ 59 : C ON EFFECTUE L ECOULEMENT 60 : C------------------------------------ 61 : C 62 : EPC(1)=DL1 63 : EPC(2)=DL2 64 : EPC(3)=0.D0 64 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 65 : DO 10 ITYP=1,3 66 : 10 TSFC(ITYP)=DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) 67 : C 68 : C------------------------------------------------ 69 : C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE 70 : C PENDANT L 'ECOULEMENT (SINON 3000) 71 : C------------------------------------------------ 72 : C 72 : CALL CDP(TSFC,ADP,RDP,VCDP) 73 : IF(VCDP.GT.0.D0) GOTO 3000 74 : C 75 : C------------------------------------------------ 76 : C CAS OU L ECOULEMENT SE FAIT ENTIEREMENT 77 : C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT 78 : C------------------------------------------------ 79 : C 80 : XLAM1=XLAM1+DL1 81 : XLAM2=XLAM2+DL2 82 : IDAM(1)=0 83 : IDAM(2)=0 84 : IDAM(3)=0 85 : DO 20 ITYP=1,3 86 : 20 DSIG(ITYP)=0.D0 86 : CALL CHREP(TSFC,SIG,-ANG) 87 : RETURN 88 : C 89 : C------------------------------------------------ 90 : C CAS OU LA FISSURE1 EST COMPLETEMENT FERMEE 91 : C------------------------------------------------ 92 : C 93 : C------------------------------------------ 94 : C OBTENTION DU SYSTEME EN X DL2 95 : C------------------------------------------ 96 : C 97 : 1000 DL1=-XLAM1 98 : B(1)=-SFG(1)+DL1*Y 99 : B(2)=-SFG(2)+DL1*ANU*Y 100 : A(4)=-Y 101 : A(1)=DSFG(1) 102 : A(2)=-ANU*Y 103 : A(3)=DSFG(2) 104 : DET=A(1)*A(4)-A(2)*A(3) 105 : IF(DET.EQ.0.D0.AND.DL2.LT.-XLAM2) GOTO 2000 106 : IF(DET.EQ.0.D0) GOTO 2500 106 : CALL SYLIN2(A,B,X,DL2) 107 : IF(DL2.LT.-XLAM2) GOTO 2000 108 : EPC(1)=DL1 109 : EPC(2)=DL2 110 : EPC(3)=0.D0 110 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 111 : DO 30 ITYP=1,3 112 : 30 SFC(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) 113 : C 114 : C------------------------------------------------ 115 : C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE 116 : C PENDANT L 'ECOULEMENT (SINON 3000) 117 : C------------------------------------------------ 118 : C 118 : CALL CDP(SFC,ADP,RDP,VCDP) 119 : IF(VCDP.GT.0.D0) GOTO 3000 120 : C 121 : C------------------------------------------------ 122 : C L ECOULEMENT SE FAIT PARTIELLEMENT 123 : C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT 124 : C ET DE L INCREMENT DSIGMA 125 : C------------------------------------------------ 126 : C 127 : XLAM1=0.D0 128 : XLAM2=XLAM2+DL2 129 : DO 40 ITYP=1,3 130 : DSFG(ITYP)=(1.D0-X)*DSFG(ITYP) 131 : 40 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP) 132 : GOTO 2750 133 : C 134 : C------------------------------------------------ 135 : C CAS OU LA FISSURE2 EST COMPLETEMENT FERMEE 136 : C------------------------------------------------ 137 : C 138 : C------------------------------------------ 139 : C OBTENTION DU SYSTEME EN X DL1 140 : C------------------------------------------ 141 : C 142 : 2000 DL2=-XLAM2 143 : B(1)=-SFG(1)+DL2*ANU*Y 144 : B(2)=-SFG(2)+DL2*Y 145 : A(2)=-Y 146 : A(1)=DSFG(1) 147 : A(4)=-ANU*Y 148 : A(3)=DSFG(2) 149 : DET=A(1)*A(4)-A(2)*A(3) 150 : IF(DET.EQ.0.D0) GOTO 2500 150 : CALL SYLIN2(A,B,X,DL1) 151 : IF(DL1.LT.-XLAM1) GOTO 2500 152 : EPC(1)=DL1 153 : EPC(2)=DL2 154 : EPC(3)=0.D0 154 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 155 : DO 130 ITYP=1,3 156 : 130 SFC(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) 157 : C 158 : C------------------------------------------------ 159 : C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE 160 : C PENDANT L 'ECOULEMENT (SINON 3000) 161 : C------------------------------------------------ 162 : C 162 : CALL CDP(SFC,ADP,RDP,VCDP) 163 : IF(VCDP.GT.0.D0) GOTO 3000 164 : C 165 : C------------------------------------------------ 166 : C L ECOULEMENT SE FAIT PARTIELLEMENT 167 : C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT 168 : C ET DE L INCREMENT DSIGMA 169 : C------------------------------------------------ 170 : C 171 : XLAM2=0.D0 172 : XLAM1=XLAM1+DL1 173 : DO 140 ITYP=1,3 174 : DSFG(ITYP)=(1.D0-X)*DSFG(ITYP) 175 : 140 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP) 176 : GOTO 2750 177 : 2500 IF(IC1.EQ.1.AND.IC2.EQ.1) THEN 178 : DL1=-XLAM1 179 : DL2=-XLAM2 180 : XLAM1=0.D0 181 : XLAM2=0.D0 181 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 182 : DO 150 ITYP=1,3 183 : SFC(ITYP)=SFG(ITYP)-SFC(ITYP) 184 : 150 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP) 185 : GOTO 2750 186 : ENDIF 187 : IF(IC1.EQ.1) THEN 188 : DL1=-XLAM1 189 : XLAM1=0.D0 190 : DL2=SFG(2)/Y-ANU*DL1 191 : IF(DL2.GT.0.D0) DL2=0.D0 192 : IF(DL2.LT.-XLAM2) DL2=-XLAM2 193 : XLAM2=XLAM2+DL2 194 : EPC(1)=DL1 195 : EPC(2)=DL2 196 : EPC(3)=0.D0 196 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 197 : DO 153 ITYP=1,3 198 : SFC(ITYP)=SFG(ITYP)-SFC(ITYP) 199 : 153 TENS(ITYP)=DSFG(ITYP)+SFC(ITYP) 200 : GOTO 2750 201 : ENDIF 202 : IF(IC2.EQ.1) THEN 203 : DL2=-XLAM2 204 : XLAM2=0.D0 205 : DL1=SFG(1)/Y-ANU*DL2 206 : IF(DL1.GT.0.D0) DL1=0.D0 207 : IF(DL1.LT.-XLAM1) DL1=-XLAM1 208 : XLAM1=XLAM1+DL1 209 : EPC(1)=DL1 210 : EPC(2)=DL2 211 : EPC(3)=0.D0 211 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 212 : DO 155 ITYP=1,3 213 : SFC(ITYP)=SFG(ITYP)-SFC(ITYP) 214 : 155 TENS(ITYP)=DSFG(ITYP)+SFC(ITYP) 215 : ENDIF 216 : 2750 IDAM(1)=0 217 : IDAM(2)=0 218 : IDAM(3)=0 219 : GAMDP=10.D0 220 : GAMTR1=10.D0 221 : GAMTR2=10.D0 222 : GAMCO1=10.D0 223 : GAMCO2=10.D0 223 : CALL CDP(TENS,ADP,RDP,VCDP) 223 : IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFG,RDP,ADP,GAMDP) 223 : CALL CTRAF(TENS(1),RT1,VCTR1) 223 : IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(1),DSFG(1),RT1,GAMTR1) 223 : CALL CCOAF(TENS(1),XLAM1,VCCO1) 223 : IF(VCCO1.GT.0.D0) CALL GAMCAF(SFC(1),DSFG(1),GAMCO1) 223 : CALL CTRAF(TENS(2),RT2,VCTR2) 223 : IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(2),DSFG(2),RT2,GAMTR2) 223 : CALL CCOAF(TENS(2),XLAM2,VCCO2) 223 : IF(VCCO2.GT.0.D0) CALL GAMCAF(SFC(2),DSFG(2),GAMCO2) 224 : GAM=MIN(GAMCO1,GAMDP,GAMTR1,GAMTR2,GAMCO2) 225 : IF(GAM.GE.1.D0) THEN 226 : DO 156 ITYP=1,3 227 : SFG(ITYP)=SFC(ITYP)+DSFG(ITYP) 228 : 156 DSIG(ITYP)=0.D0 228 : CALL CHREP(SFG,SIG,-ANG) 229 : RETURN 230 : ENDIF 231 : IF(ABS(GAM-GAMCO1).LT.1E-10) IDAM(1)=-1 232 : IF(ABS(GAM-GAMTR1).LT.1E-10) IDAM(1)=1 233 : IF(ABS(GAM-GAMCO2).LT.1E-10) IDAM(2)=-1 234 : IF(ABS(GAM-GAMTR2).LT.1E-10) IDAM(2)=1 235 : IF(ABS(GAM-GAMDP).LT.1E-10) IDAM(3)=1 236 : DO 157 ITYP=1,3 237 : SFG(ITYP)=SFC(ITYP)+GAM*DSFG(ITYP) 238 : 157 DSFG(ITYP)=DSFG(ITYP)*(1.D0-GAM) 238 : CALL CHREP(SFG,SIG,-ANG) 238 : CALL CHREP(DSFG,DSIG,-ANG) 239 : RETURN 240 : C 241 : C----------------------------------------------------- 242 : C CAS OU ON ENDOMMAGE LE DP PENDANT L ECOULEMENT 243 : C CALCUL DE X POUR ARRIVER SUR LE CRITERE 244 : C----------------------------------------------------- 245 : C 246 : 3000 CONTINUE 247 : EPC1(1)=1.D0 248 : EPC1(2)=0.D0 249 : EPC1(3)=0.D0 250 : EPC2(2)=1.D0 251 : EPC2(1)=0.D0 252 : EPC2(3)=0.D0 252 : CALL CPHOOB(EPC1,SG1,YOUN,ANU) 252 : CALL CPHOOB(EPC2,SG2,YOUN,ANU) 253 : B(1)=SFG(1) 254 : B(2)=SFG(2) 255 : A(4)=Y 256 : A(1)=A(4) 257 : A(2)=A(4)*ANU 258 : A(3)=A(2) 258 : CALL SYLIN2(A,B,DL11,DL21) 259 : B(1)=DSFG(1) 260 : B(2)=DSFG(2) 260 : CALL SYLIN2(A,B,DL12,DL22) 261 : DO 3010 ITYP=1,3 262 : SG(ITYP)=SFG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP) 263 : 3010 DSG(ITYP)=DSFG(ITYP)-DL12*SG1(ITYP)-DL22*SG2(ITYP) 263 : CALL XDP(SG,DSG,RDP,ADP,X,ITEST) 264 : IF(ITEST.EQ.1) THEN 265 : IDAM(1)=-1 266 : IDAM(2)=-1 267 : IDAM(3)=1 268 : RETURN 269 : ENDIF 270 : DL1=DL11+X*DL12 271 : DL2=DL21+X*DL22 272 : C 273 : C------------------------------------------------ 274 : C L ECOULEMENT SE FAIT PARTIELLEMENT 275 : C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT 276 : C ET DE L INCREMENT DSIGMA 277 : C------------------------------------------------ 278 : C 279 : XLAM1=XLAM1+DL1 280 : XLAM2=XLAM2+DL2 281 : IDAM(1)=-1 282 : IDAM(2)=-1 283 : IDAM(3)=1 284 : IF(XLAM1.LT.1.E-8) THEN 285 : XLAM1=0.D0 286 : IDAM(1)=0 287 : ENDIF 288 : IF(XLAM2.LT.1.E-8) THEN 289 : XLAM2=0.D0 290 : IDAM(2)=0 291 : ENDIF 292 : EPC(1)=DL1 293 : EPC(2)=DL2 294 : EPC(3)=0.D0 294 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 295 : DO 50 ITYP=1,3 296 : SFG(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) 297 : 50 DSFG(ITYP)=(1.D0-X)*DSFG(ITYP) 297 : CALL CHREP(DSFG,DSIG,-ANG) 297 : CALL CHREP(SFG,SIG,-ANG) 298 : RETURN 299 : END 300 :
© Cast3M 2003 - All rights reserved.
Disclaimer