1 : C TRIAGE SOURCE CHAT 05/01/13 03:46:28 5004 2 : SUBROUTINE TRIAGE(ITRI,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 3 : .DPELA2,PORELA,R1,R2,R3,SIGMA,DSIGMA,SIGMAT,SIGEL,DSIGP,TETAQ,IDED, 4 : .ICAS,IDAM,ITRAC,KOUPLE,IMIN,JMIN,GAMIN,ICRIT1,KASTR,DP2MIN,DGLAMP, 5 : .DL,PENTE1,PENTE2,CC,SS,CS,ICRIME,ICRIMT,ITETA,IRZ,LMIC5, 6 : .PREC,RFSG,RFEP,RFPR,KERRE) 7 : C 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8(A-H,O-Z) 10 : -INC CCOPTIO 11 : C 12 : DIMENSION SIGMA(*),DSIGMA(*),SIGMAT(*),SIGEL(*),DSIGP(*) 13 : DIMENSION SEL(7),WW1(3),DDSIGP(6),DSIGEL(6) 14 : C 15 : ZER=0.D0 16 : TOL=-RFPR 17 : KOUPLE=1 18 : ITETA=0 19 : JMIN=0 20 : ICAS=0 21 : C 22 : ITTI=ITRI+1 23 : GO TO(1001,1002,1003),ITTI 24 : WRITE(IOIMP,9005)ITRI 25 : KERRE=640 26 : RETURN 27 : C 28 : 1001 IF(IIMPI.EQ.9) WRITE(IOIMP,9006)IDAM 29 : GO TO 100 30 : C 31 : 1002 IF(IIMPI.EQ.9) WRITE(IOIMP,9007)IDAM 32 : GO TO 100 33 : C 34 : 1003 IF(IIMPI.EQ.9) WRITE(IOIMP,9008)IDAM 35 : C 36 : C CAS DU CRITERE DE LA POROSITE (1) 37 : C 38 : 100 IF(ICRIT1.EQ.1) GO TO 225 39 : IF(ICRIME.EQ.1) GO TO 225 40 : IF(ICRIMT.EQ.1) GO TO 225 40 : CALL KRITER(1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 41 : .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE) 42 : IF(CRIT.GT.0.D0) GO TO 200 43 : 225 IF(IIMPI.EQ.9) WRITE(IOIMP,10) 44 : IPOR=0 45 : SEL(1)=100.D0 46 : GO TO 1 47 : 200 IF(ITRI.EQ.2) GO TO 201 48 : SEL(1)=GAMPO(SIGMA,DSIGMA,PORELA) 49 : IF(SEL(1).LE.1.D0.AND.ITRI.EQ.0) GO TO 250 50 : IF(SEL(1).GE.TOL.AND.SEL(1).LE.1.D0.AND.ITRI.EQ.1) GO TO 250 51 : GO TO 225 51 : 201 CALL GAMMAN(1,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 52 : .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ, 53 : .SEL(1),PREC,RFSG,RFEP,RFPR,KERRE) 54 : 250 IF(IIMPI.EQ.9) WRITE(IOIMP,11) 55 : IPOR=1 56 : C 57 : C CAS DU CRITERE DE DRUCKER DUCTILE (2) 58 : C 59 : 1 IF(ICRIT1.EQ.2) GO TO 325 60 : IF(ICRIME.EQ.2) GO TO 325 61 : IF(ICRIMT.EQ.2) GO TO 325 61 : CALL KRITER(2,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 62 : .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE) 63 : ICONCA=0 64 : IF(CRIT.GT.0.D0) GO TO 300 65 : 325 IF(IIMPI.EQ.9) WRITE(IOIMP,12) 66 : IDVD=0 67 : SEL(2)=100.D0 68 : GO TO 2 69 : 300 IF(ITRI.EQ.2) GO TO 301 70 : SEL(2)=GAMDP(SIGMA,DSIGMA,ALFADV,DPELAS,ICONCA, 71 : . PREC,RFSG,RFEP,RFPR) 72 : IF(SEL(2).LE.1.D0.AND.ITRI.EQ.0) GO TO 350 73 : IF(SEL(2).GE.TOL.AND.SEL(2).LE.1.D0.AND.ITRI.EQ.1) GO TO 350 74 : GO TO 325 74 : 301 CALL GAMMAN(2,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 75 : .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ, 76 : .SEL(2),PREC,RFSG,RFEP,RFPR,KERRE) 77 : 350 IF(IIMPI.EQ.9) WRITE(IOIMP,13) 78 : IDVD=1 79 : C 80 : C CAS DU CRITERE DE VON MISES (3) 81 : C 82 : 2 IF(ICRIT1.EQ.3) GO TO 425 83 : IF(ICRIME.EQ.3) GO TO 425 84 : IF(ICRIMT.EQ.3) GO TO 425 84 : CALL KRITER(3,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 85 : .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE) 86 : IF(CRIT.GT.0.D0) GO TO 400 87 : 425 IF(IIMPI.EQ.9) WRITE(IOIMP,14) 88 : IVMIS=0 89 : SEL(3)=100.D0 90 : GO TO 3 91 : 400 IF(ITRI.EQ.2) GO TO 401 92 : SEL(3)=GAMVM(SIGMA,DSIGMA,VMELAS,PREC,RFSG,RFEP,RFPR) 93 : IF(SEL(3).LE.1.D0.AND.ITRI.EQ.0) GO TO 450 94 : IF(SEL(3).GE.TOL.AND.SEL(3).LE.1.D0.AND.ITRI.EQ.1) GO TO 450 95 : GO TO 425 95 : 401 CALL GAMMAN(3,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 96 : .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ, 97 : .SEL(3),PREC,RFSG,RFEP,RFPR,KERRE) 98 : 450 IF(IIMPI.EQ.9) WRITE(IOIMP,15) 99 : IVMIS=1 100 : C 101 : C CAS DU CRITERE DE DRUCKER FRAGILE (4) 102 : C 103 : 3 IF(ICRIT1.EQ.4) GO TO 525 104 : IF(ICRIME.EQ.4) GO TO 525 105 : IF(ICRIMT.EQ.4) GO TO 525 105 : CALL KRITER(4,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 106 : .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE) 107 : ICONCA=0 108 : IF(CRIT.LE.0.D0.AND.ICRIT1.EQ.5) GO TO 502 109 : IF(CRIT.GT.0.D0) GO TO 500 110 : 525 IF(IIMPI.EQ.9) WRITE(IOIMP,16) 111 : IDFC1=0 112 : SEL(4)=100.D0 113 : GO TO 4 114 : 502 ICONCA=1 115 : 500 IF(ITRI.EQ.2) GO TO 501 116 : SEL(4)=GAMDP(SIGMA,DSIGMA,ALFAD1,DPELA1,ICONCA, 117 : . PREC,RFSG,RFEP,RFPR) 118 : IF(SEL(4).LE.1.D0.AND.ITRI.EQ.0) GO TO 550 119 : IF(SEL(4).GE.TOL.AND.SEL(4).LE.1.D0.AND.ITRI.EQ.1) GO TO 550 120 : GO TO 525 120 : 501 CALL GAMMAN(4,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 121 : .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ, 122 : .SEL(4),PREC,RFSG,RFEP,RFPR,KERRE) 123 : 550 IF(IIMPI.EQ.9) WRITE(IOIMP,17) 124 : IDFC1=1 125 : C 126 : C CAS DU CRITERE DE DRUCKER ECROUI. FRAGILE (5) 127 : C 128 : 4 IF(ICRIT1.EQ.5) GO TO 625 129 : IF(ICRIME.EQ.5) GO TO 625 130 : IF(ICRIMT.EQ.5) GO TO 625 131 : IF(LMIC5.EQ.1) GO TO 625 131 : CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 132 : .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE) 133 : ICONCA=0 134 : IF(CRIT.LE.0.D0.AND.ICRIT1.EQ.4) GO TO 602 135 : IF(CRIT.GT.0.D0) GO TO 600 136 : 625 IF(IIMPI.EQ.9) WRITE(IOIMP,18) 137 : IDFE2=0 138 : SEL(5)=100.D0 139 : GO TO 5 140 : 602 ICONCA=1 141 : 600 IF(ITRI.EQ.2) GO TO 601 142 : SEL(5)=GAMDP(SIGMA,DSIGMA,ALFAD2,DPELA2,ICONCA, 143 : . PREC,RFSG,RFEP,RFPR) 144 : IF(SEL(5).LE.1.D0.AND.ITRI.EQ.0) GO TO 650 145 : IF(SEL(5).GE.TOL.AND.SEL(5).LE.1.D0.AND.ITRI.EQ.1) GO TO 650 146 : GO TO 625 146 : 601 CALL GAMMAN(5,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 147 : .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ, 148 : .SEL(5),PREC,RFSG,RFEP,RFPR,KERRE) 149 : 650 IF(IIMPI.EQ.9) WRITE(IOIMP,19) 150 : IDFE2=1 151 : C 152 : C CAS DU CRITERE DE LA TRACTION DANS LE PLAN RZ (6) 153 : C 154 : 5 IF(KASTR.EQ.2) GO TO 704 155 : IF(ITRAC.NE.0) GO TO 699 156 : WW1(1)=SIGMAT(1) 157 : WW1(2)=SIGMAT(2) 158 : WW1(3)=SIGMAT(4) 158 : CALL DIAGOD(WW1) 159 : IF(IIMPI.EQ.9) WRITE(IOIMP,26) (WW1(I),I=1,3) 160 : F1ST=WW1(1) 161 : F2ST=WW1(2) 162 : GO TO 701 163 : 699 UNIT=0.01745329252D0 164 : ANRUP=TETAQ*UNIT 165 : CO=COS(ANRUP) 166 : SII=SIN(ANRUP) 167 : CC=CO*CO 168 : SS=SII*SII 169 : CS=CO*SII 170 : 700 F1ST=ROTA(SIGMAT,CC,SS,CS,1) 171 : F2ST=ROTA(SIGMAT,CC,SS,CS,2) 172 : 701 CRIT1=F1ST-R1 173 : CRIT2=F2ST-R2 174 : IRZ=0 175 : IF(CRIT1.GT.0.D0) GO TO 702 176 : IF(IIMPI.EQ.9) WRITE(IOIMP,20) 177 : ITRA1=0 178 : GO TO 6 179 : 702 IF(IIMPI.EQ.9) WRITE(IOIMP,21) 180 : ITRA1=1 181 : 6 IF(CRIT2.GT.0.D0) GO TO 703 182 : IF(IIMPI.EQ.9) WRITE(IOIMP,22) 183 : ITRA2=0 184 : GO TO 7 185 : 703 IF(IIMPI.EQ.9) WRITE(IOIMP,23) 186 : ITRA2=1 187 : 7 IF(ITRA1.EQ.0.AND.ITRA2.EQ.0) GO TO 704 188 : IF(ITRI.EQ.2) GO TO 706 188 : CALL GAMTR(SIGMA,DSIGMA,F1ST,F2ST,R1,R2,CC,SS,CS,ITRAC,IRZ, 189 : .SEL(6),PREC,RFSG,RFEP,RFPR,KERRE) 190 : IF(SEL(6).LE.1.D0.AND.ITRI.EQ.0) GO TO 8 191 : IF(SEL(6).GE.TOL.AND.SEL(6).LE.1.D0.AND.ITRI.EQ.1) GO TO 8 192 : 704 SEL(6)=100.D0 193 : GO TO 8 193 : 706 CALL GAMMAN(6,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 194 : .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ, 195 : .SEL(6),PREC,RFSG,RFEP,RFPR,KERRE) 196 : C 197 : C CAS DU CRITERE DE LA TRACTION DANS LA DIRECTION TETA (7) 198 : C 199 : 8 IF(KASTR.EQ.2) GO TO 731 200 : FSIG=SIGMAT(3) 201 : CRIT3=FSIG-R3 202 : IF(CRIT3.GT.0.D0) GO TO 705 203 : 730 IF(IIMPI.EQ.9) WRITE(IOIMP,24) 204 : ITRAT=0 205 : 731 SEL(7)=100.D0 206 : GO TO 9 207 : 705 IF(ITRI.EQ.2) GO TO 707 208 : SEL(7)=GAMTT(SIGMA(3),DSIGMA(3),R3) 209 : IF(SEL(7).LE.1.D0.AND.ITRI.EQ.0) GO TO 755 210 : IF(SEL(7).GE.TOL.AND.SEL(7).LE.1.D0.AND.ITRI.EQ.1) GO TO 755 211 : GO TO 730 211 : 707 CALL GAMMAN(7,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 212 : .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ, 213 : .SEL(7),PREC,RFSG,RFEP,RFPR,KERRE) 214 : 755 IF(IIMPI.EQ.9) WRITE(IOIMP,25) 215 : ITRAT=1 216 : C 217 : C POUR SAVOIR QUEL EST LE PREMIER CRITERE ENDOMMAGE 218 : C 219 : 9 IF(ITRI.EQ.0.OR.ITRI.EQ.1) GO TO 99 220 : C 221 : C CAS DU ITRI=2 (CALCUL POUR TROUVER LA CORRECTION DU DELTA(X) AU COUR 222 : C DES ITTERATIONS INTERNES) 223 : C 224 : IMIN=1 225 : GAMIN=SEL(1) 226 : DO 799 I=2,7 227 : IF(ABS(GAMIN).LE.ABS(SEL(I))) GO TO 799 228 : GAMIN=SEL(I) 229 : IMIN=I 230 : 799 CONTINUE 231 : GO TO 801 232 : C 233 : C CAS DU ITRI=0 (CALCUL POUR TROUVER LA PREMIERE SURFACE ENDOMMAGEE) 234 : C CAS DU ITRI=1 (CALCUL POUR TROUVER LA PREMIERE ESTIMATION DE L ECOULEM 235 : C 236 : 99 IMIN=1 237 : GAMIN=SEL(1) 238 : DO 800 I=2,7 239 : IF(GAMIN.LE.SEL(I)) GO TO 800 240 : GAMIN=SEL(I) 241 : IMIN=I 242 : 800 CONTINUE 243 : C 244 : 801 IF(IIMPI.EQ.9) WRITE(IOIMP,9000)SEL,GAMIN,IMIN,IDAM 245 : C 246 : IF(GAMIN.GE.1.D0) GO TO 900 247 : C 248 : DENOR=MIN(ABS(GAMIN),ABS(SEL(1))) 249 : DENOR=MAX(DENOR,RFPR) 250 : DIFGA1=ABS(GAMIN-SEL(1))/DENOR 251 : C 252 : DENOR=MIN(ABS(GAMIN),ABS(SEL(6))) 253 : DENOR=MAX(DENOR,RFPR) 254 : DIFGA6=ABS(GAMIN-SEL(6))/DENOR 255 : C 256 : DENOR=MIN(ABS(GAMIN),ABS(SEL(7))) 257 : DENOR=MAX(DENOR,RFPR) 258 : DIFGA7=ABS(GAMIN-SEL(7))/DENOR 259 : C 260 : IF(GAMIN.LT.0.D0) GAMIN=0.D0 261 : C 262 : IF(ITRI.EQ.0) GO TO 802 263 : DO 803 III=1,6 264 : DDSIGP(III)=DSIGMA(III)*(1.D0-GAMIN) 265 : 803 DSIGEL(III)=SIGMAT(III)-DDSIGP(III) 266 : TRDSGE=DSIGEL(1)+DSIGEL(2)+DSIGEL(3) 267 : SEQCR2=AVM(DSIGEL,DSIGEL) 268 : SEQCRI=SQRT(SEQCR2) 269 : GO TO 804 270 : 802 DO 1000 III=1,6 271 : DSIGP(III)=DSIGMA(III)*(1.D0-GAMIN) 272 : SIGEL(III)=SIGMAT(III)-DSIGP(III) 273 : 1000 CONTINUE 274 : C 275 : TRSIGE=SIGEL(1)+SIGEL(2)+SIGEL(3) 276 : TRDSGE=TRSIGE 277 : SEQCR2=AVM(SIGEL,SIGEL) 278 : SEQCRI=SQRT(SEQCR2) 279 : C 280 : C L INTERSECTION DU CRITERE DE DRUCKER FRAGILE (4) 281 : C AVEC LE CRITERE DE DRUCKER DUCTILE (2) 282 : C 283 : 804 AAA=ALFAD1-ALFADV 284 : TRAME0=(DPELA1-DPELAS)/AAA 285 : SEQME0=(DPELAS*ALFAD1-DPELA1*ALFADV)/AAA 286 : C 287 : IF(IIMPI.EQ.9) WRITE(IOIMP,9001) TRDSGE,TRAME0,SEQCRI,SEQME0 288 : C 289 : DENOR=MIN(ABS(TRAME0),ABS(TRDSGE)) 290 : DENOR=MAX(DENOR,RFSG) 291 : DIFTR=ABS(TRAME0-TRDSGE)/DENOR 292 : IF(DIFTR.LE.RFPR) GO TO 1010 293 : IF(TRDSGE.LT.TRAME0) GO TO 1020 294 : IF(TRDSGE.GT.TRAME0) GO TO 1030 295 : C 296 : C ON EST SUR L INTERSECTION DES CRITERS (2) ET (4) 297 : C 298 : 1010 IF(IIMPI.EQ.9) WRITE(IOIMP,31) 299 : DENOR=MIN(ABS(SEQME0),ABS(SEQCRI)) 300 : DENOR=MAX(DENOR,RFSG) 301 : DIFSEQ=ABS(SEQME0-SEQCRI)/DENOR 302 : IF(DIFSEQ.LE.PREC) GO TO 1009 303 : WRITE(IOIMP,9004) 304 : C 305 : 1009 IF(ICRIT1.EQ.0.AND.ICRIME.EQ.0.AND.ITRI.EQ.0) GO TO 204 306 : IF(ICRIT1.EQ.2) GO TO 1011 307 : IF(ICRIT1.EQ.3) GO TO 1043 308 : IF(ICRIT1.EQ.4) GO TO 1012 309 : IF(ICRIT1.EQ.5) GO TO 1045 310 : WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI 311 : KERRE=640 312 : RETURN 313 : C 314 : 1011 IF(ICRIME.EQ.0) GO TO 1013 315 : IF(ICRIME.EQ.4) GO TO 1015 316 : IF(ICRIME.EQ.3) GO TO 1042 317 : WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI 318 : KERRE=640 319 : RETURN 320 : C 321 : 1012 IF(ICRIME.EQ.0) GO TO 1014 322 : IF(ICRIME.EQ.2) GO TO 1016 323 : IF(ICRIME.EQ.5) GO TO 1044 324 : WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI 325 : KERRE=640 326 : RETURN 327 : C 328 : 1013 IF(IDED.EQ.1.OR.IDED.EQ.3) GO TO 2004 329 : WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI 330 : KERRE=640 331 : RETURN 332 : C 333 : 1015 IF(IDED.EQ.0.OR.IDED.EQ.2) GO TO 2003 334 : GO TO 1042 335 : C 336 : 1014 IF(IDED.EQ.2.OR.IDED.EQ.3) GO TO 4002 337 : WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI 338 : KERRE=640 339 : RETURN 340 : C 341 : 1016 IF(IDED.EQ.0.OR.IDED.EQ.1) GO TO 4005 342 : GO TO 1044 343 : C 344 : C POUR ELIMINER LES MAUVAISES POSSIBILITES DE COUPLAGE 345 : C 346 : 1042 IF(IMIN.EQ.1.OR.IMIN.EQ.3.OR.IMIN.EQ.4) GO TO 1040 347 : SEL(5)=100.D0 348 : SEL(6)=100.D0 349 : SEL(7)=100.D0 350 : IF(IIMPI.EQ.9) WRITE(IOIMP,40) 351 : GO TO 9 352 : C 353 : 1043 IF(IMIN.EQ.1.OR.IMIN.EQ.2) GO TO 1040 354 : SEL(4)=100.D0 355 : SEL(5)=100.D0 356 : SEL(6)=100.D0 357 : SEL(7)=100.D0 358 : IF(IIMPI.EQ.9) WRITE(IOIMP,40) 359 : GO TO 9 360 : C 361 : 1044 IF(IMIN.EQ.2.OR.IMIN.EQ.5) GO TO 1040 362 : SEL(1)=100.D0 363 : SEL(3)=100.D0 364 : SEL(6)=100.D0 365 : SEL(7)=100.D0 366 : IF(IIMPI.EQ.9) WRITE(IOIMP,40) 367 : GO TO 9 368 : C 369 : 1045 IF(IMIN.EQ.4) GO TO 1040 370 : SEL(1)=100.D0 371 : SEL(2)=100.D0 372 : SEL(3)=100.D0 373 : SEL(6)=100.D0 374 : SEL(7)=100.D0 375 : IF(IIMPI.EQ.9) WRITE(IOIMP,40) 376 : GO TO 9 377 : C 378 : C*********************************************************************** 379 : C*********************** ON EST DANS LE DOMAINE DUCTILE **************** 380 : C*********************************************************************** 381 : C 382 : 1020 IF(IIMPI.EQ.9) WRITE(IOIMP,32) 383 : IF(IMIN.EQ.1.OR.IMIN.EQ.3) GO TO 1021 384 : IF(IDED.EQ.1.OR.IDED.EQ.3.AND.IMIN.EQ.2) GO TO 1022 385 : IF(IDED.NE.1.AND.IDED.NE.3) SEL(2)=100.D0 386 : IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IDED.EQ.1.OR.IDED.EQ.3)GO TO 1022 387 : SEL(4)=100.D0 388 : SEL(5)=100.D0 389 : SEL(6)=100.D0 390 : SEL(7)=100.D0 391 : IF(IIMPI.EQ.9) WRITE(IOIMP,40) 392 : GO TO 9 393 : 1021 IF(IDED.EQ.1.OR.IDED.EQ.3) GO TO 1022 394 : GO TO 1221 395 : C 396 : C L INTERSECTION DU CRITERE DE DRUCKER DUCTILE (2) 397 : C AVEC LE CRITERE DE VON MISES (3) 398 : C 399 : 1022 SEQME1=VMELAS 400 : IF(ICRIT1.EQ.3) SEQME1=VMELAS+PENTE1*(DGLAMP*GAMIN+DL) 401 : TRAME1=(DPELAS-SEQME1)/ALFADV 402 : C 403 : IF(IIMPI.EQ.9) WRITE(IOIMP,9002) TRDSGE,TRAME1,SEQCRI,SEQME1 404 : C 405 : DENOR=MIN(ABS(TRAME1),ABS(TRDSGE)) 406 : DENOR=MAX(DENOR,RFSG) 407 : DIFTR=ABS(TRAME1-TRDSGE)/DENOR 408 : IF(DIFTR.LE.RFPR) GO TO 1210 409 : IF(TRDSGE.LT.TRAME1) GO TO 1220 410 : IF(TRDSGE.GT.TRAME1) GO TO 1230 411 : C 412 : C ON EST SUR L INTERSECTION DES CRITERS (2) ET (3) 413 : C 414 : 1210 IF(IIMPI.EQ.9) WRITE(IOIMP,34) 415 : DENOR=MIN(ABS(SEQME1),ABS(SEQCRI)) 416 : DENOR=MAX(DENOR,RFSG) 417 : DIFSEQ=ABS(SEQME1-SEQCRI)/DENOR 418 : IF(DIFSEQ.LE.PREC) GO TO 1209 419 : WRITE(IOIMP,9004) 420 : C 421 : 1209 IF(ICRIME.NE.0.OR.ICRIMT.NE.0) GO TO 1040 422 : IF(DIFGA1.LE.PREC) GO TO 1211 423 : IF(ICRIT1.EQ.0) GO TO 203 424 : IF(ICRIT1.EQ.1) GO TO 1023 425 : IF(ICRIT1.EQ.2) GO TO 2003 426 : IF(ICRIT1.EQ.3) GO TO 3002 427 : WRITE(IOIMP,28) IDED,ICRIT1,ICRIME,ICRIMT,ITRI 428 : KERRE=640 429 : RETURN 430 : C 431 : C CAS OU LE CRITERE DE LA POROSITE (1) EST ACTIF 432 : C 433 : 1211 IF(ICRIT1.EQ.0) GO TO 123 434 : IF(ICRIT1.EQ.2) GO TO 2031 435 : IF(ICRIT1.EQ.3) GO TO 3012 436 : WRITE(IOIMP,28) IDED,ICRIT1,ICRIME,ICRIMT,ITRI 437 : KERRE=640 438 : RETURN 439 : C 440 : C ON EST DU COTE DUCTILE ECROUISSABLE 441 : C 442 : 1220 IF(IIMPI.EQ.9) WRITE(IOIMP,36) 443 : IF(IMIN.EQ.1.OR.IMIN.EQ.3) GO TO 1221 444 : IF(ICRIT1.EQ.3.AND.ITRI.GT.0.AND.IMIN.EQ.2) GO TO 1040 445 : IF(ICRIT1.NE.3.OR.ITRI.EQ.0) SEL(2)=100.D0 446 : SEL(4)=100.D0 447 : SEL(5)=100.D0 448 : SEL(6)=100.D0 449 : SEL(7)=100.D0 450 : IF(IIMPI.EQ.9) WRITE(IOIMP,40) 451 : GO TO 9 452 : C 453 : C POUR SAVOIR S IL Y A UN COUPLAGE ENTRE LES CRITERES (1) ET (3) ??????? 454 : C 455 : 1221 DENOR=MIN(ABS(SEL(1)),ABS(SEL(3))) 456 : DENOR=MAX(DENOR,RFPR) 457 : DIFFE=ABS(SEL(1)-SEL(3))/DENOR 458 : IF(DIFFE.LE.PREC) GO TO 103 459 : GO TO 1040 460 : C 461 : C ON EST DU COTE DUCTILE NON ECROUISSABLE (FIXE) 462 : C 463 : 1230 IF(IIMPI.EQ.9) WRITE(IOIMP,38) 464 : IF(IMIN.EQ.2) GO TO 1040 465 : IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.3) GO TO 1040 466 : IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.4) GO TO 1040 467 : IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.5.AND.IDED.EQ.1) 468 : . GO TO 1040 469 : SEL(1)=100.D0 470 : IF(ICRIT1.NE.2.OR.ITRI.EQ.0) SEL(3)=100.D0 471 : IF(ICRIT1.NE.2.OR.ITRI.EQ.0) SEL(4)=100.D0 472 : IF(ICRIT1.NE.2.OR.ITRI.EQ.0.OR.IDED.NE.1) SEL(5)=100.D0 473 : SEL(6)=100.D0 474 : SEL(7)=100.D0 475 : IF(IIMPI.EQ.9) WRITE(IOIMP,40) 476 : GO TO 9 477 : C 478 : C*********************************************************************** 479 : C*********************** ON EST DANS LE DOMAINE FRAGILE **************** 480 : C*********************************************************************** 481 : C 482 : 1030 IF(IIMPI.EQ.9) WRITE(IOIMP,33) 483 : IF(DIFGA6.LE.PREC.OR.DIFGA7.LE.PREC) GO TO 1050 484 : IF(IMIN.EQ.5) GO TO 1031 485 : IF(IDED.EQ.2.OR.IDED.EQ.3.AND.IMIN.EQ.4) GO TO 1032 486 : IF(IDED.NE.2.AND.IDED.NE.3) SEL(4)=100.D0 487 : IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.(IDED.EQ.2.OR.IDED.EQ.3)) 488 : . GO TO 1032 489 : SEL(1)=100.D0 490 : SEL(2)=100.D0 491 : SEL(3)=100.D0 492 : IF(IIMPI.EQ.9) WRITE(IOIMP,40) 493 : GO TO 9 494 : 1031 IF(IDED.EQ.2.OR.IDED.EQ.3) GO TO 1032 495 : GO TO 1040 496 : C 497 : C L INTERSECTION DU CRITERE DE DRUCKER FRAGILE (4) 498 : C AVEC LE CRITERE DE DRUCKER ECROUISSABLE (5) 499 : C 500 : 1032 IF(LMIC5.EQ.1) GO TO 1040 501 : AAA=ALFAD1-ALFAD2 502 : DPEL2=DPELA2 503 : IF(ICRIT1.EQ.5) DPEL2=DPELA2+PENTE2*(DGLAMP*GAMIN+DL) 504 : IF(ICRIT1.EQ.5.AND.DPEL2.LT.DP2MIN) DPEL2=DP2MIN 505 : TRAME2=(DPELA1-DPEL2)/AAA 506 : SEQME2=(DPEL2*ALFAD1-DPELA1*ALFAD2)/AAA 507 : C 508 : IF(IIMPI.EQ.9) WRITE(IOIMP,9003) TRDSGE,TRAME2,SEQCRI,SEQME2 509 : C 510 : DENOR=MIN(ABS(TRAME2),ABS(TRDSGE)) 511 : DENOR=MAX(DENOR,RFSG) 512 : DIFTR=ABS(TRAME2-TRDSGE)/DENOR 513 : IF(DIFTR.LE.RFPR) GO TO 1310 514 : IF(TRDSGE.LT.TRAME2) GO TO 1320 515 : IF(TRDSGE.GT.TRAME2) GO TO 1330 516 : C 517 : C ON EST SUR L INTERSECTION DES CRITERS (4) ET (5) 518 : C 519 : 1310 IF(IIMPI.EQ.9) WRITE(IOIMP,35) 520 : DENOR=MIN(ABS(SEQME2),ABS(SEQCRI)) 521 : DENOR=MAX(DENOR,RFSG) 522 : DIFSEQ=ABS(SEQME2-SEQCRI)/DENOR 523 : IF(DIFSEQ.LE.PREC) GO TO 1309 524 : WRITE(IOIMP,9004) 525 : C 526 : 1309 IF(ICRIT1.EQ.0.AND.ICRIME.EQ.0) GO TO 405 527 : IF(ICRIT1.EQ.4.AND.ICRIME.EQ.0) GO TO 4005 528 : IF(ICRIT1.EQ.5.AND.ICRIME.EQ.0) GO TO 5004 529 : GO TO 1040 530 : C 531 : C ON EST DU COTE FRAGILE NON ECROUISSABLE (FIXE) 532 : C 533 : 1320 IF(IIMPI.EQ.9) WRITE(IOIMP,37) 534 : IF(IMIN.EQ.4) GO TO 1040 535 : IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.2) GO TO 1040 536 : IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.5) GO TO 1040 537 : IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.3.AND.IDED.EQ.2) 538 : . GO TO 1040 539 : SEL(1)=100.D0 540 : IF(ICRIT1.NE.4.OR.ITRI.EQ.0) SEL(2)=100.D0 541 : IF(ICRIT1.NE.4.OR.ITRI.EQ.0.OR.IDED.NE.2) SEL(3)=100.D0 542 : IF(ICRIT1.NE.4.OR.ITRI.EQ.0) SEL(5)=100.D0 543 : IF(IIMPI.EQ.9) WRITE(IOIMP,40) 544 : GO TO 9 545 : C 546 : C ON EST DU COTE FRAGILE ECROUISSABLE 547 : C 548 : 1330 IF(IIMPI.EQ.9) WRITE(IOIMP,39) 549 : IF(IMIN.EQ.5) GO TO 1040 550 : IF(ICRIT1.EQ.5.AND.ITRI.GT.0.AND.IMIN.EQ.4) GO TO 1040 551 : SEL(1)=100.D0 552 : SEL(2)=100.D0 553 : SEL(3)=100.D0 554 : IF(ICRIT1.NE.5.OR.ITRI.EQ.0) SEL(4)=100.D0 555 : IF(IIMPI.EQ.9) WRITE(IOIMP,40) 556 : GO TO 9 557 : C 558 : C||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 559 : C||||||||||||||||||||||||||||||| LA SORTIE ||||||||||||||||||||||||||||| 560 : C||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 561 : C 562 : C 563 : C IL N Y A PAS D ENDOMMAGEMENT 564 : C 565 : 900 IF(IIMPI.EQ.9) WRITE(IOIMP,29) 566 : IMIN=0 567 : GAMIN=1.D0 568 : RETURN 569 : C 570 : C IL N Y A PAS DE COUPLAGE 571 : C 572 : 2003 IMIN=3 573 : GAMIN=SEL(3) 574 : GO TO 1040 575 : C 576 : 2004 IMIN=4 577 : GAMIN=SEL(4) 578 : GO TO 1040 579 : C 580 : 3002 IMIN=2 581 : GAMIN=SEL(2) 582 : GO TO 1040 583 : C 584 : 4002 IMIN=2 585 : GAMIN=SEL(2) 586 : GO TO 1040 587 : C 588 : 4005 IMIN=5 589 : GAMIN=SEL(5) 590 : GO TO 1040 591 : C 592 : 5004 IMIN=4 593 : GAMIN=SEL(4) 594 : GO TO 1040 595 : C 596 : C LA TRACTION 597 : C 598 : 1050 IMIN=6 599 : ITETA=1 600 : IF(ITRI.EQ.2.AND.ABS(SEL(6)).LT.ABS(SEL(7))) ITETA=2 601 : IF(ITRI.NE.2.AND.SEL(6).LT.SEL(7)) ITETA=2 602 : DENOR=MIN(ABS(SEL(6)),ABS(SEL(7))) 603 : DENOR=MAX(DENOR,RFPR) 604 : DFT=ABS(SEL(6)-SEL(7))/DENOR 605 : IF(ABS(DFT).LE.PREC) ITETA=3 606 : GO TO 1040 607 : C 608 : C IL Y A UN COUPLAGE 609 : C 610 : 103 ICAS=2 611 : GO TO 1060 612 : C 613 : 203 ICAS=3 614 : GO TO 1060 615 : C 616 : 204 ICAS=4 617 : GO TO 1060 618 : C 619 : 405 ICAS=7 620 : GO TO 1060 621 : C 622 : 1023 IMIN=2 623 : JMIN=3 624 : GAMIN=(SEL(2)+SEL(3))*0.5D0 625 : GO TO 1060 626 : C 627 : 2031 IMIN=3 628 : JMIN=1 629 : GAMIN=(SEL(3)+SEL(1))*0.5D0 630 : GO TO 1060 631 : C 632 : 3012 IMIN=1 633 : JMIN=2 634 : GAMIN=(SEL(1)+SEL(2))*0.5D0 635 : C 636 : 1060 KOUPLE=2 637 : GO TO 1040 638 : C 639 : C IL Y A UN TRIPLAGE 640 : C 641 : 123 KOUPLE=3 642 : C 643 : 1040 IF(GAMIN.GT.1.D0) GAMIN=1.D0 644 : IF(IIMPI.EQ.9) WRITE(IOIMP,30) 645 : . GAMIN,KOUPLE,IMIN,JMIN,ICAS,ITETA,IRZ 646 : C 647 : 10 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA POROSITE') 648 : 11 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA POROSITE') 649 : 12 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER DUCTILE') 650 : 13 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER DUCTILE') 651 : 14 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE VON MISES') 652 : 15 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE VON MISES') 653 : 16 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER FRAGILE') 654 : 17 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER FRAGILE') 655 : 18 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER ECR. FRAGILE 656 : .') 657 : 19 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER ECR. FRAGILE') 658 : 20 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (1)') 659 : 21 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (1)') 660 : 22 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (2)') 661 : 23 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (2)') 662 : 24 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (3)') 663 : 25 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (3)') 664 : 26 FORMAT(1X,'WW1 =',3(1X,1PD12.5)) 665 : 27 FORMAT(1X,'ERREUR DANS TRIAGE ON EST SUR L INTERSECTION (2) ET (4) 666 : . '/1X,'IDED =',I4,1X,'ICRIT1=',I4,1X,'ICRIME=',I4,/, 667 : . 1X,'ICRIMT=',I4,1X,'ITRI =',I4) 668 : 28 FORMAT(1X,'ERREUR DANS TRIAGE ON EST SUR L INTERSECTION (2) ET (3) 669 : . '/1X,'IDED =',I4,1X,'ICRIT1=',I4,1X,'ICRIME=',I4,/, 670 : . 1X,'ICRIMT=',I4,1X,'ITRI =',I4) 671 : 29 FORMAT(1X,'IL N Y A PAS D ENDOMMAGEMENT') 672 : 30 FORMAT(1X,'IL Y A D ENDOMMAGEMENT',3X,'GAMIN =',1PD12.5,/, 673 : . 1X,'KOUPLE=',I4,1X,'IMIN =',I4,1X,'JMIN =',I4,/, 674 : . 1X,'ICAS =',I4,1X,'ITETA =',I4,1X,'IRZ =',I4) 675 : 31 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (2) ET (4)') 676 : 32 FORMAT(1X,'ON EST DANS LE DOMAINE DUCTILE ') 677 : 33 FORMAT(1X,'ON EST DANS LE DOMAINE FRAGILE ') 678 : 34 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (2) ET (3)') 679 : 35 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (4) ET (5)') 680 : 36 FORMAT(1X,'ON EST DU COTE DUCTILE ECROUISSABLE') 681 : 37 FORMAT(1X,'ON EST DU COTE FRAGILE NON ECROUISSABLE (FIXE)') 682 : 38 FORMAT(1X,'ON EST DU COTE DUCTILE NON ECROUISSABLE (FIXE)') 683 : 39 FORMAT(1X,'ON EST DU COTE FRAGILE ECROUISSABLE') 684 : 40 FORMAT(1X,'LE CRITERE TROUVE N EST PAS BON POUR CE DOMAINE ', 685 : . 'IL FAUT RECOMMENCER LE TRI',/) 686 : 9000 FORMAT(1X,'SEL =',1PD12.5,/,6(8X,1PD12.5,/), 687 : . 1X,'GAMIN =',1PD12.5,1X,'IMIN =',I4,1X,'IDAM =',I4) 688 : 9001 FORMAT(1X,'INTERSECTION DES CRITERES (2) ET (4)',/, 689 : . 1X,'TRDSGE=',1PD12.5,1X,'TRAMR0=',1PD12.5,/, 690 : . 1X,'SEQCRI=',1PD12.5,1X,'SEQME0=',1PD12.5) 691 : 9002 FORMAT(1X,'INTERSECTION DES CRITERES (2) ET (3)',/, 692 : . 1X,'TRDSGE=',1PD12.5,1X,'TRAMR1=',1PD12.5,/, 693 : . 1X,'SEQCRI=',1PD12.5,1X,'SEQME1=',1PD12.5) 694 : 9003 FORMAT(1X,'INTERSECTION DES CRITERES (4) ET (5)',/, 695 : . 1X,'TRDSGE=',1PD12.5,1X,'TRAMR2=',1PD12.5,/, 696 : . 1X,'SEQCRI=',1PD12.5,1X,'SEQME2=',1PD12.5) 697 : 9004 FORMAT(1X,'DANS TRIAGE SUR L INTERSECTION SEQMER # SEQCRI') 698 : 9005 FORMAT(1X,'ERREUR DANS TRIAGE DANS LA VALEUR DE ITRI =',I4) 699 : 9006 FORMAT(1X,'A LA RECHERCHE DE LA PREMIERE SURFACE ENDOMMAGEE', 700 : . 1X,'IDAM =',I4/) 701 : 9007 FORMAT(1X,'LE CALCUL POUR TROUVER LA PREMIERE ESTIMATION DE ', 702 : . 'L ECOULEMENT DELTA(X) IDAM =',I4) 703 : 9008 FORMAT(1X,'LE CALCUL POUR TROUVER LA CORRECTION DE DELTA(X) AU ', 704 : . 'COUR DES ITTERATIONS INTERNES IDAM =',I4) 705 : C 706 : RETURN 707 : END 708 :
© Cast3M 2003 - All rights reserved.
Disclaimer