1 : C CYNE72 SOURCE KICH 12/06/05 21:15:26 7382 2 : SUBROUTINE CYNE72(ITLB,IWRK52,ITRULI) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : *--------------------------------------------------------------------* 6 : * voir dyne72.eso * 7 : * Op�rateur DYNE : algorithme de Fu - de Vogelaere * 8 : * ________________________________________________ * 9 : * * 10 : * D�termination des param�tres de liaison pour la base B. * 11 : * * 12 : * Param�tres: * 13 : * * 14 : * e ITLB Modele d�crivant les liaisons B * 15 : * e ITCARA Caract�ristiques * 16 : * s NLIAB Nombre total de liaisons sur base B. * 17 : * s NXPALB Maxi du nombre de param�tres d�finissant une liaison. * 18 : * s NPLBB Maxi du nombre de points intervenant dans une liaison. * 19 : * s NPLB Nombre total de points. * 20 : * s IDIMB Dimension de travail des liaisons. * 21 : * s KCPR Segment de points. * 22 : * s NIPALB Maxi du nombre de param�tres d�finissant une liaison. * 23 : * s NIP Nb de pts dans l'evolution de la loi de comportement * 24 : * * 25 : * Auteur, date de cr�ation: * 26 : * * 27 : * Lionel VIVAN, le 21 Septembre 1989. * 28 : * derniere modification: * 29 : * Ibrahim PINTO , 05/1997 * 30 : *--------------------------------------------------------------------* 31 : -INC CCOPTIO 32 : -INC SMCOORD 33 : -INC SMELEME 34 : -INC SMEVOLL 35 : -INC SMLREEL 36 : -INC SMMODEL 37 : -INC SMCHAML 38 : -INC DECHE 39 : ** segment sous-structures dynamiques 40 : segment struli 41 : integer itlia,itbmod,momoda, mostat,itmail,molia 42 : integer ldefo(np1),lcgra(np1),lsstru(np1) 43 : integer nsstru,nndefo,nliab,nsb,na2,idimb 44 : integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas 45 : INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib 46 : * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0) 47 : INTEGER ICHAIN 48 : endsegment 49 : * 50 : SEGMENT,NCPR(XCOOR(/1)/(IDIM+1)) 51 : * 52 : LOGICAL L0,L1 53 : CHARACTER*8 TYPRET,MONSYM,MONESC,CMOT1,CHARRE 54 : CHARACTER*8 CMOT 55 : * 56 : 57 : IMODEL = ITLB 58 : wrk52 = iwrk52 59 : struli = itruli 60 : SEGINI,NCPR 61 : 62 : KCPR = NCPR 63 : 64 : * index des liaisons B. Utilise le fait qu il n y a qu un seul point local 65 : jliaib = jliaib + 1 66 : * 67 : NXPALB = 0 68 : c c.a.d. 15 liaisons conditionelles (ca marche pas pour 'PROFIL..;') 69 : NIPALB = 20 70 : NPLBB = 0 71 : NPLB = 0 72 : IDIMB = 0 73 : cc NLIAB = 0 74 : C NIP = 1 dans le cas ou la liaison n'est pas ITYP =16/17 ou ITYP=50/51 75 : NIP = 1 76 : IL = 0 77 : 10 CONTINUE 78 : 79 : segact imodel 80 : cmot(1:8) = cmatee 81 : meleme = imamod 82 : segact meleme 83 : 84 : cc NLIAB = NLIAB + 1 85 : ica = 0 86 : 87 : 88 : n2cham = valmat(/1) 89 : 90 : 11 continue 91 : * 92 : * ------ choc �l�mentaire POINT_PLAN_FLUIDE 93 : * 94 : IF (CMOT.EQ.'PO_PL_FL') THEN 95 : INOE = num(1,1) 96 : IF (IERR.NE.0) RETURN 97 : IF (NCPR(INOE).EQ.0) THEN 98 : NPLB = NPLB + 1 99 : NCPR(INOE) = NPLB 100 : ENDIF 101 : KPLBB = 1 102 : KDIMB = IDIM 103 : KIPALB = 3 104 : KXPALB = 9 + IDIM 105 : NXPALB = MAX(NXPALB,KXPALB) 106 : NIPALB = MAX(NIPALB,KIPALB) 107 : NPLBB = MAX(NPLBB,KPLBB) 108 : IDIMB = MAX(IDIMB,KDIMB) 109 : * 110 : * ------ choc �l�mentaire POINT_PLAN_FROTTEMENT 111 : * 112 : ELSE IF (CMOT.EQ.'PO_PL_FR') THEN 113 : if (valmat(/1).gt.7) then 114 : if (valmat(9).gt.0) goto 1021 115 : endif 116 : KNIP = 0 117 : goto 1022 118 : 119 : 1021 MEVOLL = int(valmat(9)) 120 : SEGACT MEVOLL 121 : KEVOLL = IEVOLL(1) 122 : SEGACT KEVOLL 123 : MLREE1 = IPROGX 124 : MLREE2 = IPROGY 125 : SEGACT MLREE1 126 : SEGACT MLREE2 127 : KNIP = MLREE1.PROG(/1) 128 : SEGDES MLREE1 129 : SEGDES MLREE2 130 : SEGDES KEVOLL 131 : SEGDES MEVOLL 132 : * 133 : 1022 continue 134 : INOE = num(1,1) 135 : IF (NCPR(INOE).EQ.0) THEN 136 : NPLB = NPLB + 1 137 : NCPR(INOE) = NPLB 138 : ENDIF 139 : TYPRET = ' ' 140 : KPLBB = 1 141 : KDIMB = IDIM 142 : KIPALB = 3 143 : KXPALB = 7 + 7 * IDIM 144 : NXPALB = MAX(NXPALB,KXPALB) 145 : NIPALB = MAX(NIPALB,KIPALB) 146 : NPLBB = MAX(NPLBB,KPLBB) 147 : IDIMB = MAX(IDIMB,KDIMB) 148 : NIP = MAX(NIP,KNIP) 149 : * 150 : * ------ choc �l�mentaire POINT_PLAN 151 : * 152 : ELSE IF (CMOT.EQ.'PO_PL') THEN 153 : if (valmat(/1).gt.3) then 154 : if (valmat(4).gt.0) goto 1031 155 : endif 156 : KNIP = 0 157 : goto 1032 158 : 159 : 1031 MEVOLL = int(valmat(4)) 160 : MEVOLL = IPEVO 161 : SEGACT MEVOLL 162 : KEVOLL = IEVOLL(1) 163 : SEGACT KEVOLL 164 : MLREE1 = IPROGX 165 : MLREE2 = IPROGY 166 : SEGACT MLREE1 167 : SEGACT MLREE2 168 : KNIP = MLREE1.PROG(/1) 169 : SEGDES MLREE1 170 : SEGDES MLREE2 171 : SEGDES KEVOLL 172 : SEGDES MEVOLL 173 : * 174 : 1032 continue 175 : INOE = num(1,1) 176 : IF (NCPR(INOE).EQ.0) THEN 177 : NPLB = NPLB + 1 178 : NCPR(INOE) = NPLB 179 : ENDIF 180 : TYPRET = ' ' 181 : KPLBB = 1 182 : KDIMB = IDIM 183 : KIPALB = 4 184 : KXPALB = 3 + IDIM 185 : ** ianis 186 : if (valmat(/1).gt.3) then 187 : if (valmat(6).gt.0) KXPALB = 3 + IDIM + 2 188 : endif 189 : * 190 : 191 : NXPALB = MAX(NXPALB,KXPALB) 192 : NIPALB = MAX(NIPALB,KIPALB) 193 : NPLBB = MAX(NPLBB,KPLBB) 194 : IDIMB = MAX(IDIMB,KDIMB) 195 : NIP = MAX(NIP,KNIP) 196 : * 197 : * ----- choc �l�mentaire POINT_POINT_FROTTEMENT 198 : * 199 : ELSE IF (CMOT.EQ.'PO_PO_FR') THEN 200 : INOA = num(1,1) 201 : IF (NCPR(INOA).EQ.0) THEN 202 : NPLB = NPLB + 1 203 : NCPR(INOA) = NPLB 204 : ENDIF 205 : INOB = num(1,2) 206 : IF (NCPR(INOB).EQ.0) THEN 207 : NPLB = NPLB + 1 208 : NCPR(INOB) = NPLB 209 : ENDIF 210 : if (valmat(/1).gt.11) then 211 : if (valmat(10).gt.0) goto 1041 212 : endif 213 : 214 : KNIP = 0 215 : goto 1042 216 : 217 : 1041 ipevo = int(valmat(10)) 218 : MEVOLL = IPEVO 219 : SEGACT MEVOLL 220 : KEVOLL = IEVOLL(1) 221 : SEGACT KEVOLL 222 : MLREE1 = IPROGX 223 : MLREE2 = IPROGY 224 : SEGACT MLREE1 225 : SEGACT MLREE2 226 : KNIP = MLREE1.PROG(/1) 227 : SEGDES MLREE1 228 : SEGDES MLREE2 229 : SEGDES KEVOLL 230 : SEGDES MEVOLL 231 : 232 : 1042 continue 233 : KPLBB = 2 234 : KDIMB = IDIM 235 : KIPALB = 3 236 : KXPALB = 7 + 7 * IDIM 237 : NXPALB = MAX(NXPALB,KXPALB) 238 : NIPALB = MAX(NIPALB,KIPALB) 239 : NPLBB = MAX(NPLBB,KPLBB) 240 : IDIMB = MAX(IDIMB,KDIMB) 241 : NIP = MAX(NIP,KNIP) 242 : * 243 : * ----- choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE 244 : * 245 : ELSE IF (CMOT.EQ.'PO_PO_DP') THEN 246 : if (valmat(6).gt.0) goto 1051 247 : 247 : call erreur(5) 248 : return 249 : 1051 ipevo = int(valmat(7)) 250 : MEVOLL = IPEVO 251 : SEGACT MEVOLL 252 : KEVOLL = IEVOLL(1) 253 : SEGACT KEVOLL 254 : MLREE1 = IPROGX 255 : MLREE2 = IPROGY 256 : SEGACT MLREE1 257 : SEGACT MLREE2 258 : KNIP = MLREE1.PROG(/1) 259 : SEGDES MLREE1 260 : SEGDES MLREE2 261 : SEGDES KEVOLL 262 : SEGDES MEVOLL 263 : * 264 : INOA = num(1,1) 265 : IF (NCPR(INOA).EQ.0) THEN 266 : NPLB = NPLB + 1 267 : NCPR(INOA) = NPLB 268 : ENDIF 269 : INOB = num(1,2) 270 : IF (NCPR(INOB).EQ.0) THEN 271 : NPLB = NPLB + 1 272 : NCPR(INOB) = NPLB 273 : ENDIF 274 : TYPRET = ' ' 275 : if (valmat(/1).gt.6) then 276 : if (valmat(7).gt.0) then 277 : typret='FLOTTANT' 278 : goto 1052 279 : endif 280 : endif 281 : 1052 continue 282 : * 283 : KPLBB = 2 284 : KDIMB = IDIM 285 : C 286 : KIPALB = 5 287 : IF (TYPRET.EQ.'FLOTTANT') THEN 288 : KXPALB = 5 + IDIM 289 : ELSE IF (TYPRET.EQ.' ') THEN 290 : KXPALB = 4 + IDIM 291 : ELSE 291 : CALL ERREUR(522) 292 : RETURN 293 : ENDIF 294 : NXPALB = MAX(NXPALB,KXPALB) 295 : NIPALB = MAX(NIPALB,KIPALB) 296 : NPLBB = MAX(NPLBB,KPLBB) 297 : IDIMB = MAX(IDIMB,KDIMB) 298 : NIP = MAX(NIP,KNIP) 299 : * 300 : * ----- choc elementaire POINT_POINT_ROTATION_PLASTIQUE 301 : * 302 : ELSE IF (CMOT.EQ.'PO_PO_RP') THEN 303 : if (valmat(6).gt.0) goto 1061 303 : call erreur(5) 304 : return 305 : 1061 ipevo = int(valmat(6)) 306 : * 307 : MEVOLL = IPEVO 308 : SEGACT MEVOLL 309 : KEVOLL = IEVOLL(1) 310 : SEGACT KEVOLL 311 : MLREE1 = IPROGX 312 : MLREE2 = IPROGY 313 : SEGACT MLREE1 314 : SEGACT MLREE2 315 : KNIP = MLREE1.PROG(/1) 316 : SEGDES MLREE1 317 : SEGDES MLREE2 318 : SEGDES KEVOLL 319 : SEGDES MEVOLL 320 : * 321 : INOA = num(1,1) 322 : IF (NCPR(INOA).EQ.0) THEN 323 : NPLB = NPLB + 1 324 : NCPR(INOA) = NPLB 325 : ENDIF 326 : INOB = num(1,2) 327 : IF (NCPR(INOB).EQ.0) THEN 328 : NPLB = NPLB + 1 329 : NCPR(INOB) = NPLB 330 : ENDIF 331 : TYPRET = ' ' 332 : if (valmat(/1).gt.6) then 333 : if (valmat(7).gt.0) then 334 : typret='FLOTTANT' 335 : goto 1062 336 : endif 337 : endif 338 : 1062 continue 339 : KPLBB = 2 340 : * 341 : * NW Dans le cas de la rotule, on passe en dimension 6 342 : * car on aura Ux,Uy,Uz,Rx,Ry,Rz 343 : * 344 : KDIMB = 3+IDIM 345 : * 346 : * KIPALB = 5 : nombre maxi de parametres pour la liaison 347 : * 348 : KIPALB = 5 349 : IF (TYPRET.EQ.'FLOTTANT') THEN 350 : KXPALB = 5 + IDIM 351 : ELSE IF (TYPRET.EQ.' ') THEN 352 : KXPALB = 4 + IDIM 353 : ELSE 353 : CALL ERREUR(522) 354 : RETURN 355 : ENDIF 356 : NXPALB = MAX(NXPALB,KXPALB) 357 : NIPALB = MAX(NIPALB,KIPALB) 358 : NPLBB = MAX(NPLBB,KPLBB) 359 : IDIMB = MAX(IDIMB,KDIMB) 360 : NIP = MAX(NIP,KNIP) 361 : * 362 : * ----- choc �l�mentaire POINT_POINT 363 : * 364 : ELSE IF (CMOT.EQ.'PO_PO') THEN 365 : INOA = num(1,1) 366 : IF (NCPR(INOA).EQ.0) THEN 367 : NPLB = NPLB + 1 368 : NCPR(INOA) = NPLB 369 : ENDIF 370 : INOB = num(1,2) 371 : IF (NCPR(INOB).EQ.0) THEN 372 : NPLB = NPLB + 1 373 : NCPR(INOB) = NPLB 374 : ENDIF 375 : 376 : TYPRET = ' ' 377 : if (valmat(/1).gt.5) then 378 : if (valmat(7).gt.0) goto 1071 379 : endif 380 : KNIP = 0 381 : goto 1072 382 : 383 : 1071 ipevo = int(valmat(7)) 384 : * 385 : MEVOLL = IPEVO 386 : SEGACT MEVOLL 387 : KEVOLL = IEVOLL(1) 388 : SEGACT KEVOLL 389 : MLREE1 = IPROGX 390 : MLREE2 = IPROGY 391 : SEGACT MLREE1 392 : SEGACT MLREE2 393 : KNIP = MLREE1.PROG(/1) 394 : SEGDES MLREE1 395 : SEGDES MLREE2 396 : SEGDES KEVOLL 397 : SEGDES MEVOLL 398 : 399 : 1072 continue 400 : KPLBB = 2 401 : KDIMB = IDIM 402 : KIPALB = 4 403 : KXPALB = 3 + IDIM 404 : NXPALB = MAX(NXPALB,KXPALB) 405 : NIPALB = MAX(NIPALB,KIPALB) 406 : NPLBB = MAX(NPLBB,KPLBB) 407 : IDIMB = MAX(IDIMB,KDIMB) 408 : NIP = MAX(NIP,KNIP) 409 : * 410 : * ianis 411 : * 412 : * ----- choc �l�mentaire POINT_CERCLE_MOBILE 413 : * 414 : ELSE IF (CMOT.EQ.'PO_CE_MO') THEN 415 : INOA = num(1,1) 416 : IF (NCPR(INOA).EQ.0) THEN 417 : NPLB = NPLB + 1 418 : NCPR(INOA) = NPLB 419 : ENDIF 420 : * 421 : if (valmat(3).gt.0) goto 1081 422 : interr(1) = inoa 423 : moterr(1:4) = 'PCER' 424 : moterr(5:8) = 'CARA' 424 : call erreur(65) 425 : 1081 inob = int(valmat(3)) 426 : IF (NCPR(INOB).EQ.0) THEN 427 : NPLB = NPLB + 1 428 : NCPR(INOB) = NPLB 429 : ENDIF 430 : TYPRET = ' ' 431 : if (valmat(/1).gt.8) then 432 : if (valmat(10).gt.0) then 433 : typret='FLOTTANT' 434 : goto 1082 435 : endif 436 : endif 437 : 1082 continue 438 : KPLBB = 2 439 : * on neglige les rotations 440 : KDIMB = IDIM 441 : KIPALB = 4 442 : IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER ') THEN 443 : KXPALB = 7 + 9 * IDIM 444 : ELSE IF (TYPRET.EQ.' ') THEN 445 : KXPALB = 6 + 9 * IDIM 446 : ELSE 446 : CALL ERREUR(522) 447 : RETURN 448 : ENDIF 449 : NXPALB = MAX(NXPALB,KXPALB) 450 : NIPALB = MAX(NIPALB,KIPALB) 451 : NPLBB = MAX(NPLBB,KPLBB) 452 : IDIMB = MAX(IDIMB,KDIMB) 453 : * 454 : * 455 : * ----- choc �l�mentaire POINT_CERCLE_FROTTEMENT 456 : * 457 : ELSE IF (CMOT.EQ.'PO_CE_FR') THEN 458 : INOE=num(1,1) 459 : IF (NCPR(INOE).EQ.0) THEN 460 : NPLB = NPLB + 1 461 : NCPR(INOE) = NPLB 462 : ENDIF 463 : TYPRET = ' ' 464 : if (valmat(/1).gt.8) then 465 : if (valmat(10).gt.0) then 466 : typret='FLOTTANT' 467 : goto 1092 468 : endif 469 : endif 470 : 1092 continue 471 : KPLBB = 1 472 : KDIMB = IDIM 473 : KIPALB = 4 474 : IF (TYPRET.EQ.'FLOTTANT') THEN 475 : KXPALB = 7 + 9 * IDIM 476 : ELSE IF (TYPRET.EQ.' ') THEN 477 : KXPALB = 6 + 9 * IDIM 478 : ELSE 478 : CALL ERREUR(522) 479 : RETURN 480 : ENDIF 481 : NXPALB = MAX(NXPALB,KXPALB) 482 : NIPALB = MAX(NIPALB,KIPALB) 483 : NPLBB = MAX(NPLBB,KPLBB) 484 : IDIMB = MAX(IDIMB,KDIMB) 485 : * 486 : * ----- choc �l�mentaire POINT_CERCLE 487 : * 488 : ELSE IF (CMOT.EQ.'PO_CE') THEN 489 : INOE = num(1,1) 490 : IF (NCPR(INOE).EQ.0) THEN 491 : NPLB = NPLB + 1 492 : NCPR(INOE) = NPLB 493 : ENDIF 494 : TYPRET = ' ' 495 : if (valmat(/1).gt.4) then 496 : if (valmat(5).gt.0) then 497 : typret='FLOTTANT' 498 : goto 1102 499 : endif 500 : endif 501 : 502 : 1102 continue 503 : KPLBB = 1 504 : KDIMB = IDIM 505 : KIPALB = 3 506 : IF (TYPRET.EQ.'FLOTTANT') THEN 507 : KXPALB = 3 + 2 * IDIM 508 : ELSE IF (TYPRET.EQ.' ') THEN 509 : KXPALB = 2 + 2 * IDIM 510 : ELSE 510 : CALL ERREUR(522) 511 : RETURN 512 : ENDIF 513 : NXPALB = MAX(NXPALB,KXPALB) 514 : NIPALB = MAX(NIPALB,KIPALB) 515 : NPLBB = MAX(NPLBB,KPLBB) 516 : IDIMB = MAX(IDIMB,KDIMB) 517 : * 518 : * ----- choc �l�mentaire CERCLE_PLAN_FROTTEMENT 519 : * 520 : ELSE IF (CMOT.EQ.'CE_PL_FR') THEN 521 : INOE = num(1,1) 522 : IF (NCPR(INOE).EQ.0) THEN 523 : NPLB = NPLB + 1 524 : NCPR(INOE) = NPLB 525 : ENDIF 526 : TYPRET = ' ' 527 : if (valmat(/1).gt.8) then 528 : if (valmat(9).gt.0) then 529 : typret='FLOTTANT' 530 : goto 1112 531 : endif 532 : endif 533 : 1112 continue 534 : KPLBB = 1 535 : KDIMB = 2 * IDIM 536 : KIPALB = 3 537 : IF (TYPRET.EQ.'FLOTTANT') THEN 538 : KXPALB = 8 + 7 * IDIM 539 : ELSE IF (TYPRET.EQ.' ') THEN 540 : KXPALB = 7 + 7 * IDIM 541 : ELSE 541 : CALL ERREUR(522) 542 : RETURN 543 : ENDIF 544 : NXPALB = MAX(NXPALB,KXPALB) 545 : NIPALB = MAX(NIPALB,KIPALB) 546 : NPLBB = MAX(NPLBB,KPLBB) 547 : IDIMB = MAX(IDIMB,KDIMB) 548 : * 549 : * ----- choc �l�mentaire CERCLE_CERCLE_FROTTEMENT 550 : * 551 : ELSE IF (CMOT.EQ.'CE_CE_FR') THEN 552 : INOE = num(1,1) 553 : IF (NCPR(INOE).EQ.0) THEN 554 : NPLB = NPLB + 1 555 : NCPR(INOE) = NPLB 556 : ENDIF 557 : TYPRET = ' ' 558 : 559 : if (valmat(/1).gt.9) then 560 : if (valmat(10).gt.0) then 561 : typret='FLOTTANT' 562 : goto 1122 563 : endif 564 : endif 565 : 1122 continue 566 : KPLBB = 1 567 : KDIMB = 2 * IDIM 568 : KIPALB = 4 569 : IF (TYPRET.EQ.'FLOTTANT') THEN 570 : KXPALB = 8 + 9*IDIM 571 : ELSE IF (TYPRET.EQ.' ') THEN 572 : KXPALB = 7 + 9*IDIM 573 : ELSE 573 : CALL ERREUR(522) 574 : RETURN 575 : ENDIF 576 : NXPALB = MAX(NXPALB,KXPALB) 577 : NIPALB = MAX(NIPALB,KIPALB) 578 : NPLBB = MAX(NPLBB,KPLBB) 579 : IDIMB = MAX(IDIMB,KDIMB) 580 : * 581 : * ----- choc �l�mentaire PROFIL_PROFIL_INTERIEUR 582 : * ----- choc �l�mentaire PROFIL_PROFIL_EXTERIEUR 583 : * 584 : ELSE IF (CMOT.EQ.'PR_PR_IN'.OR. 585 : & CMOT.EQ.'PR_PR_EX') THEN 586 : 587 : ima1 = int(valmat(3)) 588 : 589 : ima2 = int(valmat(4)) 590 : 591 : INOE = num(1,1) 592 : IF (NCPR(INOE).EQ.0) THEN 593 : NPLB = NPLB + 1 594 : NCPR(INOE) = NPLB 595 : ENDIF 596 : KPLBB = 1 597 : KDIMB = 3 597 : CALL CHANGE(IMA1,1) 597 : CALL CHANGE(IMA2,1) 598 : MELEME = IMA1 599 : SEGACT MELEME 600 : NOMBN1 = NUM(/2) 601 : SEGDES MELEME 602 : MELEME = IMA2 603 : SEGACT MELEME 604 : NOMBN2 = NUM(/2) 605 : SEGDES MELEME 606 : KXPALB = 3 + 5*IDIM + 5*NOMBN1 + 3*NOMBN2 607 : KIPALB = 5 + NOMBN1 + 2*NOMBN1*NOMBN2 608 : NXPALB = MAX(NXPALB,KXPALB) 609 : NIPALB = MAX(NIPALB,KIPALB) 610 : NPLBB = MAX(NPLBB,KPLBB) 611 : IDIMB = MAX(IDIMB,KDIMB) 612 : * 613 : * ----- choc �l�mentaire LIGNE_LIGNE_FROTTEMENT 614 : * 615 : ELSE IF (CMOT.EQ.'LI_LI_FR') THEN 616 : MONESC= ' ' 617 : TYPRET = ' ' 618 : imai = int(valmat(2)) 619 : 620 : MONESC = tyval(3)(9:16) 621 : iesc = int(valmat(3)) 622 : MELEME = IESC 623 : SEGACT MELEME 624 : if (num(/2).eq.1) then 625 : MONESC = 'POINT' 626 : IESC = num(1,1) 627 : segdes meleme 628 : endif 629 : 630 : if (valmat(/1).ge.10) then 631 : typret=tyval(10)(1:8) 632 : if (typret.eq.'POINTEUR') typret=tyval(10)(9:16) 633 : endif 634 : * 635 : MELEME = IMAI 636 : SEGACT MELEME 637 : NELEMA = NUM(/2) 638 : IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN 639 : NNOEMA = NELEMA 640 : ELSE 641 : NNOEMA = NELEMA+1 642 : ENDIF 643 : INOE = NUM(1,1) 644 : IF (NCPR(INOE).EQ.0) THEN 645 : NPLB = NPLB + 1 646 : NCPR(INOE) = NPLB 647 : ENDIF 648 : DO 20 IE = 1,(NNOEMA-1) 649 : INOE = NUM(2,IE) 650 : IF (NCPR(INOE).EQ.0) THEN 651 : NPLB = NPLB + 1 652 : NCPR(INOE) = NPLB 653 : ENDIF 654 : 20 CONTINUE 655 : SEGDES MELEME 656 : * Maillage_esclave 657 : IF (MONESC.EQ.'POINT') THEN 658 : * La ligne-esclave est un point 659 : IF (NCPR(IESC).EQ.0) THEN 660 : NPLB = NPLB + 1 661 : NCPR(IESC) = NPLB 662 : ENDIF 663 : NNOEES=1 664 : ELSE 665 : IF (MONESC.EQ.'MAILLAGE') THEN 666 : * La ligne-esclave est un MAILLAGE 667 : MELEME = IESC 668 : SEGACT MELEME 669 : NELEES = NUM(/2) 670 : IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN 671 : NNOEES = NELEES 672 : ELSE 673 : NNOEES = NELEES+1 674 : ENDIF 675 : INOE = NUM(1,1) 676 : IF (NCPR(INOE).EQ.0) THEN 677 : NPLB = NPLB + 1 678 : NCPR(INOE) = NPLB 679 : ENDIF 680 : DO 30 IE = 1,(NNOEES-1) 681 : INOE = NUM(2,IE) 682 : IF (NCPR(INOE).EQ.0) THEN 683 : NPLB = NPLB + 1 684 : NCPR(INOE) = NPLB 685 : ENDIF 686 : 30 CONTINUE 687 : SEGDES MELEME 688 : ENDIF 689 : ENDIF 690 : KPLBB = NNOEMA + NNOEES 691 : IF (IDIM.EQ.3) THEN 692 : KDIMB = 6 693 : ELSE 694 : KDIMB = 3 695 : ENDIF 696 : * Pour le nombre maxi de param�tres entiers on prend 697 : * en compte les 16 espaces dus aux liaisons conditionnelles 698 : * + nos 10 autres propres param�tres 699 : * + la place pour les noeuds voisins 700 : * + la place pour les indicateurs de choc 701 : KIPALB = 16 + 10 +3*(NNOEMA+NNOEES) 702 : * 703 : IF (TYPRET.EQ.'CHPOINT') THEN 704 : KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+ 705 : &NNOEES) 706 : ELSE IF (TYPRET.EQ.'REAL*8') THEN 707 : KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+ 708 : &NNOEES) 709 : ELSE IF (TYPRET.EQ.' ') THEN 710 : KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+ 711 : &NNOEES) 712 : ELSE 712 : CALL ERREUR(522) 713 : RETURN 714 : ENDIF 715 : * 716 : NXPALB = MAX(NXPALB,KXPALB) 717 : NIPALB = MAX(NIPALB,KIPALB) 718 : NPLBB = MAX(NPLBB,KPLBB) 719 : IDIMB = MAX(IDIMB,KDIMB) 720 : 721 : 722 : 723 : * 724 : * ----- choc �l�mentaire LIGNE_CERCLE_FROTTEMENT 725 : 726 : ELSE IF (CMOT.EQ.'LI_CE_FR') THEN 727 : MONESC= ' ' 728 : TYPRET = ' ' 729 : 730 : imai = int(valmat(2)) 731 : 732 : MONESC = tyval(3)(9:16) 733 : iesc = int(valmat(3)) 734 : MELEME = IESC 735 : SEGACT MELEME 736 : if (num(/2).eq.1) then 737 : MONESC = 'POINT' 738 : IESC = num(1,1) 739 : segdes meleme 740 : endif 741 : 742 : if (valmat(/1).gt.8) then 743 : if (valmat(9).gt.0) then 744 : typret=tyval(9)(1:8) 745 : if (typret.eq.'POINTEUR') typret=tyval(9)(9:16) 746 : endif 747 : endif 748 : * 749 : MELEME = IMAI 750 : SEGACT MELEME 751 : NELEMA = NUM(/2) 752 : IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN 753 : NNOEMA = NELEMA 754 : ELSE 755 : NNOEMA = NELEMA+1 756 : ENDIF 757 : INOE = NUM(1,1) 758 : IF (NCPR(INOE).EQ.0) THEN 759 : NPLB = NPLB + 1 760 : NCPR(INOE) = NPLB 761 : ENDIF 762 : DO 40 IE = 1,(NNOEMA-1) 763 : INOE = NUM(2,IE) 764 : IF (NCPR(INOE).EQ.0) THEN 765 : NPLB = NPLB + 1 766 : NCPR(INOE) = NPLB 767 : ENDIF 768 : 40 CONTINUE 769 : SEGDES MELEME 770 : * Maillage_esclave 771 : IF (MONESC.EQ.'POINT') THEN 772 : * La ligne-esclave est un point 773 : IF (NCPR(IESC).EQ.0) THEN 774 : NPLB = NPLB + 1 775 : NCPR(IESC) = NPLB 776 : ENDIF 777 : NNOEES=1 778 : ELSE 779 : IF (MONESC.EQ.'MAILLAGE') THEN 780 : * La ligne-esclave est un MAILLAGE 781 : MELEME = IESC 782 : SEGACT MELEME 783 : NELEES = NUM(/2) 784 : IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN 785 : NNOEES = NELEES 786 : ELSE 787 : NNOEES = NELEES+1 788 : ENDIF 789 : INOE = NUM(1,1) 790 : IF (NCPR(INOE).EQ.0) THEN 791 : NPLB = NPLB + 1 792 : NCPR(INOE) = NPLB 793 : ENDIF 794 : DO 50 IE = 1,(NNOEES-1) 795 : INOE = NUM(2,IE) 796 : IF (NCPR(INOE).EQ.0) THEN 797 : NPLB = NPLB + 1 798 : NCPR(INOE) = NPLB 799 : ENDIF 800 : 50 CONTINUE 801 : SEGDES MELEME 802 : ENDIF 803 : ENDIF 804 : KPLBB = NNOEMA + NNOEES 805 : IF (IDIM.EQ.3) THEN 806 : KDIMB = 6 807 : ELSE 808 : KDIMB = 3 809 : ENDIF 810 : * Pour le nombre maxi de param�tres entiers on prend 811 : * en compte les 16 espaces dus aux liaisons conditionnelles 812 : * + nos 10 autres propres param�tres 813 : * + la place pour les noeuds voisins 814 : * + la place pour les indicateurs de choc 815 : KIPALB = 16 + 10 +3*(NNOEMA+NNOEES) 816 : * 817 : IF (TYPRET.EQ.'CHPOINT') THEN 818 : KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+ 819 : &NNOEES) 820 : ELSE IF (TYPRET.EQ.'REAL*8') THEN 821 : KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+ 822 : &NNOEES) 823 : ELSE 823 : CALL ERREUR(522) 824 : RETURN 825 : ENDIF 826 : * 827 : NXPALB = MAX(NXPALB,KXPALB) 828 : NIPALB = MAX(NIPALB,KIPALB) 829 : NPLBB = MAX(NPLBB,KPLBB) 830 : IDIMB = MAX(IDIMB,KDIMB) 831 : 832 : * 833 : * ------ liaison PALIER_FLUIDE 834 : * 835 : ELSE IF (CMOT.EQ.'PA_FL_RO') THEN 836 : * 837 : KPLBB = 1 838 : KDIMB = IDIM 839 : * 840 : C I) Gestion du point support 841 : * 842 : INOE = num(1,1) 843 : IF (NCPR(INOE).EQ.0) THEN 844 : NPLB = NPLB + 1 845 : NCPR(INOE) = NPLB 846 : ENDIF 847 : * 848 : C II) D�compte du nombre de param�tres entiers et r�els 849 : * 849 : c CALL ACCTAB(ITLIAI,'MOT',I0,X0,'MODELE_PALIER',L0,IP0, 850 : c & 'MOT',I1,X0,CMOT,L1,IP1) 851 : IF (IERR.NE.0) RETURN 852 : * 853 : C II.1) D�compte du nombre de param�tres propres aux diff�rents types 854 : C de paliers (KIPLB2 pour les entiers, LXPLB2 pour les r�els) : 855 : * 856 : * 857 : C -- Cas du palier cylindrique ou � lobes, avec mod�le de Rhode et Li : 858 : * 859 : itgeom = 0 860 : NLOB = 0 861 : 862 : itgeom = int(valmat(10)) 863 : 864 : if (itgeom.gt.0) then 864 : CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0, 865 : & 'ENTIER',NLOB,X0,' ',L1,IP1) 866 : IF (IERR.NE.0) RETURN 867 : KIPLB2 = 2 + NLOB 868 : KXPLB2 = 1 + (6*NLOB) 869 : endif 870 : * 871 : C II.2) Nombres totaux de param�tres entiers et r�els : 872 : * 873 : KIPALB = 5 + KIPLB2 874 : KXPALB = 7 + KXPLB2 + 4 875 : * 876 : C Dimensionnement des variables de sortie : 877 : * 878 : NXPALB = MAX(NXPALB,KXPALB) 879 : NIPALB = MAX(NIPALB,KIPALB) 880 : NPLBB = MAX(NPLBB,KPLBB) 881 : IDIMB = MAX(IDIMB,KDIMB) 882 : * 883 : * --> fin liaison PALIER 884 : * 885 : ELSE 885 : CALL ERREUR(490) 886 : RETURN 887 : ENDIF 888 : 889 : segdes imodel,meleme 890 : * 891 : RETURN 892 : END 893 : 894 : 895 : 896 :
© Cast3M 2003 - All rights reserved.
Disclaimer