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