1 : C OTTOFI SOURCE CHAT 05/01/13 02:07:32 5004 2 : SUBROUTINE OTTOFI(SIGMA,NFISSU,NVF,XLTR,XINVL, 3 : & VF,JRESU,FC,PRECIZ,KERRE) 4 : * 5 : C========================================================================== 6 : C 7 : C ENTREES : 8 : C SIGMA,NFISSU,NVF,XLTR,XINVL 9 : C 10 : C SORTIES : 11 : C FC CRITERES 12 : C JRESU,VF (JRESU = 1 POUR LES DIRECTIONS POTENTIELLES DE 13 : C FISSURATION DONT LA DIRECTION EST CONNUE 14 : C JRESU = 2 POUR LES DIRECTIONS POTENTIELLES DE 15 : C FISSURATION DONT LA DIRECTION EST INCONNUE EN PLAN 16 : C JRESU = 3 POUR LES DIRECTIONS POTENTIELLES DE 17 : C FISSURATION DONT LA DIRECTION EST INCONNUE EN 3D 18 : C VF CONTIENT LES VECTEURS CORRESPONDANTS) 19 : C========================================================================== 20 : C 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8(A-H,O-Z) 23 : -INC CCOPTIO 24 : C 25 : PARAMETER (XZER=0.D0,UN=1.D0) 26 : C 27 : DIMENSION SIGMA(6),XLTR(3),VF(3,3),XINVL(3) 28 : * 29 : * VF 1-ER INDICE : COMPOSANTE 30 : * 2-EME INDICE : DIRECTION DE FISSURE 31 : C 32 : DIMENSION A3(3,3),D3(3),E3(3,3) 33 : DIMENSION JRESU(3),FC(3) 34 : * 35 : DO IC=1,3 36 : JRESU(IC)=0 37 : FC(IC)=-1.D4*PRECIZ 38 : DO JC=1,3 39 : VF(IC,JC)=XZER 40 : ENDDO 41 : ENDDO 42 : C 43 : C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 44 : C LES TROIS DIRECTIONS SONT DEJA FISSUREES 45 : C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 46 : C 47 : IF (NFISSU.EQ.3) THEN 48 : RETURN 49 : ENDIF 50 : C 51 : C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 52 : C DEUX DIRECTIONS SONT DEJA FISSUREES 53 : C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 54 : C 55 : IF (NFISSU.EQ.2) THEN 56 : C 57 : C SEULE LA DIRECTION no IFIS N EST PAS FISSUREE 58 : C 59 : IF ((XINVL(1)*XINVL(2)).NE.XZER) IFIS=3 60 : IF ((XINVL(1)*XINVL(3)).NE.XZER) IFIS=2 61 : IF ((XINVL(2)*XINVL(3)).NE.XZER) IFIS=1 62 : * 63 : * IF(IIMPI.EQ.42) THEN 64 : * WRITE(IOIMP,77003) IFIS 65 : *77003 FORMAT( 2X, 'OTTOFI - IFIS =',I4/) 66 : * ENDIF 67 : C 68 : FC(IFIS)=SIGMA(IFIS)-XLTR(IFIS) 69 : JRESU(IFIS)=1 70 : IF (FC(IFIS).GT.-PRECIZ) THEN 71 : VF(IFIS,IFIS)=UN 72 : ENDIF 73 : ENDIF 74 : C 75 : C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 76 : C UNE DIRECTION EST DEJA FISSUREE 77 : C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 78 : C 79 : IF (NFISSU.EQ.1) THEN 80 : C 81 : C SEULE LA DIRECTION no IFIS EST FISSUREE 82 : C 83 : IF (XINVL(1).NE.XZER) IFIS=1 84 : IF (XINVL(2).NE.XZER) IFIS=2 85 : IF (XINVL(3).NE.XZER) IFIS=3 86 : * 87 : * IF(IIMPI.EQ.42) THEN 88 : * WRITE(IOIMP,77004) IFIS 89 : *77004 FORMAT( 2X, 'OTTOFI - IFIS =',I4/) 90 : * ENDIF 91 : C 92 : C CAS 1 : 93 : C DEUX DIRECTIONS DE FAIBLESSE NON FISSUREE, UNE DIRECTION FISSUREE 94 : C 95 : C remarque : ce cas est identique a une direction de faiblesse 96 : C non fissuree et une direction de fissuration. 97 : C 98 : IF (NVF.EQ.2.OR.NVF.EQ.1) THEN 99 : C 100 : C direction 1 fissuree 101 : C 102 : 103 : IF (IFIS.EQ.1) THEN 104 : FC(2)=SIGMA(2)-XLTR(2) 105 : JRESU(2)=1 106 : IF (FC(2).GT.-PRECIZ) THEN 107 : VF(2,2)=UN 108 : ENDIF 109 : FC(3)=SIGMA(3)-XLTR(3) 110 : JRESU(3)=1 111 : IF (FC(3).GT.-PRECIZ) THEN 112 : VF(3,3)=UN 113 : ENDIF 114 : ENDIF 115 : C 116 : C direction 2 fissuree 117 : C 118 : IF (IFIS.EQ.2) THEN 119 : FC(1)=SIGMA(1)-XLTR(1) 120 : JRESU(1)=1 121 : IF (FC(1).GT.-PRECIZ) THEN 122 : VF(1,1)=UN 123 : ENDIF 124 : FC(3)=SIGMA(3)-XLTR(3) 125 : JRESU(3)=1 126 : IF (FC(3).GT.-PRECIZ) THEN 127 : VF(3,3)=UN 128 : ENDIF 129 : ENDIF 130 : C 131 : C direction 3 fissuree 132 : C 133 : C remarque : ce cas est impossible s il n y a qu une direction imposee 134 : C et une direction de fissuration. 135 : C 136 : IF (IFIS.EQ.3) THEN 137 : FC(1)=SIGMA(1)-XLTR(1) 138 : JRESU(1)=1 139 : IF (FC(1).GT.-PRECIZ) THEN 140 : VF(1,1)=UN 141 : ENDIF 142 : FC(2)=SIGMA(2)-XLTR(2) 143 : JRESU(2)=1 144 : IF (FC(2).GT.-PRECIZ) THEN 145 : VF(2,2)=UN 146 : ENDIF 147 : ENDIF 148 : ENDIF 149 : C 150 : C CAS 2 : PAS DE DIRECTION DE FAIBLESSE 151 : C 152 : IF (NVF.EQ.0) THEN 153 : C 153 : CALL ZERO(A3,3,3) 154 : A3(1,1)=SIGMA(2) 155 : A3(1,2)=SIGMA(6) 156 : A3(2,1)=SIGMA(6) 157 : A3(2,2)=SIGMA(3) 157 : CALL JACOB3(A3,2,D3,E3) 158 : 159 : * 160 : IF(IIMPI.EQ.42) THEN 161 : WRITE(IOIMP,78783) D3(1),D3(2) 162 : 78783 FORMAT( 2X, 'OTTOFI - D3(1)=',1PE12.5,2X, 163 : & ' D3(2)=',1PE12.5/) 164 : ENDIF 165 : C 166 : C---------rq XLTR(2)=XLTR(3) puisque l on n a pas fissure--------- 167 : C-----------et qu il n y a pas de direction de faiblesse---------- 168 : C 169 : IVP1=1 170 : IVP2=2 171 : IF(D3(2).GE.D3(1)) THEN 172 : IVP1=2 173 : IVP2=1 174 : ENDIF 175 : * 176 : FC(2)=D3(IVP1)-XLTR(2) 177 : JRESU(2)=2 178 : IF(FC(2).GT.-PRECIZ) THEN 179 : VF(2,2)=E3(1,IVP1) 180 : VF(3,2)=E3(2,IVP1) 181 : ENDIF 182 : * 183 : FC(3)=D3(IVP2)-XLTR(3) 184 : JRESU(3)=2 185 : IF(FC(3).GT.-PRECIZ) THEN 186 : VF(2,3)=E3(1,IVP2) 187 : VF(3,3)=E3(2,IVP2) 188 : ENDIF 189 : ENDIF 190 : RETURN 191 : ENDIF 192 : C 193 : C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 194 : C AUCUNE DIRECTION DEJA FISSUREE 195 : C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 196 : C 197 : IF (NFISSU.EQ.0) THEN 198 : C 199 : C CAS 1 : DEUX OU TROIS DIRECTIONS DE FAIBLESSE 200 : C 201 : 202 : IF (NVF.EQ.2.OR.NVF.EQ.3) THEN 203 : FC(1)=SIGMA(1)-XLTR(1) 204 : JRESU(1)=1 205 : IF (FC(1).GT.-PRECIZ) THEN 206 : VF(1,1)=UN 207 : ENDIF 208 : FC(2)=SIGMA(2)-XLTR(2) 209 : JRESU(2)=1 210 : IF (FC(2).GT.-PRECIZ) THEN 211 : VF(2,2)=UN 212 : ENDIF 213 : FC(3)=SIGMA(3)-XLTR(3) 214 : JRESU(3)=1 215 : IF (FC(3).GT.-PRECIZ) THEN 216 : VF(3,3)=UN 217 : ENDIF 218 : ENDIF 219 : C 220 : C CAS 2 : UNE DIRECTION DE FAIBLESSE 221 : C 222 : IF (NVF.EQ.1) THEN 223 : FC(1)=SIGMA(1)-XLTR(1) 224 : JRESU(1)=1 225 : IF (FC(1).GT.-PRECIZ) THEN 226 : VF(1,1)=UN 227 : ENDIF 228 : C 228 : CALL ZERO(A3,3,3) 229 : A3(1,1)=SIGMA(2) 230 : A3(1,2)=SIGMA(6) 231 : A3(2,1)=SIGMA(6) 232 : A3(2,2)=SIGMA(3) 233 : C 233 : CALL JACOB3(A3,2,D3,E3) 234 : 235 : * 236 : IF(IIMPI.EQ.42) THEN 237 : WRITE(IOIMP,78784) D3(1),D3(2) 238 : 78784 FORMAT( 2X, 'OTTOFI - D3(1)=',1PE12.5,2X, 239 : & ' D3(2)=',1PE12.5/) 240 : ENDIF 241 : C 242 : IVP1=1 243 : IVP2=2 244 : IF(D3(2).GE.D3(1)) THEN 245 : IVP1=2 246 : IVP2=1 247 : ENDIF 248 : * 249 : FC(2)=D3(IVP1)-XLTR(2) 250 : JRESU(2)=2 251 : IF(FC(2).GT.-PRECIZ) THEN 252 : VF(2,2)=E3(1,IVP1) 253 : VF(3,2)=E3(2,IVP1) 254 : ENDIF 255 : * 256 : FC(3)=D3(IVP2)-XLTR(3) 257 : JRESU(3)=2 258 : IF(FC(3).GT.-PRECIZ) THEN 259 : VF(2,3)=E3(1,IVP2) 260 : VF(3,3)=E3(2,IVP2) 261 : ENDIF 262 : ENDIF 263 : C 264 : C CAS 3 : PAS DE DIRECTION DE FAIBLESSE 265 : C 266 : IF (NVF.EQ.0) THEN 267 : C 268 : A3(1,1)=SIGMA(1) 269 : A3(1,2)=SIGMA(4) 270 : A3(1,3)=SIGMA(5) 271 : A3(2,1)=SIGMA(4) 272 : A3(2,2)=SIGMA(2) 273 : A3(2,3)=SIGMA(6) 274 : A3(3,1)=SIGMA(5) 275 : A3(3,2)=SIGMA(6) 276 : A3(3,3)=SIGMA(3) 277 : * 278 : IF(IIMPI.EQ.42) THEN 279 : WRITE(IOIMP,78788) ((A3(I,J),J=1,3),I=1,3) 280 : 78788 FORMAT( 2X, 'OTTOFI - MATRICE A3 '/(3(1X,1PE12.5))/) 281 : ENDIF 282 : * 282 : CALL JACOB3(A3,3,D3,E3) 283 : * 284 : IF(IIMPI.EQ.42) THEN 285 : WRITE(IOIMP,78785) D3(1),D3(2),D3(3) 286 : 78785 FORMAT( 2X, 'OTTOFI - D3(1)=',1PE12.5,2X, 287 : & ' D3(2)=',1PE12.5,2X,' D3(3)=',1PE12.5/) 288 : ENDIF 289 : C 290 : IF (D3(1).GE.D3(2).AND.D3(1).GE.D3(3))THEN 291 : IVP1=1 292 : IVP2=2 293 : IVP3=3 294 : IF (D3(3).GE.D3(2)) THEN 295 : IVP2=3 296 : IVP3=2 297 : ENDIF 298 : ELSEIF (D3(2).GE.D3(3).AND.D3(2).GE.D3(1))THEN 299 : IVP1=2 300 : IVP2=3 301 : IVP3=1 302 : IF (D3(1).GE.D3(3)) THEN 303 : IVP2=1 304 : IVP3=3 305 : ENDIF 306 : ELSEIF (D3(3).GE.D3(1).AND.D3(3).GE.D3(2))THEN 307 : IVP1=3 308 : IVP2=1 309 : IVP3=2 310 : IF (D3(2).GE.D3(1)) THEN 311 : IVP2=2 312 : IVP3=1 313 : ENDIF 314 : ENDIF 315 : * 316 : FC(1)=D3(IVP1)-XLTR(1) 317 : JRESU(1)=3 318 : IF(FC(1).GT.-PRECIZ) THEN 319 : VF(1,1)=E3(1,IVP1) 320 : VF(2,1)=E3(2,IVP1) 321 : VF(3,1)=E3(3,IVP1) 322 : ENDIF 323 : * 324 : FC(2)=D3(IVP2)-XLTR(2) 325 : JRESU(2)=3 326 : IF(FC(2).GT.-PRECIZ) THEN 327 : VF(1,2)=E3(1,IVP2) 328 : VF(2,2)=E3(2,IVP2) 329 : VF(3,2)=E3(3,IVP2) 330 : ENDIF 331 : * 332 : FC(3)=D3(IVP3)-XLTR(2) 333 : JRESU(3)=3 334 : IF(FC(3).GT.-PRECIZ) THEN 335 : VF(1,3)=E3(1,IVP3) 336 : VF(2,3)=E3(2,IVP3) 337 : VF(3,3)=E3(3,IVP3) 338 : ENDIF 339 : ENDIF 340 : ENDIF 341 : 342 : RETURN 343 : END 344 : 345 : 346 : 347 : 348 : 349 :
© Cast3M 2003 - All rights reserved.
Disclaimer