1 : C DYNE20 SOURCE CHAT 11/03/16 21:19:25 6902 2 : SUBROUTINE DYNE20(ILIB,KTLIAB,ITCARA,LMODYN) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : *--------------------------------------------------------------------* 6 : * * 7 : * Op�rateur DYNE : algorithme de Fu - de Vogelaere * 8 : * ________________________________________________ * 9 : * * 10 : * Remplissage des tableaux de description des liaisons sur * 11 : * la base @ partir des informations contenues dans la * 12 : * table ILIB. * 13 : * * 14 : * Param�tres: * 15 : * * 16 : * e ILIB Table rassemblant la description des liaisons * 17 : * es KTLIAB Segment descriptif des liaisons sur la base B. * 18 : * * 19 : * * 20 : * Param�tres de dimensionnement pour une liaison sur base: * 21 : * * 22 : * NIPALB : nombre de param�tres pour d�finir le type des * 23 : * liaisons (NIPALB est fix� � 3). * 24 : * NXPALB : nombre maxi de param�tres internes d�finissant les * 25 : * liaisons. * 26 : * NPLBB : nombre maxi de points intervenant dans une liaison. * 27 : * * 28 : * NPLB : nombre total de points. * 29 : * NLIAB : nombre total de liaisons. * 30 : * * 31 : * * 32 : * Tableaux fortran pour les liaisons sur base B : * 33 : * * 34 : * XPALB(NLIAB,NXPALB) : param�tres de la liaison. * 35 : * IPALB(NLIAB,NIPALB) : renseigne sur le type de liaison. * 36 : * et les eventuelles conditions * 37 : * XABSCI Tableau contenant les abscisses de la loi plastique * 38 : * pour les liaisons point-point- ... -plastique * 39 : * XORDON Tableau contenant les ordonnees de la loi plastique * 40 : * pour les liaisons point-point- ... -plastique * 41 : * * 42 : * JPLIB(NPLB) : num�ro global des points. * 43 : * IPLIB(NLIAB,NPLBB) : num�ros locaux des points concern�s par * 44 : * la liaison. * 45 : * * 46 : * Icorres Pour garder le numero du pointeur des tables de * 47 : * liaison * 48 : * * 49 : * * 50 : * Auteur, date de cr�ation: * 51 : * * 52 : * Lionel VIVAN, le 21 Septembre 1989. * 53 : * E de LANGRE 08/94 laisns conditionnelles * 54 : * I. Pinto 05/97, liaisons ligne_cercle,appels a dyn207 * 55 : * * 56 : *--------------------------------------------------------------------* 57 : -INC CCOPTIO 58 : -INC SMCOORD 59 : -INC SMEVOLL 60 : -INC SMLREEL 61 : -INC SMMODEL 62 : -INC SMCHAML 63 : -INC SMELEME 64 : -INC SMCHPOI 65 : * 66 : SEGMENT MTLIAB 67 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) 68 : REAL*8 XPALB(NLIAB,NXPALB) 69 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) 70 : ENDSEGMENT 71 : * 72 : SEGMENT MLIGNE 73 : INTEGER KPLIB(NPLB) 74 : ENDSEGMENT 75 : * 76 : SEGMENT icorres( nliab) 77 : * 78 : LOGICAL L1,L0, log1, lmodyn,LPERM,LINTER,LECRO,LELAS 79 : CHARACTER*40 CMOT,MONMOT,CHARRE ,CMOT1 ,MONECR 80 : CHARACTER*8 MONAMO,MONSEUIL,CHARRE2,TYPRET,MARAID,MONPER 81 : CHARACTER*8 TYPREG,MONREC,MONJEU,MONSYM,MONELA,MONINTER 82 : CHARACTER*8 MONESC 83 : mchelm = itcara 84 : MTLIAB = KTLIAB 85 : NPLB = JPLIB(/1) 86 : NLIAB = IPALB(/1) 87 : segini icorres 88 : * 89 : * Boucle sur le nombre de liaisons 90 : * 91 : 92 : 93 : 94 : II = 0 95 : IF (lmodyn) THEN 96 : * 97 : mmodel = ilib 98 : segact mchelm 99 : n1 = imache(/1) 100 : do I = 1, kmodel(/1) 101 : imodel = kmodel(I) 102 : segact imodel 103 : ipt8 = imamod 104 : segact ipt8 105 : imod = ipt8.num(1,1) 106 : inoa = ipt8.num(1,1) 107 : isup = ipt8.num(1,1) 108 : 109 : do 46 in = 1,n1 110 : meleme = imache(in) 111 : if (meleme.ne.imamod) goto 46 112 : if (conche(in).ne.conmod) goto 46 113 : segact meleme 114 : mchaml = ichaml(in) 115 : segact mchaml 116 : n2 = ielval(/1) 117 : goto 51 118 : 46 continue 119 : write(6,*) 'pas de caracteristique liaison' , i, conmod 120 : return 121 : 122 : 51 continue 123 : TYPRET = ' ' 124 : MONSEUIL = ' ' 125 : if (cmatee.eq.'PO_PL_FL') then 126 : ITYP = 7 127 : do io = 1,n2 128 : if (nomche(io)(1:4).eq.'NORM') then 129 : melval = ielval(io) 130 : segact melval 131 : IPOI = ielche(1,1) 132 : else if (nomche(io)(1:4).eq.'INER') then 133 : melval = ielval(io) 134 : segact melval 135 : XINER = velche(1,1) 136 : else if (nomche(io)(1:4).eq.'CONV') then 137 : melval = ielval(io) 138 : segact melval 139 : XCONV = velche(1,1) 140 : else if (nomche(io)(1:4).eq.'VISC') then 141 : melval = ielval(io) 142 : segact melval 143 : XVISC = velche(1,1) 144 : else if (nomche(io)(1:4).eq.'PELO') then 145 : melval = ielval(io) 146 : segact melval 147 : XPCEL = velche(1,1) 148 : else if (nomche(io)(1:4).eq.'PRAP') then 149 : melval = ielval(io) 150 : segact melval 151 : XPCRA = velche(1,1) 152 : else if (nomche(io)(1:4).eq.'JFLU') then 153 : melval = ielval(io) 154 : segact melval 155 : XJEU = velche(1,1) 156 : else 157 : endif 158 : enddo 159 : 160 : IPALB(I,1) = ITYP 161 : IPALB(I,3) = IDIM 162 : XPALB(I,1) = XINER 163 : XPALB(I,2) = XCONV 164 : XPALB(I,3) = XVISC 165 : XPALB(I,4) = XPCEL 166 : XPALB(I,5) = XPCRA 167 : XPALB(I,6) = XJEU 168 : * 169 : IPNV = (IDIM + 1) * (IPOI - 1) 170 : PS = 0.D0 171 : DO 70 ID = 1,IDIM 172 : XC = XCOOR(IPNV + ID) 173 : PS = PS + XC * XC 174 : 70 CONTINUE 175 : * end do 176 : IF (PS.LE.0.D0) THEN 176 : CALL ERREUR(162) 177 : RETURN 178 : ENDIF 179 : ID1 = 6 180 : DO 72 ID = 1,IDIM 181 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 182 : 72 CONTINUE 183 : * end do 183 : CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) 184 : IPLIB(I,1) = IPLAC 185 : * 186 : else if(cmatee.eq.'PO_PL_FR') then 187 : ITYP = 3 188 : MARAID = ' ' 189 : TYPRET = ' ' 190 : MONAMO = ' ' 191 : do io = 1,n2 192 : if (nomche(io)(1:4).eq.'NORM') then 193 : melval = ielval(io) 194 : segact melval 195 : IPOI = ielche(1,1) 196 : else if (nomche(io)(1:4).eq.'RAID') then 197 : melval = ielval(io) 198 : segact melval 199 : xrain = velche(1,1) 200 : MARAID = 'FLOTTANT' 201 : else if (nomche(io)(1:4).eq.'JEU') then 202 : melval = ielval(io) 203 : segact melval 204 : XJEU = velche(1,1) 205 : else if (nomche(io)(1:4).eq.'GLIS') then 206 : melval = ielval(io) 207 : segact melval 208 : XGLIS = velche(1,1) 209 : else if (nomche(io)(1:4).eq.'ADHE') then 210 : melval = ielval(io) 211 : segact melval 212 : XADHE = velche(1,1) 213 : else if (nomche(io)(1:4).eq.'RTAN') then 214 : melval = ielval(io) 215 : segact melval 216 : XRAIT = velche(1,1) 217 : else if (nomche(io)(1:4).eq.'ATAN') then 218 : melval = ielval(io) 219 : segact melval 220 : XAMOT = velche(1,1) 221 : else if (nomche(io)(1:4).eq.'AMOR') then 222 : melval = ielval(io) 223 : segact melval 224 : xamon = velche(1,1) 225 : MONAMO = 'FLOTTANT' 226 : else if (nomche(io)(1:4).eq.'LOIC') then 227 : melval = ielval(io) 228 : segact melval 229 : ipevo = ielche(1,1) 230 : TYPRET = 'EVOLUTIO' 231 : else 232 : endif 233 : enddo 234 : 235 : IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN 235 : CALL ERREUR(891) 236 : RETURN 237 : ENDIF 238 : IF (TYPRET.EQ.'EVOLUTIO') THEN 239 : ITYP = 103 240 : XRAIN = 0.d0 241 : ENDIF 242 : IPALB(I,1) = ITYP 243 : IPALB(I,3) = IDIM 244 : XPALB(I,1) = XRAIN 245 : XPALB(I,2) = XJEU 246 : XPALB(I,3) = XGLIS 247 : XPALB(I,4) = XADHE 248 : XPALB(I,5) = XRAIT 249 : XPALB(I,6) = XAMOT 250 : IF (MONAMO.EQ.'FLOTTANT') THEN 251 : XPALB(I,7) = XAMON 252 : ELSE 253 : XPALB(I,7) = 0.D0 254 : ENDIF 255 : * 256 : IPNV = (IDIM + 1) * (IPOI - 1) 257 : PS = 0.D0 258 : DO 20 ID = 1,IDIM 259 : XC = XCOOR(IPNV + ID) 260 : PS = PS + XC * XC 261 : 20 CONTINUE 262 : * end do 263 : IF (PS.LE.0.D0) THEN 263 : CALL ERREUR(162) 264 : RETURN 265 : ENDIF 266 : ID1 = 7 267 : DO 22 ID = 1,IDIM 268 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 269 : 22 CONTINUE 270 : * end do 271 : 272 : IF (IPALB(I,1) .EQ. 103) THEN 273 : MEVOLL = IPEVO 274 : * 275 : * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) 276 : * Ici, on recupere les abscisses et les ordonnees de l'evolution dans 277 : * des tableaux xabsci et xordon 278 : * 279 : SEGACT MEVOLL 280 : KEVOLL = IEVOLL(1) 281 : SEGACT KEVOLL 282 : MLREE1 = IPROGX 283 : MLREE2 = IPROGY 284 : SEGACT MLREE1 285 : SEGACT MLREE2 286 : NIP = XABSCI(/2) 287 : * 288 : DO 26 MM=1,NIP 289 : XABSCI (I,MM) = MLREE1.PROG(MM) 290 : XORDON (I,MM) = MLREE2.PROG(MM) 291 : 26 CONTINUE 292 : SEGDES MLREE1 293 : SEGDES MLREE2 294 : SEGDES KEVOLL 295 : SEGDES MEVOLL 296 : ENDIF 297 : * 297 : CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) 298 : IPLIB(I,1) = IPLAC 299 : * 300 : else if(cmatee.eq.'PO_PL') then 301 : ITYP = 1 302 : IPERM = 0 303 : XPALB(I,3) = 0.D0 304 : do io = 1,n2 305 : if (nomche(io)(1:4).eq.'NORM') then 306 : melval = ielval(io) 307 : segact melval 308 : IPOI = ielche(1,1) 309 : else if (nomche(io)(1:4).eq.'RAID') then 310 : melval = ielval(io) 311 : segact melval 312 : xraid = velche(1,1) 313 : else if (nomche(io)(1:4).eq.'JEU') then 314 : melval = ielval(io) 315 : segact melval 316 : xjeu = velche(1,1) 317 : else if (nomche(io)(1:4).eq.'SPLA') then 318 : melval = ielval(io) 319 : segact melval 320 : xseuil = velche(1,1) 321 : MONSEUIL ='FLOTTANT' 322 : else if (nomche(io)(1:4).eq.'AMOR') then 323 : melval = ielval(io) 324 : segact melval 325 : xamon = velche(1,1) 326 : XPALB(I,3) = XAMON 327 : else if (nomche(io)(1:4).eq.'LOIC') then 328 : melval = ielval(io) 329 : segact melval 330 : ipevo = ielche(1,1) 331 : TYPRET = 'EVOLUTIO' 332 : else if (nomche(io)(1:4).eq.'PERM') then 333 : melval = ielval(io) 334 : segact melval 335 : IPERM = 1 336 : else 337 : endif 338 : enddo 339 : 340 : IPALB(I,1) = ITYP 341 : IPALB(I,3) = IDIM 342 : IPALB(I,4) = IPERM 343 : XPALB(I,1) = XRAID 344 : XPALB(I,2) = XJEU 345 : * 346 : IPNV = (IDIM + 1) * (IPOI - 1) 347 : PS = 0.D0 348 : DO 17 ID = 1,IDIM 349 : XC = XCOOR(IPNV + ID) 350 : PS = PS + XC * XC 351 : 17 CONTINUE 352 : * 353 : IF (PS.LE.0.D0) THEN 353 : CALL ERREUR(162) 354 : RETURN 355 : ENDIF 356 : ID1 = 3 357 : 358 : IF (MONSEUIL .EQ.'FLOTTANT') THEN 359 : IF (TYPRET .EQ. 'EVOLUTIO') THEN 360 : IPALB(I,1) = 101 361 : ELSE 362 : IPALB(I,1) = 100 363 : ENDIF 364 : ID1 = 4 365 : XPALB(I,ID1) = XSEUIL 366 : ELSE 367 : IF (TYPRET .EQ. 'EVOLUTIO') THEN 368 : IPALB(I,1) = 102 369 : ENDIF 370 : ENDIF 371 : 372 : * 373 : DO 12 ID = 1,IDIM 374 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 375 : 12 CONTINUE 376 : * 377 : IF (IPALB(I,1) .EQ. 101 .OR. IPALB(I,1) .EQ. 102) THEN 378 : MEVOLL = IPEVO 379 : * 380 : * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) 381 : * Ici, on recupere les abscisses et les ordonnees de l'evolution dans 382 : * des tableaux xabsci et xordon 383 : * 384 : SEGACT MEVOLL 385 : KEVOLL = IEVOLL(1) 386 : SEGACT KEVOLL 387 : MLREE1 = IPROGX 388 : MLREE2 = IPROGY 389 : SEGACT MLREE1 390 : SEGACT MLREE2 391 : NIP = XABSCI(/2) 392 : * 393 : DO 16 MM=1,NIP 394 : XABSCI (I,MM) = MLREE1.PROG(MM) 395 : XORDON (I,MM) = MLREE2.PROG(MM) 396 : 16 CONTINUE 397 : * 398 : SEGDES MLREE1 399 : SEGDES MLREE2 400 : SEGDES KEVOLL 401 : SEGDES MEVOLL 402 : ENDIF 403 : * 404 : IMOD = num(1,1) 404 : CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) 405 : IPLIB(I,1) = IPLAC 406 : * 407 : else if (cmatee.eq.'PO_PO_FR') then 408 : ITYP = 13 409 : MARAID = ' ' 410 : MONPER = ' ' 411 : MONAMO = ' ' 412 : TYPRET = ' ' 413 : TYPREG = ' ' 414 : CHARRE = ' ' 415 : do io = 1,n2 416 : if (nomche(io)(1:4).eq.'NORM') then 417 : melval = ielval(io) 418 : segact melval 419 : IPOI = ielche(1,1) 420 : else if (nomche(io)(1:4).eq.'RAID') then 421 : melval = ielval(io) 422 : segact melval 423 : xraid = velche(1,1) 424 : else if (nomche(io)(1:4).eq.'JEU') then 425 : melval = ielval(io) 426 : segact melval 427 : xjeu = velche(1,1) 428 : else if (nomche(io)(1:4).eq.'POIB') then 429 : melval = ielval(io) 430 : segact melval 431 : INOB = ielche(1,1) 432 : else if (nomche(io)(1:4).eq.'AMOR') then 433 : melval = ielval(io) 434 : segact melval 435 : xamon = velche(1,1) 436 : MONAMO='FLOTTANT' 437 : else if (nomche(io)(1:4).eq.'LOIC') then 438 : melval = ielval(io) 439 : segact melval 440 : ipevo = ielche(1,1) 441 : TYPRET = 'EVOLUTIO' 442 : else if (nomche(io)(1:4).eq.'MODE') then 443 : melval = ielval(io) 444 : segact melval 445 : igibe = ielche(1,1) 446 : TYPREG = 'MOT' 447 : CHARRE = 'GIBERT' 448 : else if (nomche(io)(1:4).eq.'GLIS') then 449 : melval = ielval(io) 450 : segact melval 451 : XGLIS = velche(1,1) 452 : else if (nomche(io)(1:4).eq.'ADHE') then 453 : melval = ielval(io) 454 : segact melval 455 : XADHE = velche(1,1) 456 : else if (nomche(io)(1:4).eq.'RTAN') then 457 : melval = ielval(io) 458 : segact melval 459 : XRAIT = velche(1,1) 460 : else if (nomche(io)(1:4).eq.'ATAN') then 461 : melval = ielval(io) 462 : segact melval 463 : XAMOT = velche(1,1) 464 : else 465 : endif 466 : enddo 467 : 468 : IF (IERR.NE.0) RETURN 469 : ** dans quel cas monamo est il entier? PV 470 : ** IF (MONAMO .EQ. 'ENTIER ') THEN 471 : ** XAMON = 1.D0*I0 472 : ** MONAMO = 'FLOTTANT' 473 : ** ENDIF 474 : IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN 474 : CALL ERREUR(891) 475 : RETURN 476 : ENDIF 477 : IF (TYPRET.EQ.'EVOLUTIO') THEN 478 : ITYP = 113 479 : XRAID = 0.d0 480 : ENDIF 481 : * 482 : IPALB(I,1) = ITYP 483 : IPALB(I,3) = IDIM 484 : XPALB(I,1) = XRAID 485 : XPALB(I,2) = XJEU 486 : XPALB(I,3) = XGLIS 487 : XPALB(I,4) = XADHE 488 : XPALB(I,5) = XRAIT 489 : XPALB(I,6) = XAMOT 490 : IF (MONAMO.EQ.'FLOTTANT') THEN 491 : XPALB(I,7) = XAMON 492 : ELSE 493 : XPALB(I,7) = 0.D0 494 : ENDIF 495 : 496 : * cas particulier pas tres orthodoxe pour Gibert 497 : * on passe a ityp = -13 et on modifie et ajoute 498 : * devlb2, devlb1-->devfb2--->dgcha4--->dgchfr--->dgchgl, devso4 499 : IF (TYPREG.EQ.'MOT') THEN 500 : IF (CHARRE.EQ.'GIBERT') THEN 501 : IPALB(I,1) = -13 502 : ELSE 502 : CALL ERREUR(891) 503 : RETURN 504 : ENDIF 505 : ELSEIF (IGIBE.NE.0) THEN 505 : CALL ERREUR(891) 506 : RETURN 507 : ENDIF 508 : 509 : * 510 : * normalisation de la normale 511 : * 512 : IPNV = (IDIM + 1) * (IPOI - 1) 513 : PS = 0.D0 514 : DO 420 ID = 1,IDIM 515 : XC = XCOOR(IPNV + ID) 516 : PS = PS + XC * XC 517 : 420 CONTINUE 518 : * end do 519 : IF (PS.LE.0.D0) THEN 519 : CALL ERREUR(162) 520 : RETURN 521 : ENDIF 522 : DO 422 ID = 1,IDIM 523 : ID2 = 7 + ID 524 : XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 525 : 422 CONTINUE 526 : * end do 527 : * 528 : IF (IPALB(I,1) .EQ. 113) THEN 529 : MEVOLL = IPEVO 530 : * 531 : * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) 532 : * Ici, on recupere les abscisses et les ordonnees de l'evolution dans 533 : * des tableaux xabsci et xordon 534 : * 535 : SEGACT MEVOLL 536 : KEVOLL = IEVOLL(1) 537 : SEGACT KEVOLL 538 : MLREE1 = IPROGX 539 : MLREE2 = IPROGY 540 : SEGACT MLREE1 541 : SEGACT MLREE2 542 : NIP = XABSCI(/2) 543 : * 544 : DO 424 MM=1,NIP 545 : XABSCI (I,MM) = MLREE1.PROG(MM) 546 : XORDON (I,MM) = MLREE2.PROG(MM) 547 : 424 CONTINUE 548 : * 549 : SEGDES MLREE1 550 : SEGDES MLREE2 551 : SEGDES KEVOLL 552 : SEGDES MEVOLL 553 : ENDIF 554 : * 554 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOA) 555 : IPLIB(I,1) = IPLAC 555 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOB) 556 : IPLIB(I,2) = IPLAC 557 : 558 : * 559 : else if(cmatee.eq.'PO_PO_DP') then 560 : ITYP = 16 561 : MARAID = ' ' 562 : MONPER = ' ' 563 : LPERM = .false. 564 : IPERM = 0 565 : MONAMO = ' ' 566 : TYPRET = ' ' 567 : do io = 1,n2 568 : if (nomche(io)(1:4).eq.'NORM') then 569 : melval = ielval(io) 570 : segact melval 571 : IPOI = ielche(1,1) 572 : else if (nomche(io)(1:4).eq.'ECRO') then 573 : melval = ielval(io) 574 : segact melval 575 : * IPERM = 2 <= isotrope , IPERM = 3 <= cinematique 576 : IPERM = ielche(1,1) 577 : else if (nomche(io)(1:4).eq.'JEU') then 578 : melval = ielval(io) 579 : segact melval 580 : xjeu = velche(1,1) 581 : else if (nomche(io)(1:4).eq.'POIB') then 582 : melval = ielval(io) 583 : segact melval 584 : INOB = ielche(1,1) 585 : else if (nomche(io)(1:4).eq.'AMOR') then 586 : melval = ielval(io) 587 : segact melval 588 : xamon = velche(1,1) 589 : MONAMO='FLOTTANT' 590 : else if (nomche(io)(1:4).eq.'LOIC') then 591 : melval = ielval(io) 592 : segact melval 593 : ipevo = ielche(1,1) 594 : TYPRET = 'EVOLUTIO' 595 : else if (nomche(io)(1:4).eq.'PERM') then 596 : melval = ielval(io) 597 : segact melval 598 : LPERM = .true. 599 : else 600 : endif 601 : enddo 602 : 603 : IF (IERR.NE.0) RETURN 604 : 605 : IF (LPERM) THEN 606 : IF (.NOT.(XJEU.EQ.0.D0)) THEN 607 : * WRITE (*,*) 'Liaison permanente, mise a zero du jeu.' 608 : XJEU = 0.D0 609 : ENDIF 610 : 611 : IF (IPERM.ne.3.and.IPERM.ne.2) THEN 611 : call erreur(21) 612 : RETURN 613 : ENDIF 614 : ENDIF 615 : * 616 : MEVOLL = IPEVO 617 : * 618 : * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) 619 : * Ici, on recupere les abscisses et les ordonnees de l'evolution dans 620 : * des tableaux xabsci et xordon 621 : * 622 : SEGACT MEVOLL 623 : KEVOLL = IEVOLL(1) 624 : SEGACT KEVOLL 625 : MLREE1 = IPROGX 626 : MLREE2 = IPROGY 627 : SEGACT MLREE1 628 : SEGACT MLREE2 629 : NIP = XABSCI(/2) 630 : * 631 : DO 426 MM=1,NIP 632 : XABSCI (I,MM) = MLREE1.PROG(MM) 633 : XORDON (I,MM) = MLREE2.PROG(MM) 634 : 426 CONTINUE 635 : * 636 : SEGDES MLREE1 637 : SEGDES MLREE2 638 : SEGDES KEVOLL 639 : SEGDES MEVOLL 640 : * 641 : IPALB(I,1) = ITYP 642 : IPALB(I,3) = IDIM 643 : XPALB(I,1) = XJEU 644 : IPALB(I,5) = IPERM 645 : * 646 : * normalisation de la normale 647 : * 648 : IPNV = (IDIM + 1) * (IPOI - 1) 649 : PS = 0.D0 650 : DO 30 ID = 1,IDIM 651 : XC = XCOOR(IPNV + ID) 652 : PS = PS + XC * XC 653 : 30 CONTINUE 654 : * end do 655 : IF (PS.LE.0.D0) THEN 655 : CALL ERREUR(162) 656 : RETURN 657 : ENDIF 658 : IF (MONAMO.EQ.'FLOTTANT') THEN 659 : IPALB(I,1) = 17 660 : XPALB(I,2) = XAMON 661 : DO 32 ID = 1,IDIM 662 : ID2 = 2 + ID 663 : XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 664 : 32 CONTINUE 665 : * end do 666 : ELSE 667 : DO 34 ID = 1,IDIM 668 : ID2 = 1 + ID 669 : XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 670 : 34 CONTINUE 671 : * end do 672 : ENDIF 673 : * 673 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOA) 674 : IPLIB(I,1) = IPLAC 674 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOB) 675 : IPLIB(I,2) = IPLAC 676 : * 677 : else if(cmatee.eq.'PO_PO_RP') then 678 : ITYP = 50 679 : MARAID = ' ' 680 : MONPER = ' ' 681 : MONELA = ' ' 682 : LPERM = .FALSE. 683 : LELAS = .FALSE. 684 : LECRO = .FALSE. 685 : IPERM = 0 686 : MONAMO = ' ' 687 : TYPRET = ' ' 688 : do io = 1,n2 689 : if (nomche(io)(1:4).eq.'AXRO') then 690 : melval = ielval(io) 691 : segact melval 692 : IPOI = ielche(1,1) 693 : else if (nomche(io)(1:4).eq.'JEU') then 694 : melval = ielval(io) 695 : segact melval 696 : xjeu = velche(1,1) 697 : else if (nomche(io)(1:4).eq.'POIB') then 698 : melval = ielval(io) 699 : segact melval 700 : INOB = ielche(1,1) 701 : else if (nomche(io)(1:4).eq.'AMOR') then 702 : melval = ielval(io) 703 : segact melval 704 : xamon = velche(1,1) 705 : MONAMO='FLOTTANT' 706 : else if (nomche(io)(1:4).eq.'LOIC') then 707 : melval = ielval(io) 708 : segact melval 709 : ipevo = ielche(1,1) 710 : TYPRET = 'EVOLUTIO' 711 : else if (nomche(io)(1:4).eq.'PERM') then 712 : melval = ielval(io) 713 : segact melval 714 : LPERM = .true. 715 : else if (nomche(io)(1:4).eq.'ELAS') then 716 : melval = ielval(io) 717 : segact melval 718 : LELAS = .true. 719 : else if (nomche(io)(1:4).eq.'ECRO') then 720 : melval = ielval(io) 721 : segact melval 722 : * IECRO = 1 <= isotrope , IECRO = 2 <= cinematique 723 : LECRO = .true. 724 : iecro = ielche(1,1) 725 : if (iecro.eq.1) monecr = 'ISOTROPE' 726 : if (iecro.eq.2) monecr = 'CINEMATIQUE' 727 : else 728 : endif 729 : enddo 730 : 731 : IF (IERR.NE.0) RETURN 732 : * 733 : * iperm = -2 : liaison elastique permanente 734 : * iperm = -1 : choc elastique 735 : * iperm = 0 : donnees incoherentes ou insuffisantes 736 : * iperm = 1 : choc plastique 737 : * iperm = 2 : liaison plastique isotrope 738 : * iperm = 3 : liaison plastique cinematique 739 : * 740 : 741 : IF (LPERM) THEN 742 : IF (LELAS.AND.(.NOT.LECRO)) IPERM = -2 743 : IF (MONECR.EQ.'ISOTROPE'.AND.(.NOT.LELAS)) IPERM = 2 744 : IF (MONECR.EQ.'CINEMATIQUE'.AND.(.NOT.LELAS)) IPERM = 3 745 : IF (.NOT.(XJEU.EQ.0.)) THEN 746 : * WRITE(*,*) 'Liaison permanente, mise a zero du jeu.' 747 : XJEU = 0.D0 748 : ENDIF 749 : ELSE 750 : IF (.NOT.LECRO) THEN 751 : IF (LELAS) THEN 752 : IPERM = -1 753 : ELSE 754 : IPERM = 1 755 : ENDIF 756 : ENDIF 757 : ENDIF 758 : IF (IPERM.EQ.0) THEN 758 : CALL ERREUR(905) 759 : RETURN 760 : ENDIF 761 : * 762 : MEVOLL = IPEVO 763 : * 764 : * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) 765 : * Ici, on recupere les abscisses et les ordonnees de l'evolution dans 766 : * des tableaux xabsci et xordon 767 : * 768 : SEGACT MEVOLL 769 : KEVOLL = IEVOLL(1) 770 : SEGACT KEVOLL 771 : MLREE1 = IPROGX 772 : MLREE2 = IPROGY 773 : SEGACT MLREE1 774 : SEGACT MLREE2 775 : * NIP = MLREE1.PROG(/1) 776 : NIP = XABSCI(/2) 777 : * 778 : DO 110 MM=1,NIP 779 : XABSCI (I,MM) = MLREE1.PROG(MM) 780 : XORDON (I,MM) = MLREE2.PROG(MM) 781 : 110 CONTINUE 782 : * 783 : SEGDES MLREE1 784 : SEGDES MLREE2 785 : SEGDES KEVOLL 786 : SEGDES MEVOLL 787 : * 788 : IPALB(I,1) = ITYP 789 : IPALB(I,3) = IDIM 790 : IPALB(I,5) = IPERM 791 : XPALB(I,1) = XJEU 792 : * 793 : * normalisation de l'axe de rotation 794 : * 795 : IPNV = (IDIM + 1) * (IPOI - 1) 796 : PS = 0.D0 797 : DO 120 ID = 1,IDIM 798 : XC = XCOOR(IPNV + ID) 799 : PS = PS + XC * XC 800 : 120 CONTINUE 801 : * end do 802 : IF (PS.LE.0.D0) THEN 802 : CALL ERREUR(162) 803 : RETURN 804 : ENDIF 805 : IF (MONAMO.EQ.'FLOTTANT') THEN 806 : IPALB(I,1) = 51 807 : XPALB(I,2) = XAMON 808 : DO 122 ID = 1,IDIM 809 : ID2 = 2 + ID 810 : XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 811 : 122 CONTINUE 812 : * end do 813 : ELSE 814 : DO 124 ID = 1,IDIM 815 : ID2 = 1 + ID 816 : XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 817 : 124 CONTINUE 818 : * end do 819 : ENDIF 820 : * 820 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOA) 821 : IPLIB(I,1) = IPLAC 821 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOB) 822 : IPLIB(I,2) = IPLAC 823 : * 824 : * 825 : else if(cmatee.eq.'PO_PO') then 826 : ITYP = 11 827 : MARAID = ' ' 828 : MONPER = ' ' 829 : LPERM = .FALSE. 830 : IPERM = 0 831 : MONAMO = ' ' 832 : TYPRET = ' ' 833 : do io = 1,n2 834 : if (nomche(io)(1:4).eq.'NORM') then 835 : melval = ielval(io) 836 : segact melval 837 : IPOI = ielche(1,1) 838 : else if (nomche(io)(1:4).eq.'RAID') then 839 : melval = ielval(io) 840 : segact melval 841 : xraid = velche(1,1) 842 : else if (nomche(io)(1:4).eq.'JEU') then 843 : melval = ielval(io) 844 : segact melval 845 : xjeu = velche(1,1) 846 : else if (nomche(io)(1:4).eq.'POIB') then 847 : melval = ielval(io) 848 : segact melval 849 : INOB = ielche(1,1) 850 : else if (nomche(io)(1:4).eq.'AMOR') then 851 : melval = ielval(io) 852 : segact melval 853 : xamon = velche(1,1) 854 : MONAMO='FLOTTANT' 855 : else if (nomche(io)(1:4).eq.'LOIC') then 856 : melval = ielval(io) 857 : segact melval 858 : ipevo = ielche(1,1) 859 : TYPRET = 'EVOLUTIO' 860 : else if (nomche(io)(1:4).eq.'PERM') then 861 : melval = ielval(io) 862 : segact melval 863 : IPERM = ielche(1,1) 864 : LPERM = .true. 865 : else 866 : endif 867 : enddo 868 : 869 : IF (IERR.NE.0) RETURN 870 : 871 : IF (MARAID.EQ.'FLOTTANT' .EQV. TYPRET.EQ.'EVOLUTIO') THEN 871 : CALL ERREUR(891) 872 : RETURN 873 : ENDIF 874 : * 875 : IF (TYPRET.EQ.'EVOLUTIO') THEN 876 : ITYP = 111 877 : XRAID = 0.d0 878 : ENDIF 879 : 880 : IPALB(I,1) = ITYP 881 : IPALB(I,3) = IDIM 882 : IPALB(I,4) = IPERM 883 : XPALB(I,1) = XRAID 884 : XPALB(I,2) = XJEU 885 : * 886 : * normalisation de la normale 887 : * 888 : IPNV = (IDIM + 1) * (IPOI - 1) 889 : PS = 0.D0 890 : DO 111 ID = 1,IDIM 891 : XC = XCOOR(IPNV + ID) 892 : PS = PS + XC * XC 893 : 111 CONTINUE 894 : * end do 895 : IF (PS.LE.0.D0) THEN 895 : CALL ERREUR(162) 896 : RETURN 897 : ENDIF 898 : IF (MONAMO.EQ.'FLOTTANT') THEN 899 : XPALB(I,3) = XAMON 900 : ELSE 901 : XPALB(I,3) = 0.d0 902 : ENDIF 903 : DO 112 ID = 1,IDIM 904 : ID2 = 3 + ID 905 : XPALB(I,ID2) = XCOOR(IPNV + ID) / SQRT(PS) 906 : 112 CONTINUE 907 : * end do 908 : * 909 : IF (IPALB(I,1) .EQ. 111) THEN 910 : MEVOLL = IPEVO 911 : * 912 : * si IEVOLL(/1) different de 1 => probleme (on veut une seule courbe) 913 : * Ici, on recupere les abscisses et les ordonnees de l'evolution dans 914 : * des tableaux xabsci et xordon 915 : * 916 : SEGACT MEVOLL 917 : KEVOLL = IEVOLL(1) 918 : SEGACT KEVOLL 919 : MLREE1 = IPROGX 920 : MLREE2 = IPROGY 921 : SEGACT MLREE1 922 : SEGACT MLREE2 923 : NIP = XABSCI(/2) 924 : * 925 : DO 116 MM=1,NIP 926 : XABSCI (I,MM) = MLREE1.PROG(MM) 927 : XORDON (I,MM) = MLREE2.PROG(MM) 928 : 116 CONTINUE 929 : * 930 : SEGDES MLREE1 931 : SEGDES MLREE2 932 : SEGDES KEVOLL 933 : SEGDES MEVOLL 934 : ENDIF 935 : * 935 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOA) 936 : IPLIB(I,1) = IPLAC 936 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOB) 937 : IPLIB(I,2) = IPLAC 938 : * 939 : else if(cmatee.eq.'PO_CE_MO') then 940 : ITYP = 33 941 : MONAMO = ' ' 942 : MARAID = ' ' 943 : MONINTER = ' ' 944 : LINTER = .true. 945 : do io = 1,n2 946 : if (nomche(io)(1:4).eq.'NORM') then 947 : melval = ielval(io) 948 : segact melval 949 : IPOI = ielche(1,1) 950 : elseif (nomche(io)(1:4).eq.'PCER') then 951 : melval = ielval(io) 952 : segact melval 953 : INOB = ielche(1,1) 954 : else if (nomche(io)(1:4).eq.'RAID') then 955 : melval = ielval(io) 956 : segact melval 957 : xrain = velche(1,1) 958 : MARAID = 'FLOTTANT' 959 : else if (nomche(io)(1:4).eq.'RAYO') then 960 : melval = ielval(io) 961 : segact melval 962 : XRAYO = velche(1,1) 963 : else if (nomche(io)(1:4).eq.'GLIS') then 964 : melval = ielval(io) 965 : segact melval 966 : XGLIS = velche(1,1) 967 : else if (nomche(io)(1:4).eq.'ADHE') then 968 : melval = ielval(io) 969 : segact melval 970 : XADHE = velche(1,1) 971 : else if (nomche(io)(1:4).eq.'RTAN') then 972 : melval = ielval(io) 973 : segact melval 974 : XRAIT = velche(1,1) 975 : else if (nomche(io)(1:4).eq.'ATAN') then 976 : melval = ielval(io) 977 : segact melval 978 : XAMOT = velche(1,1) 979 : else if (nomche(io)(1:4).eq.'CINT') then 980 : melval = ielval(io) 981 : segact melval 982 : LINTER = .FALSE. 983 : else if (nomche(io)(1:4).eq.'AMOR') then 984 : melval = ielval(io) 985 : segact melval 986 : xamon = velche(1,1) 987 : MONAMO = 'FLOTTANT' 988 : else 989 : endif 990 : enddo 991 : 992 : IF (IERR.NE.0) RETURN 993 : IPALB(I,1) = ITYP 994 : IPALB(I,3) = IDIM 995 : IPALB(I,4) = 1 996 : IF (.NOT.LINTER) THEN 997 : IPALB(I,4) = 0 998 : ENDIF 999 : XPALB(I,1) = XRAIN 1000 : XPALB(I,2) = XRAYO 1001 : XPALB(I,3) = XGLIS 1002 : XPALB(I,4) = XADHE 1003 : XPALB(I,5) = XRAIT 1004 : XPALB(I,6) = XAMOT 1005 : * 1006 : * normalisation de la normale 1007 : * 1008 : IPNV = (IDIM + 1) * (IPOI - 1) 1009 : IPNOA = (IDIM + 1) * (INOA - 1) 1010 : IPNOB = (IDIM + 1) * (INOB - 1) 1011 : PS = 0.D0 1012 : DO 202 ID = 1,IDIM 1013 : XC = XCOOR(IPNV + ID) 1014 : PS = PS + XC * XC 1015 : 202 CONTINUE 1016 : *** write (6,*) ' ps - 3 ',ps 1017 : IF (PS.LE.0.D0) THEN 1017 : CALL ERREUR(162) 1018 : RETURN 1019 : ENDIF 1020 : IF (MONAMO.EQ.'FLOTTANT') THEN 1021 : IPALB(I,1) = 34 1022 : XPALB(I,7) = XAMON 1023 : ID1 = 7 1024 : ELSE 1025 : ID1 = 6 1026 : ENDIF 1027 : ID2 = ID1 + IDIM 1028 : DO 222 ID = 1,IDIM 1029 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 1030 : XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID) 1031 : 222 CONTINUE 1031 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOA) 1032 : IPLIB(I,1) = IPLAC 1032 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOB) 1033 : IPLIB(I,2) = IPLAC 1034 : * 1035 : else if(cmatee.eq.'PO_CE_FR') then 1036 : ITYP = 23 1037 : MONAMO = ' ' 1038 : MARAID = ' ' 1039 : MONINTER = ' ' 1040 : LINTER = .true. 1041 : do io = 1,n2 1042 : if (nomche(io)(1:4).eq.'NORM') then 1043 : melval = ielval(io) 1044 : segact melval 1045 : IPOI = ielche(1,1) 1046 : elseif (nomche(io)(1:4).eq.'EXCE') then 1047 : melval = ielval(io) 1048 : segact melval 1049 : IEXC = ielche(1,1) 1050 : else if (nomche(io)(1:4).eq.'RAID') then 1051 : melval = ielval(io) 1052 : segact melval 1053 : xrain = velche(1,1) 1054 : MARAID = 'FLOTTANT' 1055 : else if (nomche(io)(1:4).eq.'RAYO') then 1056 : melval = ielval(io) 1057 : segact melval 1058 : XRAYO = velche(1,1) 1059 : else if (nomche(io)(1:4).eq.'GLIS') then 1060 : melval = ielval(io) 1061 : segact melval 1062 : XGLIS = velche(1,1) 1063 : else if (nomche(io)(1:4).eq.'ADHE') then 1064 : melval = ielval(io) 1065 : segact melval 1066 : XADHE = velche(1,1) 1067 : else if (nomche(io)(1:4).eq.'RTAN') then 1068 : melval = ielval(io) 1069 : segact melval 1070 : XRAIT = velche(1,1) 1071 : else if (nomche(io)(1:4).eq.'ATAN') then 1072 : melval = ielval(io) 1073 : segact melval 1074 : XAMOT = velche(1,1) 1075 : else if (nomche(io)(1:4).eq.'CINT') then 1076 : melval = ielval(io) 1077 : segact melval 1078 : LINTER = .false. 1079 : else if (nomche(io)(1:4).eq.'AMOR') then 1080 : melval = ielval(io) 1081 : segact melval 1082 : xamon = velche(1,1) 1083 : MONAMO = 'FLOTTANT' 1084 : else 1085 : endif 1086 : enddo 1087 : IF (IERR.NE.0) RETURN 1088 : * 1089 : IPALB(I,1) = ITYP 1090 : IPALB(I,3) = IDIM 1091 : IPALB(I,4) = 1 1092 : IF (.NOT.LINTER) THEN 1093 : IPALB(I,4) = 0 1094 : ENDIF 1095 : XPALB(I,1) = XRAIN 1096 : XPALB(I,2) = XRAYO 1097 : XPALB(I,3) = XGLIS 1098 : XPALB(I,4) = XADHE 1099 : XPALB(I,5) = XRAIT 1100 : XPALB(I,6) = XAMOT 1101 : * 1102 : * normalisation de la normale 1103 : * 1104 : IPNV = (IDIM + 1) * (IPOI - 1) 1105 : IPEX = (IDIM + 1) * (IEXC - 1) 1106 : PS = 0.D0 1107 : DO 320 ID = 1,IDIM 1108 : XC = XCOOR(IPNV + ID) 1109 : PS = PS + XC * XC 1110 : 320 CONTINUE 1111 : *** write (6,*) ' ps - 2 ',ps 1112 : * end do 1113 : IF (PS.LE.0.D0) THEN 1113 : CALL ERREUR(162) 1114 : RETURN 1115 : ENDIF 1116 : IF (MONAMO.EQ.'FLOTTANT') THEN 1117 : IPALB(I,1) = 24 1118 : XPALB(I,7) = XAMON 1119 : ID1 = 7 1120 : ELSE 1121 : ID1 = 6 1122 : ENDIF 1123 : ID2 = ID1 + IDIM 1124 : DO 322 ID = 1,IDIM 1125 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 1126 : XPALB(I,ID2+ID) = XCOOR(IPEX + ID) 1127 : 322 CONTINUE 1128 : * end do 1128 : CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) 1129 : IPLIB(I,1) = IPLAC 1130 : * 1131 : else if(cmatee.eq.'PO_CE') then 1132 : ITYP = 21 1133 : MARAID = ' ' 1134 : MONPER = ' ' 1135 : MONAMO = ' ' 1136 : TYPRET = ' ' 1137 : do io = 1,n2 1138 : if (nomche(io)(1:4).eq.'NORM') then 1139 : melval = ielval(io) 1140 : segact melval 1141 : IPOI = ielche(1,1) 1142 : else if (nomche(io)(1:4).eq.'RAID') then 1143 : melval = ielval(io) 1144 : segact melval 1145 : xraid = velche(1,1) 1146 : else if (nomche(io)(1:4).eq.'EXCE') then 1147 : melval = ielval(io) 1148 : segact melval 1149 : IEXC = ielche(1,1) 1150 : else if (nomche(io)(1:4).eq.'RAYO') then 1151 : melval = ielval(io) 1152 : segact melval 1153 : xrayo = velche(1,1) 1154 : else if (nomche(io)(1:4).eq.'AMOR') then 1155 : melval = ielval(io) 1156 : segact melval 1157 : xamon = velche(1,1) 1158 : MONAMO='FLOTTANT' 1159 : else 1160 : endif 1161 : enddo 1162 : 1163 : IF (IERR.NE.0) RETURN 1164 : IPALB(I,1) = ITYP 1165 : IPALB(I,3) = IDIM 1166 : XPALB(I,1) = XRAID 1167 : XPALB(I,2) = XRAYO 1168 : * 1169 : * normalisation de la normale 1170 : * 1171 : IPNV = (IDIM + 1) * (IPOI - 1) 1172 : IPEX = (IDIM + 1) * (IEXC - 1) 1173 : PS = 0.D0 1174 : DO 210 ID = 1,IDIM 1175 : XC = XCOOR(IPNV + ID) 1176 : PS = PS + XC * XC 1177 : 210 CONTINUE 1178 : *** write (6,*) ' ps ',ps 1179 : * end do 1180 : IF (PS.LE.0.D0) THEN 1180 : CALL ERREUR(162) 1181 : RETURN 1182 : ENDIF 1183 : IF (MONAMO.EQ.'FLOTTANT') THEN 1184 : IPALB(I,1) = 22 1185 : XPALB(I,3) = XAMON 1186 : ID1 = 3 1187 : ELSE 1188 : ID1 = 2 1189 : ENDIF 1190 : ID2 = ID1 + IDIM 1191 : DO 212 ID = 1,IDIM 1192 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 1193 : XPALB(I,ID2+ID) = XCOOR(IPEX + ID) 1194 : 212 CONTINUE 1195 : * end do 1195 : CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) 1196 : IPLIB(I,1) = IPLAC 1197 : * 1198 : else if(cmatee.eq.'CE_PL_FR') then 1199 : ITYP = 5 1200 : MONAMO = ' ' 1201 : do io = 1,n2 1202 : if (nomche(io)(1:4).eq.'NORM') then 1203 : melval = ielval(io) 1204 : segact melval 1205 : IPOI = ielche(1,1) 1206 : else if (nomche(io)(1:4).eq.'RAID') then 1207 : melval = ielval(io) 1208 : segact melval 1209 : xrain = velche(1,1) 1210 : MARAID = 'FLOTTANT' 1211 : else if (nomche(io)(1:4).eq.'JEU') then 1212 : melval = ielval(io) 1213 : segact melval 1214 : XJEU = velche(1,1) 1215 : else if (nomche(io)(1:4).eq.'RAYS') then 1216 : melval = ielval(io) 1217 : segact melval 1218 : XRAYP = velche(1,1) 1219 : else if (nomche(io)(1:4).eq.'GLIS') then 1220 : melval = ielval(io) 1221 : segact melval 1222 : XGLIS = velche(1,1) 1223 : else if (nomche(io)(1:4).eq.'ADHE') then 1224 : melval = ielval(io) 1225 : segact melval 1226 : XADHE = velche(1,1) 1227 : else if (nomche(io)(1:4).eq.'RTAN') then 1228 : melval = ielval(io) 1229 : segact melval 1230 : XRAIT = velche(1,1) 1231 : else if (nomche(io)(1:4).eq.'ATAN') then 1232 : melval = ielval(io) 1233 : segact melval 1234 : XAMOT = velche(1,1) 1235 : else if (nomche(io)(1:4).eq.'AMOR') then 1236 : melval = ielval(io) 1237 : segact melval 1238 : xamon = velche(1,1) 1239 : MONAMO = 'FLOTTANT' 1240 : else 1241 : endif 1242 : enddo 1243 : 1244 : IPALB(I,1) = ITYP 1245 : IPALB(I,3) = IDIM 1246 : XPALB(I,1) = XRAIN 1247 : XPALB(I,2) = XJEU 1248 : XPALB(I,3) = XGLIS 1249 : XPALB(I,4) = XADHE 1250 : XPALB(I,5) = XRAIT 1251 : XPALB(I,6) = XAMOT 1252 : * 1253 : IPNV = (IDIM + 1) * (IPOI - 1) 1254 : PS = 0.D0 1255 : DO 230 ID = 1,IDIM 1256 : XC = XCOOR(IPNV + ID) 1257 : PS = PS + XC * XC 1258 : 230 CONTINUE 1259 : * end do 1260 : IF (PS.LE.0.D0) THEN 1260 : CALL ERREUR(162) 1261 : RETURN 1262 : ENDIF 1263 : IF (MONAMO.EQ.'FLOTTANT') THEN 1264 : IPALB(I,1) = 6 1265 : XPALB(I,7) = XAMON 1266 : ID1 = 7 1267 : ELSE 1268 : ID1 = 6 1269 : ENDIF 1270 : ID8 = ID1 + 7*IDIM 1271 : XPALB(I,ID8+1) = XRAYP 1272 : DO 232 ID = 1,IDIM 1273 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 1274 : 232 CONTINUE 1275 : * end do 1275 : CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) 1276 : IPLIB(I,1) = IPLAC 1277 : * 1278 : else if(cmatee.eq.'CE_CE_FR') then 1279 : ITYP = 25 1280 : MONAMO = ' ' 1281 : MARAID = ' ' 1282 : MONINTER = ' ' 1283 : LINTER = .true. 1284 : do io = 1,n2 1285 : if (nomche(io)(1:4).eq.'NORM') then 1286 : melval = ielval(io) 1287 : segact melval 1288 : IPOI = ielche(1,1) 1289 : else if (nomche(io)(1:4).eq.'RAID') then 1290 : melval = ielval(io) 1291 : segact melval 1292 : xrain = velche(1,1) 1293 : MARAID = 'FLOTTANT' 1294 : else if (nomche(io)(1:4).eq.'EXCE') then 1295 : melval = ielval(io) 1296 : segact melval 1297 : IEXC = ielche(1,1) 1298 : else if (nomche(io)(1:4).eq.'RAYS') then 1299 : melval = ielval(io) 1300 : segact melval 1301 : XRAYP = velche(1,1) 1302 : else if (nomche(io)(1:4).eq.'RAYB') then 1303 : melval = ielval(io) 1304 : segact melval 1305 : XRAYB = velche(1,1) 1306 : else if (nomche(io)(1:4).eq.'GLIS') then 1307 : melval = ielval(io) 1308 : segact melval 1309 : XGLIS = velche(1,1) 1310 : else if (nomche(io)(1:4).eq.'ADHE') then 1311 : melval = ielval(io) 1312 : segact melval 1313 : XADHE = velche(1,1) 1314 : else if (nomche(io)(1:4).eq.'RTAN') then 1315 : melval = ielval(io) 1316 : segact melval 1317 : XRAIT = velche(1,1) 1318 : else if (nomche(io)(1:4).eq.'ATAN') then 1319 : melval = ielval(io) 1320 : segact melval 1321 : XAMOT = velche(1,1) 1322 : else if (nomche(io)(1:4).eq.'CINT') then 1323 : melval = ielval(io) 1324 : segact melval 1325 : LINTER = .false. 1326 : else if (nomche(io)(1:4).eq.'AMOR') then 1327 : melval = ielval(io) 1328 : segact melval 1329 : xamon = velche(1,1) 1330 : MONAMO = 'FLOTTANT' 1331 : else 1332 : endif 1333 : enddo 1334 : 1335 : IF (IERR.NE.0) RETURN 1336 : * 1337 : IPALB(I,1) = ITYP 1338 : IPALB(I,3) = IDIM 1339 : IPALB(I,4) = 1 1340 : IF (.NOT.LINTER) THEN 1341 : IPALB(I,4) = 0 1342 : ENDIF 1343 : XPALB(I,1) = XRAIN 1344 : XPALB(I,2) = XRAYB 1345 : XPALB(I,3) = XGLIS 1346 : XPALB(I,4) = XADHE 1347 : XPALB(I,5) = XRAIT 1348 : XPALB(I,6) = XAMOT 1349 : * 1350 : * normalisation de la normale 1351 : * 1352 : IPNV = (IDIM + 1) * (IPOI - 1) 1353 : IPEX = (IDIM + 1) * (IEXC - 1) 1354 : PS = 0.D0 1355 : DO 330 ID = 1,IDIM 1356 : XC = XCOOR(IPNV + ID) 1357 : PS = PS + XC * XC 1358 : 330 CONTINUE 1359 : * end do 1360 : *** write (6,*) ' ps - 4 ',ps 1361 : IF (PS.LE.0.D0) THEN 1361 : CALL ERREUR(162) 1362 : RETURN 1363 : ENDIF 1364 : IF (MONAMO.EQ.'FLOTTANT') THEN 1365 : ID1 = 7 1366 : IPALB(I,1) = 26 1367 : XPALB(I,7) = XAMON 1368 : ELSE 1369 : ID1 = 6 1370 : ENDIF 1371 : ID10 = ID1 + 9*IDIM 1372 : XPALB(I,ID10+1) = XRAYP 1373 : ID2 = ID1 + IDIM 1374 : ID3 = ID1 + 2*IDIM 1375 : DO 332 ID = 1,IDIM 1376 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS) 1377 : XPALB(I,ID2+ID) = XCOOR(IPEX + ID) 1378 : 332 CONTINUE 1379 : * end do 1379 : CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD) 1380 : IPLIB(I,1) = IPLAC 1381 : * 1382 : else if(cmatee.eq.'PR_PR_IN'.OR.cmatee.eq.'PR_PR_EX') then 1383 : if(cmatee.eq.'PR_PR_IN') ityp = 31 1384 : IF(cmatee.eq.'PR_PR_EX') ITYP = 32 1385 : 1386 : do io = 1,n2 1387 : if (nomche(io)(1:4).eq.'NORM') then 1388 : melval = ielval(io) 1389 : segact melval 1390 : INOR = ielche(1,1) 1391 : else if (nomche(io)(1:4).eq.'RAID') then 1392 : melval = ielval(io) 1393 : segact melval 1394 : xraid = velche(1,1) 1395 : MARAID = 'FLOTTANT' 1396 : else if (nomche(io)(1:4).eq.'PFIX') then 1397 : melval = ielval(io) 1398 : segact melval 1399 : IMA1 = ielche(1,1) 1400 : else if (nomche(io)(1:4).eq.'PMOB') then 1401 : melval = ielval(io) 1402 : segact melval 1403 : IMA2 = ielche(1,1) 1404 : else if (nomche(io)(1:4).eq.'ERAI') then 1405 : melval = ielval(io) 1406 : segact melval 1407 : xpuis = velche(1,1) 1408 : else 1409 : endif 1410 : enddo 1411 : IF (IERR.NE.0) RETURN 1412 : * 1413 : IPALB(I,1) = ITYP 1414 : IPALB(I,3) = IDIM 1415 : XPALB(I,1) = XRAID 1416 : XPALB(I,3) = XPUIS 1417 : ID1 = 3 1418 : IP1 = 5 1419 : * 1420 : * le maillage IMA1 est en {l{ment de type POI1 1421 : MELEME = IMA1 1422 : SEGACT MELEME 1423 : NOMBN1 = NUM(/2) 1424 : IPALB(I,4) = NOMBN1 1425 : IDP = ID1 + 5*IDIM 1426 : DO 512 IE = 1,NOMBN1 1427 : IPT = NUM(1,IE) 1428 : INPT = ( IDIM + 1 ) * ( IPT - 1 ) 1429 : DO 514 ID = 1,IDIM 1430 : XPALB(I,IDP+ID) = XCOOR(INPT + ID) 1431 : 514 CONTINUE 1432 : * end do 1433 : IDP = IDP + IDIM 1434 : 512 CONTINUE 1435 : * end do 1436 : SEGDES MELEME 1437 : * 1438 : * le maillage IMA2 est en {l{ment de type POI1 1439 : MELEME = IMA2 1440 : SEGACT MELEME 1441 : NOMBN2 = NUM(/2) 1442 : IPALB(I,5) = NOMBN2 1443 : DO 516 IE = 1,NOMBN2 1444 : IPT = NUM(1,IE) 1445 : INPT = ( IDIM + 1 ) * ( IPT - 1 ) 1446 : DO 518 ID = 1,IDIM 1447 : XPALB(I,IDP+ID) = XCOOR(INPT + ID) 1448 : 518 CONTINUE 1449 : * end do 1450 : IDP = IDP + IDIM 1451 : 516 CONTINUE 1452 : * end do 1453 : SEGDES MELEME 1453 : CALL PLACE2(JPLIB,NPLB,IPLAC,ISUP) 1454 : IPLIB(I,1) = IPLAC 1455 : * 1456 : * cr{ation d'un rep}re orthonorm{ dans le plan des maillages 1457 : * le point origine est le premier point de IMA1 1457 : CALL DYNE28(INOR,ISUP,XPALB,NLIAB,I,ID1) 1458 : IF (IERR.NE.0) RETURN 1459 : * 1460 : * coefficient des droites form{es par les {l{ments de IMA1 1460 : CALL DYNE29(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1) 1461 : * 1462 : * position initiale de IMA2 par rapport @ IMA1 1462 : CALL DYNE30(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1) 1463 : * 1464 : * calcul de la section du profil mobile 1464 : CALL DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT) 1465 : XPALB(I,2) = XSECT 1466 : * 1467 : * 1468 : else if(cmatee.eq.'LI_LI_FR') then 1469 : ITYP = 35 1470 : MONJEU = ' ' 1471 : MONAMO = ' ' 1472 : MARAID = ' ' 1473 : CMOT = ' ' 1474 : MONESC = ' ' 1475 : MONSYM = ' ' 1476 : MONREC = ' ' 1477 : INOR = 0 1478 : SEGINI MLIGNE 1479 : do io = 1,n2 1480 : if (nomche(io)(1:4).eq.'NORM') then 1481 : melval = ielval(io) 1482 : segact melval 1483 : INOR = ielche(1,1) 1484 : else if (nomche(io)(1:4).eq.'RAID') then 1485 : melval = ielval(io) 1486 : segact melval 1487 : typret=typche(io)(1:8) 1488 : if (typret.eq.'POINTEUR') then 1489 : IRAIES = ielche(1,1) 1490 : MARAID = 'CHPOINT' 1491 : else 1492 : xraide = velche(1,1) 1493 : MARAID = 'FLOTTANT' 1494 : endif 1495 : else if (nomche(io)(1:4).eq.'LIMA') then 1496 : melval = ielval(io) 1497 : segact melval 1498 : IMAI = ielche(1,1) 1499 : else if (nomche(io)(1:4).eq.'LIES') then 1500 : melval = ielval(io) 1501 : segact melval 1502 : MONESC = typche(io)(9:16) 1503 : IESC = ielche(1,1) 1504 : else if (nomche(io)(1:4).eq.'JEU') then 1505 : melval = ielval(io) 1506 : segact melval 1507 : MONJEU = 'FLOTTANT' 1508 : xjeu = velche(1,1) 1509 : else if (nomche(io)(1:4).eq.'RAYB') then 1510 : melval = ielval(io) 1511 : segact melval 1512 : XRAYB = velche(1,1) 1513 : else if (nomche(io)(1:4).eq.'GLIS') then 1514 : melval = ielval(io) 1515 : segact melval 1516 : XGLIS = velche(1,1) 1517 : else if (nomche(io)(1:4).eq.'ADHE') then 1518 : melval = ielval(io) 1519 : segact melval 1520 : XADHE = velche(1,1) 1521 : else if (nomche(io)(1:4).eq.'RTAN') then 1522 : melval = ielval(io) 1523 : segact melval 1524 : XRAIT = velche(1,1) 1525 : else if (nomche(io)(1:4).eq.'ATAN') then 1526 : melval = ielval(io) 1527 : segact melval 1528 : XAMOT = velche(1,1) 1529 : else if (nomche(io)(1:4).eq.'AMOR') then 1530 : melval = ielval(io) 1531 : segact melval 1532 : typret=typche(io)(1:8) 1533 : if (typret.eq.'POINTEUR') then 1534 : typret=typche(io)(9:16) 1535 : iamoes = ielche(1,1) 1536 : MONAMO = 'CHPOINT' 1537 : else 1538 : XAMO = velche(1,1) 1539 : MONAMO = 'FLOTTANT' 1540 : endif 1541 : else if (nomche(io)(1:4).eq.'SYME') then 1542 : melval = ielval(io) 1543 : segact melval 1544 : isyme = ielche(1,1) 1545 : MONSYM = 'MOT' 1546 : if (isyme.eq.1) CMOT1(1:7)='LOCALE' 1547 : if (isyme.eq.2) CMOT1(1:4)='VRAI' 1548 : if (isyme.eq.3) CMOT1(1:7)='GLOBALE' 1549 : else if (nomche(io)(1:4).eq.'RECH') then 1550 : melval = ielval(io) 1551 : segact melval 1552 : irchec = ielche(1,1) 1553 : MONREC = 'MOT' 1554 : if (irchec.eq.1) CMOT(1:7)= 'GLOBALE' 1555 : else 1556 : endif 1557 : enddo 1558 : * IF (IERR.NE.0) RETURN 1559 : * 1560 : IPALB(I,1) = ITYP 1561 : IPALB(I,3) = IDIM 1562 : XPALB(I,3) = XGLIS 1563 : XPALB(I,4) = XADHE 1564 : XPALB(I,5) = XRAIT 1565 : XPALB(I,6) = XAMOT 1566 : * 1567 : IF (MONAMO.EQ.'CHPOINT') THEN 1568 : IPALB(I,1) = 36 1569 : ID1 = 7 1570 : ELSE 1571 : ID1 = 6 1572 : ENDIF 1573 : * Normale au plan 1574 : IF (IDIM.EQ.3) THEN 1574 : if (inor.eq.0) call erreur(5) 1575 : IPNO = (IDIM + 1) * (INOR - 1) 1576 : PS = 0.D0 1577 : DO 80 ID = 1,IDIM 1578 : XC = XCOOR(IPNO + ID) 1579 : PS = PS + XC * XC 1580 : 80 CONTINUE 1581 : * end do 1582 : IF (PS.LE.0.D0) THEN 1582 : CALL ERREUR(162) 1583 : RETURN 1584 : ENDIF 1585 : DO 81 ID=1,IDIM 1586 : XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS) 1587 : 81 CONTINUE 1588 : ELSE 1589 : DO 82 ID=1,IDIM 1590 : XPALB(I,ID1+ID) = 0.D0 1591 : 82 CONTINUE 1592 : ENDIF 1593 : IF (MONJEU.EQ.'FLOTTANT') THEN 1594 : XPALB(I,2) = XJEU 1595 : ELSE 1596 : XPALB(I,2) = 0.D0 1597 : ENDIF 1598 : * La recherche s'effectue par d�faut localement 1599 : IF (MONREC.EQ.'MOT') THEN 1600 : IF (CMOT(1:7).EQ.'GLOBALE') THEN 1601 : IPALB(I,23) = 1 1602 : ELSE 1603 : IPALB(I,23) = 0 1604 : ENDIF 1605 : ELSE 1606 : IPALB(I,23) = 0 1607 : ENDIF 1608 : * Coordonn�es du maillage_maitre 1609 : MELEME = IMAI 1610 : SEGACT MELEME 1611 : * Pour savoir si le contour est ferm� 1612 : NELEMA = NUM(/2) 1613 : IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN 1614 : NNOEMA = NELEMA 1615 : IFERMA = 1 1616 : ELSE 1617 : NNOEMA = NELEMA +1 1618 : IFERMA = 0 1619 : ENDIF 1620 : IPALB(I,21) = NNOEMA 1621 : IPALB(I,24) = IFERMA 1622 : ID2 = ID1 + 4*IDIM 1623 : IPT = NUM(1,1) 1624 : INPT = (IDIM+1)*(IPT-1) 1624 : CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) 1625 : IPLIB(I,1) = IPLAC 1626 : KPLIB(1) = IPT 1627 : DO 84 ID=1,IDIM 1628 : XPALB(I,ID2+ID) = XCOOR(INPT+ID) 1629 : 84 CONTINUE 1630 : DO 85 IE=1,(NNOEMA-1) 1631 : IPT = NUM(2,IE) 1632 : INPT = (IDIM+1)*(IPT-1) 1632 : CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) 1633 : IPLIB(I,IE+1) = IPLAC 1634 : KPLIB(IE+1) = IPT 1635 : IDIE = ID2 + IE*IDIM 1636 : DO 86 ID=1,IDIM 1637 : XPALB(I,IDIE+ID) = XCOOR(INPT+ID) 1638 : 86 CONTINUE 1639 : 85 CONTINUE 1640 : SEGDES MELEME 1641 : * Maillage_esclave 1642 : ID3 = ID2 + NNOEMA*IDIM 1643 : IF (MONESC.EQ.'POINT') THEN 1644 : * La ligne esclave est un point 1645 : NNOEES=1 1646 : IFERES=0 1647 : ISYMET=-1 1648 : * Lecture des coordonn�es 1649 : IPESC = (IDIM+1)*(IESC-1) 1649 : CALL PLACE2(JPLIB,NPLB,IPLAC,IESC) 1650 : IPLIB(I,NNOEMA+1) = IPLAC 1651 : KPLIB(NNOEMA+1) = IESC 1652 : DO 90 ID = 1,IDIM 1653 : XPALB(I,ID3+ID) = XCOOR(IPESC+ID) 1654 : 90 CONTINUE 1655 : * 1656 : IPALB(I,22) = NNOEES 1657 : IPALB(I,25) = IFERES 1658 : IPALB(I,26) = ISYMET 1659 : ELSE 1660 : IF (MONESC.EQ.'MAILLAGE') THEN 1661 : * La ligne esclave est un maillage 1662 : MELEME = IESC 1663 : SEGACT MELEME 1664 : * Pour savoir si le contour est ferm� 1665 : NELEES = NUM(/2) 1666 : IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN 1667 : NNOEES = NELEES 1668 : IFERES = 1 1669 : ELSE 1670 : NNOEES = NELEES +1 1671 : IFERES = 0 1672 : ENDIF 1673 : IPALB(I,22) = NNOEES 1674 : IPALB(I,25) = IFERES 1675 : * Coordonn�es du maillage_esclave 1676 : IPT = NUM(1,1) 1677 : INPT = (IDIM+1)*(IPT-1) 1677 : CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) 1678 : IPLIB(I,NNOEMA+1) = IPLAC 1679 : KPLIB(NNOEMA+1) = IPT 1680 : DO 94 ID=1,IDIM 1681 : XPALB(I,ID3+ID) = XCOOR(INPT+ID) 1682 : 94 CONTINUE 1683 : DO 95 IE=1,(NNOEES-1) 1684 : IPT = NUM(2,IE) 1685 : INPT = (IDIM+1)*(IPT-1) 1685 : CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) 1686 : IPLIB(I,NNOEMA+IE+1) = IPLAC 1687 : KPLIB(NNOEMA+IE+1) = IPT 1688 : IDIE = ID3 + IE*IDIM 1689 : DO 96 ID=1,IDIM 1690 : XPALB(I,IDIE+ID) = XCOOR(INPT+ID) 1691 : 96 CONTINUE 1692 : 95 CONTINUE 1693 : SEGDES MELEME 1694 : * Le traitement sym�trique par d�faut ne s'effectue pas 1695 : IF (MONSYM.EQ.'MOT') THEN 1696 : IF (CMOT1(1:7).EQ.'LOCALE') THEN 1697 : IPALB(I,26) = 1 1698 : ELSE 1699 : IF (CMOT1(1:4).EQ.'VRAI'.OR. 1700 : & CMOT1(1:7).EQ.'GLOBALE') THEN 1701 : IPALB(I,26) = 0 1702 : ELSE 1703 : IPALB(I,26) = -1 1704 : ENDIF 1705 : ENDIF 1706 : ELSE 1707 : IPALB(I,26) = -1 1708 : ENDIF 1709 : ELSE 1710 : * La ligne esclave n'est ni un point ni un maillage 1710 : * CALL ERREUR(...) 1711 : RETURN 1712 : ENDIF 1713 : ENDIF 1714 : * Lecture des chpoints de raideur et d amortissement 1715 : * Raideurs des noeuds esclaves et maitres 1716 : ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM 1717 : MCHPOI=IRAIES 1718 : SEGACT,MCHPOI 1719 : NSOUP=IPCHP(/1) 1720 : DO 700 IPC=1,NSOUP 1721 : MSOUPO=IPCHP(IPC) 1722 : SEGACT,MSOUPO 1723 : MELEME = IGEOC 1724 : SEGACT,MELEME 1725 : MPOVAL = IPOVAL 1726 : SEGACT,MPOVAL 1727 : NNN = NUM(/2) 1728 : DO 711 INN=1,NNN 1729 : IPT = NUM(1,INN) 1729 : CALL PLACE2(KPLIB,NPLB,IPLAC,IPT) 1730 : IF (IPLAC.NE.0) THEN 1731 : XPALB(I,ID4+IPLAC)=VPOCHA(INN,1) 1732 : ENDIF 1733 : 711 CONTINUE 1734 : SEGDES,MPOVAL,MELEME 1735 : SEGDES MSOUPO 1736 : 700 CONTINUE 1737 : SEGDES,MCHPOI 1738 : * Amortissement des noeuds esclaves et maitres 1739 : ID5=ID4+NNOEMA+NNOEES 1740 : IF (IPALB(I,1).EQ.36) THEN 1741 : MCHPOI=IAMOES 1742 : SEGACT,MCHPOI 1743 : NSOUP = IPCHP(/1) 1744 : DO 121 IPC=1,NSOUP 1745 : MSOUPO=IPCHP(IPC) 1746 : SEGACT,MSOUPO 1747 : MELEME = IGEOC 1748 : SEGACT,MELEME 1749 : MPOVAL = IPOVAL 1750 : SEGACT,MPOVAL 1751 : NNN=NUM(/2) 1752 : DO 130 INN=1,NNN 1753 : IPT = NUM(1,INN) 1753 : CALL PLACE2(KPLIB,NPLB,IPLAC,IPT) 1754 : IF (IPLAC.NE.0) THEN 1755 : XPALB(I,ID5+IPLAC)=VPOCHA(INN,1) 1756 : ENDIF 1757 : 130 CONTINUE 1758 : SEGDES MPOVAL,MELEME 1759 : SEGDES MSOUPO 1760 : 121 CONTINUE 1761 : SEGDES MCHPOI 1762 : ENDIF 1763 : SEGSUP MLIGNE 1764 : 1765 : else if(cmatee.eq.'LI_CE_FR') then 1766 : 1767 : 1768 : else if(cmatee.eq.'PA_FL_RO') then 1769 : ITYP = 60 1770 : MONMOT='RODELI' 1771 : MTLIAB = KTLIAB 1772 : * 1773 : NUML = I 1774 : IP1 = imod 1775 : IF (IERR.NE.0) RETURN 1775 : CALL PLACE2(JPLIB,NPLB,IPLAC,IP1) 1776 : IPLIB(NUML,1) = IPLAC 1777 : * 1778 : * Valeurs de IPALB et XPALB communes à tous les types de 1779 : * paliers fluides : 1780 : * 1781 : IPALB(NUML,1) = ITYP 1782 : IPALB(NUML,2) = 0 1783 : IPALB(NUML,3) = 3 1784 : IPALB(NUML,4) = 0 1785 : * 1786 : do io = 1,n2 1787 : if (nomche(io)(1:4).eq.'VISC') then 1788 : melval = ielval(io) 1789 : segact melval 1790 : X1 = velche(1,1) 1791 : XPALB(NUML,1) = X1 1792 : else if (nomche(io)(1:4).eq.'RHOF') then 1793 : melval = ielval(io) 1794 : segact melval 1795 : X1 = velche(1,1) 1796 : XPALB(NUML,2) = X1 1797 : else if (nomche(io)(1:4).eq.'PADM') then 1798 : melval = ielval(io) 1799 : segact melval 1800 : X1 = velche(1,1) 1801 : XPALB(NUML,3) = X1 1802 : else if (nomche(io)(1:4).eq.'LONG') then 1803 : melval = ielval(io) 1804 : segact melval 1805 : X1 = velche(1,1) 1806 : XPALB(NUML,4) = X1 1807 : else if (nomche(io)(1:4).eq.'AFFI') then 1808 : melval = ielval(io) 1809 : segact melval 1810 : X1 = velche(1,1) 1811 : XPALB(NUML,5) = X1 1812 : else if (nomche(io)(1:4).eq.'RAYO') then 1813 : melval = ielval(io) 1814 : segact melval 1815 : X1 = velche(1,1) 1816 : XPALB(NUML,6) = X1 1817 : else if (nomche(io)(1:4).eq.'VROT') then 1818 : melval = ielval(io) 1819 : segact melval 1820 : X1 = velche(1,1) 1821 : XPALB(NUML,7) = X1 1822 : else if (nomche(io)(1:4).eq.'EPSI') then 1823 : melval = ielval(io) 1824 : segact melval 1825 : X1 = velche(1,1) 1826 : XPALB(NUML,8) = X1 1827 : else if (nomche(io)(1:4).eq.'PHII') then 1828 : melval = ielval(io) 1829 : segact melval 1830 : X1 = velche(1,1) 1831 : XPALB(NUML,9) = X1 1832 : else if (nomche(io)(1:4).eq.'TLOB') then 1833 : melval = ielval(io) 1834 : segact melval 1835 : itgeom = ielche(1,1) 1836 : else 1837 : endif 1838 : enddo 1839 : * 1840 : IF (MONMOT.EQ.'RODELI'.and.itgeom.gt.0) THEN 1841 : * ----- Cas du palier cylindrique ou à lobes, avec modèle de Rhode et Li 1842 : * 1843 : IPALB(NUML,5) = 1 1843 : CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0, 1844 : & 'ENTIER',NLOB,X1,' ',L1,IP1) 1845 : 1846 : IF (IERR.NE.0) RETURN 1847 : IPALB(NUML,6) = NLOB 1848 : 1849 : C Nombre de parametres reels : 1850 : NBPR = 6 1851 : IPALB(NUML,7) = NBPR 1852 : 1852 : CALL ACCTAB(ITGEOM,'MOT',I0,X0,'CRITERE_ARRET',L0,IP0, 1853 : & 'FLOTTANT',I1,X1,MONMOT,L1,IP1) 1854 : XPALB(NUML,10) = X1 1855 : 1856 : IF (IERR.NE.0) RETURN 1857 : DO 610 ILOB = 1, NLOB 1858 : * 1858 : CALL ACCTAB(ITGEOM,'ENTIER',ILOB,X0,MONMOT,L0,IP0, 1859 : & 'TABLE',I1,X1,' ',L1,ITLOB) 1860 : 1861 : IF (IERR.NE.0) RETURN 1861 : CALL ACCTAB(ITLOB,'MOT',I0,X0,'NB_MAILLES',L0,IP0, 1862 : & 'ENTIER',I1,X1,' ',L1,IP1) 1863 : IPALB(NUML,7+ILOB) = I1 1864 : 1865 : IF (IERR.NE.0) RETURN 1865 : CALL ACCTAB(ITLOB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0, 1866 : & 'FLOTTANT',I1,X1,MONMOT,L1,IP1) 1867 : XPALB(NUML,11+NBPR*(ILOB-1)) = X1 1868 : 1869 : IF (IERR.NE.0) RETURN 1869 : CALL ACCTAB(ITLOB,'MOT',I0,X0,'ASYMETRIE',L0,IP0, 1870 : & 'FLOTTANT',I1,X1,MONMOT,L1,IP1) 1871 : XPALB(NUML,12+NBPR*(ILOB-1)) = X1 1872 : 1873 : IF (IERR.NE.0) RETURN 1873 : CALL ACCTAB(ITLOB,'MOT',I0,X0,'PRECHARGE',L0,IP0, 1874 : & 'FLOTTANT',I1,X1,MONMOT,L1,IP1) 1875 : XPALB(NUML,13+NBPR*(ILOB-1)) = X1 1876 : 1877 : IF (IERR.NE.0) RETURN 1877 : CALL ACCTAB(ITLOB,'MOT',I0,X0,'ANGLE_DEBUT',L0,IP0, 1878 : & 'FLOTTANT',I1,X1,MONMOT,L1,IP1) 1879 : XPALB(NUML,14+NBPR*(ILOB-1)) = X1 1880 : 1881 : IF (IERR.NE.0) RETURN 1881 : CALL ACCTAB(ITLOB,'MOT',I0,X0,'AMPL_ANGLE',L0,IP0, 1882 : & 'FLOTTANT',I1,X1,MONMOT,L1,IP1) 1883 : XPALB(NUML,15+NBPR*(ILOB-1)) = X1 1884 : 1885 : IF (IERR.NE.0) RETURN 1885 : CALL ACCTAB(ITLOB,'MOT',I0,X0,'COEF_SUR',L0,IP0, 1886 : & 'FLOTTANT',I1,X1,MONMOT,L1,IP1) 1887 : XPALB(NUML,16+NBPR*(ILOB-1)) = X1 1888 : 1889 : IF (IERR.NE.0) RETURN 1890 : 610 CONTINUE 1891 : ENDIF 1892 : * 1893 : else 1894 : write(6,*) 'verifier nom liaison', cmatee 1894 : call erreur(5) 1895 : return 1896 : endif 1897 : enddo 1898 : * 1899 : * traiter liaisons conditionnelles 1900 : * 1901 : DO I = 1,kmodel(/1) 1902 : ksi = 0 1903 : imodel = kmodel(I) 1904 : segact imodel 1905 : if (tymode(/2).gt.0) then 1906 : do 722 ilc = 1,tymode(/2) 1907 : do j =1,kmodel(/1) 1908 : if (kmodel(j).eq.ivamod(ilc)) then 1909 : ksi = ksi + 1 1910 : ipalb(i,4) = 1 1911 : IF (tymode(ilc).EQ.'CONDINFE' ) THEN 1912 : ipalb (i,4+ksi) = j 1913 : ELSE IF (tymode(ilc).EQ.'CONDSUPE' ) THEN 1914 : ipalb (i,4+ksi) = -1 * j 1915 : ENDIF 1916 : endif 1917 : goto 722 1918 : enddo 1919 : 722 continue 1920 : endif 1921 : 723 continue 1922 : ENDDO 1923 : 1924 : * ranger 1925 : do I = 1, kmodel(/1) 1926 : imodel = kmodel(I) 1927 : ipt8 = imamod 1928 : segdes imodel,ipt8 1929 : enddo 1930 : do in = 1,n1 1931 : meleme = imache(in) 1932 : mchaml = ichaml(in) 1933 : segact mchaml 1934 : n2 = ielval(/1) 1935 : do io = 1,n2 1936 : melval = ielval(io) 1937 : segdes melval 1938 : enddo 1939 : segdes meleme,mchaml 1940 : enddo 1941 : segdes mchelm 1942 : * 1943 : * donn�es par table 1944 : * 1945 : ELSE 1946 : * 1947 : DO 10 I = 1,NLIAB 1947 : CALL ACCTAB(ILIB,'ENTIER',I,X0,' ',L0,IP0, 1948 : & 'TABLE',I0,X0,' ',L1,ITLIAI) 1949 : 1950 : icorres ( i )=itliai 1951 : 1952 : IF (IERR.NE.0) RETURN 1952 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SOUSTYPE',L0,IP0, 1953 : & 'MOT',I1,X0,MONMOT,L1,IP1) 1954 : IF (IERR.NE.0) RETURN 1955 : * 1956 : * Liaison �l�mentaire 1957 : * 1958 : IF (MONMOT(1:19).EQ.'LIAISON_ELEMENTAIRE') THEN 1959 : CMOT = ' ' 1959 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0, 1960 : & 'MOT',I1,X0,CMOT,L1,IP1) 1961 : IF (IERR.NE.0) RETURN 1962 : * 1963 : IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN 1964 : ITYP = 7 1964 : CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB) 1965 : IF (IERR.NE.0) RETURN 1966 : ELSE IF (CMOT(1:22).EQ.'CERCLE_PLAN_FROTTEMENT') THEN 1967 : ITYP = 5 1967 : CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB) 1968 : IF (IERR.NE.0) RETURN 1969 : ELSE IF 1970 : & (CMOT(1:30).EQ.'POINT_POINT_ROTATION_PLASTIQUE') THEN 1971 : ITYP = 50 1971 : CALL DYN205(I,ITLIAI,ITYP,KTLIAB,NPLB) 1972 : IF (IERR.NE.0) RETURN 1973 : ELSE IF 1974 : & (CMOT(1:33).EQ.'POINT_POINT_DEPLACEMENT_PLASTIQUE') THEN 1975 : ITYP = 16 1975 : CALL DYN202(I,ITLIAI,ITYP,KTLIAB,NPLB) 1976 : IF (IERR.NE.0) RETURN 1977 : ELSE IF (CMOT(1:21).EQ.'POINT_PLAN_FROTTEMENT') THEN 1978 : ITYP = 3 1978 : CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB) 1979 : IF (IERR.NE.0) RETURN 1980 : ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN 1981 : ITYP = 1 1981 : CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB) 1982 : IF (IERR.NE.0) RETURN 1983 : ELSE IF (CMOT(1:22).EQ.'POINT_POINT_FROTTEMENT') THEN 1984 : ITYP = 13 1984 : CALL DYN202(I,ITLIAI,ITYP,KTLIAB,NPLB) 1985 : IF (IERR.NE.0) RETURN 1986 : ELSE IF (CMOT(1:11).EQ.'POINT_POINT') THEN 1987 : ITYP = 11 1987 : CALL DYN202(I,ITLIAI,ITYP,KTLIAB,NPLB) 1988 : IF (IERR.NE.0) RETURN 1989 : ELSE IF (CMOT(1:24).EQ.'CERCLE_CERCLE_FROTTEMENT') THEN 1990 : ITYP = 25 1990 : CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB) 1991 : IF (IERR.NE.0) RETURN 1992 : ELSE IF (CMOT(1:23).EQ.'POINT_CERCLE_FROTTEMENT') THEN 1993 : ITYP = 23 1993 : CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB) 1994 : IF (IERR.NE.0) RETURN 1995 : ELSE IF (CMOT(1:19).EQ.'POINT_CERCLE_MOBILE') THEN 1996 : ITYP = 33 1996 : CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB) 1997 : IF (IERR.NE.0) RETURN 1998 : ELSE IF (CMOT(1:12).EQ.'POINT_CERCLE') THEN 1999 : ITYP = 21 1999 : CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB) 2000 : IF (IERR.NE.0) RETURN 2001 : ELSE IF (CMOT(1:23).EQ.'PROFIL_PROFIL_INTERIEUR') THEN 2002 : ITYP = 31 2002 : CALL DYN204(I,ITLIAI,ITYP,KTLIAB,NPLB) 2003 : IF (IERR.NE.0) RETURN 2004 : ELSE IF (CMOT(1:23).EQ.'PROFIL_PROFIL_EXTERIEUR') THEN 2005 : ITYP = 32 2005 : CALL DYN204(I,ITLIAI,ITYP,KTLIAB,NPLB) 2006 : IF (IERR.NE.0) RETURN 2007 : ELSE IF (CMOT(1:22).EQ.'LIGNE_LIGNE_FROTTEMENT') THEN 2008 : ITYP = 35 2008 : CALL DYN206(I,ITLIAI,ITYP,KTLIAB,NPLB) 2009 : 2010 : ELSE IF 2011 : &(CMOT(1:23).EQ.'LIGNE_CERCLE_FROTTEMENT') THEN 2012 : ITYP = 37 2012 : CALL DYN207(I,ITLIAI,ITYP,KTLIAB,NPLB) 2013 : 2014 : ELSE IF (CMOT(1:13).EQ.'PALIER_FLUIDE') THEN 2015 : ITYP = 60 2015 : CALL DYN208(I,ITLIAI,ITYP,KTLIAB,NPLB) 2016 : IF (IERR.NE.0) RETURN 2017 : 2018 : 2019 : ELSE 2019 : CALL ERREUR(490) 2020 : RETURN 2021 : ENDIF 2022 : * 2023 : * Liaison ........... 2024 : * 2025 : * ELSE IF (MONMOT(1: ).EQ.' ') THEN 2026 : * ....... 2027 : * ....... 2028 : * 2029 : ELSE 2029 : CALL ERREUR(489) 2030 : RETURN 2031 : ENDIF 2032 : 10 CONTINUE 2033 : * 2034 : * 2035 : * 2036 : * 2037 : * ----- liaisons conditionnelles ? 2038 : * 2039 : * 2040 : DO 911 I = 1,NLIAB 2041 : ksi = 0 2041 : CALL ACCTAB(ILIB,'ENTIER',I,X0,' ',L0,IP0, 2042 : & 'TABLE',I0,X0,' ',L1,ITLIAI) 2043 : 2044 : DO 912 j = 1,NLIAB 2045 : jtliai = icorres ( j ) 2046 : monmot = ' ' 2046 : CALL ACCTAB(ITLIAI,'TABLE',I0,x0,' ',L0,jtliai, 2047 : & monmot,I1,X0,CHARRE,L1,IP1) 2048 : IF (IERR.NE.0) RETURN 2049 : * ------- si on trouve un logique en face d'une table 2050 : * de liaison , c'est bon 2051 : IF (MONMOT.EQ.'LOGIQUE ') THEN 2052 : ksi = ksi + 1 2053 : ipalb(i,4) = 1 2054 : IF (L1 ) tHEN 2055 : ipalb (i,4+ksi) = j 2056 : ELSE IF (.NOT. L1) THEN 2057 : ipalb (i,4+ksi) = -1 * j 2058 : ENDIF 2059 : ENDIF 2060 : 912 CONTINUE 2061 : 911 CONTINUE 2062 : * --------- fin des conditions 2063 : * 2064 : * end do 2065 : ENDIF 2066 : * 2067 : IF (IIMPI.EQ.333) THEN 2068 : NLIAB = IPALB(/1) 2069 : NIPALB = IPALB(/2) 2070 : NXPALB = XPALB(/2) 2071 : NPLBB = IPLIB(/2) 2072 : NPLB = JPLIB(/1) 2073 : DO 1000 IN = 1,NLIAB 2074 : DO 1002 II = 1,NIPALB 2075 : WRITE(IOIMP,*)'DYNE20 : IPALB(',IN,',',II,') =',IPALB(IN,II) 2076 : 1002 CONTINUE 2077 : DO 1004 IX = 1,NXPALB 2078 : WRITE(IOIMP,*)'DYNE20 : XPALB(',IN,',',IX,') =',XPALB(IN,IX) 2079 : 1004 CONTINUE 2080 : DO 1006 IP = 1,NPLBB 2081 : WRITE(IOIMP,*)'DYNE20 : IPLIB(',IN,',',IP,') =',IPLIB(IN,IP) 2082 : 1006 CONTINUE 2083 : 1000 CONTINUE 2084 : DO 1008 IP = 1,NPLB 2085 : WRITE(IOIMP,*)'DYNE20 : JPLIB(',IP,') =',JPLIB(IP) 2086 : 1008 CONTINUE 2087 : ENDIF 2088 : 2089 : * 2090 : RETURN 2091 : END 2092 : 2093 : 2094 : 2095 : 2096 : 2097 : 2098 : 2099 : 2100 : 2101 : 2102 : 2103 : 2104 : 2105 : 2106 :
© Cast3M 2003 - All rights reserved.
Disclaimer