1 : C KEULE1 SOURCE CHAT 11/03/16 21:26:08 6902 2 : SUBROUTINE KEULE1 (IPMODL,IPCHE1,IPROTA,IPRIG,IFLAM,IRET) 3 : * 4 : *_______________________________________________________________________ 5 : * 6 : * appelé par KEULER ( opérateur KEULER ) 7 : * 8 : * Creation d'une matrice de raideur d'Euler dans le repère tournant 9 : * (éléments BARR, POUTR, TIMO, TUYAU, Massif, COQ3, DST,DKT,COQ6,COQ8) 10 : * 11 : * entrees : 12 : * ======== 13 : * 14 : * ipmodl pointeur sur un mmodel 15 : * ipche1 pointeur sur un mchaml de caracteristique 16 : * iprota pointeur sur un point (vecteur vitesse de rotation) 17 : * 18 : * sorties : 19 : * ========= 20 : * 21 : * iprig pointeur sur la matrice d'amortissement construite 22 : * iret 1 si ok, 0 sinon 23 : * 24 : * Didier COMBESCURE mars 2003 25 : * 26 : *_______________________________________________________________________ 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8(A-H,O-Z) 29 : -INC CCOPTIO 30 : -INC CCHAMP 31 : -INC CCGEOME 32 : -INC CCREEL 33 : 34 : -INC SMRIGID 35 : -INC SMCHAML 36 : -INC SMELEME 37 : -INC SMCOORD 38 : -INC SMINTE 39 : -INC SMMODEL 40 : C 41 : SEGMENT NOTYPE 42 : CHARACTER*16 TYPE(NBTYPE) 43 : ENDSEGMENT 44 : C 45 : SEGMENT MPTVAL 46 : INTEGER IPOS(NS),NSOF(NS) 47 : INTEGER IVAL(NCOSOU) 48 : CHARACTER*16 TYVAL(NCOSOU) 49 : ENDSEGMENT 50 : C 51 : CHARACTER*8 CMATE 52 : CHARACTER*(NCONCH) CONM 53 : PARAMETER (NINF=3) 54 : INTEGER INFOS(NINF) 55 : DIMENSION VROT(3) 56 : LOGICAL lsupfo,lsupdp 57 : C 58 : IRET = 0 59 : C 60 : NHRM=NIFOUR 61 : * 62 : * verification du lieu support du mchaml de caracteristiques 63 : * 64 : * am 5/1/95 on remplace par un appel a quesuq plus 65 : * loin pour ne tester que sur les composantes ad hoc 66 : * 66 : * call quesup(ipmodl,ipche1,4,0,isup) 67 : * if(isup.gt.1) return 68 : C 69 : C ACTIVATION DU MODELE 70 : C 71 : MMODEL=IPMODL 72 : SEGACT MMODEL 73 : NSOUS=KMODEL(/1) 74 : C 75 : C CREATION DE L'OBJET MATRICE D AMORTISSEMENT 76 : C 77 : NRIGEL=NSOUS 78 : SEGINI MRIGID 79 : IF (IFLAM.NE.0) THEN 80 : MTYMAT='MASSE' 81 : ELSE 82 : MTYMAT='RIGIDITE' 83 : ENDIF 84 : IFORIG=IFOMOD 85 : ICHOLE=0 86 : IMGEO1=0 87 : IMGEO2=0 88 : C 89 : ISUPEQ=0 90 : C 91 : C____________________________________________________________________ 92 : C 93 : C LECTURE DU VECTEUR ROTATION ET MULTIPLICATION PAR 2 (pour Euler) 94 : C____________________________________________________________________ 95 : C 96 : IF (IPROTA.EQ.0) THEN 97 : VROT(1)=0. 98 : VROT(2)=0. 99 : VROT(3)=1.D0 100 : ELSEIF (IFOUR.NE.1) THEN 101 : VROT(1)=XCOOR((4*IPROTA) - 3) 102 : VROT(2)=XCOOR((4*IPROTA) - 2) 103 : VROT(3)=XCOOR((4*IPROTA) - 1) 104 : ELSE 105 : VROT(1)= 0.D0 106 : VROT(2)=XCOOR((3*IPROTA) - 1) 107 : VROT(3)=0.D0 108 : ENDIF 109 : C 110 : C BOUCLE SUR LES SOUS ZONES 111 : C 112 : DO 499 ISOUS=1,NSOUS 113 : IRIGEL(4,ISOUS)=0 114 : COERIG(ISOUS)=1.D0 115 : 499 CONTINUE 116 : C 117 : C_______________________________________________________________________ 118 : C 119 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES 120 : C_______________________________________________________________________ 121 : C 122 : DO 500 ISOUS=1,NSOUS 123 : C 124 : C ON RECUPERE LINFORMATION GENERALES 125 : C 126 : IMODEL=KMODEL(ISOUS) 127 : SEGACT IMODEL 128 : IIPDPG=IPDPGE 129 : IPMAIL=IMAMOD 130 : CONM =CONMOD 131 : C 132 : C TRAITEMENT DU MODELE 133 : C 134 : MELEME=IMAMOD 135 : MELE=NEFMOD 136 : NFOR=FORMOD(/2) 137 : NMAT=MATMOD(/2) 138 : npint=1 139 : if (infmod(/1).ne.0) npint = infmod(1) 140 : C 141 : C NATURE DU MATERIAU 142 : C 142 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 143 : IF (CMATE.EQ.' ') THEN 143 : CALL ERREUR(251) 144 : SEGDES MMODEL 145 : GOTO 9997 146 : ENDIF 147 : C Quelques initialisations : 148 : MOMATR=0 149 : IVAMAT=0 150 : MOCARA=0 151 : IVACAR=0 152 : C_______________________________________________________________________ 153 : C 154 : C INFORMATION SUR L ELEMENT FINI 155 : C_______________________________________________________________________ 156 : C 157 : * if (npint.eq.12345) then 158 : * integration aux noeuds 158 : * CALL ELQUOI(MELE,0,1,IPINF,IMODEL) 159 : ** else 159 : * CALL ELQUOI(MELE,0,4,IPINF,IMODEL) 160 : * endif 161 : iplaz=4 162 : if (npint.eq.12345) iplaz=1 163 : * IF (IERR.NE.0) THEN 164 : * SEGDES IMODEL 165 : * GOTO 9997 166 : * ENDIF 167 : * INFO=IPINF 168 : MFR =INFELE(13) 169 : IF (IFOUR.NE.1) THEN 170 : NDDL =INFELE(15) 171 : LRE =INFELE(9) 172 : ELSE 173 : LRE =2*INFELE(9) 174 : NDDL =2*INFELE(15) 175 : ENDIF 176 : LW =INFELE(7) 177 : LHOOK =INFELE(10) 178 : IELE=INFELE(14) 179 : * ICARA=INFELE(5) 180 : * MINTE=INFELE(11) 181 : MINTE=INFMOD(2+iplaz) 182 : MINTE1=INFMOD(8) 183 : IPMINT=MINTE 184 : IPMIN1=MINTE1 185 : * SEGSUP INFO 186 : C 187 : C INITIALISATION DE MINTE 188 : C 189 : SEGACT MINTE 190 : NBPGAU=POIGAU(/1) 191 : C 192 : C CREATION DU TABLEAU INFOS 193 : C 193 : CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD) 194 : IF (IRTD.EQ.0) GOTO 9990 195 : C 196 : C ON RECUPERE LES MELVAL ET LES MELEME 197 : C 198 : MELEME=IPMAIL 199 : SEGACT MELEME 200 : * 201 : * modification du meleme pour le remplissage du segment descripteur 202 : * en deformations planes generalisees 203 : * 204 : NBNN =NUM(/1) 205 : NBELEM=NUM(/2) 206 : IPPORE=0 207 : IF(MFR.EQ.33) IPPORE=NBNN 208 : C 209 : C ---------------------------------------------------------* 210 : C INITIALISATION DU SEGMENT DESCR, SEGMENT DESCRIPTEUR DES * 211 : C DES INCONNUES RELATIVES A LA MATRICE DE RIGIDITE * 212 : C ---------------------------------------------------------* 213 : NLIGRP = LRE 214 : NLIGRD = LRE 215 : SEGINI DESCR 216 : IPDSCR=DESCR 217 : if(lnomid(1).ne.0) then 218 : nomid=lnomid(1) 219 : segact nomid 220 : modepl=nomid 221 : ndepl=lesobl(/2) 222 : ndum=lesfac(/2) 223 : lsupdp=.false. 224 : else 225 : lsupdp=.true. 225 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEPL,NDUM) 226 : endif 227 : if(lnomid(2).ne.0) then 228 : nomid=lnomid(2) 229 : segact nomid 230 : moforc=nomid 231 : nforc=lesobl(/2) 232 : lsupfo=.false. 233 : else 234 : lsupfo=.true. 234 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NDUM) 235 : endif 236 : C 237 : IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN 237 : CALL ERREUR(5) 238 : SEGSUP DESCR 239 : GOTO 9990 240 : ENDIF 241 : C 242 : C REMPLISSAGE DU SEGMENT DESCRIPTEUR 243 : C 244 : IDDL=1 245 : NCOMP=NDEPL 246 : NBNNS=NBNN 247 : IF (MFR.EQ.33) NCOMP=NDEPL-1 248 : C IF (IFOUR.EQ.-3) THEN 249 : C NCOMP=NDEPL-3 250 : C NBNNS=NBNN-1 251 : C ENDIF 252 : IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2 253 : NOMID=MODEPL 254 : SEGACT NOMID 255 : NOMID=MOFORC 256 : SEGACT NOMID 257 : DO 1004 INOEUD=1,NBNNS 258 : DO 1005 ICOMP=1,NCOMP 259 : IF (IFOUR.NE.1) THEN 260 : NOMID=MODEPL 261 : LISINC(IDDL)=LESOBL(ICOMP) 262 : NOMID=MOFORC 263 : LISDUA(IDDL)=LESOBL(ICOMP) 264 : NOELEP(IDDL)=INOEUD 265 : NOELED(IDDL)=INOEUD 266 : ELSE 267 : NOMID=MODEPL 268 : LISINC(2*IDDL-1)=LESOBL(ICOMP) 269 : IF (LESOBL(ICOMP).EQ.'UR ') THEN 270 : LISINC(2*IDDL)='IUR ' 271 : ELSEIF (LESOBL(ICOMP).EQ.'UZ ') THEN 272 : LISINC(2*IDDL)='IUZ ' 273 : ELSEIF (LESOBL(ICOMP).EQ.'UT ') THEN 274 : LISINC(2*IDDL)='IUT ' 275 : ELSEIF (LESOBL(ICOMP).EQ.'RT ') THEN 276 : LISINC(2*IDDL)='IRT ' 277 : ENDIF 278 : NOMID=MOFORC 279 : LISDUA(2*IDDL-1)=LESOBL(ICOMP) 280 : IF (LESOBL(ICOMP).EQ.'FR ') THEN 281 : LISDUA(2*IDDL)='IFR ' 282 : ELSEIF (LESOBL(ICOMP).EQ.'FZ ') THEN 283 : LISDUA(2*IDDL)='IFZ ' 284 : ELSEIF (LESOBL(ICOMP).EQ.'FT ') THEN 285 : LISDUA(2*IDDL)='IFT ' 286 : ELSEIF (LESOBL(ICOMP).EQ.'MT ') THEN 287 : LISDUA(2*IDDL)='IMT ' 288 : ENDIF 289 : NOELEP(2*IDDL-1)=INOEUD 290 : NOELED(2*IDDL-1)=INOEUD 291 : NOELEP(2*IDDL)=INOEUD 292 : NOELED(2*IDDL)=INOEUD 293 : ENDIF 294 : IDDL=IDDL+1 295 : 1005 CONTINUE 296 : 1004 CONTINUE 297 : * 298 : NOMID=MODEPL 299 : SEGDES NOMID 300 : NOMID=MOFORC 301 : SEGDES NOMID 302 : SEGDES DESCR 303 : C 304 : C ------------------------------------------------------------* 305 : C INITIALISATION DU SEGMENT xMATRI * 306 : C CONTENANT LES MATRICES DE RIGIDITE ELEMENTAIRES * 307 : C ------------------------------------------------------------* 308 : C NBELEM: NB D'ELEMENTS DANS LA SOUS ZONE 309 : NLIGRP=LRE 310 : NLIGRD=LRE 311 : C LVAL=(LRE*(LRE+1))/2 312 : C 313 : NELRIG=NBELEM 314 : SEGINI xMATRI 315 : IPMATR=xMATRI 316 : C 317 : C------------------------------------------------------* 318 : C 319 : C TRAITEMENT DU CHAPEAU DES RIGIDITES, SEGMENT MRIGID * 320 : C------------------------------------------------------* 321 : C 322 : IRIGEL(1,ISOUS)=IPMAIL 323 : IRIGEL(2,ISOUS)=0 324 : IRIGEL(3,ISOUS)=IPDSCR 325 : IRIGEL(4,ISOUS)=xMATRI 326 : IRIGEL(5,ISOUS)=NHRM 327 : C 328 : C MATRICE ANTI-SYMETRIQUE 329 : C 330 : IRIGEL(7,ISOUS)=1 331 : C_______________________________________________________________________ 332 : C 333 : C TRAITEMENT DES CHAMP MATERIAUX 334 : C_______________________________________________________________________ 335 : C 336 : NOMID=0 337 : NOTYPE=0 338 : NBROBL=0 339 : NBRFAC=0 340 : LHOTRA=0 341 : * 342 : * rho dans les cas poutre,tuyau, massif, coque 343 : * 344 : IF (MFR.EQ.1.OR.MFR.EQ.27.OR.MFR.EQ.7.OR.MFR.EQ.13.OR. 345 : . MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 346 : * 347 : IF(CMATE.NE.'SECTION') THEN 348 : NBROBL=1 349 : C NBRFAC=0 350 : SEGINI NOMID 351 : LESOBL(1)='RHO ' 352 : NBTYPE=1 353 : SEGINI NOTYPE 354 : TYPE(1)='REAL*8' 355 : ELSE 356 : LHOTRA=LHOOK 357 : NBROBL=2 358 : C NBRFAC=0 359 : SEGINI NOMID 360 : LESOBL(1)='MODS' 361 : LESOBL(2)='MATS' 362 : NBTYPE=2 363 : SEGINI NOTYPE 364 : TYPE(1)='POINTEURMMODEL' 365 : TYPE(2)='POINTEURMCHAML' 366 : ENDIF 367 : MOMATR=NOMID 368 : MOTYPE=NOTYPE 369 : ENDIF 370 : C 371 : NMATR=NBROBL 372 : NMATF=NBRFAC 373 : NMATT=NMATR+NMATF 374 : C 375 : IF (MOMATR.NE.0) THEN 376 : * 377 : * verification du support des composantes recherchees 378 : * 378 : CALL QUESUQ(IMODEL,IPCHE1,4,0,MOMATR,IPLAZ,ISUP,IRET1) 379 : IF(ISUP.GT.1)THEN 380 : SEGSUP NOTYPE 381 : GO TO 9990 382 : ENDIF 383 : * 383 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 384 : SEGSUP NOTYPE 385 : IF (IERR.NE.0) GOTO 9996 386 : IF(ISUP.EQ.1)THEN 386 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 387 : IF(IERR.NE.0)THEN 388 : ISUP=0 389 : GOTO 9990 390 : ENDIF 391 : ENDIF 392 : ENDIF 393 : C 394 : C____________________________________________________________________ 395 : C 396 : C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES 397 : C____________________________________________________________________ 398 : C 399 : NBROBL=0 400 : NBRFAC=0 401 : NOMID=0 402 : NOTYPE=0 403 : IVECT=0 404 : * 405 : * caracteristiques pour les poutres 406 : * 407 : IF (MFR.EQ.7 ) THEN 408 : IF (CMATE.EQ.'SECTION') THEN 409 : NBROBL=0 410 : NBRFAC=2 411 : SEGINI NOMID 412 : LESFAC(1)='OMEG' 413 : LESFAC(2)='VECT' 414 : IVECT=1 415 : * 416 : NBTYPE=2 417 : SEGINI NOTYPE 418 : MOTYPE=NOTYPE 419 : TYPE(1)='REAL*8' 420 : TYPE(2)='POINTEURPOINT ' 421 : * 422 : ELSE 423 : NBROBL=4 424 : NBRFAC=4 425 : SEGINI NOMID 426 : LESOBL(1)='TORS' 427 : LESOBL(2)='INRY' 428 : LESOBL(3)='INRZ' 429 : LESOBL(4)='SECT' 430 : LESFAC(1)='SECY' 431 : LESFAC(2)='SECZ' 432 : LESFAC(3)='OMEG' 433 : LESFAC(4)='VECT' 434 : IVECT=1 435 : * 436 : NBTYPE=8 437 : SEGINI NOTYPE 438 : MOTYPE=NOTYPE 439 : TYPE(1)='REAL*8' 440 : TYPE(2)='REAL*8' 441 : TYPE(3)='REAL*8' 442 : TYPE(4)='REAL*8' 443 : TYPE(5)='REAL*8' 444 : TYPE(6)='REAL*8' 445 : TYPE(7)='REAL*8' 446 : TYPE(8)='POINTEURPOINT ' 447 : ENDIF 448 : * 449 : * caracteristiques pour les tuyaux 450 : * 451 : ELSE IF (MFR.EQ.13) THEN 452 : NBROBL=2 453 : NBRFAC=3 454 : SEGINI NOMID 455 : LESOBL(1)='EPAI' 456 : LESOBL(2)='RAYO' 457 : LESFAC(1)='RACO' 458 : LESFAC(2)='OMEG' 459 : LESFAC(3)='VECT' 460 : IVECT=1 461 : * 462 : NBTYPE=5 463 : SEGINI NOTYPE 464 : MOTYPE=NOTYPE 465 : TYPE(1)='REAL*8' 466 : TYPE(2)='REAL*8' 467 : TYPE(3)='REAL*8' 468 : TYPE(4)='REAL*8' 469 : TYPE(5)='POINTEURPOINT ' 470 : * 471 : * caracteristiques pour les barres 472 : * 473 : ELSE IF (MFR.EQ.27) THEN 474 : NBRFAC=0 475 : NBROBL=1 476 : SEGINI NOMID 477 : LESOBL(1)='SECT' 478 : * 479 : NBTYPE=1 480 : SEGINI NOTYPE 481 : MOTYPE=NOTYPE 482 : TYPE(1)='REAL*8' 483 : * 484 : * epaisseur et excentrement dans le cas des coques 485 : * 486 : ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 487 : NBROBL=1 488 : NBRFAC=1 489 : SEGINI NOMID 490 : LESOBL(1)='EPAI' 491 : LESFAC(1)='EXCE' 492 : * 493 : NBTYPE=1 494 : SEGINI NOTYPE 495 : MOTYPE=NOTYPE 496 : TYPE(1)='REAL*8' 497 : * 498 : ENDIF 499 : * 500 : NCARA=NBROBL 501 : NCARF=NBRFAC 502 : NCARR=NCARA+NCARF 503 : MOCARA=NOMID 504 : * 505 : IF (MOCARA.NE.0) THEN 506 : * 507 : * verification du support des composantes recherchees 508 : * 508 : CALL QUESUQ(IMODEL,IPCHE1,4,0,MOCARA,IPLAZ,ISUP,IRET2) 509 : IF(ISUP.GT.1)THEN 510 : SEGSUP NOTYPE 511 : GO TO 9990 512 : ENDIF 513 : * 513 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR) 514 : SEGSUP NOTYPE 515 : IF (IERR.NE.0) GOTO 9990 516 : IF(ISUP.EQ.1)THEN 516 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 517 : IF(IERR.NE.0)THEN 518 : ISUP=0 519 : GOTO 9990 520 : ENDIF 521 : ENDIF 522 : ENDIF 523 : C 524 : C____________________________________________________________________ 525 : C 526 : C LECTURE DU VECTEUR ROTATION 527 : C____________________________________________________________________ 528 : C 529 : C IBP1=4*IPROTA 530 : C VROT(1)=1.*XCOOR((4*IPROTA) - 3) 531 : C VROT(2)=1.*XCOOR((4*IPROTA) - 2) 532 : C VROT(3)=1.*XCOOR((4*IPROTA) - 1) 533 : C 534 : C_______________________________________________________________________ 535 : C 536 : C NUMERO DES ETIQUETTES : 537 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT 538 : C LES ELEMENTS SONT GROUPES COMME SUIT : 539 : C - MASSIF,LIQUIDE 'SURFACE LIBRE' ----------------------> CORIO3 540 : C - COQ3/POUTRE,DKT,COQ4,COQ8,COQ2,DST ------------------> CORIO2 541 : C ET POUTRE DE TIMOSCHENKO 542 : C_______________________________________________________________________ 543 : * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9 544 : GOTO ( 99, 99, 99, 11, 99, 11, 99, 11, 99, 11, 99 545 : * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT 546 : & , 99, 99, 11, 11, 11, 11, 99, 99, 99, 99, 99 547 : * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6 548 : & , 11, 11, 11, 11, 21, 21, 21, 99, 99, 99, 99 549 : * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2 550 : & , 99, 99, 99, 99, 99, 99, 99, 21, 21, 99, 21 551 : * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO 552 : & , 99, 21, 99, 99, 21, 99, 99, 99, 99, 99, 99 553 : * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15 554 : & , 21, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 555 : * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10 556 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 557 : * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4 558 : & , 99, 99, 99, 99, 99, 99, 21, 99, 99, 99, 99 559 : * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3 560 : & , 99, 99, 99, 99, 21, 99, 99, 99, 99, 99, 99 561 : * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8 562 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 563 : * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13 564 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 565 : * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8 566 : & , 99, 21, 99, 99, 99, 99, 99, 99, 99, 99, 99 567 : * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3 568 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 569 : * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126 570 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 571 : * TE56 PY91 TRH6 572 : & , 99, 99, 99),MELE 573 : C 574 : 99 CONTINUE 575 : SEGSUP xMATRI 576 : IRIGEL(4,ISOUS)=0 577 : MOTERR(1:4)=NOMTP(MELE) 578 : MOTERR(5:12)='KEULE1' 578 : CALL ERREUR(86) 579 : GOTO 9990 580 : C_______________________________________________________________________ 581 : C 582 : C MASSIF 583 : C_______________________________________________________________________ 584 : C 585 : 11 CONTINUE 585 : CALL CORIO3 (IPMAIL,NDDL,LRE,NBPGAU,IPMINT,MELE,MFR,IVAMAT, 586 : &IVACAR,NMATT,IPMATR,VROT,0,IIPDPG) 587 : GOTO 510 588 : C_______________________________________________________________________ 589 : C 590 : C POUTRE, POUTRE DE TIMOSCHENKO, COQUE, BARRE 591 : C_______________________________________________________________________ 592 : C 593 : 21 CONTINUE 593 : CALL CORIO2(IPMAIL,LRE,LW,MELE,IVAMAT,NMATT,IVACAR,NCARR, 594 : &IVECT,ISOUS,NBPGAU,IPMINT,IPMIN1,NDDL,MATE, 595 : &CMATE,LHOTRA,IPMATR,VROT,0,IIPDPG) 596 : GOTO 510 597 : C_______________________________________________________________________ 598 : C 599 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA 600 : C_______________________________________________________________________ 601 : C 602 : 510 CONTINUE 603 : SEGDES MINTE 604 : SEGDES MELEME 605 : SEGDES IMODEL 606 : C 607 : IF (ISUP.EQ.1) THEN 607 : CALL DTMVAL(IVAMAT,3) 607 : CALL DTMVAL(IVACAR,3) 608 : ELSE 608 : CALL DTMVAL(IVAMAT,1) 608 : CALL DTMVAL(IVACAR,1) 609 : ENDIF 610 : C 611 : NOMID=MOCARA 612 : IF (MOCARA.NE.0) SEGSUP NOMID 613 : NOMID=MOMATR 614 : IF (MOMATR.NE.0) SEGSUP NOMID 615 : NOMID=MOFORC 616 : if(lsupfo)SEGSUP NOMID 617 : NOMID=MODEPL 618 : if(lsupdp)SEGSUP NOMID 619 : C 620 : C ERREUR DANS LES S-P MASSE2 ,MASSE3 ,MASSE4 621 : C 622 : IF (IERR.NE.0) GOTO 9997 623 : C 624 : 500 CONTINUE 625 : C 626 : C FIN NORMALE 627 : IRET = 1 628 : SEGDES MRIGID 629 : C WRITE(*,*) 'Je desactive MRIGID' 630 : IPRIG = MRIGID 631 : GOTO 666 632 : C 633 : C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR 634 : C 635 : 9990 CONTINUE 636 : IRET=0 637 : C 638 : IF (ISUP.EQ.1) THEN 638 : CALL DTMVAL(IVAMAT,3) 638 : CALL DTMVAL(IVACAR,3) 639 : ELSE 639 : CALL DTMVAL(IVAMAT,1) 639 : CALL DTMVAL(IVACAR,1) 640 : ENDIF 641 : 642 : NOMID=MOMATR 643 : IF (MOMATR.NE.0) SEGSUP NOMID 644 : NOMID=MOCARA 645 : IF (MOCARA.NE.0) SEGSUP NOMID 646 : NOMID=MOFORC 647 : if(lsupfo)SEGSUP NOMID 648 : NOMID=MODEPL 649 : if(lsupdp)SEGSUP NOMID 650 : C 651 : 9996 CONTINUE 652 : SEGDES MELEME 653 : SEGDES MINTE 654 : SEGDES IMODEL 655 : C 656 : 9997 CONTINUE 657 : SEGSUP MRIGID 658 : IPRIG = 0 659 : C 660 : C Fin commune 661 : 666 CONTINUE 662 : SEGDES MMODEL 663 : C 664 : RETURN 665 : END 666 : 667 : 668 :
© Cast3M 2003 - All rights reserved.
Disclaimer