1 : C DYNE22 SOURCE CHAT 05/01/12 23:15:29 5004 2 : SUBROUTINE DYNE22(ITLB, NLIAB,NXPALB,NPLBB,NPLB,IDIMB,KCPR, 3 : & NIPALB,NIP) 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 Table rassemblant la description des liaisons * 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 : * 37 : SEGMENT,NCPR(XCOOR(/1)/(IDIM+1)) 38 : * 39 : LOGICAL L0,L1 40 : CHARACTER*8 TYPRET,MONSYM,MONESC,CMOT1,CHARRE 41 : CHARACTER*40 CMOT 42 : * 43 : SEGINI,NCPR 44 : KCPR = NCPR 45 : 46 : 47 : 48 : 49 : * 50 : * Boucle sur le nombre de liaisons 51 : * 52 : NXPALB = 0 53 : c c.a.d. 15 liaisons conditionelles (ca marche pas pour 'PROFIL..;') 54 : NIPALB = 20 55 : NPLBB = 0 56 : NPLB = 0 57 : IDIMB = 0 58 : NLIAB = 0 59 : C NIP = 1 dans le cas ou la liaison n'est pas ITYP = 16/17 ou ITYP = 50/51 60 : NIP = 1 61 : IL = 0 62 : 10 CONTINUE 63 : IL = IL+ 1 64 : TYPRET = ' ' 64 : CALL ACCTAB(ITLB,'ENTIER',IL,X0,' ',L0,IP0, 65 : & TYPRET,I0,X0,CHARRE,L1,ITLIAI) 66 : IF (IERR.NE.0) RETURN 67 : IF (ITLIAI.NE.0) THEN 68 : NLIAB = NLIAB + 1 68 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0, 69 : & 'MOT',I1,X0,CMOT,L1,IP1) 70 : IF (IERR.NE.0) RETURN 71 : * 72 : * ------ choc élémentaire POINT_PLAN_FLUIDE 73 : * 74 : IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN 74 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, 75 : & 'POINT',I1,X0,' ',L1,INOE) 76 : IF (IERR.NE.0) RETURN 77 : IF (NCPR(INOE).EQ.0) THEN 78 : NPLB = NPLB + 1 79 : NCPR(INOE) = NPLB 80 : ENDIF 81 : KPLBB = 1 82 : KDIMB = IDIM 83 : KIPALB = 3 84 : KXPALB = 9 + IDIM 85 : NXPALB = MAX(NXPALB,KXPALB) 86 : NIPALB = MAX(NIPALB,KIPALB) 87 : NPLBB = MAX(NPLBB,KPLBB) 88 : IDIMB = MAX(IDIMB,KDIMB) 89 : * 90 : * ------ choc élémentaire POINT_PLAN_FROTTEMENT 91 : * 92 : ELSE IF (CMOT(1:21).EQ.'POINT_PLAN_FROTTEMENT') THEN 93 : TYPRET = ' ' 93 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, 94 : & IP0,TYPRET,I1,X1,' ',L1,IPEVO) 95 : IF (IERR.NE.0) RETURN 96 : * 97 : IF (TYPRET.EQ.'EVOLUTIO')THEN 98 : MEVOLL = IPEVO 99 : SEGACT MEVOLL 100 : KEVOLL = IEVOLL(1) 101 : SEGACT KEVOLL 102 : MLREE1 = IPROGX 103 : MLREE2 = IPROGY 104 : SEGACT MLREE1 105 : SEGACT MLREE2 106 : KNIP = MLREE1.PROG(/1) 107 : SEGDES MLREE1 108 : SEGDES MLREE2 109 : SEGDES KEVOLL 110 : SEGDES MEVOLL 111 : ELSE 112 : KNIP = 0 113 : ENDIF 114 : * 114 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, 115 : & 'POINT',I1,X0,' ',L1,INOE) 116 : IF (IERR.NE.0) RETURN 117 : IF (NCPR(INOE).EQ.0) THEN 118 : NPLB = NPLB + 1 119 : NCPR(INOE) = NPLB 120 : ENDIF 121 : TYPRET = ' ' 122 : KPLBB = 1 123 : KDIMB = IDIM 124 : KIPALB = 3 125 : KXPALB = 7 + 7 * IDIM 126 : NXPALB = MAX(NXPALB,KXPALB) 127 : NIPALB = MAX(NIPALB,KIPALB) 128 : NPLBB = MAX(NPLBB,KPLBB) 129 : IDIMB = MAX(IDIMB,KDIMB) 130 : NIP = MAX(NIP,KNIP) 131 : * 132 : * ------ choc élémentaire POINT_PLAN 133 : * 134 : ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN 135 : TYPRET = ' ' 135 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, 136 : & IP0,TYPRET,I1,X1,' ',L1,IPEVO) 137 : IF (IERR.NE.0) RETURN 138 : * 139 : IF (TYPRET.EQ.'EVOLUTIO')THEN 140 : MEVOLL = IPEVO 141 : SEGACT MEVOLL 142 : KEVOLL = IEVOLL(1) 143 : SEGACT KEVOLL 144 : MLREE1 = IPROGX 145 : MLREE2 = IPROGY 146 : SEGACT MLREE1 147 : SEGACT MLREE2 148 : KNIP = MLREE1.PROG(/1) 149 : SEGDES MLREE1 150 : SEGDES MLREE2 151 : SEGDES KEVOLL 152 : SEGDES MEVOLL 153 : ELSE 154 : KNIP = 0 155 : ENDIF 156 : * 156 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, 157 : & 'POINT',I1,X0,' ',L1,INOE) 158 : IF (IERR.NE.0) RETURN 159 : IF (NCPR(INOE).EQ.0) THEN 160 : NPLB = NPLB + 1 161 : NCPR(INOE) = NPLB 162 : ENDIF 163 : TYPRET = ' ' 164 : KPLBB = 1 165 : KDIMB = IDIM 166 : KIPALB = 4 167 : KXPALB = 3 + IDIM 168 : ** ianis 169 : TYPRET = ' ' 169 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SEUIL_PLASTIQUE', 170 : & L0,IP0,TYPRET,I1,XSEUIL,CHARRE,L1,IP1) 171 : IF (IERR.NE.0) RETURN 172 : IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER ')THEN 173 : KXPALB = 3 + IDIM + 2 174 : ENDIF 175 : * 176 : 177 : NXPALB = MAX(NXPALB,KXPALB) 178 : NIPALB = MAX(NIPALB,KIPALB) 179 : NPLBB = MAX(NPLBB,KPLBB) 180 : IDIMB = MAX(IDIMB,KDIMB) 181 : NIP = MAX(NIP,KNIP) 182 : * 183 : * ----- choc élémentaire POINT_POINT_FROTTEMENT 184 : * 185 : ELSE IF (CMOT(1:22).EQ.'POINT_POINT_FROTTEMENT') THEN 185 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0, 186 : & 'POINT',I1,X0,' ',L1,INOA) 187 : IF (IERR.NE.0) RETURN 188 : IF (NCPR(INOA).EQ.0) THEN 189 : NPLB = NPLB + 1 190 : NCPR(INOA) = NPLB 191 : ENDIF 191 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0, 192 : & 'POINT',I1,X0,' ',L1,INOB) 193 : IF (IERR.NE.0) RETURN 194 : IF (NCPR(INOB).EQ.0) THEN 195 : NPLB = NPLB + 1 196 : NCPR(INOB) = NPLB 197 : ENDIF 198 : TYPRET = ' ' 198 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, 199 : & IP0,TYPRET,I1,X1,' ',L1,IPEVO) 200 : IF (IERR.NE.0) RETURN 201 : * 202 : IF (TYPRET.EQ.'EVOLUTIO')THEN 203 : MEVOLL = IPEVO 204 : SEGACT MEVOLL 205 : KEVOLL = IEVOLL(1) 206 : SEGACT KEVOLL 207 : MLREE1 = IPROGX 208 : MLREE2 = IPROGY 209 : SEGACT MLREE1 210 : SEGACT MLREE2 211 : KNIP = MLREE1.PROG(/1) 212 : SEGDES MLREE1 213 : SEGDES MLREE2 214 : SEGDES KEVOLL 215 : SEGDES MEVOLL 216 : ELSE 217 : KNIP = 0 218 : ENDIF 219 : 220 : KPLBB = 2 221 : KDIMB = IDIM 222 : KIPALB = 3 223 : KXPALB = 7 + 7 * IDIM 224 : NXPALB = MAX(NXPALB,KXPALB) 225 : NIPALB = MAX(NIPALB,KIPALB) 226 : NPLBB = MAX(NPLBB,KPLBB) 227 : IDIMB = MAX(IDIMB,KDIMB) 228 : NIP = MAX(NIP,KNIP) 229 : * 230 : * ----- choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE 231 : * 232 : ELSE IF 233 : & (CMOT(1:33).EQ.'POINT_POINT_DEPLACEMENT_PLASTIQUE') THEN 233 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, 234 : & IP0,'EVOLUTIO',I1,X1,' ',L1,IPEVO) 235 : IF (IERR.NE.0) RETURN 236 : * 237 : MEVOLL = IPEVO 238 : SEGACT MEVOLL 239 : KEVOLL = IEVOLL(1) 240 : SEGACT KEVOLL 241 : MLREE1 = IPROGX 242 : MLREE2 = IPROGY 243 : SEGACT MLREE1 244 : SEGACT MLREE2 245 : KNIP = MLREE1.PROG(/1) 246 : SEGDES MLREE1 247 : SEGDES MLREE2 248 : SEGDES KEVOLL 249 : SEGDES MEVOLL 250 : * 250 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0, 251 : & 'POINT',I1,X0,' ',L1,INOA) 252 : IF (IERR.NE.0) RETURN 253 : IF (NCPR(INOA).EQ.0) THEN 254 : NPLB = NPLB + 1 255 : NCPR(INOA) = NPLB 256 : ENDIF 256 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0, 257 : & 'POINT',I1,X0,' ',L1,INOB) 258 : IF (IERR.NE.0) RETURN 259 : IF (NCPR(INOB).EQ.0) THEN 260 : NPLB = NPLB + 1 261 : NCPR(INOB) = NPLB 262 : ENDIF 263 : TYPRET = ' ' 263 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT', 264 : & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) 265 : IF (IERR.NE.0) RETURN 266 : KPLBB = 2 267 : KDIMB = IDIM 268 : C 269 : KIPALB = 5 270 : IF (TYPRET.EQ.'FLOTTANT') THEN 271 : KXPALB = 5 + IDIM 272 : ELSE IF (TYPRET.EQ.' ') THEN 273 : KXPALB = 4 + IDIM 274 : ELSE 274 : CALL ERREUR(522) 275 : RETURN 276 : ENDIF 277 : NXPALB = MAX(NXPALB,KXPALB) 278 : NIPALB = MAX(NIPALB,KIPALB) 279 : NPLBB = MAX(NPLBB,KPLBB) 280 : IDIMB = MAX(IDIMB,KDIMB) 281 : NIP = MAX(NIP,KNIP) 282 : * 283 : * ----- choc elementaire POINT_POINT_ROTATION_PLASTIQUE 284 : * 285 : ELSE IF 286 : & (CMOT(1:30).EQ.'POINT_POINT_ROTATION_PLASTIQUE') THEN 286 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, 287 : & IP0,'EVOLUTIO',I1,X1,' ',L1,IPEVO) 288 : IF (IERR.NE.0) RETURN 289 : * 290 : MEVOLL = IPEVO 291 : SEGACT MEVOLL 292 : KEVOLL = IEVOLL(1) 293 : SEGACT KEVOLL 294 : MLREE1 = IPROGX 295 : MLREE2 = IPROGY 296 : SEGACT MLREE1 297 : SEGACT MLREE2 298 : KNIP = MLREE1.PROG(/1) 299 : SEGDES MLREE1 300 : SEGDES MLREE2 301 : SEGDES KEVOLL 302 : SEGDES MEVOLL 303 : * 303 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0, 304 : & 'POINT',I1,X0,' ',L1,INOA) 305 : IF (IERR.NE.0) RETURN 306 : IF (NCPR(INOA).EQ.0) THEN 307 : NPLB = NPLB + 1 308 : NCPR(INOA) = NPLB 309 : ENDIF 309 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0, 310 : & 'POINT',I1,X0,' ',L1,INOB) 311 : IF (IERR.NE.0) RETURN 312 : IF (NCPR(INOB).EQ.0) THEN 313 : NPLB = NPLB + 1 314 : NCPR(INOB) = NPLB 315 : ENDIF 316 : TYPRET = ' ' 316 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT', 317 : & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) 318 : IF (IERR.NE.0) RETURN 319 : KPLBB = 2 320 : * 321 : * NW Dans le cas de la rotule, on passe en dimension 6 322 : * car on aura Ux,Uy,Uz,Rx,Ry,Rz 323 : * 324 : KDIMB = 3+IDIM 325 : * 326 : * KIPALB = 5 : nombre maxi de parametres pour la liaison 327 : * 328 : KIPALB = 5 329 : IF (TYPRET.EQ.'FLOTTANT') THEN 330 : KXPALB = 5 + IDIM 331 : ELSE IF (TYPRET.EQ.' ') THEN 332 : KXPALB = 4 + IDIM 333 : ELSE 333 : CALL ERREUR(522) 334 : RETURN 335 : ENDIF 336 : NXPALB = MAX(NXPALB,KXPALB) 337 : NIPALB = MAX(NIPALB,KIPALB) 338 : NPLBB = MAX(NPLBB,KPLBB) 339 : IDIMB = MAX(IDIMB,KDIMB) 340 : NIP = MAX(NIP,KNIP) 341 : * 342 : * ----- choc élémentaire POINT_POINT 343 : * 344 : ELSE IF (CMOT(1:11).EQ.'POINT_POINT') THEN 344 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0, 345 : & 'POINT',I1,X0,' ',L1,INOA) 346 : IF (IERR.NE.0) RETURN 347 : IF (NCPR(INOA).EQ.0) THEN 348 : NPLB = NPLB + 1 349 : NCPR(INOA) = NPLB 350 : ENDIF 350 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0, 351 : & 'POINT',I1,X0,' ',L1,INOB) 352 : IF (IERR.NE.0) RETURN 353 : IF (NCPR(INOB).EQ.0) THEN 354 : NPLB = NPLB + 1 355 : NCPR(INOB) = NPLB 356 : ENDIF 357 : 358 : TYPRET = ' ' 358 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, 359 : & IP0,TYPRET,I1,X1,' ',L1,IPEVO) 360 : IF (IERR.NE.0) RETURN 361 : * 362 : IF (TYPRET.EQ.'EVOLUTIO')THEN 363 : MEVOLL = IPEVO 364 : SEGACT MEVOLL 365 : KEVOLL = IEVOLL(1) 366 : SEGACT KEVOLL 367 : MLREE1 = IPROGX 368 : MLREE2 = IPROGY 369 : SEGACT MLREE1 370 : SEGACT MLREE2 371 : KNIP = MLREE1.PROG(/1) 372 : SEGDES MLREE1 373 : SEGDES MLREE2 374 : SEGDES KEVOLL 375 : SEGDES MEVOLL 376 : ELSE 377 : KNIP = 0 378 : ENDIF 379 : 380 : KPLBB = 2 381 : KDIMB = IDIM 382 : KIPALB = 4 383 : KXPALB = 3 + IDIM 384 : NXPALB = MAX(NXPALB,KXPALB) 385 : NIPALB = MAX(NIPALB,KIPALB) 386 : NPLBB = MAX(NPLBB,KPLBB) 387 : IDIMB = MAX(IDIMB,KDIMB) 388 : NIP = MAX(NIP,KNIP) 389 : * 390 : * ianis 391 : * 392 : * ----- choc élémentaire POINT_CERCLE_MOBILE 393 : * 394 : ELSE IF (CMOT(1:19).EQ.'POINT_CERCLE_MOBILE') THEN 394 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT',L0,IP0, 395 : & 'POINT',I1,X0,' ',L1,INOA) 396 : IF (IERR.NE.0) RETURN 397 : IF (NCPR(INOA).EQ.0) THEN 398 : NPLB = NPLB + 1 399 : NCPR(INOA) = NPLB 400 : ENDIF 400 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'CERCLE',L0,IP0, 401 : & 'POINT',I1,X0,' ',L1,INOB) 402 : IF (IERR.NE.0) RETURN 403 : IF (NCPR(INOB).EQ.0) THEN 404 : NPLB = NPLB + 1 405 : NCPR(INOB) = NPLB 406 : ENDIF 407 : TYPRET = ' ' 407 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0, 408 : & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) 409 : IF (IERR.NE.0) RETURN 410 : KPLBB = 2 411 : * on neglige les rotations 412 : KDIMB = IDIM 413 : KIPALB = 4 414 : IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER ') THEN 415 : KXPALB = 7 + 9 * IDIM 416 : ELSE IF (TYPRET.EQ.' ') THEN 417 : KXPALB = 6 + 9 * IDIM 418 : ELSE 418 : CALL ERREUR(522) 419 : RETURN 420 : ENDIF 421 : NXPALB = MAX(NXPALB,KXPALB) 422 : NIPALB = MAX(NIPALB,KIPALB) 423 : NPLBB = MAX(NPLBB,KPLBB) 424 : IDIMB = MAX(IDIMB,KDIMB) 425 : * 426 : * 427 : * ----- choc élémentaire POINT_CERCLE_FROTTEMENT 428 : * 429 : ELSE IF (CMOT(1:23).EQ.'POINT_CERCLE_FROTTEMENT') THEN 429 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, 430 : & 'POINT',I1,X0,' ',L1,INOE) 431 : IF (IERR.NE.0) RETURN 432 : IF (NCPR(INOE).EQ.0) THEN 433 : NPLB = NPLB + 1 434 : NCPR(INOE) = NPLB 435 : ENDIF 436 : TYPRET = ' ' 436 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0, 437 : & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) 438 : IF (IERR.NE.0) RETURN 439 : KPLBB = 1 440 : KDIMB = IDIM 441 : KIPALB = 4 442 : IF (TYPRET.EQ.'FLOTTANT') 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 : * ----- choc élémentaire POINT_CERCLE 455 : * 456 : ELSE IF (CMOT(1:12).EQ.'POINT_CERCLE') THEN 456 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, 457 : & 'POINT',I1,X0,' ',L1,INOE) 458 : IF (IERR.NE.0) RETURN 459 : IF (NCPR(INOE).EQ.0) THEN 460 : NPLB = NPLB + 1 461 : NCPR(INOE) = NPLB 462 : ENDIF 463 : TYPRET = ' ' 463 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT', 464 : & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) 465 : IF (IERR.NE.0) RETURN 466 : KPLBB = 1 467 : KDIMB = IDIM 468 : KIPALB = 3 469 : IF (TYPRET.EQ.'FLOTTANT') THEN 470 : KXPALB = 3 + 2 * IDIM 471 : ELSE IF (TYPRET.EQ.' ') THEN 472 : KXPALB = 2 + 2 * IDIM 473 : ELSE 473 : CALL ERREUR(522) 474 : RETURN 475 : ENDIF 476 : NXPALB = MAX(NXPALB,KXPALB) 477 : NIPALB = MAX(NIPALB,KIPALB) 478 : NPLBB = MAX(NPLBB,KPLBB) 479 : IDIMB = MAX(IDIMB,KDIMB) 480 : * 481 : * ----- choc élémentaire CERCLE_PLAN_FROTTEMENT 482 : * 483 : ELSE IF (CMOT(1:22).EQ.'CERCLE_PLAN_FROTTEMENT') THEN 483 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, 484 : & 'POINT',I1,X0,' ',L1,INOE) 485 : IF (IERR.NE.0) RETURN 486 : IF (NCPR(INOE).EQ.0) THEN 487 : NPLB = NPLB + 1 488 : NCPR(INOE) = NPLB 489 : ENDIF 490 : TYPRET = ' ' 490 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0, 491 : & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) 492 : IF (IERR.NE.0) RETURN 493 : KPLBB = 1 494 : KDIMB = 2 * IDIM 495 : KIPALB = 3 496 : IF (TYPRET.EQ.'FLOTTANT') THEN 497 : KXPALB = 8 + 7 * IDIM 498 : ELSE IF (TYPRET.EQ.' ') THEN 499 : KXPALB = 7 + 7 * IDIM 500 : ELSE 500 : CALL ERREUR(522) 501 : RETURN 502 : ENDIF 503 : NXPALB = MAX(NXPALB,KXPALB) 504 : NIPALB = MAX(NIPALB,KIPALB) 505 : NPLBB = MAX(NPLBB,KPLBB) 506 : IDIMB = MAX(IDIMB,KDIMB) 507 : * 508 : * ----- choc élémentaire CERCLE_CERCLE_FROTTEMENT 509 : * 510 : ELSE IF (CMOT(1:24).EQ.'CERCLE_CERCLE_FROTTEMENT') THEN 510 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, 511 : & 'POINT',I1,X0,' ',L1,INOE) 512 : IF (IERR.NE.0) RETURN 513 : IF (NCPR(INOE).EQ.0) THEN 514 : NPLB = NPLB + 1 515 : NCPR(INOE) = NPLB 516 : ENDIF 517 : TYPRET = ' ' 517 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0, 518 : & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) 519 : IF (IERR.NE.0) RETURN 520 : KPLBB = 1 521 : KDIMB = 2 * IDIM 522 : KIPALB = 4 523 : IF (TYPRET.EQ.'FLOTTANT') THEN 524 : KXPALB = 8 + 9*IDIM 525 : ELSE IF (TYPRET.EQ.' ') THEN 526 : KXPALB = 7 + 9*IDIM 527 : ELSE 527 : CALL ERREUR(522) 528 : RETURN 529 : ENDIF 530 : NXPALB = MAX(NXPALB,KXPALB) 531 : NIPALB = MAX(NIPALB,KIPALB) 532 : NPLBB = MAX(NPLBB,KPLBB) 533 : IDIMB = MAX(IDIMB,KDIMB) 534 : * 535 : * ----- choc élémentaire PROFIL_PROFIL_INTERIEUR 536 : * ----- choc élémentaire PROFIL_PROFIL_EXTERIEUR 537 : * 538 : ELSE IF (CMOT(1:23).EQ.'PROFIL_PROFIL_INTERIEUR' .OR. 539 : & CMOT(1:23).EQ.'PROFIL_PROFIL_EXTERIEUR') THEN 539 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'PROFIL_FIXE',L0,IP0, 540 : & 'MAILLAGE',I1,X0,' ',L1,IMA1) 541 : IF (IERR.NE.0) RETURN 541 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'PROFIL_MOBILE',L0,IP0, 542 : & 'MAILLAGE',I1,X0,' ',L1,IMA2) 543 : IF (IERR.NE.0) RETURN 543 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, 544 : & 'POINT',I1,X0,' ',L1,INOE) 545 : IF (IERR.NE.0) RETURN 546 : IF (NCPR(INOE).EQ.0) THEN 547 : NPLB = NPLB + 1 548 : NCPR(INOE) = NPLB 549 : ENDIF 550 : KPLBB = 1 551 : KDIMB = 3 551 : CALL CHANGE(IMA1,1) 551 : CALL CHANGE(IMA2,1) 552 : MELEME = IMA1 553 : SEGACT MELEME 554 : NOMBN1 = NUM(/2) 555 : SEGDES MELEME 556 : MELEME = IMA2 557 : SEGACT MELEME 558 : NOMBN2 = NUM(/2) 559 : SEGDES MELEME 560 : KXPALB = 3 + 5*IDIM + 5*NOMBN1 + 3*NOMBN2 561 : KIPALB = 5 + NOMBN1 + 2*NOMBN1*NOMBN2 562 : NXPALB = MAX(NXPALB,KXPALB) 563 : NIPALB = MAX(NIPALB,KIPALB) 564 : NPLBB = MAX(NPLBB,KPLBB) 565 : IDIMB = MAX(IDIMB,KDIMB) 566 : * 567 : * ----- choc élémentaire LIGNE_LIGNE_FROTTEMENT 568 : * 569 : ELSE IF 570 : & (CMOT(1:22).EQ.'LIGNE_LIGNE_FROTTEMENT') THEN 570 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0, 571 : & 'MAILLAGE',I1,X1,' ',L1,IMAI) 572 : IF (IERR.NE.0) RETURN 573 : MONESC= ' ' 573 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0, 574 : & MONESC,I1,X1,CHARRE,L1,IESC) 575 : TYPRET = ' ' 575 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENTS', 576 : & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) 577 : IF (IERR.NE.0) RETURN 578 : * 579 : MELEME = IMAI 580 : SEGACT MELEME 581 : NELEMA = NUM(/2) 582 : IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN 583 : NNOEMA = NELEMA 584 : ELSE 585 : NNOEMA = NELEMA+1 586 : ENDIF 587 : INOE = NUM(1,1) 588 : IF (NCPR(INOE).EQ.0) THEN 589 : NPLB = NPLB + 1 590 : NCPR(INOE) = NPLB 591 : ENDIF 592 : DO 20 IE = 1,(NNOEMA-1) 593 : INOE = NUM(2,IE) 594 : IF (NCPR(INOE).EQ.0) THEN 595 : NPLB = NPLB + 1 596 : NCPR(INOE) = NPLB 597 : ENDIF 598 : 20 CONTINUE 599 : SEGDES MELEME 600 : * Maillage_esclave 601 : IF (MONESC.EQ.'POINT') THEN 602 : * La ligne-esclave est un point 603 : IF (NCPR(IESC).EQ.0) THEN 604 : NPLB = NPLB + 1 605 : NCPR(IESC) = NPLB 606 : ENDIF 607 : NNOEES=1 608 : ELSE 609 : IF (MONESC.EQ.'MAILLAGE') THEN 610 : * La ligne-esclave est un MAILLAGE 611 : MELEME = IESC 612 : SEGACT MELEME 613 : NELEES = NUM(/2) 614 : IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN 615 : NNOEES = NELEES 616 : ELSE 617 : NNOEES = NELEES+1 618 : ENDIF 619 : INOE = NUM(1,1) 620 : IF (NCPR(INOE).EQ.0) THEN 621 : NPLB = NPLB + 1 622 : NCPR(INOE) = NPLB 623 : ENDIF 624 : DO 30 IE = 1,(NNOEES-1) 625 : INOE = NUM(2,IE) 626 : IF (NCPR(INOE).EQ.0) THEN 627 : NPLB = NPLB + 1 628 : NCPR(INOE) = NPLB 629 : ENDIF 630 : 30 CONTINUE 631 : SEGDES MELEME 632 : ENDIF 633 : ENDIF 634 : KPLBB = NNOEMA + NNOEES 635 : IF (IDIM.EQ.3) THEN 636 : KDIMB = 6 637 : ELSE 638 : KDIMB = 3 639 : ENDIF 640 : * Pour le nombre maxi de paramètres entiers on prend 641 : * en compte les 16 espaces dus aux liaisons conditionnelles 642 : * + nos 10 autres propres paramètres 643 : * + la place pour les noeuds voisins 644 : * + la place pour les indicateurs de choc 645 : KIPALB = 16 + 10 +3*(NNOEMA+NNOEES) 646 : * 647 : IF (TYPRET.EQ.'CHPOINT') THEN 648 : KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+ 649 : &NNOEES) 650 : ELSE IF (TYPRET.EQ.' ') THEN 651 : KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+ 652 : &NNOEES) 653 : ELSE 653 : CALL ERREUR(522) 654 : RETURN 655 : ENDIF 656 : * 657 : NXPALB = MAX(NXPALB,KXPALB) 658 : NIPALB = MAX(NIPALB,KIPALB) 659 : NPLBB = MAX(NPLBB,KPLBB) 660 : IDIMB = MAX(IDIMB,KDIMB) 661 : 662 : 663 : 664 : * 665 : * ----- choc élémentaire LIGNE_CERCLE_FROTTEMENT 666 : 667 : 668 : ELSE IF 669 : & (CMOT(1:23).EQ.'LIGNE_CERCLE_FROTTEMENT') THEN 669 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0, 670 : & 'MAILLAGE',I1,X1,' ',L1,IMAI) 671 : IF (IERR.NE.0) RETURN 672 : MONESC= ' ' 672 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0, 673 : & MONESC,I1,X1,CHARRE,L1,IESC) 674 : TYPRET = ' ' 674 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENTS', 675 : & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) 676 : IF (IERR.NE.0) RETURN 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 40 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 : 40 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 50 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 : 50 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.' ') THEN 750 : KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+ 751 : &NNOEES) 752 : ELSE 752 : CALL ERREUR(522) 753 : RETURN 754 : ENDIF 755 : * 756 : NXPALB = MAX(NXPALB,KXPALB) 757 : NIPALB = MAX(NIPALB,KIPALB) 758 : NPLBB = MAX(NPLBB,KPLBB) 759 : IDIMB = MAX(IDIMB,KDIMB) 760 : 761 : * 762 : * ------ liaison PALIER_FLUIDE 763 : * 764 : ELSE IF (CMOT(1:13).EQ.'PALIER_FLUIDE') THEN 765 : * 766 : KPLBB = 1 767 : KDIMB = IDIM 768 : * 769 : C I) Gestion du point support 770 : * 770 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_SUPPORT',L0,IP0, 771 : & 'POINT',I1,X0,' ',L1,INOE) 772 : IF (IERR.NE.0) RETURN 773 : IF (NCPR(INOE).EQ.0) THEN 774 : NPLB = NPLB + 1 775 : NCPR(INOE) = NPLB 776 : ENDIF 777 : * 778 : C II) Décompte du nombre de paramètres entiers et réels 779 : * 779 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'MODELE_PALIER',L0,IP0, 780 : & 'MOT',I1,X0,CMOT,L1,IP1) 781 : IF (IERR.NE.0) RETURN 782 : * 783 : C II.1) Décompte du nombre de paramètres propres aux différents types 784 : C de paliers (KIPLB2 pour les entiers, LXPLB2 pour les réels) : 785 : * 786 : IF (CMOT.EQ.'RODELI') THEN 787 : * 788 : C -- Cas du palier cylindrique ou à lobes, avec modèle de Rhode et Li : 789 : * 789 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'GEOMETRIE_PALIER', 790 : & L0,IP0,'TABLE',I0,X0,' ',L1,ITGEOM) 791 : IF (IERR.NE.0) RETURN 791 : CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0, 792 : & 'ENTIER',NLOB,X0,' ',L1,IP1) 793 : IF (IERR.NE.0) RETURN 794 : KIPLB2 = 2 + NLOB 795 : KXPLB2 = 1 + (6*NLOB) 796 : * 797 : C -- Cas des autres types de paliers (à définir si nécessaire) 798 : * 799 : C ELSE IF (CMOT.EQ.'...') THEN 800 : C KIPLB2 = ... 801 : C KXPLB2 = ... 802 : ENDIF 803 : * 804 : C II.2) Nombres totaux de paramètres entiers et réels : 805 : * 806 : KIPALB = 5 + KIPLB2 807 : KXPALB = 7 + KXPLB2 + 4 808 : * 809 : C Dimensionnement des variables de sortie : 810 : * 811 : NXPALB = MAX(NXPALB,KXPALB) 812 : NIPALB = MAX(NIPALB,KIPALB) 813 : NPLBB = MAX(NPLBB,KPLBB) 814 : IDIMB = MAX(IDIMB,KDIMB) 815 : * 816 : * --> fin liaison PALIER 817 : * 818 : 819 : ELSE 819 : CALL ERREUR(490) 820 : RETURN 821 : ENDIF 822 : GOTO 10 823 : ENDIF 824 : 825 : 826 : * 827 : END 828 : 829 : 830 : 831 : 832 : 833 : 834 : 835 : 836 : 837 : 838 :
© Cast3M 2003 - All rights reserved.
Disclaimer