1 : C MASSE1 SOURCE AM 13/12/16 21:15:58 7825 2 : 3 : SUBROUTINE MASSE1 (MODORI,IPCHE1,IPMASS,IRET,ILUMP) 4 : 5 : *_______________________________________________________________________ 6 : * 7 : * appele par masse ( opérateur masse et lump ) 8 : * 9 : * entrees : 10 : * ======== 11 : * 12 : * modori pointeur sur un mmodel 13 : * ipche1 pointeur sur un mchaml de caracteristique 14 : * ilump si il s'agit de l'opérateur lump 15 : * 16 : * sorties : 17 : * ========= 18 : * 19 : * ipmass pointeur sur la masse construite 20 : * iret 1 si ok, 0 sinon 21 : * 22 : *_______________________________________________________________________ 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8(A-H,O-Z) 25 : 26 : INTEGER oooval 27 : 28 : -INC CCOPTIO 29 : -INC CCHAMP 30 : -INC CCGEOME 31 : -INC CCREEL 32 : -INC SMRIGID 33 : -INC SMCHAML 34 : -INC SMELEME 35 : -INC SMCOORD 36 : -INC SMINTE 37 : -INC SMMODEL 38 : C 39 : SEGMENT INFO 40 : INTEGER INFELL(JG) 41 : ENDSEGMENT 42 : C 43 : SEGMENT NOTYPE 44 : C 45 : CHARACTER*16 TYPE(NBTYPE) 46 : ENDSEGMENT 47 : C 48 : SEGMENT MPTVAL 49 : INTEGER IPOS(NS),NSOF(NS) 50 : INTEGER IVAL(NCOSOU) 51 : CHARACTER*16 TYVAL(NCOSOU) 52 : ENDSEGMENT 53 : C 54 : segment modsta 55 : integer pimoda(nmoda),pistat(nstat) 56 : integer ivmoda(nmoda),ivstat(nstat) 57 : endsegment 58 : C 59 : CHARACTER*8 CMATE 60 : CHARACTER*(NCONCH) CONM 61 : PARAMETER (NINF=3) 62 : INTEGER INFOS(NINF) 63 : LOGICAL BDPGE,lsupfo,lsupdp,dcmate,dcmat2,dcmoda 64 : C 65 : NHRM=NIFOUR 66 : 67 : IRET = 0 68 : * 69 : * verification du lieu support du mchaml de caracteristiques 70 : * 71 : * am 5/1/95 on remplace par un appel a quesup plus 72 : * loin pour ne tester que sur les composantes ad hoc 73 : * 73 : * call quesup(ipmodl,ipche1,4,0,isup) 74 : * if(isup.gt.1) return 75 : C 76 : C ACTIVATION DU MODELE 77 : C 78 : * MODORI = Modele initial complet 79 : * IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX") 79 : CALL PIMODL(MODORI,IPMODL) 80 : IF (IPMODL.EQ.0) RETURN 81 : * IPMODL est ACTIF en retour (nouveau pointeur pouvant etre detruit) 82 : MMODEL=IPMODL 83 : NSOUS=KMODEL(/1) 84 : C 85 : C CREATION DE L'OBJET MATRICE DE MASSE 86 : C 87 : NRIGEL=0 88 : SEGINI,MRIGID 89 : IPMASS=MRIGID 90 : MTYMAT='MASSE' 91 : IFORIG=IFOUR 92 : ICHOLE=0 93 : IMGEO1=0 94 : IMGEO2=0 95 : ISUPEQ=0 96 : C Cas des modes de calculs en DEFORMATIONS GENERALISEES 97 : IF (IFOUR.EQ.-3) THEN 98 : NDPGE=3 99 : NDDLGE=1 100 : BDPGE=.TRUE. 101 : ELSE IF (IFOUR.EQ.11) THEN 102 : NDPGE=2 103 : NDDLGE=2 104 : BDPGE=.TRUE. 105 : ELSE IF (IFOUR.EQ. 7.OR.IFOUR.EQ. 8.OR.IFOUR.EQ. 9.OR. 106 : . IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN 107 : NDPGE=1 108 : NDDLGE=1 109 : BDPGE=.TRUE. 110 : ELSE 111 : NDPGE=0 112 : NDDLGE=0 113 : BDPGE=.FALSE. 114 : ENDIF 115 : 116 : * termes croises STATIQUE et/ou MODAL 117 : nstat = 100 118 : kstat = 0 119 : nmoda = 100 120 : kmoda = 0 121 : segini modsta 122 : C_______________________________________________________________________ 123 : C 124 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES 125 : C_______________________________________________________________________ 126 : C 127 : isouss=0 128 : DO 500 ISOUS=1,NSOUS 129 : C 130 : C ON RECUPERE LINFORMATION GENERALES 131 : C 132 : IMODEL=KMODEL(ISOUS) 133 : SEGACT IMODEL 134 : IIPDPG=IPDPGE 135 : IPMAIL=IMAMOD 136 : CONM =CONMOD 137 : dcmate = .false. 138 : dcmat2 = .false. 139 : dcmoda = .false. 140 : C 141 : C TRAITEMENT DU MODELE 142 : C 143 : MELEME=IMAMOD 144 : MELE=NEFMOD 145 : * Cas particulier des relations de conformites : pas de masse 146 : IF (MELE.EQ.22) GOTO 500 147 : * 148 : npint=1 149 : if (infmod(/1).ne.0) npint = infmod(1) 150 : C 151 : C NATURE DU MATERIAU 152 : C 153 : * NFOR=FORMOD(/2) 154 : * NMAT=MATMOD(/2) 154 : * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 155 : CMATE = CMATEE 156 : MATE = IMATEE 157 : INAT = INATUU 158 : * IF (CMATE.EQ.' ') THEN 158 : * CALL ERREUR(251) 159 : * SEGDES IMODEL,MMODEL 160 : * SEGSUP MRIGID 161 : * RETURN 162 : * ENDIF 163 : do im = 1,matmod(/2) 164 : if (matmod(im).eq.'IMPEDANCE') then 165 : dcmate =.true. 166 : if(tymode(/2).gt.0)then 167 : if(tymode(1).eq.'LISTMOTS') dcmat2 = .true. 168 : endif 169 : endif 170 : enddo 171 : C 172 : C CREATION DU TABLEAU INFOS 173 : C 174 : IRTD=1 174 : CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD) 175 : IF (IRTD.EQ.0) GOTO 9996 176 : C_______________________________________________________________________ 177 : C 178 : C INFORMATION SUR L ELEMENT FINI 179 : C_______________________________________________________________________ 180 : C 181 : isupo=4 182 : if (npint.eq.12345) isupo=1 183 : * integration aux noeuds 184 : 185 : if(infmod(/1).lt.2+isupo)then 185 : CALL ELQUOI(MELE,0,isupo,IPINF,IMODEL) 186 : INFO=IPINF 187 : MINTE=INFELL(11) 188 : MINTE1=INFELL(12) 189 : MFR =INFELL(13) 190 : LRE =INFELL(9) 191 : LW =INFELL(7) 192 : LHOOK =INFELL(10) 193 : NDDL =INFELL(15) 194 : IELE=INFELL(14) 195 : ICARA=INFELL(5) 196 : NLIGRP = INFELL(9) 197 : NLIGRD = INFELL(9) 198 : segsup info 199 : if(mele.ne.260) segact minte 200 : * write(6,*) ' premier elquoi' 201 : * write(6,*) 'poigau',(poigau(iou),iou=1,poigau(/1)) 202 : * write(6,*) ((shptot(ir,it,1),ir=1,shptot(/1)),it=1,shptot(/2)) 203 : else 204 : MINTE=INFMOD(2+isupo) 205 : MINTE1=INFMOD(8) 206 : MFR =INFELE(13) 207 : LRE =INFELE(9) 208 : LW =INFELE(7) 209 : LHOOK =INFELE(10) 210 : NDDL =INFELE(15) 211 : IELE=INFELE(14) 212 : ICARA=INFELE(5) 213 : NLIGRP = INFELE(9) 214 : NLIGRD = INFELE(9) 215 : endif 216 : IPMINT=MINTE 217 : IPMIN1=MINTE1 218 : * segact minte 219 : * write(6,*) ' deuxieme elquoi' 220 : * write(6,*) 'poigau',(poigau(iou),iou=1,poigau(/1)) 221 : * write(6,*) ((shptot(ir,it,1),ir=1,shptot(/1)),it=1,shptot(/2)) 222 : C 223 : C INITIALISATION DE MINTE 224 : C 225 : if(mele.ne.260) SEGACT MINTE 226 : NBPGAU=POIGAU(/1) 227 : C 228 : * Preparation du PARTITIONNEMENT du segment XMATRI 229 : LTRK=OOOVAL(1,4) 230 : IF (LTRK.EQ.0) LTRK=OOOVAL(1,1) 231 : IPT1=IPMAIL 232 : SEGACT,IPT1 233 : NBNN1 =IPT1.NUM(/1) 234 : NBELE1=IPT1.NUM(/2) 235 : * Ajout a la taille en mots de la matrice des infos du segment 236 : LSEG=LRE*LRE*NBELE1 + 16 237 : NBLPRT=(LSEG-1)/LTRK+1 238 : NBLMAX=(NBELE1-1)/NBLPRT+1 239 : NBLPRT=(NBELE1-1)/NBLMAX+1 240 : * write (ioimp,*) ' masse1 nblprt nblmax ',NBLPRT,NBLMAX,NBELE1 241 : NRIGEL = IRIGEL(/2) + NBLPRT 242 : SEGADJ,MRIGID 243 : IPMASS=MRIGID 244 : MELEME=IPT1 245 : 246 : * Boucle (5000) de PARTITIONNEMENT du segment XMATRI 247 : DO 5000 IPRT = 1,NBLPRT 248 : isouss=isouss+1 249 : IF (NBLPRT.GT.1) THEN 250 : JPRT=(IPRT-1)*NBLMAX 251 : SEGACT,IPT1 252 : NBSOUS=0 253 : NBREF=0 254 : NBNN=NBNN1 255 : NBELEM=MIN(NBLMAX,NBELE1-JPRT) 256 : * write (6,*) ' creation segment ',nbnn,nbelem 257 : SEGINI,MELEME 258 : ITYPEL=IPT1.ITYPEL 259 : DO I=1,NBELEM 260 : IB=I+JPRT 261 : DO J=1,NBNN 262 : NUM(J,I)=IPT1.NUM(J,IB) 263 : ENDDO 264 : ICOLOR(I)=IPT1.ICOLOR(IB) 265 : ENDDO 266 : ENDIF 267 : IPMAIL=MELEME 268 : C 269 : C ON RECUPERE LES MELVAL ET LES MELEME 270 : C 271 : MELEME=IPMAIL 272 : SEGACT MELEME 273 : * 274 : * modification du meleme pour le remplissage du segment descripteur 275 : * en deformations planes generalisees 276 : * 277 : IF (BDPGE.AND.MFR.NE.35.AND.MFR.NE.53) THEN 278 : IPT2=IPMAIL 279 : C* SEGACT IPT2 280 : NBELEM=IPT2.NUM(/2) 281 : NBNN=IPT2.NUM(/1)+1 282 : NBREF=0 283 : NBSOUS=0 284 : SEGINI MELEME 285 : DO 1007 I=1,NBELEM 286 : DO 1008 J=1,NBNN-1 287 : NUM(J,I)=IPT2.NUM(J,I) 288 : 1008 CONTINUE 289 : NUM(NBNN,I)=IIPDPG 290 : ICOLOR(I)=IPT2.ICOLOR(I) 291 : 1007 CONTINUE 292 : ITYPEL=28 293 : IPMADG=MELEME 294 : SEGDES IPT2 295 : ELSE 296 : NBNN =NUM(/1) 297 : NBELEM=NUM(/2) 298 : ENDIF 299 : IPPORE=0 300 : IF(MFR.EQ.33) IPPORE=NBNN 301 : C 302 : c cas Xfem: DESCR et IMATRI créé par massxr.eso 303 : C* Cas particulier des elements XFEM en cas de partition : 304 : C* Il faut aussi partitionner le modele (nomme imoxfem) 305 : IF (MFR.EQ.63) THEN 306 : IF (nblprt.GT.1) THEN 307 : imoxfem = 0 307 : CALL PARTXR(IMODEL,ipmail,imoxfem) 308 : IF (IERR.NE.0) RETURN 309 : ELSE 310 : imoxfem = IMODEL 311 : ENDIF 312 : GOTO 1999 313 : ENDIF 314 : c 315 : C ---------------------------------------------------------* 316 : C INITIALISATION DU SEGMENT DESCR, SEGMENT DESCRIPTEUR DES * 317 : C DES INCONNUES RELATIVES A LA MATRICE DE RIGIDITE * 318 : C ---------------------------------------------------------* 319 : 320 : SEGINI DESCR 321 : IPDSCR=DESCR 322 : if(lnomid(1).ne.0) then 323 : nomid=lnomid(1) 324 : segact nomid 325 : modepl=nomid 326 : ndepl=lesobl(/2) 327 : ndum=lesfac(/2) 328 : lsupdp=.false. 329 : else 330 : lsupdp=.true. 330 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEPL,NDUM) 331 : endif 332 : if(lnomid(2).ne.0) then 333 : nomid=lnomid(2) 334 : segact nomid 335 : moforc=nomid 336 : nforc=lesobl(/2) 337 : lsupfo=.false. 338 : else 339 : lsupfo=.true. 339 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NDUM) 340 : endif 341 : C 342 : IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN 342 : CALL ERREUR(5) 343 : SEGSUP DESCR,MRIGID 344 : SEGDES MMODEL,MELEME 345 : RETURN 346 : ENDIF 347 : C 348 : C REMPLISSAGE DU SEGMENT DESCRIPTEUR 349 : C 350 : IDDL=1 351 : NCOMP=NDEPL 352 : NBNNS=NBNN 353 : IF (MFR.EQ.33) NCOMP=NDEPL-1 354 : IF (BDPGE.AND.MFR.NE.35.AND.MFR.NE.53) THEN 355 : NCOMP=NDEPL-NDPGE 356 : NBNNS=NBNN-1 357 : ENDIF 358 : IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2 359 : if (dcmat2) NCOMP = NDEPL/2 360 : NOMID=MODEPL 361 : SEGACT NOMID 362 : NOMID=MOFORC 363 : SEGACT NOMID 364 : DO 1004 INOEUD=1,NBNNS 365 : DO 1005 ICOMP=1,NCOMP 366 : NOMID=MODEPL 367 : LISINC(IDDL)=LESOBL(ICOMP) 368 : if (dcmat2) LISINC(IDDL)=LESOBL(IDDL) 369 : NOMID=MOFORC 370 : LISDUA(IDDL)=LESOBL(ICOMP) 371 : if (dcmat2) LISDUA(IDDL)=LESOBL(IDDL) 372 : NOELEP(IDDL)=INOEUD 373 : NOELED(IDDL)=INOEUD 374 : IDDL=IDDL+1 375 : 1005 CONTINUE 376 : 1004 CONTINUE 377 : * 378 : * cas de la deformation plane generalisee 379 : * 380 : IF (BDPGE.AND.MFR.NE.35.AND.MFR.NE.53) THEN 381 : DO 1006 ICOMP=(NDPGE-1),0,-1 382 : NOMID=MODEPL 383 : LISINC(IDDL)=LESOBL(NDEPL-ICOMP) 384 : NOMID=MOFORC 385 : LISDUA(IDDL)=LESOBL(NFORC-ICOMP) 386 : NOELEP(IDDL)=NBNN 387 : NOELED(IDDL)=NBNN 388 : IDDL=IDDL+1 389 : 1006 CONTINUE 390 : ENDIF 391 : C 392 : C CAS DES MILIEUX POREUX 393 : C 394 : IF (MFR.EQ.33) THEN 395 : DO 1104 INOEUD=1,NBSOM(IELE) 396 : NOMID=MODEPL 397 : LISINC(IDDL)=LESOBL(NDEPL) 398 : NOMID=MOFORC 399 : LISDUA(IDDL)=LESOBL(NDEPL) 400 : NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1) 401 : NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1) 402 : IDDL=IDDL+1 403 : 1104 CONTINUE 404 : ENDIF 405 : * 406 : * cas des element raccord 407 : * 408 : IF (MFR.EQ.19.OR.MFR.EQ.21) THEN 408 : CALL IDDEPL(MFR+1000,IFOUR,MODPL,NDEPL,NDUM) 408 : CALL IDFORC(MFR+1000,IFOUR,MOFRC,NFORC,NDUM) 409 : NOMID=MODPL 410 : SEGACT NOMID 411 : NOMID=MOFRC 412 : SEGACT NOMID 413 : DO 1106 INOEUD=NBNNS+1,NBNN 414 : DO 1107 ICOMP=1,NDEPL 415 : NOMID=MODPL 416 : LISINC(IDDL)=LESOBL(ICOMP) 417 : NOMID=MOFRC 418 : LISDUA(IDDL)=LESOBL(ICOMP) 419 : NOELEP(IDDL)=INOEUD 420 : NOELED(IDDL)=INOEUD 421 : IDDL=IDDL+1 422 : 1107 CONTINUE 423 : 1106 CONTINUE 424 : NOMID=MODPL 425 : SEGsup NOMID 426 : NOMID=MOFRC 427 : SEGsup NOMID 428 : ENDIF 429 : NOMID=MODEPL 430 : SEGDES NOMID 431 : NOMID=MOFORC 432 : SEGDES NOMID 433 : SEGDES DESCR 434 : C 435 : C ------------------------------------------------------------* 436 : C INITIALISATION DU SEGMENT IMATRI, CHAPEAU SUR LES SEGMENTS * 437 : C CONTENANT LES MATRICES DE RIGIDITE ELEMENTAIRES * 438 : C ------------------------------------------------------------* 439 : C NBELEM: NB D'ELEMENTS DANS LA SOUS ZONE 440 : NLIGRP=LRE 441 : NLIGRD=LRE 442 : C 443 : NELRIG=NBELEM 444 : SEGINI xMATRI 445 : IPMATR=xMATRI 446 : C 447 : C------------------------------------------------------* 448 : C 449 : C TRAITEMENT DU CHAPEAU DES RIGIDITES, SEGMENT MRIGID * 450 : C------------------------------------------------------* 451 : C 452 : COERIG(isouss)=1.D0 453 : IF (BDPGE.AND.MFR.NE.35.AND.MFR.NE.53) THEN 454 : IRIGEL(1,isouss)=IPMADG 455 : ELSE 456 : IRIGEL(1,isouss)=IPMAIL 457 : ENDIF 458 : IRIGEL(2,isouss)=0 459 : IRIGEL(3,isouss)=IPDSCR 460 : IRIGEL(4,isouss)=xMATRI 461 : IRIGEL(5,isouss)=NHRM 462 : IRIGEL(6,isouss)=0 463 : IRIGEL(7,isouss)=0 464 : IRIGEL(8,isouss)=0 465 : IF (BDPGE.AND.MFR.NE.35.AND.MFR.NE.53) THEN 466 : SEGDES MELEME 467 : MELEME=IPMAIL 468 : SEGACT MELEME 469 : NBNN=NUM(/1) 470 : ENDIF 471 : C 472 : C CAS DE L'OPERATEUR LUMP ON INDIQUE QUE LA MATRICE MASSE GENEREE EST DIAGONALE 473 : C 474 : * IF (ILUMP .EQ. 1) THEN 475 : * IRIGEL(7,isouss) = 3 476 : * ENDIF 477 : c 478 : 1999 continue 479 : C_______________________________________________________________________ 480 : C 481 : C TRAITEMENT DES CHAMP MATERIAUX 482 : C_______________________________________________________________________ 483 : C 484 : NBROBL=0 485 : NBRFAC=0 486 : MOMATR=0 487 : IVAMAT=0 488 : IVACAR=0 489 : LHOTRA=0 490 : * 491 : * JOINT UNIDIMENSIONNEL JOI1 492 : * 493 : IF (MFR.EQ.75) THEN 494 : IF (IDIM.EQ.3) THEN 495 : NBROBL=10 496 : SEGINI NOMID 497 : LESOBL(1)='V1X' 498 : LESOBL(2)='V1Y' 499 : LESOBL(3)='V1Z' 500 : LESOBL(4)='V2X' 501 : LESOBL(5)='V2Y' 502 : LESOBL(6)='V2Z' 503 : LESOBL(7)='MASS' 504 : LESOBL(8)='JX' 505 : LESOBL(9)='JY' 506 : LESOBL(10)='JZ' 507 : ELSE IF (IDIM.EQ.2) THEN 508 : NBROBL=4 509 : SEGINI NOMID 510 : LESOBL(1)='V1X' 511 : LESOBL(2)='V1Y' 512 : LESOBL(3)='MASS' 513 : LESOBL(4)='JZ' 514 : ENDIF 515 : * 516 : NBTYPE=1 517 : SEGINI NOTYPE 518 : TYPE(1)='REAL*8' 519 : MOMATR=NOMID 520 : MOTYPE=NOTYPE 521 : * 522 : * rho dans les cas,massif,coq3,poutre,tuyau,coq8,coq2,barre,jot3,joi4,joi2,xfem 523 : * 524 : ELSE IF (MFR.EQ.1.OR.MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.3. 525 : 1 OR.MFR.EQ.27.OR.MFR.EQ.9.OR.MFR.EQ.35.OR.MFR.EQ.31. 526 : 2 OR.MFR.EQ.49.OR.MFR.EQ.53.OR.MFR.EQ.63.OR.MFR.EQ.5) THEN 527 : * 528 : IF(CMATE.NE.'SECTION') THEN 529 : NBROBL=1 530 : SEGINI NOMID 531 : LESOBL(1)='RHO ' 532 : NBTYPE=1 533 : SEGINI NOTYPE 534 : TYPE(1)='REAL*8' 535 : ELSE 536 : LHOTRA=LHOOK 537 : NBROBL=2 538 : SEGINI NOMID 539 : MOMATR=NOMID 540 : LESOBL(1)='MODS' 541 : LESOBL(2)='MATS' 542 : NBTYPE=2 543 : SEGINI NOTYPE 544 : TYPE(1)='POINTEURMMODEL' 545 : TYPE(2)='POINTEURMCHAML' 546 : ENDIF 547 : MOMATR=NOMID 548 : MOTYPE=NOTYPE 549 : * 550 : * rhoref rlcar dans le cas des elements de raccord et surface libre 551 : * 552 : ELSE IF (MFR.EQ.19.OR.MFR.EQ.21.OR.MFR.EQ.23) THEN 553 : NBROBL=2 554 : NBRFAC=0 555 : SEGINI NOMID 556 : MOMATR=NOMID 557 : LESOBL(1)='RORF' 558 : LESOBL(2)='LCAR' 559 : * 560 : NBTYPE=1 561 : SEGINI NOTYPE 562 : MOTYPE=NOTYPE 563 : TYPE(1)='REAL*8' 564 : * 565 : * caracteristiques pour les elements liquides 566 : * 567 : ELSE IF (MFR.EQ.11) THEN 568 : NBROBL=5 569 : NBRFAC=0 570 : SEGINI NOMID 571 : MOMATR=NOMID 572 : LESOBL(1)='RHO ' 573 : LESOBL(2)='CSON' 574 : LESOBL(3)='RORF' 575 : LESOBL(4)='CREF' 576 : LESOBL(5)='LCAR' 577 : * 578 : NBTYPE=1 579 : SEGINI NOTYPE 580 : MOTYPE=NOTYPE 581 : TYPE(1)='REAL*8' 582 : * 583 : * caracteristiques pour les elements homogeneises 584 : * 585 : ELSE IF (MFR.EQ.37) THEN 586 : IF (MELE.EQ.157) THEN 587 : NBROBL=15 588 : NBRFAC=0 589 : SEGINI NOMID 590 : MOMATR=NOMID 591 : LESOBL(1)='B11 ' 592 : LESOBL(2)='B22 ' 593 : LESOBL(3)='B12 ' 594 : LESOBL(4)='ROF ' 595 : LESOBL(5)='ROS ' 596 : LESOBL(6)='CSON' 597 : LESOBL(7)='RORF' 598 : LESOBL(8)='CREF' 599 : LESOBL(9)='LCAR' 600 : LESOBL(10)='E111' 601 : LESOBL(11)='E112' 602 : LESOBL(12)='E121' 603 : LESOBL(13)='E122' 604 : LESOBL(14)='E221' 605 : LESOBL(15)='E222' 606 : ELSE 607 : NBROBL=9 608 : NBRFAC=0 609 : SEGINI NOMID 610 : MOMATR=NOMID 611 : LESOBL(1)='B11 ' 612 : LESOBL(2)='B22 ' 613 : LESOBL(3)='B12 ' 614 : LESOBL(4)='ROF ' 615 : LESOBL(5)='ROS ' 616 : LESOBL(6)='CSON' 617 : LESOBL(7)='RORF' 618 : LESOBL(8)='CREF' 619 : LESOBL(9)='LCAR' 620 : ENDIF 621 : * 622 : NBTYPE=1 623 : SEGINI NOTYPE 624 : MOTYPE=NOTYPE 625 : TYPE(1)='REAL*8' 626 : * 627 : * caracteristiques pour l'element acoustique pure 628 : * 629 : ELSE IF (MFR.EQ.41) THEN 630 : NBROBL=5 631 : NBRFAC=0 632 : SEGINI NOMID 633 : MOMATR=NOMID 634 : LESOBL(1)='RHO ' 635 : LESOBL(2)='CSON' 636 : LESOBL(3)='RORF' 637 : LESOBL(4)='CREF' 638 : LESOBL(5)='LCAR' 639 : * 640 : NBTYPE=1 641 : SEGINI NOTYPE 642 : MOTYPE=NOTYPE 643 : TYPE(1)='REAL*8' 644 : * 645 : * caracteristiques pour l'element raccord liquide tuyau 646 : * 647 : ELSE IF (MFR.EQ.43) THEN 648 : NBROBL=3 649 : NBRFAC=0 650 : SEGINI NOMID 651 : MOMATR=NOMID 652 : LESOBL(1)='RHO ' 653 : LESOBL(3)='RORF' 654 : LESOBL(2)='LCAR' 655 : * 656 : NBTYPE=1 657 : SEGINI NOTYPE 658 : MOTYPE=NOTYPE 659 : TYPE(1)='REAL*8' 660 : * 661 : * caracteristiques pour les joints generalises 662 : * 663 : ELSE IF (MFR.EQ.55) THEN 664 : CcPPj NBROBL=2 665 : CcPPj NBRFAC=0 666 : CcPPj SEGINI NOMID 667 : CcPPj MOMATR=NOMID 668 : CcPPj LESOBL(1)='RHO ' 669 : CcPPj LESOBL(2)='EPAI' 670 : NBROBL=1 671 : NBRFAC=1 672 : SEGINI NOMID 673 : MOMATR=NOMID 674 : LESOBL(1)='RHO ' 675 : LESFAC(1)='EPAI' 676 : * 677 : NBTYPE=1 678 : SEGINI NOTYPE 679 : MOTYPE=NOTYPE 680 : TYPE(1)='REAL*8' 681 : * 682 : * poi1 -- MODAL 683 : * 684 : ELSE IF (CMATE.EQ.'MODAL') THEN 685 : NBROBL=3 686 : NBRFAC=0 687 : SEGINI NOMID 688 : MOMATR=NOMID 689 : LESOBL(1)='FREQ' 690 : LESOBL(2)='MASS' 691 : LESOBL(3)='DEFO' 692 : * 693 : NBTYPE=3 694 : SEGINI NOTYPE 695 : MOTYPE=NOTYPE 696 : TYPE(1)='REAL*8' 697 : TYPE(2)='REAL*8' 698 : TYPE(3)='POINTEURCHPOINT' 699 : * 700 : * poi1 -- STATIQUE 701 : * 702 : ELSE IF (CMATE.EQ.'STATIQUE') THEN 703 : NBROBL=3 704 : NBRFAC=0 705 : SEGINI NOMID 706 : MOMATR=NOMID 707 : LESOBL(1)='DEFO' 708 : LESOBL(2)='RIDE' 709 : LESOBL(3)='MADE' 710 : * 711 : NBTYPE=1 712 : SEGINI NOTYPE 713 : MOTYPE=NOTYPE 714 : TYPE(1)='POINTEURCHPOINT' 715 : * 716 : ENDIF 717 : 718 : DO imat = 1 , matmod(/2) 719 : IF (matmod(imat).eq.'IMPEDANCE') THEN 720 : 721 : NBROBL=0 722 : NBRFAC=2 723 : SEGINI NOMID 724 : MOMATR=NOMID 725 : LESFAC(1)='MASS' 726 : LESFAC(2)='INER' 727 : * 728 : NBTYPE=1 729 : SEGINI NOTYPE 730 : MOTYPE=NOTYPE 731 : TYPE(1)='REAL*8' 732 : 733 : ENDIF 734 : ENDDO 735 : C 736 : NMATR=NBROBL 737 : NMATF=NBRFAC 738 : NMATT=NMATR+NMATF 739 : 740 : IF (MOMATR.NE.0) THEN 741 : * 742 : * verification du support des composantes recherchees 743 : * 743 : CALL QUESUQ(IMODEL,IPCHE1,4,0,MOMATR,isupo,ISUP,IRET1) 744 : IF(ISUP.GT.1)THEN 745 : SEGSUP NOTYPE 746 : GO TO 9990 747 : ENDIF 748 : * 748 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 749 : SEGSUP NOTYPE 750 : IF (IERR.NE.0) THEN 751 : GOTO 9996 752 : ENDIF 753 : IF(ISUP.EQ.1)THEN 753 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 754 : IF(IERR.NE.0)THEN 755 : ISUP=0 756 : GOTO 9990 757 : ENDIF 758 : ENDIF 759 : if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then 760 : mptval = ivamat 761 : segact mptval 761 : if (ival(/1).lt.3) call erreur(5) 762 : endif 763 : if (cmate.eq.'STATIQUE') then 764 : kstat = kstat + 1 765 : ivstat(kstat) = ivamat 766 : pistat(kstat) = imodel 767 : if (kstat.eq.nstat) then 768 : nstat = nstat + 100 769 : segadj modsta 770 : endif 771 : endif 772 : if (cmate.eq.'MODAL') then 773 : kmoda = kmoda + 1 774 : ivmoda(kmoda) = ivamat 775 : pimoda(kmoda) = imodel 776 : if (kmoda.eq.nmoda) then 777 : nmoda = nmoda + 100 778 : segadj modsta 779 : endif 780 : endif 781 : ENDIF 782 : C 783 : C____________________________________________________________________ 784 : C 785 : C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES 786 : C____________________________________________________________________ 787 : C 788 : NBROBL=0 789 : NBRFAC=0 790 : MOCARA=0 791 : NCARA=0 792 : NCARF=0 793 : NCARR=0 794 : IVECT=0 795 : * 796 : * epaisseur dans le cas massif en contraintes planes 797 : * 798 : IF((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.63.OR.MELE.EQ.35.OR. 799 : +MELE.EQ.36.OR.MELE.EQ.63).AND.IFOUR.EQ.-2)THEN 800 : NBROBL=0 801 : NBRFAC=1 802 : SEGINI NOMID 803 : MOCARA=NOMID 804 : LESFAC(1)='DIM3' 805 : * 806 : NBTYPE=1 807 : SEGINI NOTYPE 808 : MOTYPE=NOTYPE 809 : TYPE(1)='REAL*8' 810 : * 811 : * epaisseur et excentrement dans le cas des coques 812 : * 813 : ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 814 : NBROBL=1 815 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN 816 : NBRFAC=2 817 : ELSE 818 : NBRFAC=1 819 : ENDIF 820 : SEGINI NOMID 821 : MOCARA=NOMID 822 : LESOBL(1)='EPAI' 823 : LESFAC(1)='EXCE' 824 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3' 825 : * 826 : NBTYPE=1 827 : SEGINI NOTYPE 828 : MOTYPE=NOTYPE 829 : TYPE(1)='REAL*8' 830 : * 831 : * section pour les barres et les cerces 832 : * 833 : ELSE IF (MFR.EQ.27) THEN 834 : do im = 1,matmod(/2) 835 : if (matmod(im).eq.'MODAL') dcmoda =.true. 836 : enddo 837 : IF(.NOT.(dcmate.or.dcmoda)) THEN 838 : NBROBL=1 839 : SEGINI NOMID 840 : MOCARA=NOMID 841 : LESOBL(1)='SECT' 842 : * 843 : NBTYPE=1 844 : SEGINI NOTYPE 845 : MOTYPE=NOTYPE 846 : TYPE(1)='REAL*8' 847 : ENDIF 848 : * 849 : * section, excentrements et orientation pour les barres excentrees 850 : * 851 : ELSE IF (MFR.EQ.49) THEN 852 : NBROBL=6 853 : SEGINI NOMID 854 : MOCARA=NOMID 855 : LESOBL(1)='SECT' 856 : LESOBL(2)='EXCZ' 857 : LESOBL(3)='EXCY' 858 : LESOBL(4)='VX ' 859 : LESOBL(5)='VY ' 860 : LESOBL(6)='VZ ' 861 : * 862 : NBTYPE=1 863 : SEGINI NOTYPE 864 : MOTYPE=NOTYPE 865 : TYPE(1)='REAL*8' 866 : * 867 : * caracteristiques pour les poutres 868 : * 869 : ELSE IF (MFR.EQ.7 ) THEN 870 : if (dcmate) then 871 : NBROBL=0 872 : NBRFAC=1 873 : SEGINI NOMID 874 : MOCARA=NOMID 875 : LESFAC(1)='VECT' 876 : IVECT=1 877 : * 878 : NBTYPE=1 879 : SEGINI NOTYPE 880 : MOTYPE=NOTYPE 881 : TYPE(1)='POINTEURPOINT ' 882 : else 883 : IF (CMATE.EQ.'SECTION') THEN 884 : NBROBL=0 885 : NBRFAC=1 886 : SEGINI NOMID 887 : MOCARA=NOMID 888 : LESFAC='VECT' 889 : IVECT=1 890 : * 891 : NBTYPE=1 892 : SEGINI NOTYPE 893 : MOTYPE=NOTYPE 894 : TYPE(1)='POINTEURPOINT ' 895 : * 896 : * CAS 2D 897 : ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 898 : NBRFAC=1 899 : NBROBL=2 900 : SEGINI NOMID 901 : MOCARA=NOMID 902 : LESOBL(1)= 'SECT' 903 : LESOBL(2)= 'INRZ' 904 : LESFAC(1)= 'SECY' 905 : * 906 : NBTYPE=1 907 : SEGINI NOTYPE 908 : MOTYPE=NOTYPE 909 : TYPE(1)='REAL*8' 910 : * 911 : ELSE 912 : NBROBL=4 913 : NBRFAC=3 914 : SEGINI NOMID 915 : MOCARA=NOMID 916 : LESOBL(1)='TORS' 917 : LESOBL(2)='INRY' 918 : LESOBL(3)='INRZ' 919 : LESOBL(4)='SECT' 920 : LESFAC(1)='SECY' 921 : LESFAC(2)='SECZ' 922 : LESFAC(3)='VECT' 923 : IVECT=1 924 : * 925 : NBTYPE=7 926 : SEGINI NOTYPE 927 : MOTYPE=NOTYPE 928 : TYPE(1)='REAL*8' 929 : TYPE(2)='REAL*8' 930 : TYPE(3)='REAL*8' 931 : TYPE(4)='REAL*8' 932 : TYPE(5)='REAL*8' 933 : TYPE(6)='REAL*8' 934 : TYPE(7)='POINTEURPOINT ' 935 : ENDIF 936 : endif 937 : * 938 : * caracteristiques pour les tuyaux 939 : * 940 : ELSE IF (MFR.EQ.13) THEN 941 : NBROBL=2 942 : NBRFAC=3 943 : SEGINI NOMID 944 : MOCARA=NOMID 945 : LESOBL(1)='EPAI' 946 : LESOBL(2)='RAYO' 947 : LESFAC(1)='RACO' 948 : LESFAC(2)='CISA' 949 : LESFAC(3)='VECT' 950 : IVECT=1 951 : * 952 : NBTYPE=5 953 : SEGINI NOTYPE 954 : MOTYPE=NOTYPE 955 : TYPE(1)='REAL*8' 956 : TYPE(2)='REAL*8' 957 : TYPE(3)='REAL*8' 958 : TYPE(4)='REAL*8' 959 : TYPE(5)='POINTEURPOINT ' 960 : * 961 : * caracteristique pour les elements de raccord 962 : * 963 : ELSE IF (MFR.EQ.19.OR.MFR.EQ.21) THEN 964 : IF(IDIM.EQ.2)THEN 965 : NBROBL=2 966 : SEGINI NOMID 967 : MOCARA=NOMID 968 : LESOBL(1)='VX ' 969 : LESOBL(2)='VY ' 970 : ELSEIF(IDIM.EQ.3)THEN 971 : NBROBL=3 972 : SEGINI NOMID 973 : MOCARA=NOMID 974 : LESOBL(1)='VX ' 975 : LESOBL(2)='VY ' 976 : LESOBL(3)='VZ ' 977 : ENDIF 978 : * 979 : NBTYPE=1 980 : SEGINI NOTYPE 981 : MOTYPE=NOTYPE 982 : TYPE(1)='REAL*8' 983 : * 984 : * caracteristiques des elements homogeneises 985 : * 986 : ELSE IF (MFR.EQ.37) THEN 987 : IF(IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN 988 : NBROBL=5 989 : SEGINI NOMID 990 : MOCARA=NOMID 991 : LESOBL(1)='SCEL' 992 : LESOBL(2)='SFLU' 993 : LESOBL(3)='EPS ' 994 : LESOBL(4)='SECT' 995 : LESOBL(5)='INRZ ' 996 : ELSE 997 : NBROBL=5 998 : SEGINI NOMID 999 : MOCARA=NOMID 1000 : LESOBL(1)='SCEL' 1001 : LESOBL(2)='SFLU' 1002 : LESOBL(3)='EPS ' 1003 : LESOBL(4)='NOF1' 1004 : LESOBL(5)='NOF2' 1005 : ENDIF 1006 : * 1007 : NBTYPE=1 1008 : SEGINI NOTYPE 1009 : MOTYPE=NOTYPE 1010 : TYPE(1)='REAL*8' 1011 : * 1012 : * caracteristiques de l'element tuyau acoustique 1013 : * 1014 : ELSE IF (MFR.EQ.41) THEN 1015 : NBROBL=1 1016 : NBRFAC=1 1017 : SEGINI NOMID 1018 : MOCARA=NOMID 1019 : LESOBL(1)='RAYO' 1020 : LESFAC(1)='RACO' 1021 : * 1022 : NBTYPE=2 1023 : SEGINI NOTYPE 1024 : MOTYPE=NOTYPE 1025 : TYPE(1)='REAL*8' 1026 : TYPE(2)='REAL*8' 1027 : * 1028 : * caracteristiques de l'element de raccord liquide tuyau 1029 : * 1030 : ELSE IF (MFR.EQ.43) THEN 1031 : NBROBL=1 1032 : NBRFAC=2 1033 : SEGINI NOMID 1034 : MOCARA=NOMID 1035 : LESOBL(1)='RAYO' 1036 : LESFAC(1)='RACO' 1037 : LESFAC(2)='VECT' 1038 : * 1039 : NBTYPE=3 1040 : SEGINI NOTYPE 1041 : MOTYPE=NOTYPE 1042 : TYPE(1)='REAL*8' 1043 : TYPE(2)='REAL*8' 1044 : TYPE(3)='POINTEURPOINT ' 1045 : IVECT=1 1046 : ENDIF 1047 : 1048 : NCARA=NBROBL 1049 : NCARF=NBRFAC 1050 : NCARR=NCARA+NCARF 1051 : * 1052 : IF (MOCARA.NE.0) THEN 1053 : * 1054 : * verification du support des composantes recherchees 1055 : * 1055 : CALL QUESUQ(IMODEL,IPCHE1,4,0,MOCARA,isupo,ISUP,IRET2) 1056 : IF(ISUP.GT.1)THEN 1057 : SEGSUP NOTYPE 1058 : GO TO 9990 1059 : ENDIF 1060 : * 1060 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR) 1061 : SEGSUP NOTYPE 1062 : IF (IERR.NE.0) GOTO 9990 1063 : MPTVAL=IVACAR 1064 : IF(ISUP.EQ.1)THEN 1064 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 1065 : IF(IERR.NE.0)THEN 1066 : ISUP=0 1067 : GOTO 9990 1068 : ENDIF 1069 : ENDIF 1070 : ENDIF 1071 : C 1072 : imod = imodel 1073 : if (dcmat2.and.mele.eq.2) goto 27 1074 : 1075 : C_______________________________________________________________________ 1076 : C 1077 : C NUMERO DES ETIQUETTES : 1078 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT 1079 : C LES ELEMENTS SONT GROUPES COMME SUIT : 1080 : C - MASSIF,LIQUIDE 'SURFACE LIBRE' ----------------------> MASSE2 1081 : C - COQ3/POUTRE,DKT,COQ4,COQ8,COQ2,DST ------------------> MASSE3 1082 : C ET POUTRE DE TIMOSCHENKO 1083 : C - RACCORDS LIQUIDE/MASSIFS,RACCORDS LIQUIDE/COQUES, 1084 : C BARRE,HOMOGENEISE,JOINTS --------------------------> MASSE4 1085 : C_______________________________________________________________________ 1086 : IF (MELE.LE.100) 1087 : * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9 1088 : & GOTO ( 99, 99, 99, 4, 99, 4, 99, 4, 99, 4, 99 1089 : * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT 1090 : & , 12, 99, 4, 4, 4, 4, 12, 12, 99, 99, 99 1091 : * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6 1092 : & , 4, 4, 4, 4, 27, 27, 27, 30, 99, 99, 99 1093 : * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2 1094 : & , 99, 4, 4, 4, 4, 4, 4, 27, 27, 43, 27 1095 : * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO 1096 : & , 12, 12, 12, 4, 27, 99, 99, 99, 4, 4, 12 1097 : * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15 1098 : & , 27, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 1099 : * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10 1100 : & , 99, 99, 4, 4, 4, 4, 99, 99, 99, 99, 99 1101 : * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4 1102 : & , 99, 99, 99, 99, 99, 99, 27, 12, 99, 12, 12 1103 : * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3 1104 : & , 99, 99, 99, 12, 27, 12, 12, 27, 27, 12, 99 1105 : * HYQ4 1106 : & , 99),MELE 1107 : IF (MELE.LE.200) 1108 : * HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8 1109 : & GOTO ( 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 1110 : * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13 1111 : & , 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 1112 : * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8 1113 : & , 4, 12, 12, 50, 12, 12, 99, 99, 99, 99, 99 1114 : * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3 1115 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 1116 : * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126 1117 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 1118 : * TE56 PY91 TRH6 ???? ???? ???? ???? ???? ???? ???? ???? 1119 : & , 99, 99, 12, 51, 51, 51, 51, 51, 51, 51, 51 1120 : * ???? ???? JCT3 JCI4 JGI2 JGT3 JGI4 ???? ???? ???? ???? 1121 : & , 51, 51, 12, 12, 12, 12, 12, 51, 51, 51, 51 1122 : * ???? ???? ???? ???? ???? ???? E183 E184 ???? ???? ???? 1123 : & , 51, 51, 51, 51, 51, 51, 4, 4, 51, 51, 51 1124 : * ???? ???? ???? ???? ???? M1D2 M1D3 ???? ???? ???? ???? 1125 : & , 51, 51, 51, 51, 51, 4, 4, 51, 51, 51, 51 1126 : * ???? ???? 1127 : & , 51, 51),MELE-100 1128 : IF (MELE.LE.300) 1129 : * ???? ???? ???? ???? ???? ???? ???? ???? ???? 1130 : & GOTO ( 51, 51, 51, 51, 51, 51, 51, 51, 51 1131 : * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? 1132 : & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51 1133 : * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? 1134 : & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51 1135 : * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? 1136 : & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51 1137 : * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? 1138 : & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51 1139 : * ???? ???? ???? ???? ???? ???? SHB8 ???? ???? XQ4R XC8R 1140 : & , 51, 51, 51, 51, 51, 51, 4, 51, 51, 63, 63 1141 : * JOI1 1142 : & , 12),MELE-200 1143 : C 1144 : 51 CONTINUE 1145 : 99 CONTINUE 1146 : SEGSUP xMATRI 1147 : IRIGEL(4,isouss)=0 1148 : MOTERR(1:4)=NOMTP(MELE) 1149 : MOTERR(5:12)='MASSE' 1149 : CALL ERREUR(86) 1150 : GOTO 9990 1151 : C_______________________________________________________________________ 1152 : C 1153 : C MASSIF, LIQUIDE, 'SURFACE LIBRE' 1154 : C_______________________________________________________________________ 1155 : C 1156 : 4 CONTINUE 1157 : IF (BDPGE) NDDL=NDDL+NDDLGE 1157 : CALL MASSE2 (IPMAIL,NDDL,LRE,NBPGAU,IPMINT,MELE,MFR,IVAMAT, 1158 : &IVACAR,NMATT,IPMATR,ILUMP,IIPDPG) 1159 : GOTO 510 1160 : C_______________________________________________________________________ 1161 : C 1162 : C RACCORDS LIQUIDE/MASSIF,RACCORD LIQUIDE/COQUE,BARRE,HOMOGENEISE,JOT3 1163 : C JOI4,JOI2,JOI1 1164 : C_______________________________________________________________________ 1165 : C 1166 : 12 CONTINUE 1166 : CALL MASSE4(IPMAIL,LW,LRE,IVAMAT,NMATT,IVACAR,NCARR,IVECT,NBPGAU, 1167 : &IPMINT,NDDL,MELE,MFR,IPMATR,ILUMP,isouss,IIPDPG,imod) 1168 : GOTO 510 1169 : C_______________________________________________________________________ 1170 : C 1171 : C COQ3/POUTRE,DKT,COQ4,COQ8,COQ2 ,DST, POUTRE DE TIMOSCHENKO 1172 : C_______________________________________________________________________ 1173 : C 1174 : 27 CONTINUE 1174 : CALL MASSE3(IPMAIL,LRE,LW,MELE,IVAMAT,NMATT,IVACAR,NCARR, 1175 : &IVECT,isouss,NBPGAU,IPMINT,IPMIN1,NDDL,MATE, 1176 : &CMATE,LHOTRA,IPMATR,ILUMP,IIPDPG,imod) 1177 : GOTO 510 1178 : C_______________________________________________________________________ 1179 : C 1180 : C ELEMENT LINESPRING CA NE PESE RIEN 1181 : C_______________________________________________________________________ 1182 : C 1183 : 30 CONTINUE 1184 : * DO 3030 IB=1,NBELEM 1185 : * SEGINI XMATRI 1186 : * IMATTT(IB)=XMATRI 1187 : * SEGDES XMATRI 1188 : * 3030 CONTINUE 1189 : GOTO 510 1190 : CC______________________________________________________________________ 1191 : C 1192 : C ELEMENT TUYAU FISSURE CA NE PESE RIEN 1193 : C_______________________________________________________________________ 1194 : C 1195 : 43 CONTINUE 1196 : * DO 3043 IB=1,NBELEM 1197 : * SEGINI XMATRI 1198 : * IMATTT(IB)=XMATRI 1199 : * SEGDES XMATRI 1200 : * 3043 CONTINUE 1201 : GOTO 510 1202 : C_______________________________________________________________________ 1203 : C 1204 : C ELEMENT LIA2 (LIAISON A 2 NOEUDS) CA NE PESE RIEN 1205 : C_______________________________________________________________________ 1206 : C 1207 : 50 CONTINUE 1208 : * DO 3050 IB=1,NBELEM 1209 : * SEGINI XMATRI 1210 : * IMATTT(IB)=XMATRI 1211 : * SEGDES XMATRI 1212 : * 3050 CONTINUE 1213 : GOTO 510 1214 : C_______________________________________________________________________ 1215 : C 1216 : C ELEMENT XFEM (MFR = 63) 1217 : C_______________________________________________________________________ 1218 : C Le sous-programme MASSXR gere les appels aux elements de type XFEM 1219 : C (imoxfem est le modele complet ou partitionne si necessaire) 1220 : 63 CONTINUE 1220 : CALL MASSXR (isouss,imoxfem, 1221 : $ IVAMAT,IVACAR,NMATT,CMATE, IIPDPG,IPMASS,IRETER) 1222 : IF (IRETER.NE.0) RETURN 1223 : if (nblprt.GT.1) THEN 1224 : imode1 = imoxfem 1225 : segsup,imode1 1226 : endif 1227 : C il n'y aura plus que les desactivations a faire 1228 : GOTO 510 1229 : C_______________________________________________________________________ 1230 : C 1231 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA 1232 : C_______________________________________________________________________ 1233 : C 1234 : 510 CONTINUE 1235 : SEGDES MELEME 1236 : C 1237 : IF (ISUP.EQ.1) THEN 1237 : CALL DTMVAL(IVACAR,3) 1238 : ELSE 1238 : CALL DTMVAL(IVACAR,1) 1239 : ENDIF 1240 : 1241 : if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 519 1242 : IF (ISUP.EQ.1) THEN 1242 : CALL DTMVAL(IVAMAT,3) 1243 : ELSE 1243 : CALL DTMVAL(IVAMAT,1) 1244 : ENDIF 1245 : 519 continue 1246 : C 1247 : NOMID=MOCARA 1248 : IF (MOCARA.NE.0) SEGSUP NOMID 1249 : NOMID=MOMATR 1250 : SEGSUP NOMID 1251 : if(mfr.ne.63) then 1252 : NOMID=MOFORC 1253 : if(lsupfo)SEGSUP NOMID 1254 : NOMID=MODEPL 1255 : if(lsupdp)SEGSUP NOMID 1256 : endif 1257 : C 1258 : * INFO=IPINF 1259 : * SEGSUP INFO 1260 : C 1261 : C ERREUR DANS LES S-P MASSE2 ,MASSE3 ,MASSE4 1262 : C 1263 : IF (IERR.NE.0) GOTO 888 1264 : * 1265 : * Fin de la boucle (5000) de PARTITIONNEMENT du segment XMATRI 1266 : 5000 CONTINUE 1267 : * 1268 : if(mele.ne.260) SEGDES MINTE 1269 : SEGDES IMODEL 1270 : * 1271 : *----------------------------------------------------------------------- 1272 : * Fin de la boucle sur les sous-zones du modele 1273 : *----------------------------------------------------------------------- 1274 : 500 CONTINUE 1275 : 1276 : IF (isouss.NE.IRIGEL(/2)) THEN 1277 : NRIGEL = isouss 1278 : SEGADJ,MRIGID 1279 : ENDIF 1280 : 1281 : *termes croises 'STATIQUE'/'MODAL' 1282 : nstat = kstat 1283 : nmoda = kmoda 1284 : segadj modsta 1285 : if (kstat.ne.0) then 1285 : if (nstat.gt.0.and.nstat+nmoda.gt.0) call ricroi(modsta, ir2,1) 1286 : if (nstat.gt.0) then 1287 : do kstat=1,nstat 1288 : mptval = ivstat(kstat) 1289 : segact mptval 1290 : IF (ISUP.EQ.1) THEN 1290 : CALL DTMVAL(mptval,3) 1291 : ELSE 1291 : CALL DTMVAL(mptval,1) 1292 : ENDIF 1293 : enddo 1294 : endif 1295 : if (nmoda.gt.0) then 1296 : do kmoda=1,nmoda 1297 : mptval = ivmoda(kmoda) 1298 : segact mptval 1299 : IF (ISUP.EQ.1) THEN 1299 : CALL DTMVAL(mptval,3) 1300 : ELSE 1300 : CALL DTMVAL(mptval,1) 1301 : ENDIF 1302 : enddo 1303 : endif 1304 : endif 1305 : IRET = 1 1306 : 1307 : 888 CONTINUE 1308 : if (nstat.gt.0.and.nstat+nmoda.gt.1) then 1309 : ir1 = mrigid 1309 : call fusrig(ir1,ir2,ir3) 1310 : mrigid = ir3 1311 : ipmass = mrigid 1312 : endif 1313 : segsup modsta 1314 : SEGDES MRIGID 1315 : GOTO 666 1316 : C 1317 : C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR 1318 : C 1319 : 9990 CONTINUE 1320 : IRET=0 1321 : C 1322 : IF (ISUP.EQ.1) THEN 1322 : CALL DTMVAL(IVAMAT,3) 1322 : CALL DTMVAL(IVACAR,3) 1323 : ELSE 1323 : CALL DTMVAL(IVAMAT,1) 1323 : CALL DTMVAL(IVACAR,1) 1324 : ENDIF 1325 : C 1326 : NOMID=MOMATR 1327 : IF (MOMATR.NE.0) SEGSUP NOMID 1328 : NOMID=MOCARA 1329 : IF (MOCARA.NE.0) SEGSUP NOMID 1330 : if(mfr.ne.63) then 1331 : NOMID=MOFORC 1332 : if(lsupfo)SEGSUP NOMID 1333 : NOMID=MODEPL 1334 : if(lsupdp)SEGSUP NOMID 1335 : endif 1336 : if(mele.ne.260) SEGDES MINTE 1337 : C 1338 : 9996 CONTINUE 1339 : SEGDES MELEME 1340 : SEGDES IMODEL 1341 : SEGSUP MRIGID 1342 : C 1343 : 666 CONTINUE 1344 : MMODEL = IPMODL 1345 : * SEGDES MMODEL 1346 : SEGSUP,MMODEL 1347 : 1348 : RETURN 1349 : END 1350 : 1351 : 1352 : 1353 : 1354 :
© Cast3M 2003 - All rights reserved.
Disclaimer