1 : C C1 SOURCE CHAT 05/01/12 21:44:51 5004 2 : SUBROUTINE C1(SIG,DSIG,YOUN,ANU,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 A(4),B(2),IDAM(3),EPC(3),SG(3),DSG(3) 9 : Y=YOUN/(1.D0-ANU*ANU) 10 : C 11 : C-------------------------------------------- 12 : C BOITE D ECOULEMENT DE COMPRESSION 13 : C-------------------------------------------- 14 : C 15 : C----------------------------------------------- 16 : C ON SE PLACE DANS LE REPERE DE FISSURATION 17 : C----------------------------------------------- 18 : C 19 : IF(IIMPI.EQ.9) WRITE(IOIMP,9999) 20 : 9999 FORMAT(1X,'C1 ECOULEMENT SUIVANT COMP 1',/) 20 : CALL CHREP(SIG,SFG,ANG) 20 : CALL CHREP(DSIG,DSFG,ANG) 21 : DL1=(SFG(1)+DSFG(1))/Y 22 : C 23 : C------------------------------------------ 24 : C CAS OU LA FISSURE RESTE OUVERTE 25 : C TOUT LE TEMPS DE L ECOULEMENT (1000) 26 : C------------------------------------------- 27 : C 28 : IF(DL1.GT.0.D0) THEN 29 : IDAM(1)=0 30 : RETURN 31 : ENDIF 32 : IF(DL1.GE.-XLAM1) THEN 33 : EPC(1)=DL1 34 : EPC(2)=0.D0 35 : EPC(3)=0.D0 35 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 36 : X=1.D0 37 : GOTO 1000 38 : ENDIF 39 : C 40 : C------------------------------------------- 41 : C CAS OU LA FISSURE EST FERME AVANT 42 : C LA FIN DE L ECOULEMENT 43 : C------------------------------------------- 44 : C 45 : DL1=-XLAM1 46 : EPC(1)=DL1 47 : EPC(2)=0.D0 48 : EPC(3)=0.D0 48 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 49 : C 50 : C------------------------------------------ 51 : C ON CALCULE LA PARTIE DE DSIGMA 52 : C QU IL FAUT POUR FERMER LA FISSURE 53 : C------------------------------------------ 54 : C 55 : IF(DSFG(1).EQ.0.D0) THEN 56 : X=0.D0 57 : DO 10 ITYP=1,3 58 : DSFC(ITYP)=DSFG(ITYP) 59 : 10 SFC(ITYP)=SFG(ITYP)-SFC(ITYP) 60 : XLAM1=0.D0 61 : DL1=0.D0 62 : GOTO 1010 63 : ENDIF 64 : X=(-SFG(1)+SFC(1))/DSFG(1) 65 : IF(X.LT.0.D0) THEN 66 : X=0.D0 67 : DO 15 ITYP=1,3 68 : DSFC(ITYP)=DSFG(ITYP) 69 : 15 SFC(ITYP)=SFG(ITYP)-SFC(ITYP) 70 : XLAM1=0.D0 71 : DL1=0.D0 72 : GOTO 1010 73 : ENDIF 74 : 1000 DO 20 ITYP=1,3 75 : DSFC(ITYP)=(1.D0-X)*DSFG(ITYP) 76 : 20 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP) 77 : C 78 : C----------------------------------------------- 79 : C ON REGARDE SI LES AUTRES CRITERES NE 80 : C SONT PAS ENDOMMAGES PENDANT L ECOULEMENT 81 : C----------------------------------------------- 82 : C 82 : CALL CDP(SFC,ADP,RDP,VCDP) 82 : CALL CTRAF(SFC(2),RT2,VCTR2) 82 : CALL CCOAF(SFC(2),XLAM2,VCCO2) 83 : C 84 : C------------------------------------ 85 : C CRITERE DE TRACTION ENDOMMAGE 86 : C------------------------------------ 87 : C 88 : IF(VCTR2.GT.0.D0) GOTO 2000 89 : C 90 : C---------------------------------------- 91 : C CRITERE DE COMPRESSION ENDOMMAGE 92 : C---------------------------------------- 93 : C 94 : IF(VCCO2.GT.0.D0) GOTO 3000 95 : C 96 : C------------------------------------ 97 : C CRITERE DE TRACTION ENDOMMAGE 98 : C------------------------------------ 99 : C 100 : IF(VCDP.GT.0.D0) GOTO 4000 101 : C 102 : C--------------------------------------------------- 103 : C AUCUN CRITERE ENDOMMAGE PENDANT L ECOULEMENT 104 : C--------------------------------------------------- 105 : C 106 : 1010 DO 30 ITYP=1,3 107 : 30 TSFC(ITYP)=DSFC(ITYP)+SFC(ITYP) 108 : C 109 : C--------------------------------------------------- 110 : C ON REGARDE SI L ECOULEMENT RESTANT N ENDOMMAGE 111 : C PAS LES CRITERES 112 : C--------------------------------------------------- 113 : C 114 : IDAM(1)=0 115 : IDAM(2)=0 116 : IDAM(3)=0 117 : C=1.D0-1.D-10 118 : IF(X.GE.C) THEN 119 : GAM=1.D0 120 : GOTO 1500 121 : ENDIF 122 : GAMDP=10.D0 123 : GAMCO2=10.D0 124 : GAMTR2=10.D0 124 : CALL CDP(TSFC,ADP,RDP,VCDP) 124 : IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFC,RDP,ADP,GAMDP) 124 : CALL CTRAF(TSFC(2),RT2,VCTR2) 124 : IF(VCTR2.GT.0.D0) CALL GAMTAF(SFC(2),DSFC(2),RT2,GAMTR2) 124 : CALL CCOAF(TSFC(2),XLAM2,VCCO2) 124 : IF(VCCO2.GT.0.D0) CALL GAMCAF(SFC(2),DSFC(2),GAMCO2) 125 : GAM=MIN(GAMTR2,GAMCO2,GAMDP) 126 : IF(GAM.GE.C) THEN 127 : GAM=1.D0 128 : GOTO 1500 129 : ENDIF 130 : IF(ABS(GAMCO2-GAM).LT.1.E-10) IDAM(2)=-1 131 : IF(ABS(GAMTR2-GAM).LT.1.E-10) IDAM(2)=1 132 : IF(ABS(GAMDP-GAM).LT.1.E-10) IDAM(3)=1 133 : XLAM1=0.D0 134 : DL1=0.D0 135 : 1500 DO 40 ITYP=1,3 136 : SFG(ITYP)=SFC(ITYP)+GAM*DSFC(ITYP) 137 : 40 DSFG(ITYP)=(1.D0-GAM)*DSFC(ITYP) 137 : CALL CHREP(SFG,SIG,-ANG) 137 : CALL CHREP(DSFG,DSIG,-ANG) 138 : XLAM1=XLAM1+DL1 139 : RETURN 140 : C 141 : C---------------------------------------- 142 : C CAS OU EN ENDOMMAGE LA TRACTION2 143 : C PENDANT LA FERMETURE DE LA FISSURE 144 : C---------------------------------------- 145 : C 146 : 2000 A(1)=DSFG(1) 147 : A(3)=DSFG(2) 148 : A(2)=-Y 149 : A(4)=A(2)*ANU 150 : DET=A(1)*A(4)-A(2)*A(3) 151 : IF(DET.EQ.0.D0) THEN 152 : IDAM(1)=-1 153 : IDAM(2)=1 154 : IDAM(3)=0 155 : RETURN 156 : ENDIF 157 : B(1)=-SFG(1) 158 : B(2)=RT2-SFG(2) 158 : CALL SYLIN2(A,B,X,DL1) 159 : EPC(1)=DL1 160 : EPC(2)=0.D0 161 : EPC(3)=0.D0 161 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 162 : DO 50 ITYP=1,3 163 : DSFC(ITYP)=(1.D0-X)*DSFG(ITYP) 164 : 50 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP) 164 : CALL CDP(SFC,ADP,RDP,VCDP) 165 : IF(VCDP.GT.0.D0) GOTO 4000 166 : IDAM(1)=-1 167 : IDAM(2)=1 168 : IDAM(3)=0 169 : XLAM1=XLAM1+DL1 169 : CALL CHREP(DSFC,DSIG,-ANG) 169 : CALL CHREP(SFC,SIG,-ANG) 170 : RETURN 171 : C 172 : C---------------------------------------- 173 : C CAS OU EN ENDOMMAGE LA COMPRESSION2 174 : C PENDANT LA FERMETURE DE LA FISSURE 175 : C---------------------------------------- 176 : C 177 : 3000 A(1)=DSFG(1) 178 : A(3)=DSFG(2) 179 : A(2)=-Y 180 : A(4)=A(2)*ANU 181 : DET=A(1)*A(4)-A(2)*A(3) 182 : IF(DET.EQ.0.D0) THEN 183 : IDAM(1)=-1 184 : IDAM(2)=-1 185 : IDAM(3)=0 186 : RETURN 187 : ENDIF 188 : B(1)=-SFG(1) 189 : B(2)=-SFG(2) 189 : CALL SYLIN2(A,B,X,DL1) 190 : EPC(1)=DL1 191 : EPC(2)=0.D0 192 : EPC(3)=0.D0 192 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 193 : DO 150 ITYP=1,3 194 : DSFC(ITYP)=(1.D0-X)*DSFG(ITYP) 195 : 150 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP) 195 : CALL CDP(SFC,ADP,RDP,VCDP) 196 : IF(VCDP.GT.0.D0) GOTO 4000 197 : IDAM(1)=-1 198 : IDAM(2)=-1 199 : IDAM(3)=0 200 : XLAM1=XLAM1+DL1 200 : CALL CHREP(DSFC,DSIG,-ANG) 200 : CALL CHREP(SFC,SIG,-ANG) 201 : RETURN 202 : C 203 : C---------------------------------------- 204 : C CAS OU EN ENDOMMAGE LE DP 205 : C PENDANT LA FERMETURE DE LA FISSURE 206 : C---------------------------------------- 207 : C 208 : 4000 CONTINUE 209 : EPC(1)=1.D0 210 : EPC(2)=0.D0 211 : EPC(3)=0.D0 211 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 212 : E=Y 213 : F=SFG(1)/E 214 : G=DSFG(1)/E 215 : DO 70 ITYP=1,3 216 : SG(ITYP)=SFG(ITYP)-F*SFC(ITYP) 217 : 70 DSG(ITYP)=DSFG(ITYP)-G*SFC(ITYP) 217 : CALL XDP(SG,DSG,RDP,ADP,X,ITEST) 218 : IF(ITEST.EQ.1) THEN 219 : IDAM(1)=-1 220 : IDAM(2)=0 221 : IDAM(3)=1 222 : RETURN 223 : ENDIF 224 : DL1=(SFG(1)+X*DSFG(1))/Y 225 : EPC(1)=DL1 226 : EPC(2)=0.D0 227 : EPC(3)=0.D0 227 : CALL CPHOOB(EPC,SFC,YOUN,ANU) 228 : DO 60 ITYP=1,3 229 : SFG(ITYP)=X*DSFG(ITYP)-SFC(ITYP)+SFG(ITYP) 230 : 60 DSFG(ITYP)=DSFG(ITYP)*(1.D0-X) 231 : XLAM1=XLAM1+DL1 231 : CALL CHREP(DSFG,DSIG,-ANG) 231 : CALL CHREP(SFG,SIG,-ANG) 232 : IDAM(1)=-1 233 : IDAM(2)=0 234 : IDAM(3)=1 235 : RETURN 236 : END 237 :
© Cast3M 2003 - All rights reserved.
Disclaimer