1 : C AMOR1 SOURCE FANDEUR 13/01/29 21:15:05 7683 2 : 3 : SUBROUTINE AMOR1(MODORI,IPCHE1,ICAS,IPRIG) 4 : 5 : *---------------------------------------------------------------------* 6 : * * 7 : * OPERATEUR AMORTISSEMENT VISQUEUX * 8 : * * 9 : *---------------------------------------------------------------------* 10 : * * 11 : * CE SOUS-PROGRAMME SERT A TRAITER ET A METTRE EN FORME * 12 : * LES INFORMATIONS NECESSAIRES POUR LES CALCULS * 13 : * * 14 : *---------------------------------------------------------------------* 15 : * * 16 : * ENTREES : * 17 : * ________ * 18 : * * 19 : * IPMODL Pointeur sur le modele * 20 : * IPCHE1 Pointeur sur le chamelem de carateristiques * 21 : * ICAS 1 si matrice d amortissement * 22 : * 2 si matrice de rigidite antisymetrique * 23 : * 3 si matrice d amortissement en frequentiel * 24 : * (amortissement corotatif) * 25 : * * 26 : * SORTIES : * 27 : * ________ * 28 : * * 29 : * IPRIG pointeur sur la rigidite construite * 30 : * =0 en cas d'erreur (et IERR non nul) * 31 : * * 32 : *---------------------------------------------------------------------* 33 : 34 : IMPLICIT INTEGER(I-N) 35 : IMPLICIT REAL*8(A-H,O-Z) 36 : * 37 : -INC CCOPTIO 38 : -INC CCHAMP 39 : -INC CCGEOME 40 : -INC CCREEL 41 : * 42 : -INC SMCHAML 43 : -INC SMINTE 44 : -INC SMELEME 45 : -INC SMRIGID 46 : -INC SMMODEL 47 : -INC SMCOORD 48 : -INC SMLREEL 49 : * 50 : INTEGER oooval 51 : 52 : SEGMENT INFO 53 : INTEGER INFELL(JG) 54 : ENDSEGMENT 55 : * 56 : SEGMENT NOTYPE 57 : CHARACTER*16 TYPE(NBTYPE) 58 : ENDSEGMENT 59 : * 60 : SEGMENT MPTVAL 61 : INTEGER IPOS(NS) ,NSOF(NS) 62 : INTEGER IVAL(NCOSOU) 63 : CHARACTER*16 TYVAL(NCOSOU) 64 : ENDSEGMENT 65 : * 66 : segment modsta 67 : integer pimoda(nmoda),pistat(nstat) 68 : integer ivmoda(nmoda),ivstat(nstat) 69 : endsegment 70 : * 71 : CHARACTER*8 CMATE 72 : CHARACTER*(NCONCH) CONM 73 : 74 : PARAMETER ( INTTYP=3 ) 75 : * INTTYP DEFINIT LE TYPE DE POINTS D'INTEGRATION 76 : * UTILISE PAR RIGI 77 : PARAMETER ( NINF=3 ) 78 : INTEGER INFOS(NINF) 79 : * 80 : LOGICAL lsupfo,lsupde,bdpge,brend,lsupma,dcmate,dcmat2,dcmoda 81 : * 82 : IPRIG = 0 83 : * 84 : * VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES 85 : * ZZZZZZZZ PEUT ETRE A FAIRE PLUTOT SUR LES SOUS-ZONES 86 : * 87 : ISUP1 = 0 87 : CALL QUESUP(IPMODL,IPCHE1,INTTYP,0,ISUP1,IRET1) 88 : IF (ISUP1.GT.1) RETURN 89 : ISUPM = ISUP1 90 : ISUPC = ISUP1 91 : IPCHE2 = 0 92 : * 93 : * ACTIVATION DU MODELE 94 : * -------------------- 95 : * MODORI = Modele initial complet 96 : * IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX") 96 : CALL PIMODL(MODORI,IPMODL) 97 : IF (IPMODL.EQ.0) RETURN 98 : * IPMODL est ACTIF en retour (nouveau pointeur pouvant etre detruit) 99 : MMODEL=IPMODL 100 : NSOUS = KMODEL(/1) 101 : * 102 : * INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE 103 : * --------------------------------------------- 104 : JRIGE = 0 105 : NRIGEL = 0 106 : SEGINI MRIGID 107 : MTYMAT = 'RIGIDITE' 108 : * IFORIG = IFOMOD 109 : IFORIG = IFOUR 110 : ICHOLE = 0 111 : IMGEO1 = 0 112 : IMGEO2 = 0 113 : ISUPEQ = 0 114 : * termes croises STATIQUE et/ou MODAL 115 : nstat = 100 116 : kstat = 0 117 : nmoda = 100 118 : kmoda = 0 119 : segini modsta 120 : * 121 : *--------------------------------------------------------------------* 122 : * 123 : * BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF ) 124 : * 125 : *--------------------------------------------------------------------* 126 : * 127 : DO 500 ISOMO=1,NSOUS 128 : 129 : IMODEL = KMODEL(ISOMO) 130 : SEGACT,IMODEL 131 : * 132 : * INITIALISATIONS 133 : * 134 : IPMINT = 0 135 : IPMIN1 = 0 136 : 137 : MOMATR = 0 138 : MOCARA = 0 139 : MOTYPM = 0 140 : MOTYPC = 0 141 : 142 : MODEPL = 0 143 : MOFORC = 0 144 : lsupde = .false. 145 : lsupfo = .false. 146 : 147 : IDESCR = 0 148 : 149 : C- Recuperation d'informations sur le maillage elementaire 150 : IPT1 = IMAMOD 151 : SEGACT,IPT1 152 : NBNOE1 = IPT1.NUM(/1) 153 : NBELE1 = IPT1.NUM(/2) 154 : 155 : C- Quelques informations sur le modele 156 : IF (FORMOD(1).EQ.'LIAISON') GOTO 599 157 : 158 : IIPDPG=IPDPGE 159 : MELE = NEFMOD 160 : 161 : CONM = CONMOD 162 : CMATE = CMATEE 163 : MATE = IMATEE 164 : INAT = INATUU 165 : dcmate = .false. 166 : dcmat2 = .false. 167 : dcmoda = .false. 168 : 169 : do im = 1,matmod(/2) 170 : if (matmod(im).eq.'IMPEDANCE') then 171 : dcmate =.true. 172 : if(tymode(/2).gt.0)then 173 : if(tymode(1).eq.'LISTMOTS') dcmat2 = .true. 174 : endif 175 : endif 176 : enddo 177 : 178 : IRTD = 1 178 : CALL IDENT(IPT1,CONM,IPCHE1,IPCHE2, INFOS,IRTD) 179 : IF (IRTD.EQ.0) GOTO 599 180 : 181 : C 182 : C- Recuperation d'informations sur l'element fini 183 : c 184 : C COQUE INTEGREE OU PAS ? 185 : IF (INFMOD(/1).NE.0)THEN 186 : NPINT=INFMOD(1) 187 : ELSE 188 : NPINT=0 189 : ENDIF 190 : 191 : * write(6,*) ' infmod(/1) inttyp ',infmod(/1),inttyp 192 : if (infmod(/1).lt.2+inttyp) then 192 : CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL) 193 : IF ( IERR.NE.0 ) GOTO 599 194 : INFO = IPINF 195 : LHOOK = INFELL(10) 196 : NSTRS = INFELL(16) 197 : MFR = INFELL(13) 198 : LW = INFELL(7) 199 : LRE = INFELL(9) 200 : NDDL = INFELL(15) 201 : IELE = INFELL( 14) 202 : IPORE = INFELL(8) 203 : IPMINT= INFELL(11) 204 : IPMIN1= INFELL(12) 205 : NBPGAU= INFELL( 6) 206 : C* ICARA = INFELL( 5) 207 : segsup info 208 : ELSE 209 : LHOOK = INFELE(10) 210 : NSTRS = INFELE(16) 211 : MFR = INFELE(13) 212 : LW = INFELE(7) 213 : LRE = INFELE(9) 214 : NDDL = INFELE(15) 215 : IELE = INFELE( 14) 216 : IPORE = INFELE(8) 217 : IPMINT=INFMOD(2+INTTYP) 218 : C* IPMINT = INFELE(11) 219 : IPMIN1= INFMOD(8) 220 : NBPGAU= INFELE( 6) 221 : C* ICARA = INFELE( 5) 222 : ENDIF 223 : c* LHOO2 = LHOOK*LHOOK 224 : 225 : bdpge = IFOUR.EQ.-3 .AND. MFR.NE.35 .AND. MFR.NE.53 226 : 227 : IPPORE=0 228 : IF(MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN 229 : IPPORE=NBNNE(NUMGEO(MELE)) 230 : ENDIF 231 : 232 : MINTE = IPMINT 233 : IF (IPMINT.NE.0) SEGACT,MINTE 234 : * 235 : C- RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX 236 : * 237 : if (lnomid(1).ne.0) then 238 : modepl=lnomid(1) 239 : else 240 : lsupde=.true. 240 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEPL,NDUM) 241 : endif 242 : nomid=MODEPL 243 : segact nomid 244 : ndepl=lesobl(/2) 245 : c* ndum = lesfac(/1) 246 : * 247 : if (lnomid(2).ne.0) then 248 : moforc = lnomid(2) 249 : else 250 : lsupfo=.true. 250 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NDUM) 251 : endif 252 : nomid=MOFORC 253 : segact nomid 254 : nforc=lesobl(/2) 255 : c* ndum = lesfac(/1) 256 : * 257 : IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN 257 : CALL ERREUR(5) 258 : GOTO 598 259 : ENDIF 260 : * 261 : * REMPLISSAGE DU SEGMENT DESCRIPTEUR 262 : * 263 : NCOMP = NDEPL 264 : NBNNS = NBNOE1 265 : NBNN = NBNOE1 266 : *PV idecap pas defini 267 : ** IF (MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN 268 : ** NCOMP = NDEPL-IDECAP 269 : ** ENDIF 270 : IF (bdpge) THEN 271 : NCOMP = NDEPL-3 272 : NBNN = NBNOE1 + 1 273 : ENDIF 274 : IF (MFR.EQ.19.OR.MFR.EQ.21) THEN 275 : NBNNS = NBNN / 2 276 : ENDIF 277 : if (dcmat2) NCOMP = NDEPL/2 278 : * 279 : NFAC = NBNNS 280 : IF (MELE.GE.108.AND.MELE.LE.110) 281 : & NFAC = MIN(NFAC,(3*NBNN-IPORE)/2) 282 : * 283 : NLIGRP = LRE 284 : NLIGRD = LRE 285 : * erreur dans les dimensions de DESCR 286 : * le mode de calcul n'est pas correct 287 : IF (NBNNS*NCOMP .GT. NLIGRD) THEN 287 : CALL ERREUR(717) 288 : GOTO 598 289 : ENDIF 290 : 291 : SEGINI,DESCR 292 : 293 : IDDL = 1 294 : DO 1004 INOEUD=1,NFAC 295 : DO 1005 ICOMP=1,NCOMP 296 : NOMID=MODEPL 297 : LISINC(IDDL)=LESOBL(ICOMP) 298 : if (dcmat2) LISINC(IDDL)=LESOBL(IDDL) 299 : NOMID=MOFORC 300 : if (dcmat2) LISDUA(IDDL)=LESOBL(IDDL) 301 : LISDUA(IDDL)=LESOBL(ICOMP) 302 : NOELEP(IDDL)=INOEUD 303 : NOELED(IDDL)=INOEUD 304 : IDDL=IDDL+1 305 : 1005 CONTINUE 306 : 1004 CONTINUE 307 : * 308 : * CAS DES ELEMENT RACCORD 309 : * 310 : IF (MFR.EQ.19.OR.MFR.EQ.21) THEN 310 : CALL IDDEPL(MFR+1000,IFOUR,MODPL,NDEPL,NDUM) 310 : CALL IDFORC(MFR+1000,IFOUR,MOFRC,NFORC,NDUM) 311 : NOMID=MODPL 312 : SEGACT NOMID 313 : NOMID=MOFRC 314 : SEGACT NOMID 315 : DO 1106 INOEUD=NBNNS+1,NBNN 316 : DO 1107 ICOMP=1,NDEPL 317 : NOMID=MODPL 318 : LISINC(IDDL)=LESOBL(ICOMP) 319 : NOMID=MOFRC 320 : LISDUA(IDDL)=LESOBL(ICOMP) 321 : NOELEP(IDDL)=INOEUD 322 : NOELED(IDDL)=INOEUD 323 : IDDL=IDDL+1 324 : 1107 CONTINUE 325 : 1106 CONTINUE 326 : NOMID=MODPL 327 : SEGSUP,NOMID 328 : NOMID=MOFRC 329 : SEGSUP,NOMID 330 : ENDIF 331 : * 332 : SEGDES,DESCR 333 : IDESCR = DESCR 334 : * 335 : * TRAITEMENT DES CHAMPS EN ENTREE 336 : * ------------------------------- 337 : * 338 : NBROBL = 0 339 : NBRFAC = 0 340 : NOMID = 0 341 : NOTYPE = 0 342 : * 343 : * >>> CHAMP DE MATERIAU 344 : * 345 : C* IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN 346 : IF (FORMOD(1).EQ.'MECANIQUE'.AND.MATE.EQ.1) THEN 347 : IF (MFR.EQ.35) THEN 348 : NBROBL=2 349 : SEGINI NOMID 350 : LESOBL(1)='KS ' 351 : LESOBL(2)='KN ' 352 : ELSE IF(MFR.EQ.53) THEN 353 : NBROBL=1 354 : SEGINI,NOMID 355 : LESOBL(1)='KS ' 356 : ELSE 357 : NBROBL=2 358 : SEGINI NOMID 359 : LESOBL(1)='VISQ' 360 : LESOBL(2)='NU ' 361 : ENDIF 362 : NBTYPE=1 363 : SEGINI NOTYPE 364 : TYPE(1)='REAL*8' 365 : C* ELSE IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN 366 : ELSE IF (FORMOD(1).EQ.'MECANIQUE'.AND.MATE.EQ.4) THEN 367 : IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN 368 : NBROBL=7 369 : SEGINI NOMID 370 : LESOBL(1)='VISQ' 371 : LESOBL(2)='V1X ' 372 : LESOBL(3)='V1Y ' 373 : LESOBL(4)='V1Z ' 374 : LESOBL(5)='V2X ' 375 : LESOBL(6)='V2Y ' 376 : LESOBL(7)='V2Z ' 377 : ELSE 378 : NBROBL=3 379 : SEGINI NOMID 380 : LESOBL(1)='VISQ' 381 : LESOBL(2)='V1X ' 382 : LESOBL(3)='V1Y ' 383 : ENDIF 384 : NBTYPE=1 385 : SEGINI NOTYPE 386 : TYPE(1)='REAL*8' 387 : * 388 : C* ELSE IF (INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN 389 : ELSEIF(INAT.EQ.67.AND. MATE.EQ.2) THEN 390 : NBROBL=6 391 : SEGINI NOMID 392 : LESOBL(1)='YG1 ' 393 : LESOBL(2)='YG2 ' 394 : LESOBL(3)='NU12' 395 : LESOBL(4)='G12 ' 396 : LESOBL(5)='V1X ' 397 : LESOBL(6)='V1Y ' 398 : NBTYPE=1 399 : SEGINI NOTYPE 400 : TYPE(1)='REAL*8' 401 : * 402 : C* ELSEIF (CMATE.EQ.'SECTION') THEN 403 : ELSE IF (MATE.EQ.11) THEN 404 : C 405 : C MODELE ET MATERIAU DE LA SECTION DU MODELE A FIBRE 406 : C 407 : NBROBL=2 408 : SEGINI NOMID 409 : LESOBL(1)='MODS' 410 : LESOBL(2)='MATS' 411 : NBTYPE=2 412 : SEGINI NOTYPE 413 : TYPE(1)='POINTEURMMODEL' 414 : TYPE(2)='POINTEURMCHAML' 415 : C 416 : ELSEIF (CMATE.EQ.'MODAL') THEN 417 : NBROBL=3 418 : NBRFAC=1 419 : SEGINI NOMID 420 : LESOBL(1)='FREQ' 421 : LESOBL(2)='MASS' 422 : LESOBL(3)='DEFO' 423 : LESFAC(1) ='AMOR' 424 : NBTYPE=4 425 : SEGINI NOTYPE 426 : TYPE(1)='REAL*8' 427 : TYPE(2)='REAL*8' 428 : TYPE(3)='POINTEURCHPOINT' 429 : TYPE(4)='REAL*8' 430 : 431 : ELSEIF (CMATE.EQ.'STATIQUE') THEN 432 : NBROBL=3 433 : NBRFAC=1 434 : SEGINI NOMID 435 : LESOBL(1)='DEFO' 436 : LESOBL(2)='RIDE' 437 : LESOBL(3)='MADE' 438 : LESFAC(1) ='AMOR' 439 : NBTYPE=4 440 : SEGINI NOTYPE 441 : TYPE(1)='POINTEURCHPOINT' 442 : TYPE(2)='POINTEURCHPOINT' 443 : TYPE(3)='POINTEURCHPOINT' 444 : TYPE(4)='REAL*8' 445 : * 446 : * IMPEDANCE COMPLEXE 447 : * 448 : ELSE IF (CMATE.EQ.'IMPCOMPL') THEN 449 : NBROBL=0 450 : NBRFAC=1 451 : SEGINI NOMID 452 : MOMATR=NOMID 453 : LESFAC(1)='AMOR' 454 : * 455 : NBTYPE=1 456 : SEGINI NOTYPE 457 : MOTYPE=NOTYPE 458 : TYPE(1)='REAL*8' 459 : * 460 : ELSE 460 : C* CALL IDMATR(MFR,IMODEL,MOMATR,NBROBL,NBRFAC) 461 : C* NOMID = MOMATR 462 : C* NBTYPE=1 463 : C* SEGINI NOTYPE 464 : C* TYPE(1)='REAL*8' 465 : ENDIF 466 : * 467 : IF (dcmate) THEN 468 : 469 : NBROBL=0 470 : NBRFAC=2 471 : SEGINI NOMID 472 : MOMATR=NOMID 473 : LESFAC(1) ='AMOR' 474 : LESFAC(2) ='AROT' 475 : * 476 : NBTYPE=1 477 : SEGINI NOTYPE 478 : MOTYPE=NOTYPE 479 : TYPE(1)='REAL*8' 480 : 481 : ENDIF 482 : 483 : * 484 : MOMATR = NOMID 485 : MOTYPM = NOTYPE 486 : * 487 : NMATR = NBROBL 488 : NMATF = NBRFAC 489 : NMATT = NMATR+NMATF 490 : * 491 : * >>> CHAMPS DE CARACTERISTIQUES 492 : * 493 : NBROBL = 0 494 : NBRFAC = 0 495 : IVECT = 0 496 : NOMID = 0 497 : NOTYPE = 0 498 : * 499 : * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES 500 : * 501 : IF ((MFR.EQ.1.OR.MFR.EQ.31.OR. 502 : + ((MELE.GE.79.AND.MELE.LE.83).OR. 503 : + (MELE.GE.173.AND.MELE.LE.182))) 504 : + .AND.IFOUR.EQ.-2)THEN 505 : NBRFAC=1 506 : SEGINI NOMID 507 : LESFAC(1)='DIM3' 508 : * 509 : NBTYPE=1 510 : SEGINI NOTYPE 511 : TYPE(1)='REAL*8' 512 : * 513 : * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES 514 : * 515 : ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 516 : NBROBL=1 517 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN 518 : NBRFAC=2 519 : ELSE 520 : NBRFAC=1 521 : ENDIF 522 : SEGINI NOMID 523 : LESOBL(1)='EPAI' 524 : LESFAC(1)='EXCE' 525 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3' 526 : * 527 : NBTYPE=1 528 : SEGINI NOTYPE 529 : TYPE(1)='REAL*8' 530 : * 531 : * SECTION POUR LES BARRES ET LES CERCES 532 : * 533 : ELSE IF (MFR.EQ.27) THEN 534 : IF(.NOT.(dcmate.or.dcmoda)) THEN 535 : NBROBL=1 536 : SEGINI NOMID 537 : LESOBL(1)='SECT' 538 : * 539 : NBTYPE=1 540 : SEGINI NOTYPE 541 : TYPE(1)='REAL*8' 542 : ENDIF 543 : * 544 : * section, excentrements et orientation pour les barres excentrees 545 : * 546 : ELSE IF (MFR.EQ.49) THEN 547 : NBROBL=6 548 : SEGINI NOMID 549 : LESOBL(1)='SECT' 550 : LESOBL(2)='EXCZ' 551 : LESOBL(3)='EXCY' 552 : LESOBL(4)='VX ' 553 : LESOBL(5)='VY ' 554 : LESOBL(6)='VZ ' 555 : 556 : NBTYPE=1 557 : SEGINI NOTYPE 558 : TYPE(1)='REAL*8' 559 : 560 : * CARACTERISTIQUES POUR LES POUTRES 561 : * 562 : ELSE IF (MFR.EQ.7 ) THEN 563 : if (dcmate) then 564 : NBROBL=0 565 : NBRFAC=1 566 : SEGINI NOMID 567 : MOCARA=NOMID 568 : LESFAC(1)='VECT' 569 : IVECT=1 570 : * 571 : NBTYPE=1 572 : SEGINI NOTYPE 573 : MOTYPE=NOTYPE 574 : TYPE(1)='POINTEURPOINT ' 575 : else 576 : C MODELE A FIBRE 577 : C* IF (CMATE.EQ.'SECTION') THEN 578 : IF (MATE.EQ.11) THEN 579 : IF (ICAS.EQ.2) THEN 580 : NBRFAC=2 581 : SEGINI NOMID 582 : LESFAC(1)='OMEG' 583 : LESFAC(2)='VECT' 584 : IVECT=1 585 : NBTYPE=2 586 : SEGINI NOTYPE 587 : TYPE(1)='REAL*8' 588 : TYPE(2)='POINTEURPOINT ' 589 : ELSE 590 : NBRFAC=1 591 : SEGINI NOMID 592 : LESFAC(1)='VECT' 593 : IVECT=1 594 : NBTYPE=1 595 : SEGINI NOTYPE 596 : TYPE(1)='POINTEURPOINT ' 597 : ENDIF 598 : * 599 : * POUTRE STANDARD 600 : * CAS 2D 601 : * 602 : ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 603 : NBROBL=2 604 : NBRFAC=1 605 : SEGINI NOMID 606 : LESOBL(1)= 'SECT' 607 : LESOBL(2)= 'INRZ' 608 : LESFAC(1)= 'SECY' 609 : * 610 : NBTYPE=1 611 : SEGINI NOTYPE 612 : TYPE(1)='REAL*8' 613 : 614 : * CAS 3D 615 : * 616 : ELSE 617 : * 618 : * AMORTISSEMENT COROTATIF 619 : * 620 : IF (ICAS.EQ.2) THEN 621 : NBROBL=4 622 : NBRFAC=4 623 : SEGINI NOMID 624 : LESOBL(1)='TORS' 625 : LESOBL(2)='INRY' 626 : LESOBL(3)='INRZ' 627 : LESOBL(4)='SECT' 628 : LESFAC(1)='SECY' 629 : LESFAC(2)='SECZ' 630 : LESFAC(3)='OMEG' 631 : LESFAC(4)='VECT' 632 : IVECT=1 633 : * 634 : NBTYPE=8 635 : SEGINI NOTYPE 636 : TYPE(1)='REAL*8' 637 : TYPE(2)='REAL*8' 638 : TYPE(3)='REAL*8' 639 : TYPE(4)='REAL*8' 640 : TYPE(5)='REAL*8' 641 : TYPE(6)='REAL*8' 642 : TYPE(7)='REAL*8' 643 : TYPE(8)='POINTEURPOINT ' 644 : ELSE 645 : * 646 : * AMORTISSEMENT STANDARD 647 : * 648 : NBROBL=4 649 : NBRFAC=3 650 : SEGINI NOMID 651 : LESOBL(1)='TORS' 652 : LESOBL(2)='INRY' 653 : LESOBL(3)='INRZ' 654 : LESOBL(4)='SECT' 655 : LESFAC(1)='SECY' 656 : LESFAC(2)='SECZ' 657 : LESFAC(3)='VECT' 658 : IVECT=1 659 : * 660 : NBTYPE=7 661 : SEGINI NOTYPE 662 : TYPE(1)='REAL*8' 663 : TYPE(2)='REAL*8' 664 : TYPE(3)='REAL*8' 665 : TYPE(4)='REAL*8' 666 : TYPE(5)='REAL*8' 667 : TYPE(6)='REAL*8' 668 : TYPE(7)='POINTEURPOINT ' 669 : ENDIF 670 : ENDIF 671 : endif 672 : * 673 : * CARACTERISTIQUES POUR LES TUYAUX 674 : * 675 : ELSE IF (MFR.EQ.13) THEN 676 : IF (ICAS.EQ.2) THEN 677 : NBROBL=2 678 : NBRFAC=5 679 : SEGINI NOMID 680 : LESOBL(1)='EPAI' 681 : LESOBL(2)='RAYO' 682 : LESFAC(1)='RACO' 683 : LESFAC(2)='PRES' 684 : LESFAC(3)='CISA' 685 : LESFAC(4)='OMEG' 686 : LESFAC(5)='VECT' 687 : IVECT=1 688 : * 689 : NBTYPE=7 690 : SEGINI NOTYPE 691 : TYPE(1)='REAL*8' 692 : TYPE(2)='REAL*8' 693 : TYPE(3)='REAL*8' 694 : TYPE(4)='REAL*8' 695 : TYPE(5)='REAL*8' 696 : TYPE(6)='REAL*8' 697 : TYPE(7)='POINTEURPOINT ' 698 : ELSE 699 : NBROBL=2 700 : NBRFAC=4 701 : SEGINI NOMID 702 : LESOBL(1)='EPAI' 703 : LESOBL(2)='RAYO' 704 : LESFAC(1)='RACO' 705 : LESFAC(2)='PRES' 706 : LESFAC(3)='CISA' 707 : LESFAC(4)='VECT' 708 : IVECT=1 709 : * 710 : NBTYPE=6 711 : SEGINI NOTYPE 712 : TYPE(1)='REAL*8' 713 : TYPE(2)='REAL*8' 714 : TYPE(3)='REAL*8' 715 : TYPE(4)='REAL*8' 716 : TYPE(5)='REAL*8' 717 : TYPE(6)='POINTEURPOINT ' 718 : ENDIF 719 : * 720 : ELSE IF (MFR.EQ.39) THEN 721 : IF (ICAS.EQ.2) THEN 722 : NBROBL=2 723 : NBRFAC=4 724 : SEGINI NOMID 725 : LESOBL(1)='EPAI' 726 : LESOBL(2)='RAYO' 727 : LESFAC(1)='RACO' 728 : LESFAC(2)='PRES' 729 : LESFAC(3)='OMEG' 730 : LESFAC(4)='VECT' 731 : IVECT=1 732 : 733 : NBTYPE=6 734 : SEGINI NOTYPE 735 : TYPE(1)='REAL*8' 736 : TYPE(2)='REAL*8' 737 : TYPE(3)='REAL*8' 738 : TYPE(4)='REAL*8' 739 : TYPE(5)='REAL*8' 740 : TYPE(6)='POINTEURPOINT ' 741 : 742 : ELSE 743 : NBROBL=2 744 : NBRFAC=3 745 : SEGINI NOMID 746 : LESOBL(1)='EPAI' 747 : LESOBL(2)='RAYO' 748 : LESFAC(1)='RACO' 749 : LESFAC(2)='PRES' 750 : LESFAC(3)='VECT' 751 : IVECT=1 752 : 753 : NBTYPE=5 754 : SEGINI NOTYPE 755 : TYPE(1)='REAL*8' 756 : TYPE(2)='REAL*8' 757 : TYPE(3)='REAL*8' 758 : TYPE(4)='REAL*8' 759 : TYPE(5)='POINTEURPOINT ' 760 : ENDIF 761 : ENDIF 762 : 763 : * Rendement : 764 : * Notion non utilisee actuellement (mais conserver a titre historique !) 765 : IF (NOMID.LE.0) THEN 766 : NBROBL = 0 767 : NBRFAC = 0 768 : SEGINI,NOMID 769 : NBTYPE = 0 770 : SEGINI,NOTYPE 771 : ENDIF 772 : ncar1 = NBROBL + NBRFAC + 1 773 : ifac = NBRFAC 774 : NBRFAC = NBRFAC + 10 775 : SEGADJ,NOMID 776 : LESFAC(ifac + 1) = 'REND' 777 : LESFAC(ifac + 2) = 'W1X ' 778 : LESFAC(ifac + 3) = 'W1Y ' 779 : LESFAC(ifac + 4) = 'W1Z ' 780 : LESFAC(ifac + 5) = 'W2X ' 781 : LESFAC(ifac + 6) = 'W2Y ' 782 : LESFAC(ifac + 7) = 'W2Z ' 783 : LESFAC(ifac + 8) = 'REN1' 784 : LESFAC(ifac + 9) = 'REN2' 785 : LESFAC(ifac + 10) = 'REN3' 786 : NBTYPE = NBTYPE + 1 787 : SEGADJ,NOTYPE 788 : TYPE(NBTYPE) = 'REAL*8' 789 : * 790 : MOCARA = NOMID 791 : MOTYPC = NOTYPE 792 : NCARA = NBROBL 793 : NCARF = NBRFAC 794 : NCARR = NCARA+NCARF 795 : 796 : C- Partionnement si necessaire de la matrice d'amortissement 797 : C- determinant ainsi le nombre d'objets elementaires de MRIGID 798 : LTRK = oooval(1,4) 799 : IF (LTRK.EQ.0) LTRK = oooval(1,1) 800 : * Ajout a la taille en mots de la matrice des infos du segment 801 : LSEG = LRE*LRE*NBELE1 + 16 802 : NBLPRT = (LSEG-1)/LTRK + 1 803 : NBLMAX = (NBELE1-1)/NBLPRT + 1 804 : NBLPRT = (NBELE1-1)/NBLMAX + 1 805 : * write(ioimp,*) ' amor1 : nblprt nblmax = ',nblprt,nblmax,nbele1 806 : 807 : C Ajout de la matrice d'AMORTISSEMENT a la matrice globale 808 : C ======================================================== 809 : NRIGE0 = IRIGEL(/2) 810 : NRIGEL = NRIGE0 + NBLPRT 811 : SEGADJ,MRIGID 812 : 813 : descr = IDESCR 814 : meleme = IPT1 815 : nbnn = NBNOE1 816 : nbelem = NBELE1 817 : nbsous = 0 818 : nbref = 0 819 : * 820 : ************************************************************************ 821 : * P H A S E 2 822 : * 823 : * Boucle sur les PARTITIONS elementaires de la matrice 824 : * 825 : ************************************************************************ 826 : isous = 0 827 : DO irige = 1, NBLPRT 828 : 829 : IF (NBLPRT.GT.1) THEN 830 : C- Partitionnement du maillage support de la matrice elementaire 831 : C- (IPT1 peut etre desactive suite a l'appel a KOMCHA !) 832 : SEGACT,IPT1 833 : ielem = (irige-1)*NBLMAX 834 : nbelem = MIN(NBLMAX,NBELE1-ielem) 835 : * write(ioimp,*) ' creation segment ',nbnn,nbelem 836 : SEGINI,meleme 837 : itypel = IPT1.itypel 838 : DO ielt = 1, nbelem 839 : jelt = ielt + ielem 840 : DO inoe = 1, nbnn 841 : num(inoe,ielt) = IPT1.NUM(inoe,jelt) 842 : ENDDO 843 : icolor(ielt) = IPT1.ICOLOR(jelt) 844 : ENDDO 845 : C- Recopie du descripteur 846 : des1 = IDESCR 847 : SEGINI,descr=des1 848 : SEGDES,descr 849 : ENDIF 850 : 851 : C- Cas particulier en DEFO PLAN GENE 852 : IF (bdpge) THEN 853 : c* nbelem = NUM(/2) 854 : nbnn = NBNOE1 + 1 855 : SEGINI,ipt2 856 : ipt2.itypel = 28 857 : DO ielt = 1,nbelem 858 : DO inoe = 1,NBNOE1 859 : ipt2.num(inoe,ielt) = NUM(inoe,ielt) 860 : ENDDO 861 : ipt2.num(nbnn,ielt) = IIPDPG 862 : ipt2.icolor(ielt) = ICOLOR(jelt) 863 : ENDDO 864 : SEGDES,IPT2 865 : nbnn = NBNOE1 866 : ELSE 867 : ipt2 = meleme 868 : ENDIF 869 : 870 : ipmail = meleme 871 : ipdesc = descr 872 : ipmadg = ipt2 873 : 874 : C- Initialisation de la matrice de rigidite elementaire (xmatri) 875 : NELRIG = nbelem 876 : SEGINI,xmatri 877 : ipmatr = xmatri 878 : 879 : C- Recuperation des valeurs des proprietes materiau et geometriques 880 : IVAMAT = 0 881 : IVACAR = 0 882 : brend = .FALSE. 883 : * 883 : CALL KOMCHA(IPCHE1,ipmail,CONM,MOMATR,MOTYPM,1,INFOS,3,IVAMAT) 884 : IF (IERR.NE.0) GOTO 597 885 : IF (ISUPM.EQ.1) THEN 885 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 886 : IF (IERR.NE.0) THEN 887 : ISUPM = 0 888 : GOTO 597 889 : ENDIF 890 : ENDIF 891 : 892 : if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then 893 : mptval = ivamat 894 : segact mptval 894 : if (ival(/1).lt.3) call erreur(5) 895 : endif 896 : if (cmate.eq.'STATIQUE') then 897 : kstat = kstat + 1 898 : ivstat(kstat) = ivamat 899 : pistat(kstat) = imodel 900 : if (kstat.eq.nstat) then 901 : nstat = nstat + 100 902 : segadj modsta 903 : endif 904 : endif 905 : if (cmate.eq.'MODAL') then 906 : kmoda = kmoda + 1 907 : ivmoda(kmoda) = ivamat 908 : pimoda(kmoda) = imodel 909 : if (kmoda.eq.nmoda) then 910 : nmoda = nmoda + 100 911 : segadj modsta 912 : endif 913 : endif 914 : if ((cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE')) then 915 : if (ival(4).eq.0) goto 519 916 : endif 917 : 918 : MPTVAL = IVAMAT 919 : NBGMAT = 0 920 : NELMAT = 0 921 : DO i = 1,NMATT 922 : IF (IVAL(i).NE.0) THEN 923 : MELVAL = IVAL(i) 924 : C* IF (CMATE.EQ.'SECTION') THEN 925 : IF (MATE.EQ.11) THEN 926 : NBGMAT = MAX(NBGMAT,IELCHE(/1)) 927 : NELMAT = MAX(NELMAT,IELCHE(/2)) 928 : ELSE 929 : NBGMAT = MAX(NBGMAT,VELCHE(/1)) 930 : NELMAT = MAX(NELMAT,VELCHE(/2)) 931 : ENDIF 932 : ENDIF 933 : ENDDO 934 : 935 : IF (MOCARA.NE.0) THEN 935 : CALL KOMCHA(IPCHE1,ipmail,CONM,MOCARA,MOTYPC,1, 936 : & INFOS,3,IVACAR) 937 : IF (IERR.NE.0) GOTO 597 938 : IF (ISUPC.EQ.1) THEN 938 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 939 : IF (IERR.NE.0) THEN 940 : ISUPC = 0 941 : GOTO 597 942 : ENDIF 943 : ENDIF 944 : * Rendement : 945 : mptval = IVACAR 946 : IF (ival(/1).GE.ncar1+9) THEN 947 : brend = ival(ncar1+7).GT.0 .OR. ival(ncar1+8).GT.0 .OR. 948 : & ival(ncar1+9).GT.0 949 : ENDIF 950 : ENDIF 951 : 952 : isous = isous + 1 953 : imod = imodel 954 : if (dcmat2.and.mele.eq.2) goto 29 955 : 956 : ************************************************************************ 957 : * P H A S E 3 958 : * 959 : * CALCUL DES RIGIDITES ELEMENTAIRES 960 : * 961 : ************************************************************************ 962 : * 963 : * NUMERO DES ETIQUETTES : 964 : * Les elements sont groupes comme suit : 965 : * - massif,liquide 'surface libre' poreux ----------------------> r 966 : * - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> r 967 : * - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> r 968 : * - joi4,joi2,poutre de timoschenko,joi3 969 : * 970 : * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9 971 : GOTO ( 99, 99, 99, 4, 99, 4, 99, 4, 99, 4, 99 972 : * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT 973 : & , 99, 99, 4 , 4, 4, 4, 99, 99, 99, 99, 99 974 : * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6 975 : & , 4, 4, 4, 4, 27, 27, 29, 29, 99, 99, 99 976 : * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2 977 : & , 99, 4, 4, 4, 4, 4, 4, 27, 29, 29, 27 978 : * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO 979 : & , 29, 29, 99, 4, 27, 99, 99, 99, 4, 4, 99 980 : * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15 981 : & , 27, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 982 : * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10 983 : & , 99, 99, 4, 4, 4, 4, 99, 99, 99, 99, 99 984 : * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4 985 : & , 99, 99, 99, 99, 99, 99, 29, 29, 29, 29, 29 986 : * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3 987 : & , 99, 99, 99, 29, 27, 99, 29, 29, 29, 29, 99 988 : * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8 989 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 990 : * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13 991 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 992 : * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8 993 : & , 99, 29, 29, 29, 99, 99, 99, 99, 99, 99, 99 994 : * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3 995 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 996 : * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126 997 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 998 : * TE56 PY91 TRH6 999 : & , 99, 99, 99),MELE 1000 : C 1001 : C CASE OF THE NEW JOINT ELEMENTS (JCT3 AND JCI4 IN 2D SHEAR) 1002 : C (JGI2 2D GENERALIZED) 1003 : C (JGT3 AND JGI4 GENERALIZED) 1004 : IF (MELE.GE.168.AND.MELE.LE.172)GOTO 29 1005 : IF (MELE.GE.173.OR.MELE.LE.184) GO TO 4 1006 : C 1007 : 99 CONTINUE 1008 : MOTERR(1:4) = NOMTP(MELE) 1009 : MOTERR(9:12)= 'AMOR1' 1009 : CALL ERREUR(86) 1010 : GOTO 510 1011 : C_______________________________________________________________________ 1012 : C 1013 : C massif 1014 : C_______________________________________________________________________ 1015 : C 1016 : 4 CONTINUE 1017 : IF (ICAS.EQ.2) GOTO 99 1017 : CALL AMOR2 (MATE,MELE,ipmail,IPMINT,NBPGAU,LRE,NSTRS,IVAMAT, 1018 : & IVACAR,CMATE,MFR,NBGMAT,NELMAT,1,LHOOK,NMATT, 1019 : & IPORE,NDDL,IPMATR,IIPDPG,ncar1) 1020 : GOTO 510 1021 : C_______________________________________________________________________ 1022 : C 1023 : C coq3,dkt,coq4,coq8,coq2,dst 1024 : C_______________________________________________________________________ 1025 : C 1026 : 27 CONTINUE 1027 : IF (ICAS.EQ.2) GOTO 99 1027 : CALL RIGI3(MATE,MELE,ipmail,IPMINT,IPMIN1,NBPGAU,LRE,NSTRS, 1028 : & IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,1,LHOOK, 1029 : & NMATT,LW,NPINT,IPMATR,IIPDPG) 1030 : GOTO 510 1031 : C_______________________________________________________________________ 1032 : C 1033 : C poutre,tuyau,linespring,tuyau fissure,barre,joints 2-3D 1034 : C poutre de Timoschenko,point 1035 : C_______________________________________________________________________ 1036 : C 1037 : 29 CONTINUE 1038 : n_z = ncar1 - 1 1038 : CALL AMOR4(MATE,MELE,ipmail,IPMINT,NBPGAU,LRE,NSTRS, 1039 : & IVAMAT,IVACAR,IVECT,CMATE,MFR,ICAS,NBGMAT,NELMAT, 1040 : & LHOOK,NMATT,n_z,ISOUS,LW,IPORE,IPMATR,IIPDPG,IMOD) 1041 : GOTO 510 1042 : * 1043 : ************************************************************************ 1044 : * P H A S E 4 1045 : * 1046 : * DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA 1047 : * 1048 : *********************************************************************** 1049 : 510 CONTINUE 1050 : 597 CONTINUE 1051 : if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 518 1052 : IF (ISUPM.EQ.1 .OR. nblprt.GT.1) THEN 1052 : CALL DTMVAL(IVAMAT,3) 1053 : ELSE 1053 : CALL DTMVAL(IVAMAT,1) 1054 : ENDIF 1055 : IF (ISUPC.EQ.1 .OR. nblprt.GT.1) THEN 1055 : CALL DTMVAL(IVACAR,3) 1056 : ELSE 1056 : CALL DTMVAL(IVACAR,1) 1057 : ENDIF 1058 : c* xmatri = ipmatr 1059 : 518 continue 1060 : SEGDES,xmatri 1061 : IF (NBLPRT.GT.1) THEN 1062 : meleme = ipmail 1063 : SEGDES,meleme 1064 : ENDIF 1065 : 1066 : C- Sortie prematuree en cas d'erreur 1067 : IF (IERR.NE.0) GOTO 598 1068 : C- Stockage de la matrice 1069 : jrige = NRIGE0 + isous 1070 : COERIG(jrige) = 1. 1071 : IRIGEL(1,jrige) = ipmadg 1072 : IRIGEL(2,jrige) = 0 1073 : IRIGEL(3,jrige) = ipdesc 1074 : IRIGEL(4,jrige) = ipmatr 1075 : IRIGEL(5,jrige) = NIFOUR 1076 : IRIGEL(6,jrige) = 0 1077 : IF (ICAS.EQ.2) THEN 1078 : IRIGEL(7,jrige) = 2 1079 : ELSE IF (MFR.EQ.57.OR.MFR.EQ.59) THEN 1080 : IRIGEL(7,jrige) = 2 1081 : ELSE IF (brend) THEN 1082 : IRIGEL(7,jrige) = 2 1083 : ELSE 1084 : IRIGEL(7,jrige) = 0 1085 : ENDIF 1086 : IRIGEL(8,jrige) = 0 1087 : 1088 : ENDDO 1089 : C- Fin de la boucle sur les partitions 1090 : * 1091 : 519 continue 1092 : 598 CONTINUE 1093 : IF (MOMATR.NE.0) THEN 1094 : nomid = MOMATR 1095 : SEGSUP,nomid 1096 : notype = MOTYPM 1097 : SEGSUP,notype 1098 : ENDIF 1099 : IF (MOCARA.NE.0) THEN 1100 : nomid = MOCARA 1101 : SEGSUP,nomid 1102 : notype = MOTYPC 1103 : SEGSUP,notype 1104 : ENDIF 1105 : NOMID = MODEPL 1106 : SEGDES,NOMID 1107 : IF (lsupde) SEGSUP,NOMID 1108 : NOMID = MOFORC 1109 : SEGDES,NOMID 1110 : IF (lsupfo) SEGSUP,NOMID 1111 : 599 CONTINUE 1112 : IF (IPMINT.NE.0) SEGDES,MINTE 1113 : SEGDES,IPT1 1114 : SEGDES,IMODEL 1115 : 1116 : C EN CAS D'ERREUR 1117 : IF (IERR.NE.0) GOTO 999 1118 : 1119 : 500 CONTINUE 1120 : C* Fin de la boucle sur les modeles elementaires 1121 : NRIGEL = jrige 1122 : segadj mrigid 1123 : 1124 : *termes croises 'STATIQUE'/'MODAL' 1125 : nstat = kstat 1126 : nmoda = kmoda 1127 : segadj modsta 1128 : if (kstat.ne.0) then 1128 : if (nstat.gt.0.and.nstat+nmoda.gt.0) call ricroi(modsta, ir2,3) 1129 : if (nstat.gt.0) then 1130 : do kstat=1,nstat 1131 : mptval = ivstat(kstat) 1132 : segact mptval 1133 : IF (ISUPM.EQ.1) THEN 1133 : CALL DTMVAL(mptval,3) 1134 : ELSE 1134 : CALL DTMVAL(mptval,1) 1135 : ENDIF 1136 : enddo 1137 : endif 1138 : if (nmoda.gt.0) then 1139 : do kmoda=1,nmoda 1140 : mptval = ivmoda(kmoda) 1141 : segact mptval 1142 : IF (ISUPM.EQ.1) THEN 1142 : CALL DTMVAL(mptval,3) 1143 : ELSE 1143 : CALL DTMVAL(mptval,1) 1144 : ENDIF 1145 : enddo 1146 : endif 1147 : endif 1148 : 1149 : if (nstat.gt.0.and.nstat+nmoda.gt.1) then 1150 : ir1 = mrigid 1150 : call fusrig(ir1,ir2,ir3) 1151 : mrigid = ir3 1152 : endif 1153 : segsup modsta 1154 : 1155 : 999 CONTINUE 1156 : IF (IERR.NE.0) THEN 1157 : SEGSUP,MRIGID 1158 : IPRIG = 0 1159 : ELSE 1160 : SEGDES,MRIGID 1161 : IPRIG = MRIGID 1162 : ENDIF 1163 : 1164 : SEGDES,MMODEL 1165 : 1166 : RETURN 1167 : END 1168 : 1169 : 1170 : 1171 : 1172 :
© Cast3M 2003 - All rights reserved.
Disclaimer