1 : C CRITP SOURCE CHAT 11/03/16 21:18:23 6902 2 : SUBROUTINE CRITP(IPMODL,IPCHE1,IPCHE2,IPCAR,IPCHE3) 3 : ******************************************************************* 4 : * 5 : * CALCUL LE CRITERE DE PLASTICITE 6 : * 7 : ********************************************************************** 8 : * 9 : * ENTREES: 10 : * 11 : * IPMODL = POINTEUR SUR UN OBJET MMODEL 12 : * IPCHE1 = POINTEUR SUR UN MCHAML DE CONTRAINTES 13 : * IPCHE2 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES 14 : * IPCAR = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES 15 : * 16 : * SORTIES: 17 : * 18 : * IPCHE3 = POINTEUR SUR UN MCHAML SCALAIRE 19 : * 20 : ************************************************************************ 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8(A-H,O-Z) 23 : * 24 : -INC CCOPTIO 25 : -INC SMCHAML 26 : -INC SMELEME 27 : -INC SMCOORD 28 : -INC SMMODEL 29 : -INC SMINTE 30 : -INC CCHAMP 31 : C---------------------------------------------------------------------- 32 : C KERRE REGIT LES MESSAGES D'ERREUR DANS CRIT 33 : C 34 : C = 0 TOUT OK 35 : C = 1 ET 2 S ALIGNER SUR LES VALEURS DONNEES PAR ECOCRI 36 : C = 7 UN ELEMENT TUYAU A UNE EPAISSEUR NULLE 37 : C 38 : C ANOMALIES AVEC LA COURBE DE TRACTION 39 : C = 30 LIMITE ELASTIQUE NULLE 40 : C = 31 TROP DE POINTS 41 : C = 32 PAS ASSEZ DE POINTS 42 : C = 33 PENTE INCORRECTE 43 : C = 34 MODULE D'YOUNG NUL 44 : C = 35 MANQUE L'ORIGINE 45 : C = 36 PENTE A L'ORIGINE NON EGALE A E 46 : C = 37 MANQUE LA COURBE DE TRACTION 47 : C = 48 DONNEES DRUCKER-PRAGER ERRONNEES 48 : C = 99 CAS NON ENCORE DISPONIBLE 49 : C---------------------------------------------------------------------- 50 : C 51 : SEGMENT NOTYPE 52 : CHARACTER*16 TYPE(NBTYPE) 53 : ENDSEGMENT 54 : * 55 : SEGMENT MPTVAL 56 : INTEGER IPOS(NS) ,NSOF(NS) 57 : INTEGER IVAL(NCOSOU) 58 : CHARACTER*16 TYVAL(NCOSOU) 59 : ENDSEGMENT 60 : * 61 : SEGMENT WRK0 62 : REAL*8 XMAT(NCXMAT) 63 : ENDSEGMENT 64 : * 65 : SEGMENT WRK1 66 : REAL*8 DDHOOK(NSTRS,NSTRS),SIG0(NSTRS),DSIGT(NSTRS) 67 : REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI) 68 : REAL*8 DEFP(NSTRS),XCAR(ICARA) 69 : ENDSEGMENT 70 : * 71 : SEGMENT WRK2 72 : REAL*8 TRAC(LTRAC) 73 : ENDSEGMENT 74 : * 75 : SEGMENT WRK3 76 : REAL*8 WORK(LW),WORK2(LW2) 77 : ENDSEGMENT 78 : * 79 : SEGMENT WRK4 80 : REAL*8 XE(3,NBBB) 81 : ENDSEGMENT 82 : * 83 : SEGMENT ECOU 84 : *** COMMON/ECOU/TEST,ALFAH, 85 : REAL*8 TEST,ALFAH, 86 : C REAL*8 TEST, ALFAH, 87 : 1 HPAS, TEMPS,ecow3(6),ecow4(9),ecow5(6), 88 : C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 89 : 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6), 90 : 2 ecow12(6), 91 : C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 92 : 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3), 93 : C 1 DALPHA(6),EPSPLA(6),E(12),XINV(3), 94 : 2 ecow17(6),ecow18(6),ecow19,ecow20 95 : C 2 SIPLAD(6),DSIGP0(6),TET,TETI 96 : ENDSEGMENT 97 : 98 : SEGMENT NECOU 99 : * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 100 : INTEGER NCOURB, IPLAST,IT,IMAPLA, ISOTRO, 101 : C INTEGER NCOURB,IPLAST,IT, IMAPLA,ISOTRO, 102 : 1 ITYP, IFOURB, IFLUAG, 103 : C . ITYP, IFOURB,IFLUAG, 104 : 2 ICINE,ITHER, IFLUPL,ICYCL, IBI, 105 : C . ICINE,ITHER, IFLUPL,ICYCL, IBI, 106 : 3 JFLUAG,KFLUAG, LFLUAG, 107 : C . JFLUAG,KFLUAG,LFLUAG, 108 : 4 IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEP 109 : C . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 110 : ENDSEGMENT 111 : * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 112 : * . ITYP,IFOURB,IFLUAG, 113 : * . ICINE,ITHER,IFLUPL,ICYCL,IBI, 114 : * . JFLUAG,KFLUAG,LFLUAG, 115 : * . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 116 : 117 : DIMENSION MOMAT(2) 118 : DIMENSION XEPOU(2),YEPOU(2),ZEPOU(2) 119 : DIMENSION BID(3) 120 : * 121 : CHARACTER*8 CMATE 122 : CHARACTER*(NCONCH) CONM 123 : PARAMETER ( NINF=3 ) 124 : INTEGER INFOS(NINF) 125 : LOGICAL LSUPVA,lsupco,lsupma 126 : DATA IUN,IZERO/1,0/ 127 : DATA UN,XZER,UNDEMI/1.D0,0.D0,.5D0/ 128 : C 129 : NHRM=NIFOUR 130 : C 131 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES 132 : C 132 : CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1) 133 : IF (ISUP1.GT.1) RETURN 134 : C 135 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES 136 : C 136 : CALL QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2) 137 : IF (ISUP2.GT.1) RETURN 138 : C 139 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES 140 : C 140 : CALL QUESUP(IPMODL,IPCAR,5,0,ISUP3,IRET3) 141 : IF (ISUP3.GT.1) RETURN 142 : C 143 : C ACTIVATION DU MODELE 144 : C 145 : MMODEL=IPMODL 146 : SEGACT MMODEL 147 : NSOUS=KMODEL(/1) 148 : C 149 : C CREATION DU MCHAML 150 : C 151 : N1=NSOUS 152 : L1=8 153 : N3=6 154 : SEGINI MCHELM 155 : TITCHE='SCALAIRE' 156 : IFOCHE=IFOUR 157 : IPCHE3=MCHELM 158 : C____________________________________________________________________ 159 : C 160 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES 161 : C____________________________________________________________________ 162 : C 163 : DO 500 ISOUS=1,NSOUS 164 : * 165 : * INITIALISATION 166 : * 167 : segini necou,ecou 168 : NSTR=0 169 : MOSTRS=0 170 : IVASTR=0 171 : MOVARI=0 172 : NVARI=0 173 : IVARI=0 174 : NCARA=0 175 : NCARF=0 176 : MOCARA=0 177 : IVACAR=0 178 : NMATF=0 179 : NMATR=0 180 : MOMATR=0 181 : IVAMAT=0 182 : IMELCR=0 183 : KERRE=0 184 : KERR1=0 185 : lsupma=.true. 186 : lsupva=.false. 187 : C 188 : C ON RECUPERE L INFORMATION GENERALE 189 : C 190 : IMODEL=KMODEL(ISOUS) 191 : SEGACT IMODEL 192 : IPMAIL=IMAMOD 193 : CONM =CONMOD 194 : IMACHE(ISOUS)=IPMAIL 195 : CONCHE(ISOUS)=CONMOD 196 : * 197 : MELE=NEFMOD 198 : MELEME=IMAMOD 199 : SEGACT MELEME 200 : NBNN=NUM(/1) 201 : NBELEM=NUM(/2) 202 : C 203 : C TRAITEMENT DU MODELE 204 : C 205 : C 206 : C COQUE INTEGREE OU PAS ? 207 : C 208 : IF(INFMOD(/1).NE.0)THEN 209 : NPINT=INFMOD(1) 210 : ELSE 211 : NPINT=0 212 : ENDIF 213 : IF (NPINT.NE.0)THEN 213 : CALL ERREUR(615) 214 : SEGDES IMODEL,MMODEL 215 : SEGSUP MCHELM 216 : RETURN 217 : ENDIF 218 : C 219 : C NATURE DU MATERIAU 220 : C 221 : C* NFOR=FORMOD(/2) 222 : C* NMAT=MATMOD(/2) 222 : C* CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INPLAS) 223 : CMATE = CMATEE 224 : MATE = IMATEE 225 : INPLAS = INATUU 226 : C* IF (CMATE.EQ.' ')THEN 226 : C* CALL ERREUR(251) 227 : C* SEGDES IMODEL,MMODEL 228 : C* SEGSUP MCHELM 229 : C* RETURN 230 : C* ENDIF 231 : C____________________________________________________________________ 232 : C 233 : C INFORMATION SUR L'ELEMENT FINI 234 : C____________________________________________________________________ 235 : C 235 : * CALL ELQUOI(MELE,0,5,IPINF,IMODEL) 236 : * IF (IERR.NE.0) THEN 237 : * SEGDES IMODEL,MMODEL 238 : * SEGSUP MCHELM 239 : * RETURN 240 : * ENDIF 241 : MFR =INFELE(13) 242 : NBG =INFELE(6) 243 : NBGS =INFELE(4) 244 : NSTRS=INFELE(16) 245 : LRE =INFELE(9) 246 : IPPORE=0 247 : IF(MFR.EQ.33) IPPORE=NBNN 248 : LW =200 249 : LW2=150 250 : LHOOK=INFELE(10) 251 : LHOO2=LHOOK*LHOOK 252 : * MINTE=INFELE(11) 253 : minte=infmod(7) 254 : * 255 : IPMINT=MINTE 256 : SEGACT,MINTE 257 : * 258 : * REMPLISSAGE DES TABLEAUX INFCHE 259 : * 260 : INFCHE(ISOUS,1)=0 261 : INFCHE(ISOUS,2)=0 262 : INFCHE(ISOUS,3)=NHRM 263 : INFCHE(ISOUS,4)=MINTE 264 : INFCHE(ISOUS,5)=0 265 : INFCHE(ISOUS,6)=5 266 : C 267 : C CREATION DU TABLEAU INFOS 268 : C 268 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD) 269 : IF (IRTD.EQ.0)THEN 270 : SEGDES IMODEL,MMODEL 271 : SEGSUP MCHELM 272 : RETURN 273 : ENDIF 274 : * 275 : * TRAITEMENT DU CHAMP DE CONTRAINTES 276 : * 277 : if(lnomid(4).ne.0) then 278 : nomid=lnomid(4) 279 : segact nomid 280 : mostrs=nomid 281 : nstr=lesobl(/2) 282 : nfac=lesfac(/2) 283 : lsupco=.false. 284 : else 285 : lsupco=.true. 285 : CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC) 286 : endif 287 : IF (MOSTRS.EQ.0) THEN 288 : MOTERR(1:4)='CONT' 289 : MOTERR(5:8)=NOMTP(MELE) 289 : CALL ERREUR (76) 290 : SEGDES IMODEL,MMODEL 291 : SEGSUP MCHELM 292 : RETURN 293 : ENDIF 294 : * 295 : NBTYPE=1 296 : SEGINI NOTYPE 297 : MOTYPE=NOTYPE 298 : TYPE(1)='REAL*8' 298 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR) 299 : IF(IERR.NE.0)THEN 300 : SEGSUP NOTYPE 301 : KERRE=999 302 : GOTO 9990 303 : ENDIF 304 : * 305 : IF (ISUP1.EQ.1) THEN 305 : CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE) 306 : IF(IERR.NE.0)THEN 307 : SEGSUP NOTYPE 308 : KERRE=999 309 : ISUP1=0 310 : GOTO 9990 311 : ENDIF 312 : ENDIF 313 : * 314 : * TRAITEMENT DU CHAMP DE VARIABLES INTERNES 315 : * 316 : if(lnomid(10).ne.0) then 317 : nomid=lnomid(10) 318 : segact nomid 319 : movari=nomid 320 : nvari=lesobl(/2) 321 : nvarf=lesfac(/2) 322 : else 323 : lsupva=.true. 323 : CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF) 324 : endif 325 : 326 : IF (MOVARI.EQ.0) THEN 327 : MOTERR(1:4)='VARI' 328 : MOTERR(5:8)=NOMTP(MELE) 328 : CALL ERREUR (76) 329 : KERRE=999 330 : SEGSUP NOTYPE 331 : GOTO 9990 332 : ENDIF 333 : * 333 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI) 334 : SEGSUP NOTYPE 335 : IF(IERR.NE.0)THEN 336 : KERRE=999 337 : GOTO 9990 338 : ENDIF 339 : * 340 : IF (ISUP2.EQ.1) THEN 340 : CALL VALCHE(IVARI,NVARI,IPMINT,IPPORE) 341 : IF(IERR.NE.0)THEN 342 : KERRE=999 343 : ISUP2=0 344 : GOTO 9990 345 : ENDIF 346 : ENDIF 347 : * 348 : * TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES 349 : * 350 : if(lnomid(6).ne.0) then 351 : nomid=lnomid(6) 352 : segact nomid 353 : momatr=nomid 354 : nmatr=lesobl(/2) 355 : nmatf=lesfac(/2) 356 : lsupma=.false. 357 : else 358 : lsupma=.true. 358 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 359 : endif 360 : IF (MOMATR.EQ.0) THEN 361 : MOTERR(1:4)='MATE' 362 : MOTERR(5:8)=NOMTP(MELE) 362 : CALL ERREUR (76) 363 : KERRE=999 364 : GOTO 9990 365 : ENDIF 366 : * 367 : NOTYPE=0 368 : IF(INPLAS.EQ.5)THEN 369 : NBTYPE=5 370 : SEGINI NOTYPE 371 : TYPE(1)='REAL*8' 372 : TYPE(2)='REAL*8' 373 : TYPE(3)='POINTEUREVOLUTIO' 374 : TYPE(4)='REAL*8' 375 : TYPE(5)='REAL*8' 376 : ELSE IF (INPLAS.EQ.14) THEN 377 : NBTYPE=9 378 : SEGINI NOTYPE 379 : TYPE(1)='REAL*8' 380 : TYPE(2)='REAL*8' 381 : TYPE(3)='REAL*8' 382 : TYPE(4)='REAL*8' 383 : TYPE(5)='REAL*8' 384 : TYPE(6)='POINTEUREVOLUTIO' 385 : TYPE(7)='POINTEUREVOLUTIO' 386 : TYPE(8)='REAL*8' 387 : TYPE(9)='REAL*8' 388 : ELSE IF (INPLAS.EQ.26) THEN 389 : NBTYPE=8 390 : SEGINI NOTYPE 391 : TYPE(1)='REAL*8' 392 : TYPE(2)='REAL*8' 393 : TYPE(3)='POINTEUREVOLUTIO' 394 : TYPE(4)='REAL*8' 395 : TYPE(5)='REAL*8' 396 : TYPE(6)='REAL*8' 397 : TYPE(7)='REAL*8' 398 : TYPE(8)='REAL*8' 399 : ELSEIF(INPLAS.EQ.29)THEN 400 : NBTYPE=13 401 : SEGINI NOTYPE 402 : TYPE(1)='REAL*8' 403 : TYPE(2)='REAL*8' 404 : TYPE(3)='REAL*8' 405 : TYPE(4)='REAL*8' 406 : TYPE(5)='REAL*8' 407 : TYPE(6)='REAL*8' 408 : TYPE(7)='REAL*8' 409 : TYPE(8)='REAL*8' 410 : TYPE(9)='REAL*8' 411 : TYPE(10)='POINTEUREVOLUTIO' 412 : TYPE(11)='REAL*8' 413 : TYPE(12)='REAL*8' 414 : TYPE(13)='REAL*8' 415 : ELSEIF(INPLAS.EQ.16)THEN 416 : NBTYPE=7 417 : SEGINI NOTYPE 418 : TYPE(1)='REAL*8' 419 : TYPE(2)='REAL*8' 420 : TYPE(3)='POINTEUREVOLUTIO' 421 : TYPE(4)='REAL*8' 422 : TYPE(5)='REAL*8' 423 : TYPE(6)='REAL*8' 424 : TYPE(7)='REAL*8' 425 : ELSEIF(INPLAS.EQ.2)THEN 426 : NBTYPE=6 427 : SEGINI NOTYPE 428 : TYPE(1)='REAL*8' 429 : TYPE(2)='REAL*8' 430 : TYPE(3)='REAL*8' 431 : TYPE(4)='POINTEUREVOLUTIO' 432 : TYPE(5)='REAL*8' 433 : TYPE(6)='REAL*8' 434 : ELSE 435 : NBTYPE=1 436 : SEGINI NOTYPE 437 : TYPE(1)='REAL*8' 438 : ENDIF 439 : MOTYPE=NOTYPE 439 : CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1, 440 : & INFOS,3,IVAMAT) 441 : SEGSUP NOTYPE 442 : IF(IERR.NE.0)THEN 443 : KERRE=999 444 : GOTO 9990 445 : ENDIF 446 : NMATT=NMATR+NMATF 447 : * 448 : IF (ISUP3.EQ.1) THEN 448 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 449 : IF(IERR.NE.0)THEN 450 : KERRE=999 451 : ISUP3=0 452 : GOTO 9990 453 : ENDIF 454 : ENDIF 455 : * 456 : * TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES 457 : * 458 : NBROBL=0 459 : NBRFAC=0 460 : NOMID =0 461 : IVECT=0 462 : * 463 : * COQUES MINCES 464 : * 465 : IF (MFR.EQ.3.OR.MFR.EQ.9) THEN 466 : NBROBL=1 467 : NBRFAC=2 468 : SEGINI NOMID 469 : LESOBL(1)='EPAI' 470 : LESFAC(1)='CALF' 471 : LESFAC(2)='EXCE' 472 : * 473 : NBTYPE=1 474 : SEGINI NOTYPE 475 : TYPE(1)='REAL*8' 476 : ELSEIF (MFR.EQ.5) THEN 477 : NBROBL=1 478 : NBRFAC=1 479 : SEGINI NOMID 480 : LESOBL(1)='EPAI' 481 : LESFAC(1)='EXCE' 482 : * 483 : NBTYPE=1 484 : SEGINI NOTYPE 485 : TYPE(1)='REAL*8' 486 : * 487 : * SECTION POUR LES BARRES 488 : * 489 : ELSE IF (MFR.EQ.27) THEN 490 : NBROBL=1 491 : SEGINI NOMID 492 : LESOBL(1)='SECT' 493 : * 494 : NBTYPE=1 495 : SEGINI NOTYPE 496 : TYPE(1)='REAL*8' 497 : * 498 : * CARACTERISTIQUES POUR LES POUTRES 499 : * 500 : ELSE IF (MFR.EQ.7 ) THEN 501 : NBROBL=4 502 : NBRFAC=6 503 : SEGINI NOMID 504 : LESOBL(1)='TORS' 505 : LESOBL(2)='INRY' 506 : LESOBL(3)='INRZ' 507 : LESOBL(4)='SECT' 508 : LESFAC(1)='SECY' 509 : LESFAC(2)='SECZ' 510 : LESFAC(3)='DX ' 511 : LESFAC(4)='DY ' 512 : LESFAC(5)='DZ ' 513 : LESFAC(6)='VECT' 514 : IVECT=1 515 : * 516 : NBTYPE=10 517 : SEGINI NOTYPE 518 : TYPE(1)='REAL*8' 519 : TYPE(2)='REAL*8' 520 : TYPE(3)='REAL*8' 521 : TYPE(4)='REAL*8' 522 : TYPE(5)='REAL*8' 523 : TYPE(6)='REAL*8' 524 : TYPE(7)='REAL*8' 525 : TYPE(8)='REAL*8' 526 : TYPE(9)='REAL*8' 527 : TYPE(10)='POINTEURPOINT ' 528 : 529 : * 530 : * CARACTERISTIQUES POUR LES TUYAUX 531 : * 532 : ELSE IF (MFR.EQ.13) THEN 533 : NBROBL=2 534 : NBRFAC=9 535 : SEGINI NOMID 536 : LESOBL(1)='EPAI' 537 : LESOBL(2)='RAYO' 538 : LESFAC(1)='RACO' 539 : LESFAC(2)='PRES' 540 : LESFAC(3)='CISA' 541 : LESFAC(4)='CFFX' 542 : LESFAC(5)='CFMX' 543 : LESFAC(6)='CFMY' 544 : LESFAC(7)='CFMZ' 545 : LESFAC(8)='CFPR' 546 : LESFAC(9)='VECT' 547 : IVECT=1 548 : * 549 : NBTYPE=11 550 : SEGINI NOTYPE 551 : TYPE(1)='REAL*8' 552 : TYPE(2)='REAL*8' 553 : TYPE(3)='REAL*8' 554 : TYPE(4)='REAL*8' 555 : TYPE(5)='REAL*8' 556 : TYPE(6)='REAL*8' 557 : TYPE(7)='REAL*8' 558 : TYPE(8)='REAL*8' 559 : TYPE(9)='REAL*8' 560 : TYPE(10)='REAL*8' 561 : TYPE(11)='POINTEURPOINT ' 562 : * 563 : * CARACTERISTIQUES POUR LES LINESPRING 564 : * 565 : ELSE IF (MFR.EQ.15) THEN 566 : NBROBL=5 567 : SEGINI NOMID 568 : LESOBL(1)='EPAI' 569 : LESOBL(2)='FISS' 570 : LESOBL(3)='VX ' 571 : LESOBL(4)='VY ' 572 : LESOBL(5)='VZ ' 573 : * 574 : NBTYPE=1 575 : SEGINI NOTYPE 576 : TYPE(1)='REAL*8' 577 : * 578 : * CARACTERISTIQUES POUR LES TUYAUX FISSURES 579 : * 580 : ELSE IF (MFR.EQ.17) THEN 581 : NBROBL=9 582 : SEGINI NOMID 583 : LESOBL(1)='RAYO' 584 : LESOBL(2)='EPAI' 585 : LESOBL(3)='VX ' 586 : LESOBL(4)='VY ' 587 : LESOBL(5)='VZ ' 588 : LESOBL(6)='VXF ' 589 : LESOBL(7)='VYF ' 590 : LESOBL(8)='VZF ' 591 : LESOBL(9)='ANGL' 592 : * 593 : NBTYPE=1 594 : SEGINI NOTYPE 595 : TYPE(1)='REAL*8' 596 : * 597 : * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES 598 : * 599 : ELSE IF (MFR.EQ.37) THEN 600 : IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN 601 : NBROBL=4 602 : SEGINI NOMID 603 : LESOBL(1)='SCEL' 604 : LESOBL(2)='SFLU' 605 : LESOBL(3)='EPS ' 606 : LESOBL(4)='XINE' 607 : ELSE 608 : NBROBL=3 609 : SEGINI NOMID 610 : LESOBL(1)='SCEL' 611 : LESOBL(2)='SFLU' 612 : LESOBL(3)='EPS ' 613 : ENDIF 614 : * 615 : NBTYPE=1 616 : SEGINI NOTYPE 617 : TYPE(1)='REAL*8' 618 : ENDIF 619 : * 620 : MOCARA=NOMID 621 : NCARA=NBROBL 622 : NCARF=NBRFAC 623 : NCARR=NCARA+NCARF 624 : 625 : IF(MOCARA.NE.0)THEN 626 : MOTYPE=NOTYPE 626 : CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1, 627 : & INFOS,3,IVACAR) 628 : SEGSUP NOTYPE 629 : IF(IERR.NE.0)THEN 630 : KERRE=999 631 : GOTO 9990 632 : ENDIF 633 : * 634 : IF (IVECT.EQ.1) THEN 635 : MPTVAL=IVACAR 636 : IF (IVAL(NCARR).EQ.0) THEN 637 : * 638 : * MOT CLE VECT EN CAS DE CONVERSION 639 : * 640 : IVECT=2 641 : NOMID=MOCARA 642 : SEGACT NOMID 643 : NBRFAC=NBRFAC+2 644 : SEGADJ NOMID 645 : MOCARA=NOMID 646 : LESFAC(NBRFAC-2)='VX ' 647 : LESFAC(NBRFAC-1)='VY ' 648 : LESFAC(NBRFAC )='VZ ' 649 : 650 : NCARF=NBRFAC 651 : NCARR=NCARA+NCARF 652 : * 653 : NBTYPE=1 654 : SEGINI NOTYPE 655 : MOTYPE=NOTYPE 656 : TYPE(1)='REAL*8' 657 : * 657 : CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3, 658 : & IVACAR) 659 : SEGSUP NOTYPE 660 : IF (IERR.NE.0) THEN 661 : KERRE=999 662 : GOTO 9990 663 : ENDIF 664 : ENDIF 665 : ENDIF 666 : * 667 : IF (ISUP3.EQ.1) THEN 667 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 668 : IF(IERR.NE.0)THEN 669 : KERRE=999 670 : ISUP3=0 671 : GOTO 9990 672 : ENDIF 673 : ENDIF 674 : ENDIF 675 : ICARA=NCARR 676 : IF((MFR.EQ.7.OR.MFR.EQ.13).AND.IVECT.EQ.1)ICARA=NCARR+IDIM-1 677 : * 678 : * CREATION DES MCHAMLS DE LA SOUS ZONE 679 : * 680 : NBPTEL=NBGS 681 : NEL=NBELEM 682 : N1PTEL=NBPTEL 683 : N1EL=NEL 684 : * 685 : N2=1 686 : SEGINI MCHAML 687 : ICHAML(ISOUS)=MCHAML 688 : NOMCHE(1)='SCAL' 689 : TYPCHE(1)='REAL*8' 690 : N2PTEL=0 691 : N2EL=0 692 : SEGINI MELVAL 693 : IELVAL(1)=MELVAL 694 : IMELCR=MELVAL 695 : C 696 : C MISE A 0 DES VARIABLES DU COMMON NECOU SI BESOIN 697 : C LES BONNES VALEURS SONT ATTRIBUEES SELON LES MODELES 698 : C INITIALISATIONS SELON LES CAS 699 : C 700 : LTRAC=0 701 : IF(INPLAS.NE.2)THEN 702 : IFOURB=IFOUR 703 : NCOURB=0 704 : IPLAST=0 705 : IMAPLA=1 706 : IT=1 707 : ISOTRO=0 708 : ITYP=0 709 : C 710 : C CORRESPONDANCE ( MFR,IFOUR) ET ITYP FAITE DANS ECOCRI 711 : C 712 : IFLUAG=0 713 : ICINE=0 714 : ITHER=0 715 : IFLUPL=0 716 : ICYCL=0 717 : IBI=0 718 : JFLUAG=0 719 : KFLUAG=0 720 : LFLUAG=0 721 : IRELAX=0 722 : JNTRIN=0 723 : MFLUAG=0 724 : JSOUFL=0 725 : JGRDEF=0 726 : LTRAC=60 727 : ENDIF 728 : * 729 : * INITIALISATION DES SEGMENTS DE TRAVAIL 730 : * 731 : NCXMAT=NMATT 732 : IF(INPLAS.EQ.3)NCXMAT=NMATT+7 733 : SEGINI WRK0,WRK1,WRK2,WRK3 734 : IF(MFR.EQ.7.OR.MFR.EQ.13)THEN 735 : NBBB=NBNN 736 : SEGINI WRK4 737 : ENDIF 738 : * 739 : * BOUCLE SUR LES ELEMENTS 740 : * 741 : DO 200 IB=1,NBELEM 742 : * 743 : * BOUCLE SUR LES POINTS DE GAUSS 744 : * 745 : DO 300 IGAU=1,NBPTEL 746 : * 747 : * ON RECUPERE LES CONTRAINTES 748 : * 749 : MPTVAL=IVASTR 750 : DO 201 IC=1,NSTRS 751 : MELVAL=IVAL(IC) 752 : IBMN=MIN(IB,VELCHE(/2)) 753 : IGMN=MIN(IGAU,VELCHE(/1)) 754 : SIG0(IC)=VELCHE(IGMN,IBMN) 755 : 201 CONTINUE 756 : * 757 : * ON RECUPERE LES VARIABLES INTERNES 758 : * 759 : MPTVAL=IVARI 760 : DO 202 IC=1,NVARI 761 : MELVAL=IVAL(IC) 762 : IBMN=MIN(IB,VELCHE(/2)) 763 : IGMN=MIN(IGAU,VELCHE(/1)) 764 : VAR0(IC)=VELCHE(IGMN,IBMN) 765 : 202 CONTINUE 766 : * 767 : * ON RECUPERE LES CONSTANTES DU MATERIAU 768 : * 769 : MPTVAL=IVAMAT 770 : IF(INPLAS.EQ.9 .OR.INPLAS .EQ. 28)THEN 771 : * 772 : * POUR LE MODELE BETON ET UBIQUITOUS 773 : * 774 : DO 203 IC=1,NMATT 775 : MELVAL=IVAL(IC) 776 : IF(MELVAL.NE.0)THEN 777 : IBMN=MIN(IB,VELCHE(/2)) 778 : IGMN=MIN(IGAU,VELCHE(/1)) 779 : XMAT(IC)=VELCHE(IGMN,IBMN) 780 : ELSE 781 : XMAT(IC)=0.D0 782 : ENDIF 783 : 203 CONTINUE 784 : ELSE 785 : * 786 : * POUR LES AUTRES MODELES 787 : * 788 : MELVAL=IVAL(1) 789 : IF(MELVAL.NE.0)THEN 790 : IF(TYVAL(1)(1:8).NE.'POINTEUR')THEN 791 : IBMN=MIN(IB,VELCHE(/2)) 792 : IGMN=MIN(IGAU,VELCHE(/1)) 793 : XMAT(1)=VELCHE(IGMN,IBMN) 794 : ELSE 795 : IBMN=MIN(IB,IELCHE(/2)) 796 : IGMN=MIN(IGAU,IELCHE(/1)) 797 : XMAT(1)=IELCHE(IGMN,IBMN) 798 : ENDIF 799 : ELSE 800 : XMAT(1)=0.D0 801 : IF(TYVAL(1)(1:8).EQ.'POINTEUR') THEN 802 : XMAT(1)=0 803 : END IF 804 : ENDIF 805 : MELVAL=IVAL(2) 806 : IF(MELVAL.NE.0)THEN 807 : IF(TYVAL(2)(1:8).NE.'POINTEUR')THEN 808 : IBMN=MIN(IB,VELCHE(/2)) 809 : IGMN=MIN(IGAU,VELCHE(/1)) 810 : XMAT(2)=VELCHE(IGMN,IBMN) 811 : ELSE 812 : IBMN=MIN(IB,IELCHE(/2)) 813 : IGMN=MIN(IGAU,IELCHE(/1)) 814 : XMAT(2)=IELCHE(IGMN,IBMN) 815 : ENDIF 816 : ELSE 817 : XMAT(2)=0.D0 818 : IF(TYVAL(2)(1:8).EQ.'POINTEUR') THEN 819 : XMAT(2)=0 820 : END IF 821 : ENDIF 822 : DO 205 IC=3,NMATT-2 823 : MELVAL=IVAL(IC) 824 : IF(MELVAL.NE.0)THEN 825 : IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN 826 : IBMN=MIN(IB,VELCHE(/2)) 827 : IGMN=MIN(IGAU,VELCHE(/1)) 828 : XMAT(IC+2)=VELCHE(IGMN,IBMN) 829 : ELSE 830 : IBMN=MIN(IB,IELCHE(/2)) 831 : IGMN=MIN(IGAU,IELCHE(/1)) 832 : XMAT(IC+2)=IELCHE(IGMN,IBMN) 833 : ENDIF 834 : ELSE 835 : XMAT(IC+2)=0.D0 836 : IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN 837 : XMAT(IC+2)=0 838 : END IF 839 : ENDIF 840 : 205 CONTINUE 841 : MELVAL=IVAL(NMATT-1) 842 : IF(MELVAL.NE.0)THEN 843 : IF(TYVAL(NMATT-1)(1:8).NE.'POINTEUR')THEN 844 : IBMN=MIN(IB,VELCHE(/2)) 845 : IGMN=MIN(IGAU,VELCHE(/1)) 846 : XMAT(3)=VELCHE(IGMN,IBMN) 847 : ELSE 848 : IBMN=MIN(IB,IELCHE(/2)) 849 : IGMN=MIN(IGAU,IELCHE(/1)) 850 : XMAT(3)=IELCHE(IGMN,IBMN) 851 : ENDIF 852 : ELSE 853 : XMAT(3)=0.D0 854 : IF(TYVAL(NMATT-1)(1:8).EQ.'POINTEUR')XMAT(3)=0 855 : END IF 856 : MELVAL=IVAL(NMATT) 857 : IF(MELVAL.NE.0)THEN 858 : IF(TYVAL(NMATT)(1:8).NE.'POINTEUR')THEN 859 : IBMN=MIN(IB,VELCHE(/2)) 860 : IGMN=MIN(IGAU,VELCHE(/1)) 861 : XMAT(4)=VELCHE(IGMN,IBMN) 862 : ELSE 863 : IBMN=MIN(IB,IELCHE(/2)) 864 : IGMN=MIN(IGAU,IELCHE(/1)) 865 : XMAT(4)=IELCHE(IGMN,IBMN) 866 : ENDIF 867 : ELSE 868 : XMAT(4)=0.D0 869 : IF(TYVAL(NMATT)(1:8).EQ.'POINTEUR') THEN 870 : XMAT(4)=0 871 : END IF 872 : ENDIF 873 : * 874 : * REARRANGEMENT POUR CERTAINES LOIS 875 : * 876 : IF (INPLAS.EQ.14) THEN 877 : IF(XMAT(8).NE.XZER.OR.XMAT(9).NE.XZER)THEN 878 : INPLAS=18 879 : XMAT(5)=XMAT(8) 880 : XMAT(6)=XMAT(9) 881 : ENDIF 882 : ELSE IF (INPLAS.EQ.2) THEN 883 : IF (XMAT(6).NE.XZER) THEN 884 : INPLAS=27 885 : XMAT(5)=XMAT(6) 886 : ENDIF 887 : ELSE IF (INPLAS.EQ.29)THEN 888 : YXMAT=XMAT(13) 889 : XMAT(13)=XMAT(4) 890 : XMAT(4)=XMAT(3) 891 : XMAT(3)=YXMAT 892 : ENDIF 893 : ENDIF 894 : * 895 : * ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES 896 : * 897 : IF(IVACAR.NE.0)THEN 898 : MPTVAL=IVACAR 899 : * 900 : * cas des tuyaux 901 : * 902 : IF(MFR.EQ.13)THEN 903 : DO 106 IC=1,5 904 : MELVAL=IVAL(IC) 905 : IF(MELVAL.NE.0)THEN 906 : IBMN=MIN(IB,VELCHE(/2)) 907 : IGMN=MIN(IGAU,VELCHE(/1)) 908 : XCAR(IC)=VELCHE(IGMN,IBMN) 909 : ELSE 910 : XCAR(IC)=0.D0 911 : ENDIF 912 : 106 CONTINUE 913 : IF(IVECT.EQ.1)THEN 914 : DO 107 IC=6,NCARR-1 915 : MELVAL=IVAL(IC) 916 : IF(MELVAL.NE.0)THEN 917 : IBMN=MIN(IB,VELCHE(/2)) 918 : IGMN=MIN(IGAU,VELCHE(/1)) 919 : XCAR(IC)=VELCHE(IGMN,IBMN) 920 : ELSE 921 : XCAR(IC)=-1.D0 922 : ENDIF 923 : 107 CONTINUE 924 : IF(IVAL(NCARR).NE.0)THEN 925 : MELVAL=IVAL(NCARR) 926 : IBMN=MIN(IB,IELCHE(/2)) 927 : IGMN=MIN(IGAU,IELCHE(/1)) 928 : IP=IELCHE(IGMN,IBMN) 929 : IREF=(IP-1)*(IDIM+1) 930 : DO 108 IC=1,IDIM 931 : XCAR(NCARR+IC-1)=XCOOR(IREF+IC) 932 : 108 CONTINUE 933 : ELSE 934 : DO 109 IC=1,IDIM 935 : XCAR(NCARR+IC-1)=0.D0 936 : 109 CONTINUE 937 : ENDIF 938 : ELSE 939 : DO 110 IC=6,10 940 : MELVAL=IVAL(IC) 941 : IF(MELVAL.NE.0)THEN 942 : IBMN=MIN(IB,VELCHE(/2)) 943 : IGMN=MIN(IGAU,VELCHE(/1)) 944 : XCAR(IC)=VELCHE(IGMN,IBMN) 945 : ELSE 946 : XCAR(IC)=-1.D0 947 : ENDIF 948 : 110 CONTINUE 949 : DO 111 IC=11,ICARA 950 : MELVAL=IVAL(IC) 951 : IF(MELVAL.NE.0)THEN 952 : IBMN=MIN(IB,VELCHE(/2)) 953 : IGMN=MIN(IGAU,VELCHE(/1)) 954 : XCAR(IC)=VELCHE(IGMN,IBMN) 955 : ELSE 956 : XCAR(IC)=0.D0 957 : ENDIF 958 : 111 CONTINUE 959 : ENDIF 960 : ELSE IF(MFR.EQ.7.AND.IVECT.EQ.1)THEN 961 : DO 206 IC=1,NCARR-1 962 : MELVAL=IVAL(IC) 963 : IF(MELVAL.NE.0)THEN 964 : IBMN=MIN(IB,VELCHE(/2)) 965 : IGMN=MIN(IGAU,VELCHE(/1)) 966 : XCAR(IC)=VELCHE(IGMN,IBMN) 967 : ELSE 968 : XCAR(IC)=0.D0 969 : ENDIF 970 : 206 CONTINUE 971 : IF(IVAL(NCARR).NE.0)THEN 972 : MELVAL=IVAL(NCARR) 973 : IBMN=MIN(IB,IELCHE(/2)) 974 : IGMN=MIN(IGAU,IELCHE(/1)) 975 : IP=IELCHE(IGMN,IBMN) 976 : IREF=(IP-1)*(IDIM+1) 977 : DO 207 IC=1,IDIM 978 : XCAR(NCARR+IC-1)=XCOOR(IREF+IC) 979 : 207 CONTINUE 980 : ELSE 981 : DO 208 IC=1,IDIM 982 : XCAR(NCARR+IC-1)=0.D0 983 : 208 CONTINUE 984 : ENDIF 985 : ELSE 986 : DO 209 IC=1,ICARA 987 : MELVAL=IVAL(IC) 988 : IF(MELVAL.NE.0)THEN 989 : IBMN=MIN(IB,VELCHE(/2)) 990 : IGMN=MIN(IGAU,VELCHE(/1)) 991 : XCAR(IC)=VELCHE(IGMN,IBMN) 992 : ELSE 993 : XCAR(IC)=0.D0 994 : ENDIF 995 : 209 CONTINUE 996 : ENDIF 997 : * 998 : * REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE 999 : * QUE L'ANCIEN CHAMELEM 1000 : * 1001 : IF(MFR.EQ.7)THEN 1002 : IF(IDIM.EQ.2)THEN 1003 : VX=XCAR(ICARA-3) 1004 : VY=XCAR(ICARA-2) 1005 : XCAR(ICARA-3)=XCAR(ICARA-1) 1006 : XCAR(ICARA-2)=XCAR(ICARA) 1007 : XCAR(ICARA-1)=VX 1008 : XCAR(ICARA)=VY 1009 : ELSEIF(IDIM.EQ.3)THEN 1010 : VX=XCAR(ICARA-5) 1011 : VY=XCAR(ICARA-4) 1012 : VZ=XCAR(ICARA-3) 1013 : XCAR(ICARA-5)=XCAR(ICARA-2) 1014 : XCAR(ICARA-4)=XCAR(ICARA-1) 1015 : XCAR(ICARA-3)=XCAR(ICARA) 1016 : XCAR(ICARA-2)=VX 1017 : XCAR(ICARA-1)=VY 1018 : XCAR(ICARA)=VZ 1019 : ENDIF 1020 : ELSE IF(MFR.EQ.13)THEN 1021 : NWORK2 = 7 1022 : DO 210 IC=4,10 1023 : WORK2(IC-3)=XCAR(IC) 1024 : 210 CONTINUE 1025 : IF(IDIM.EQ.2)THEN 1026 : XCAR(4)=XCAR(ICARA-1) 1027 : XCAR(5)=XCAR(ICARA) 1028 : DO 211 IC=1,NWORK2 1029 : XCAR(IC+5)=WORK2(IC) 1030 : 211 CONTINUE 1031 : ELSE IF(IDIM.EQ.3)THEN 1032 : XCAR(4)=XCAR(ICARA-2) 1033 : XCAR(5)=XCAR(ICARA-1) 1034 : XCAR(6)=XCAR(ICARA) 1035 : DO 212 IC=1,NWORK2 1036 : XCAR(IC+6)=WORK2(IC) 1037 : 212 CONTINUE 1038 : ENDIF 1039 : ENDIF 1040 : ENDIF 1041 : * 1042 : IF(INPLAS.EQ.0) THEN 1043 : CRITER = 0.D0 1044 : GOTO 510 1045 : C 1046 : ELSE 1047 : C======================================================================= 1048 : C NUMERO DES ETIQUETTES : 1049 : C 1050 : C 1 A 99 POUR LES MODELES DE PLASTICITE ( INDICE INPLAS ) 1051 : C 1052 : C======================================================================= 1053 : GOTO (1, 2, 3, 4, 5,99, 7,99,99,99, 7, 7, 7,14,15,99,99,99,99,99, 1054 : . 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 1055 : . 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 1056 : . 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99),INPLAS 1057 : C 1058 : 99 CONTINUE 1059 : KERRE=999 1060 : MOTERR(1:4)=NOMAC(INPLAS) 1061 : MOTERR(5:12)=NOMFR(MFR) 1061 : CALL ERREUR(269) 1062 : SEGSUP WRK0,WRK1,WRK2,WRK3 1063 : IF(MFR.EQ.7.OR.MFR.EQ.13)SEGSUP WRK4 1064 : GOTO 9990 1065 : C 1066 : C MODELE VON MISES ISOTROPE ASSOCIE ( D'APRES INCA ) 1067 : C 1068 : 1 CONTINUE 1069 : C 1070 : C CAS DE LA PLASTICITE PARFAITE 1071 : C 1072 : NCOURB=2 1073 : TRAC(1)=XMAT(5) 1074 : TRAC(2)=0.D0 1075 : TRAC(3)=XMAT(5) 1076 : TRAC(4)=1.D0 1077 : IF(XMAT(5).EQ.XZER) THEN 1078 : KERRE=33 1079 : GO TO 510 1080 : ENDIF 1081 : GOTO 682 1082 : C 1083 : 3 CONTINUE 1084 : C 1085 : C CAS DU MODELE DE DRUCKER-PRAGER PARFAIT 1086 : C LES DONNEES SONT LES LIMITES EN TRACTION ET EN COMPRESSION 1087 : C 1088 : IMAPLA=5 1089 : DEN = ABS(XMAT(6)) + XMAT(5) 1090 : IF(DEN.EQ.0.D0) THEN 1091 : KERRE=48 1092 : GO TO 510 1093 : ENDIF 1094 : XMAT(7) = 2.0D0*ABS(XMAT(6))*XMAT(5)/DEN 1095 : XMAT(5) = (ABS(XMAT(6)) - XMAT(5))/DEN 1096 : XMAT(6) = SQRT(3.D0) 1097 : XMAT(8)=XMAT(5) 1098 : XMAT(9)=XMAT(6) 1099 : XMAT(10)=XMAT(5) 1100 : XMAT(11)=XMAT(6) 1101 : XMAT(12)=XMAT(7) 1102 : XMAT(13)=0.D0 1103 : C PETITS TESTS SUR LES DONNEES 1104 : IF(XMAT(10)/(XMAT(11)+1.D-20).GT.XMAT(5)*1.01/(XMAT(6)+1.D-20) 1105 : . .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN 1106 : KERRE=48 1107 : GO TO 510 1108 : ENDIF 1109 : GOTO 682 1110 : C 1111 : 4 CONTINUE 1112 : C 1113 : C CAS DE LA PLASTICITE CINEMATIQUE BILINEAIRE 1114 : C 1115 : ICINE=1 1116 : NCOURB=2 1117 : TRAC(1)=XMAT(5) 1118 : TRAC(2)=0.D0 1119 : TRAC(3)=XMAT(5)+XMAT(6) 1120 : TRAC(4)=1.D0 1121 : IF(XMAT(5).EQ.0.D0) THEN 1122 : KERRE=33 1123 : GO TO 510 1124 : ENDIF 1125 : GOTO 682 1126 : C 1127 : 5 CONTINUE 1128 : C 1129 : C CAS DE LA PLASTICITE ISOTROPE ECROUISSABLE 1130 : C 1131 : C ON RECUPERE LA COURBE DE TRACTION 1132 : C 1133 : nccor=ncourb 1133 : CALL COTRAC(WRK0,WRK2,NCcor,KERRE) 1134 : ncourb=nccor 1135 : IF(KERRE.NE.0) GO TO 510 1136 : GO TO 682 1137 : C 1138 : 7 CONTINUE 1139 : C 1140 : C CAS DU MODELE CHABOCHE 1141 : C 1142 : ICINE=1 1143 : IMAPLA=4 1144 : GOTO 682 1145 : C 1146 : 15 CONTINUE 1147 : C 1148 : C CAS DU MODELE DE DRUCKER-PRAGER GENERAL 1149 : C 1150 : IMAPLA=5 1151 : C PAS D'INITIALISATIONS PAR DEFAUT POUR LE MOMENT 1152 : C IF(XMAT(8).EQ.0.) XMAT(8)=XMAT(5) 1153 : C IF(XMAT(9).EQ.0.) XMAT(9)=XMAT(6) 1154 : C IF(XMAT(10).EQ.0.) XMAT(10)=XMAT(5) 1155 : C IF(XMAT(11).EQ.0.) XMAT(11)=XMAT(6) 1156 : C IF(XMAT(12).EQ.0.) XMAT(12)=XMAT(7) 1157 : C PETITS TESTS SUR LES DONNEES 1158 : IF(XMAT(10)/(XMAT(11)+1.D-20).GT.XMAT(5)*1.01/(XMAT(6)+1.D-20) 1159 : . .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN 1160 : KERRE=48 1161 : GO TO 510 1162 : ENDIF 1163 : C PERMUTATIONS POUR ECOCRI 1164 : DO 615 I=5,7 1165 : WW=XMAT(I) 1166 : XMAT(I)=XMAT(I+5) 1167 : 615 XMAT(I+5)=WW 1168 : GOTO 682 1169 : C 1170 : 682 CONTINUE 1171 : DO 675 IC=1,ICARA 1172 : 675 WORK(IC)=XCAR(IC) 1173 : BID(1)=0.D00 1174 : BID(2)=0.D00 1175 : BID(3)=0.D00 1176 : necobi=necou 1177 : neecbi=ecou 1177 : CALL ECOCRI(SIG0,VAR0,BID,XMAT,CRITER,WORK , 1178 : . TRAC,KERRE,MFR,NSTRS,INPLAS,necou,ecou) 1179 : IF(KERRE.EQ.99) GO TO 99 1180 : GOTO 510 1181 : C 1182 : C MODELE LINESPRING 1183 : C 1184 : 2 CONTINUE 1184 : CALL LISCRI(SIG0,XMAT,XCAR,KERRE,CRITER) 1185 : GOTO 510 1186 : C 1187 : C TUYAU FISSURE 1188 : C 1189 : 14 CONTINUE 1189 : CALL TUFCRI(SIG0,VAR0,XMAT,XCAR,KERRE,CRITER) 1190 : GOTO 510 1191 : ENDIF 1192 : C 1193 : 510 CONTINUE 1194 : IF(KERRE.NE.0) THEN 1195 : C 1196 : C IMPRESSION DE QUELQUES MESSAGES D ERREURS 1197 : C 1198 : INTERR(1)=IB 1199 : INTERR(2)=IGAU 1200 : MOTERR(1:4)=NOMTP(MELE) 1200 : IF(KERRE.EQ.1) CALL ERREUR(267) 1200 : IF(KERRE.EQ.2) CALL ERREUR(268) 1200 : IF(KERRE.EQ.7) CALL ERREUR(355) 1200 : IF(KERRE.EQ.30) CALL ERREUR(270) 1200 : IF(KERRE.EQ.31) CALL ERREUR(271) 1200 : IF(KERRE.EQ.32) CALL ERREUR(272) 1200 : IF(KERRE.EQ.33) CALL ERREUR(273) 1200 : IF(KERRE.EQ.34) CALL ERREUR(325) 1200 : IF(KERRE.EQ.35) CALL ERREUR(331) 1200 : IF(KERRE.EQ.36) CALL ERREUR(330) 1200 : IF(KERRE.EQ.37) CALL ERREUR(354) 1200 : IF(KERRE.EQ.38) CALL ERREUR(360) 1200 : IF(KERRE.EQ.48) CALL ERREUR(366) 1200 : IF(KERRE.EQ.75) CALL ERREUR(876) 1201 : SEGSUP WRK0,WRK1,WRK2,WRK3 1202 : IF(MFR.EQ.7.OR.MFR.EQ.13)SEGSUP WRK4 1203 : GO TO 9990 1204 : ENDIF 1205 : C 1206 : C REMPLISSAGE DU SEGMENT 1207 : C 1208 : MELVAL=IMELCR 1209 : VELCHE(IGAU,IB)=CRITER 1210 : C 1211 : 300 CONTINUE 1212 : 200 CONTINUE 1213 : SEGSUP WRK0,WRK1,WRK2,WRK3 1214 : IF(MFR.EQ.7.OR.MFR.EQ.13)SEGSUP WRK4 1215 : 9990 CONTINUE 1216 : * 1217 : * DESACTIVATION DES SEGMENTS 1218 : * 1219 : SEGDES MELEME,IMODEL 1220 : SEGDES,MINTE 1221 : * 1222 : IF(ISUP1.EQ.1)THEN 1222 : CALL DTMVAL (IVASTR,3) 1223 : ELSE 1223 : CALL DTMVAL (IVASTR,1) 1224 : ENDIF 1225 : IF(ISUP2.EQ.1)THEN 1225 : CALL DTMVAL (IVARI,3) 1226 : ELSE 1226 : CALL DTMVAL (IVARI,1) 1227 : ENDIF 1228 : IF(ISUP3.EQ.1)THEN 1228 : CALL DTMVAL (IVAMAT,3) 1229 : ELSE 1229 : CALL DTMVAL (IVAMAT,1) 1230 : ENDIF 1231 : IF(ISUP3.EQ.1)THEN 1231 : CALL DTMVAL (IVACAR,3) 1232 : ELSE 1232 : CALL DTMVAL (IVACAR,1) 1233 : ENDIF 1234 : * 1235 : IF (MOCARA.NE.0) THEN 1236 : NOMID=MOCARA 1237 : SEGSUP NOMID 1238 : END IF 1239 : * 1240 : IF (MOMATR.NE.0) THEN 1241 : NOMID=MOMATR 1242 : if(lsupma)SEGSUP NOMID 1243 : END IF 1244 : * 1245 : IF (MOVARI.NE.0) THEN 1246 : NOMID=MOVARI 1247 : if(lsupva)SEGSUP NOMID 1248 : END IF 1249 : * 1250 : IF (MOSTRS.NE.0) THEN 1251 : NOMID=MOSTRS 1252 : if(lsupco)SEGSUP NOMID 1253 : END IF 1254 : * 1255 : segsup necou,ecou 1256 : IF(KERRE.EQ.0)THEN 1257 : MELVAL=IMELCR 1258 : SEGDES MELVAL 1259 : SEGDES MCHAML 1260 : ELSE 1261 : MELVAL=IMELCR 1262 : SEGSUP MELVAL 1263 : SEGSUP MCHAML 1264 : GO TO 888 1265 : ENDIF 1266 : 500 CONTINUE 1267 : * 1268 : 888 CONTINUE 1269 : SEGDES MMODEL 1270 : IF(KERRE.EQ.0)THEN 1271 : SEGDES MCHELM 1272 : ELSE 1273 : SEGSUP MCHELM 1274 : ENDIF 1275 : * 1276 : RETURN 1277 : END 1278 : 1279 : 1280 :
© Cast3M 2003 - All rights reserved.
Disclaimer