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