1 : C OTTOET SOURCE CHAT 05/01/13 02:07:28 5004 2 : SUBROUTINE OTTOET(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR, 3 : & XLTR,XINVL,SBILI,PRECIE,PRECIZ,FC,FC2,LEBIL,NFISSU, 4 : & NVF,VF,FC0,PENTE,PENTE2,DX,DXV1,YOUN,NCA,MC,MM, 5 : & ISING,IFERM,IBRUP,IPLAS,XCOMP,XLAMC,DFF,DGG,KERRE) 6 : C 7 : C========================================================================= 8 : C 9 : C ENTREES : 10 : C SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR,XLTR,XINVL,SBILI 11 : C 12 : C 13 : C SORTIES : 14 : C FC,LEBIL,NCA,MC,MM,FC0,PENTE 15 : C 16 : C========================================================================== 17 : C 18 : IMPLICIT INTEGER(I-N) 19 : IMPLICIT REAL*8(A-H,O-Z) 20 : -INC CCOPTIO 21 : C 22 : PARAMETER (XZER=0.D0) 23 : C 24 : DIMENSION SIGMA(6),W(3),WMAX(3),BILIN(3),WREOUV(3), 25 : & WRUPT(3),XLTR(3),XINVL(3),SBILI(3),XCOMP(*) 26 : DIMENSION PENTE(*),PENTE2(*),JFIS(3) 27 : DIMENSION FC(*),FC2(*),NN(*),MM(*),LEBIL(*),SMAX(*) 28 : DIMENSION VF(3,3),FC0(*) 29 : DIMENSION ISING(*),IFERM(*),IBRUP(*) 30 : DIMENSION DX(*),DXV1(*) 31 : * 32 : DIMENSION DFF(*),DGG(*) 33 : 34 : 35 : KERRE=0 36 : IPLAS=0 36 : CALL IANUL(ISING,NC) 36 : CALL IANUL(IFERM,NC) 36 : CALL IANUL(IBRUP,NC) 37 : * 38 : DO IC=1,NC 39 : NN(IC)=IC 40 : ENDDO 41 : * 41 : CALL OTTOEC(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR, 42 : & XLTR,XINVL,SBILI,FC,FC2,PENTE,PENTE2,LEBIL,ISING, 43 : & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE) 44 : IF(KERRE.NE.0) THEN 45 : PRINT *, ' OTTOET - APRES OTTOEC KERRE=',KERRE 46 : RETURN 47 : ENDIF 48 : * 49 : NCA=0 50 : MC=0 51 : LACOMP=0 52 : * 53 : * 54 : DO IC=1,3 55 : WREOUV(IC)=BTR*MIN(WMAX(IC),WRUPT(IC)) 56 : * 57 : IF(FC(IC).GT.PRECIZ.OR.FC2(IC).GT.PRECIZ) THEN 58 : * cas ou le critere est violé 59 : KERRE=2 60 : PRINT *,' OTTOET - CRITERE VIOLE ',IC 61 : RETURN 62 : ENDIF 63 : * 64 : * cas ou le critere n'est pas atteint 65 : * ----------------------------------- 66 : * 67 : IF(FC(IC).LT.-PRECIZ.AND.FC2(IC).LT.-PRECIZ) THEN 68 : * 69 : * ---> sous-cas 1 : la direction n'a pas encore fissure 70 : * 71 : IF(XINVL(IC).EQ.XZER) THEN 72 : 73 : MC=MC+1 74 : MM(MC)= IC 75 : * 76 : ELSE 77 : * 78 : * ---> sous-cas 2 : la direction a deja fissure 79 : * 80 : IF(LEBIL(IC).EQ.0) THEN 81 : * on est en compression 82 : * 83 : IF(BTR.LT.1.D0.AND.WMAX(IC).NE.XZER) THEN 84 : MC=MC+1 85 : MM(MC)= 9+IC 86 : LACOMP=1 87 : ELSE 88 : MC=MC+1 89 : MM(MC)= 3+IC 90 : LACOMP=1 91 : ENDIF 92 : ELSE 93 : KERRE=2 94 : PRINT *,' OTTOET - CAS IMPOSSIBLE ',IC 95 : * CAS IMPOSSIBLE 96 : RETURN 97 : ENDIF 98 : * 99 : ENDIF 100 : 101 : ELSE 102 : * 103 : * cas ou le critere est atteint 104 : * ----------------------------- 105 : * 106 : IF(XINVL(IC).EQ.XZER) THEN 107 : KERRE=2 108 : PRINT *,' OTTOET - XINVL EST NUL IC= ',IC 109 : RETURN 110 : ENDIF 111 : * 112 : PRECIW=PRECIE/XINVL(IC) 113 : NCA=NCA+1 114 : NN(NCA)=IC 115 : * 116 : * ---> sous-cas 1 : le materiau n'est pas totalement casse 117 : * --------------------------------------------------- 118 : * 119 : IF(WMAX(IC).LT.WRUPT(IC)) THEN 120 : * 121 : IF(ABS(W(IC)-WREOUV(IC)).LT.PRECIW) THEN 122 : * 123 : IF(WMAX(IC).EQ.0.D0.OR.BTR.EQ.1.D0) THEN 124 : * 125 : * le materiau vient d'atteindre la limite 126 : * 127 : MC=MC+1 128 : MM(MC)= 6+IC 129 : LACOMP=1 130 : IBRUP(IC)=1 131 : 132 : ELSE 133 : * 134 : * on est pile sur le critere sigma=0 (==> IFERM=1) 135 : * et LEBIL vaut 1 136 : * 137 : IF(LEBIL(IC).NE.1) THEN 138 : KERRE=2 139 : PRINT *,' OTTOET - LEBIL NEG 1 SELON ',IC 140 : RETURN 141 : ENDIF 142 : * 143 : MC=MC+1 144 : MM(MC)= 3+IC 145 : LACOMP=1 146 : IFERM(IC)=1 147 : ENDIF 148 : 149 : ELSE IF(W(IC).GT.WREOUV(IC)) THEN 150 : IPLAS=1 151 : * 152 : IF(ABS(W(IC)-WMAX(IC)).LT.PRECIW) THEN 153 : * 154 : * LEBIL vaut 2 155 : * 156 : IF(LEBIL(IC).NE.2) THEN 157 : KERRE=2 158 : PRINT *,' OTTOET - LEBIL NEG 2 SELON ',IC 159 : RETURN 160 : ENDIF 161 : * 162 : * d'abord les 2 163 : * 164 : IF(FC(IC).GT.-PRECIZ.AND. 165 : & FC2(IC).GT.-PRECIZ) THEN 166 : * 167 : MC=MC+1 168 : MM(MC)= 6+IC 169 : MC=MC+1 170 : MM(MC)= 12+IC 171 : * 172 : * sinon seul le secant 173 : * 174 : ELSE IF(FC(IC).LT.-PRECIZ.AND. 175 : & FC2(IC).GT.-PRECIZ) THEN 176 : * 177 : * on remet lebil a 1 178 : * 179 : LEBIL(IC)=1 180 : FC(IC)=FC2(IC) 181 : PENTE(IC)=PENTE2(IC) 182 : MC=MC+1 183 : MM(MC)= 3+IC 184 : MC=MC+1 185 : MM(MC)= 12+IC 186 : * 187 : ELSE 188 : KERRE=2 189 : PRINT *,' OTTOET - CAS PAS ', 190 : & 'POSSIBLE SELON ',IC 191 : RETURN 192 : ENDIF 193 : * 194 : * 195 : ELSE 196 : * 197 : * on est sur le secant , 198 : * et LEBIL vaut 1 199 : * 200 : IF(LEBIL(IC).NE.1) THEN 201 : KERRE=2 202 : PRINT *,' OTTOET - LEBIL NEG 1 SELON ',IC 203 : RETURN 204 : ENDIF 205 : * 206 : MC=MC+1 207 : MM(MC)= 3+IC 208 : MC=MC+1 209 : MM(MC)= 12+IC 210 : ENDIF 211 : * 212 : ELSE 213 : * 214 : * W < WREOUV : CAS IMPOSSIBLE 215 : * 216 : KERRE=2 217 : PRINT *,' OTTOET - W < WREOUV IC= ',IC 218 : PRINT *,'W(IC)=',W(IC) 219 : PRINT *,'WMAX(IC)=',WMAX(IC) 220 : PRINT *,'WREOUV(IC)=',WREOUV(IC) 221 : PRINT *,'WRUPT(IC)=',WRUPT(IC) 222 : 223 : 224 : RETURN 225 : ENDIF 226 : * 227 : * ---> sous-cas 2 : le materiau est totalement casse 228 : * --------------------------------------------- 229 : * 230 : ELSE IF(WMAX(IC).GE.WRUPT(IC)) THEN 231 : * 232 : 233 : IF(W(IC)-WREOUV(IC).LT.-PRECIW) THEN 234 : 235 : * 236 : * W < WREOUV : CAS IMPOSSIBLE 237 : * 238 : KERRE=2 239 : PRINT *,' OTTOET - W < WREOUV IC= ',IC 240 : PRINT *,'W(IC)=',W(IC) 241 : PRINT *,'WMAX(IC)=',WMAX(IC) 242 : PRINT *,'WREOUV(IC)=',WREOUV(IC) 243 : PRINT *,'WRUPT(IC)=',WRUPT(IC) 244 : RETURN 245 : 246 : 247 : ELSE 248 : * 249 : * on est en ouverture (IPLAS=1) 250 : * ou bien on est pile sur la limite sigma=0 (IPLAS=0) 251 : * LEBIL vaut 1 dans les 2 cas 252 : * 253 : IF(LEBIL(IC).NE.1) THEN 254 : KERRE=2 255 : PRINT *,' OTTOET - LEBIL NEG 1 SELON ',IC 256 : RETURN 257 : ENDIF 258 : * 259 : IF(W(IC)-WREOUV(IC).GT.PRECIW) THEN 260 : IPLAS=1 261 : MC=MC+1 262 : MM(MC)= 12+IC 263 : ELSE 264 : IFERM(IC)=1 265 : LACOMP=1 266 : ENDIF 267 : * 268 : ENDIF 269 : ENDIF 270 : 271 : ENDIF 272 : 273 : ENDDO 274 : * 275 : * 276 : * 277 : * CAS NUMERO 4 278 : * 279 : IF(FC(4).GT.PRECIZ) THEN 280 : KERRE=2 281 : PRINT *,' OTTOET - CRITERE VIOLE N0 4 ' 282 : RETURN 283 : ENDIF 284 : * 285 : * 286 : 287 : IF(FC(4).LT.-PRECIZ) THEN 288 : LACOMP=1 289 : ELSE 290 : NCA=NCA+1 291 : NN(NCA)=4 292 : LACOMP=0 293 : IFERM(4)=1 294 : ENDIF 295 : * 296 : 297 : * MLR 9/7/99 298 : * ON MET 16 SYSTEMATIQUEMENT 299 : * 300 : * 301 : ***** IF(LACOMP.EQ.1) THEN 302 : ***** MC=MC+1 303 : ***** MM(MC)=16 304 : ***** ENDIF 305 : * 306 : 307 : MC=MC+1 308 : MM(MC)=16 309 : 310 : * 311 : * 312 : * TEST SUR MC 313 : * 314 : IF(MC.EQ.0) THEN 315 : KERRE=2 316 : PRINT *,' OTTOET - MC EST NUL ' 317 : RETURN 318 : ENDIF 319 : * 320 : * APPEL A OTTOCE 321 : * 321 : CALL OTTOCE(MC,MM,SIGMA,DX,DXV1,W,WMAX,SMAX,WRUPT, 322 : & XLTR,XINVL,BTR,NFISSU,NVF,FC0,VF,YOUN, 323 : & PRECIZ,JFIS,XCOMP,XLAMC,DFF,DGG,KERRE) 324 : IF(KERRE.NE.0) THEN 325 : PRINT *, ' OTTOET - APRES OTTOCE KERRE=',KERRE 326 : RETURN 327 : ENDIF 328 : * 329 : * TEST DE L'ETAT INITIAL 330 : * 331 : DO IC=1,MC 332 : JC=MM(IC) 333 : IF(FC0(JC).GT.PRECIZ)THEN 334 : PRINT *,'OTTOET - ETAT INITIAL INADMISSIBLE' 335 : KERRE=2 336 : RETURN 337 : ENDIF 338 : ENDDO 339 : * 340 : IF(IIMPI.EQ.42) THEN 341 : WRITE(IOIMP,77000) (FC(IC),IC=1,NC) 342 : 77000 FORMAT( 2X, ' OTTOET - FC '/(4(1X,1PE12.5)/)/) 343 : WRITE(IOIMP,77001) (LEBIL(IC),IC=1,NC) 344 : 77001 FORMAT( 2X, ' OTTOET - LEBIL '/(7I4)/) 345 : WRITE(IOIMP,77002) NCA,MC 346 : 77002 FORMAT( 2X, ' OTTOET - NCA=',I3,2X,'MC=',I3/) 347 : WRITE(IOIMP,77003) (NN(IC),IC=1,NCA) 348 : 77003 FORMAT( 2X, ' OTTOET - NN '/16(1X,I3)/) 349 : WRITE(IOIMP,77004) (MM(IC),IC=1,MC) 350 : 77004 FORMAT( 2X, ' OTTOET - MM '/16(1X,I3)/) 351 : ENDIF 352 : * 353 : RETURN 354 : END 355 : 356 : 357 : 358 : 359 : 360 : 361 :
© Cast3M 2003 - All rights reserved.
Disclaimer