1 : C VARIN6 SOURCE KICH 11/08/11 21:16:11 7079 2 : SUBROUTINE VARIN6(ipmode,icara) 3 : * 4 : * cree compos facultatives modele modal et statique 5 : * 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8(A-H,O-Z) 8 : * 9 : -INC SMCHAML 10 : -INC SMMODEL 11 : -INC CCOPTIO 12 : -INC SMLREEL 13 : -INC SMLMOTS 14 : -INC SMELEME 15 : -INC CCNOYAU 16 : -INC CCREEL 17 : -INC SMLENTI 18 : * 19 : LOGICAL dricr,dmacr,damcr 20 : CHARACTER*4 lesinc(8),lesdua(8) 21 : DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR','UT'/ 22 : DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR','FT'/ 23 : POINTEUR MLENT4.MLENTI,MLENT5.MLENTI,MLENT6.MLENTI, 24 : &MLENT7.MLENTI,MLENT8.MLENTI,MLENT9.MLENTI,MLEN10.MLENTI 25 : POINTEUR MLREAM.MLREEL,MLREE4.MLREEL,MLREE5.MLREEL 26 : C 27 : * 0 : point support, 1: imodel, 2: mchaml, 3: defo, 28 : * 4: ricr , 5: maia, 6, maib, 7: macr, 8: imade, 9: itreac, 10: amcr 29 : jgn = 4 30 : if (ifour.eq.2) then 31 : jgm = 6 32 : segini mlmots 33 : iinc = mlmots 34 : do igm = 1,jgm 35 : mots(igm) = lesinc(igm) 36 : enddo 37 : segini mlmots 38 : idua = mlmots 39 : do igm= 1,jgm 40 : mots(igm) = lesdua(igm) 41 : enddo 42 : else if (ifour.lt.0) then 43 : jgm = 4 44 : segini mlmots 45 : iinc = mlmots 46 : mots(1) = lesinc(1) 47 : mots(2) = lesinc(2) 48 : mots(3) = lesinc(4) 49 : mots(4) = lesinc(5) 50 : segini mlmots 51 : idua = mlmots 52 : mots(1) = lesdua(1) 53 : mots(2) = lesdua(2) 54 : mots(3) = lesdua(4) 55 : mots(4) = lesdua(5) 56 : else if (ifour.eq.0) then 57 : jgm = 3 58 : segini mlmots 59 : iinc = mlmots 60 : mots(1) = lesinc(7) 61 : mots(2) = lesinc(3) 62 : mots(3) = lesinc(6) 63 : segini mlmots 64 : idua = mlmots 65 : mots(1) = lesdua(7) 66 : mots(2) = lesdua(3) 67 : mots(3) = lesdua(6) 68 : else if (ifour.eq.1) then 69 : * a faire 70 : endif 71 : 72 : mchelm = icara 73 : segact mchelm 74 : 75 : mmodel = ipmode 76 : segact mmodel 77 : NBELEM = kmodel(/1) 78 : do im = 1,kmodel(/1) 79 : imodel = kmodel(im) 80 : segact imodel 81 : enddo 82 : 83 : NBNN = 1 84 : NBELEM = kmodel(/1) 85 : JG = NBELEM 86 : segini mlenti,mlent1,mlent2 87 : JG = 0 88 : 89 : do im = 1,kmodel(/1) 90 : imodel = kmodel(im) 91 : if (cmatee.eq.'STATIQUE'.OR.cmatee.eq.'MODAL') then 92 : meleme = imamod 93 : segact meleme 94 : JG = JG + 1 95 : * a ameliorer si maillage non reduit à un point 96 : lect(JG) = num(1,1) 97 : segdes meleme 98 : mlent1.lect(JG) = imodel 99 : do isous = 1,imache(/1) 100 : if (imache(isous).eq.imamod.and.conche(isous).eq.conmod) then 101 : mchaml = ichaml(isous) 102 : segact mchaml*mod 103 : mlent2.lect(JG) = mchaml 104 : endif 105 : enddo 106 : else 107 : segdes imodel 108 : endif 109 : enddo 110 : segadj mlenti,mlent1,mlent2 111 : JG0 = JG 112 : segini mlent3,mlent4,mlent5,mlent6,mlent7,mlent8,mlent9,mlen10 113 : segini mlream 114 : 115 : do jjgg = 1,mlent1.lect(/1) 116 : imodel = mlent1.lect(jjgg) 117 : itreac = 0 118 : imade = 0 119 : idepl = 0 120 : Xm1 = 0.d0 121 : mchaml = mlent2.lect(jjgg) 122 : do ie = 1,ielval(/1) 123 : if (NOMCHE(IE).eq.'DEFO'.and.mlent3.lect(jjgg).eq.0) then 124 : MELVA5 = ielval(ie) 125 : segact melva5 126 : idepl = melva5.ielche(1,1) 127 : segdes melva5 128 : mlent3.lect(jjgg)= idepl 129 : endif 130 : if (NOMCHE(IE).eq.'AMOR') then 131 : MELVA5 = ielval(ie) 132 : segact melva5 133 : xam0 = melva5.velche(1,1) 134 : segdes melva5 135 : mlream.prog(jjgg)= xam0 136 : endif 137 : if (cmatee.eq.'STATIQUE') then 138 : if (NOMCHE(IE).eq.'MADE') then 139 : MELVA6 = ielval(ie) 140 : segact melva6 141 : imade = melva6.ielche(1,1) 142 : mlent8.lect(jjgg) = melva6.ielche(1,1) 143 : segdes melva6 144 : endif 145 : if (NOMCHE(IE).eq.'RIDE') then 146 : MELVA4 = ielval(ie) 147 : segact melva4 148 : itreac = melva4.ielche(1,1) 149 : mlent9.lect(jjgg) = melva4.ielche(1,1) 150 : segdes melva4 151 : endif 152 : endif 153 : enddo 154 : 155 : if(idepl.le.0) then 155 : call erreur(26) 156 : return 157 : endif 158 : if (cmatee.eq.'STATIQUE') then 159 : if (itreac.le.0.or.imade.le.0) then 159 : call erreur(26) 160 : return 161 : endif 162 : endif 163 : 164 : NBNN = 1 165 : NBELEM = JG 166 : NBSOUS = 0 167 : NBREF = 0 168 : 169 : if(mlent4.lect(jjgg).eq.0) then 170 : segini mlreel 171 : mlent4.lect(jjgg) = mlreel 172 : endif 173 : if(mlent5.lect(jjgg).eq.0.and.cmatee.eq.'STATIQUE') then 174 : segini ipt1 175 : mlent5.lect(jjgg) = ipt1 176 : ipt1.ITYPEL = 1 177 : endif 178 : if(mlent6.lect(jjgg).eq.0) then 179 : segini ipt1 180 : mlent6.lect(jjgg) = ipt1 181 : ipt1.ITYPEL = 1 182 : endif 183 : if(mlent7.lect(jjgg).eq.0) then 184 : segini mlreel 185 : mlent7.lect(jjgg) = mlreel 186 : endif 187 : if(mlen10.lect(jjgg).eq.0) then 188 : segini mlreel 189 : mlen10.lect(jjgg) = mlreel 190 : endif 191 : * boucle jjgg 192 : enddo 193 : 194 : 195 : do jjgg = 1,mlent1.lect(/1) 196 : imodel = mlent1.lect(jjgg) 197 : if (cmatee.eq.'STATIQUE') then 198 : itreac = mlent9.lect(jjgg) 199 : imade = mlent8.lect(jjgg) 200 : 201 : 202 : do jg2 = 1,mlent1.lect(/1) 203 : imode2 = mlent1.lect(jg2) 204 : if (jg2.lt.jjgg.and.imode2.cmatee.eq.'STATIQUE') goto 21 205 : idepl = mlent3.lect(jg2) 206 : Xk1 = 0.d0 207 : Xm1 = 0.d0 208 : 208 : CALL XTY1(idepl,itreac,iinc,idua,Xk1) 209 : if (ierr.ne.0) return 210 : if (dabs(Xk1).gt.dble(xspeti)) then 211 : mlreel = mlent4.lect(jjgg) 212 : prog(jg2) = Xk1 213 : * rangement symetrique 214 : mlreel = mlent4.lect(jg2) 215 : prog(jjgg) = Xk1 216 : if (imode2.cmatee.eq.'MODAL') then 217 : * croisé ALFA - BETA 218 : ipt1 = mlent5.lect(jjgg) 219 : ipt1.num(1,jg2) = lect(jg2) 220 : ipt1 = mlent6.lect(jg2) 221 : ipt1.num(1,jjgg) = lect(jjgg) 222 : elseif (imode2.cmatee.eq.'STATIQUE') then 223 : ipt1 = mlent6.lect(jjgg) 224 : ipt1.num(1,jg2) = lect(jg2) 225 : ipt1 = mlent6.lect(jg2) 226 : ipt1.num(1,jjgg) = lect(jjgg) 227 : endif 228 : endif 229 : 230 : xm1 = 0.d0 230 : if(imade.gt.0) CALL XTY1(idepl,imade,iinc,idua,Xm1) 231 : if (ierr.ne.0) return 232 : if (dabs(xm1).gt.dble(xspeti)) then 233 : mlreel = mlent7.lect(jjgg) 234 : prog(jg2) = Xm1 235 : * rangement symetrique 236 : mlreel = mlent7.lect(jg2) 237 : prog(jjgg) = Xm1 238 : if (dabs(Xk1).le.dble(xspeti)) then 239 : if (imode2.cmatee.eq.'MODAL') then 240 : * croisé ALFA - BETA 241 : ipt1 = mlent5.lect(jjgg) 242 : ipt1.num(1,jg2) = lect(jg2) 243 : ipt1 = mlent6.lect(jg2) 244 : ipt1.num(1,jjgg) = lect(jjgg) 245 : elseif (imode2.cmatee.eq.'STATIQUE') then 246 : ipt1 = mlent6.lect(jjgg) 247 : ipt1.num(1,jg2) = lect(jg2) 248 : ipt1 = mlent6.lect(jg2) 249 : ipt1.num(1,jjgg) = lect(jjgg) 250 : endif 251 : endif 252 : * amortissement homologue à la masse 253 : xamo1 = mlream.prog(jg2) 254 : xamo2 = mlream.prog(jjgg) 255 : xamo3 = xamo1*xamo2 256 : if (xamo3.eq.0.) then 257 : xamo = 0. 258 : else 259 : if (jg2.eq.jjgg) then 260 : xamo = dsqrt(dabs(xamo3*Xm1*Xk1)) 261 : else 262 : xamo = dsqrt(dabs(xamo3))*Xm1 263 : endif 264 : if (xamo3.lt.0) xamo = xamo * (-1.d0) 265 : mlreel = mlen10.lect(jjgg) 266 : prog(jg2) = xamo 267 : mlreel = mlen10.lect(jg2) 268 : prog(jjgg) = xamo 269 : endif 270 : * 271 : endif 272 : 273 : 274 : 21 continue 275 : * boucle jg2 276 : enddo 277 : endif 278 : * boucle jjgg 279 : enddo 280 : 281 : do jjgg = 1,mlent5.lect(/1) 282 : NBELEM = 0 283 : ipt1 = mlent5.lect(jjgg) 284 : mlreel = mlent4.lect(jjgg) 285 : if (mlreel.gt.0) then 286 : segini,mlree1=mlreel 287 : else 288 : mlreel = -1 289 : endif 290 : mlree2 = mlent7.lect(jjgg) 291 : if (mlree2.gt.0) then 292 : segini,mlree3=mlree2 293 : else 294 : mlree2 = -1 295 : endif 296 : * write(6,*) jjgg, lect(jjgg),(prog(ii), ii = 1,prog(/1)) 297 : mlree4 = mlen10.lect(jjgg) 298 : if (mlree4.gt.0) then 299 : segini,mlree5=mlree4 300 : else 301 : mlree4 = -1 302 : endif 303 : if (ipt1.gt.0) then 304 : do jg2 = 1,mlent5.lect(/1) 305 : if (ipt1.num(1,jg2).ne.0) then 306 : NBELEM = NBELEM + 1 307 : if (jg2.eq.NBELEM) then 308 : else 309 : ipt1.num(1,NBELEM) = ipt1.num(1,jg2) 310 : if (mlreel.gt.0) then 311 : prog(NBELEM) = mlree1.prog(jg2) 312 : endif 313 : if (mlree2.gt.0) then 314 : mlree2.prog(NBELEM) = mlree3.prog(jg2) 315 : endif 316 : if (mlree4.gt.0) then 317 : mlree4.prog(NBELEM) = mlree5.prog(jg2) 318 : endif 319 : endif 320 : endif 321 : enddo 322 : segadj ipt1 323 : segdes ipt1 324 : endif 325 : if (NBELEM.eq.0) then 326 : segsup ipt1 327 : mlent5.lect(jjgg) = 0 328 : endif 329 : ipt1 = mlent6.lect(jjgg) 330 : JG0 = NBELEM 331 : NBELEM = 0 332 : if (ipt1.gt.0) then 333 : do jg2 = 1,mlent5.lect(/1) 334 : * write(6,*) ipt1,jg2,ipt1.num(1,jg2) 335 : if (ipt1.num(1,jg2).ne.0) then 336 : NBELEM = NBELEM + 1 337 : if (jg2.eq.NBELEM) then 338 : else 339 : ipt1.num(1,NBELEM) = ipt1.num(1,jg2) 340 : endif 341 : * write(6,*) jg2, NBELEM, mlree1.prog(jg2) 342 : if (mlreel.gt.0) then 343 : prog(JG0+NBELEM) = mlree1.prog(jg2) 344 : endif 345 : if (mlree2.gt.0) then 346 : mlree2.prog(JG0+NBELEM) = mlree3.prog(jg2) 347 : endif 348 : if (mlree4.gt.0) then 349 : mlree4.prog(JG0+NBELEM) = mlree5.prog(jg2) 350 : endif 351 : endif 352 : enddo 353 : segadj ipt1 354 : segdes ipt1 355 : endif 356 : JG = JG0 + NBELEM 357 : if (JG.GT.0 ) then 358 : if (mlreel.gt.0) then 359 : segadj mlreel 360 : segdes mlreel 361 : segsup mlree1 362 : endif 363 : if (mlree2.gt.0) then 364 : segadj mlree2 365 : segdes mlree2 366 : segsup mlree3 367 : endif 368 : if (mlree4.gt.0) then 369 : segadj mlree4 370 : segsup mlree5 371 : do iam=1,JG 372 : if (mlree4.prog(iam).ne.0) goto 32 373 : enddo 374 : segsup mlree4 375 : mlen10.lect(jjgg) = 0 376 : goto 33 377 : 32 segdes mlree4 378 : 33 continue 379 : endif 380 : else 381 : if (mlreel.gt.0) then 382 : segsup mlreel,mlree1 383 : mlent4.lect(jjgg) = 0 384 : endif 385 : if (mlree2.gt.0) then 386 : segsup mlree2,mlree3 387 : mlent7.lect(jjgg) = 0 388 : endif 389 : if (mlree4.gt.0) then 390 : segsup mlree4,mlree5 391 : mlen10.lect(jjgg) = 0 392 : endif 393 : endif 394 : if (NBELEM.eq.0) then 395 : segsup ipt1 396 : mlent6.lect(jjgg) = 0 397 : endif 398 : enddo 399 : 400 : 401 : N1PTEL=0 402 : N1EL =0 403 : N2PTEL=1 404 : N2EL =1 405 : 406 : do jjgg = 1,mlent1.lect(/1) 407 : imodel = mlent1.lect(jjgg) 408 : mchaml = mlent2.lect(jjgg) 409 : dricr = .true. 410 : dmacr = .true. 411 : damcr = .true. 412 : nu2 = ielval(/1) 413 : nu20 = nu2 414 : do ie = 1,nu20 415 : 416 : if (nomche(ie)(1:4).eq.'RICR'.and.mlent4.lect(jjgg).gt.0) then 417 : MELVA5 = ielval(ie) 418 : segact melva5 419 : mlree1 = melva5.ielche(1,1) 420 : segdes melva5 421 : mlreel = mlent4.lect(jjgg) 422 : segact mlreel,mlree1 423 : do 211 ig = 1,prog(/1) 424 : do ig1 = 1,mlree1.prog(/1) 425 : if(dabs(prog(ig) - mlree1.prog(ig1)).lt. 426 : &dble(xspeti)*dabs(mlree1.prog(ig1))) goto 211 427 : enddo 428 : * non concordance données utilisateurs / calcul 428 : call erreur(26) 429 : return 430 : 211 continue 431 : dricr = .false. 432 : * on ne pousse pas trop la verif 433 : endif 434 : if (nomche(ie)(1:4).eq.'MACR'.and.mlent7.lect(jjgg).gt.0) then 435 : MELVA5 = ielval(ie) 436 : segact melva5 437 : mlree1 = melva5.ielche(1,1) 438 : segdes melva5 439 : mlreel = mlent7.lect(jjgg) 440 : segact mlreel,mlree1 441 : do 311 ig = 1,prog(/1) 442 : do ig1 = 1,mlree1.prog(/1) 443 : if(dabs(prog(ig) - mlree1.prog(ig1)).lt. 444 : &dble(xspeti)*dabs(mlree1.prog(ig1))) goto 311 445 : enddo 446 : * non concordance données utilisateurs / calcul 446 : call erreur(26) 447 : return 448 : 311 continue 449 : dmacr = .false. 450 : * on ne pousse pas trop la verif 451 : endif 452 : if (nomche(ie)(1:4).eq.'AMCR'.and.mlen10.lect(jjgg).gt.0) then 453 : MELVA5 = ielval(ie) 454 : segact melva5 455 : mlree1 = melva5.ielche(1,1) 456 : segdes melva5 457 : mlreel = mlen10.lect(jjgg) 458 : segact mlreel,mlree1 459 : do 411 ig = 1,prog(/1) 460 : do ig1 = 1,mlree1.prog(/1) 461 : if(dabs(prog(ig) - mlree1.prog(ig1)).lt. 462 : &dble(xspeti)*dabs(mlree1.prog(ig1))) goto 411 463 : enddo 464 : * non concordance données utilisateurs / calcul 464 : call erreur(26) 465 : return 466 : 411 continue 467 : damcr = .false. 468 : * on ne pousse pas trop la verif 469 : endif 470 : 471 : enddo 472 : 473 : n2 = nu2 + 5 474 : segadj mchaml 475 : 476 : if(mlent4.lect(jjgg).gt.0.and.dricr) then 477 : nu2 = nu2 + 1 478 : typche(nu2)='POINTEURLISTREEL' 479 : nomche(nu2)='RICR' 480 : SEGINI,MELVAL 481 : IELVAL(nu2) = MELVAL 482 : ielche(1,1) = mlent4.lect(jjgg) 483 : endif 484 : if(mlent5.lect(jjgg).gt.0.and.(dmacr.or.dricr)) then 485 : nu2 = nu2 + 1 486 : typche(nu2)='POINTEURMAILLAGE' 487 : nomche(nu2)='MAIA' 488 : SEGINI,MELVAL 489 : IELVAL(nu2) = MELVAL 490 : ielche(1,1) = mlent5.lect(jjgg) 491 : endif 492 : if(mlent6.lect(jjgg).gt.0.and.(dmacr.or.dricr)) then 493 : nu2 = nu2 + 1 494 : typche(nu2)='POINTEURMAILLAGE' 495 : nomche(nu2)='MAIB' 496 : SEGINI,MELVAL 497 : IELVAL(nu2) = MELVAL 498 : ielche(1,1) = mlent6.lect(jjgg) 499 : endif 500 : if(mlent7.lect(jjgg).gt.0.and.dmacr) then 501 : nu2 = nu2 + 1 502 : typche(nu2)='POINTEURLISTREEL' 503 : nomche(nu2)='MACR' 504 : SEGINI,MELVAL 505 : IELVAL(nu2) = MELVAL 506 : ielche(1,1) = mlent7.lect(jjgg) 507 : endif 508 : if(mlen10.lect(jjgg).gt.0.and.damcr) then 509 : nu2 = nu2 + 1 510 : typche(nu2)='POINTEURLISTREEL' 511 : nomche(nu2)='AMCR' 512 : SEGINI,MELVAL 513 : IELVAL(nu2) = MELVAL 514 : ielche(1,1) = mlen10.lect(jjgg) 515 : endif 516 : 517 : n2 = nu2 518 : segadj mchaml 519 : segdes mchaml 520 : segdes imodel 521 : enddo 522 : 523 : 524 : mlmots = idua 525 : segsup mlmots 526 : mlmots = iinc 527 : segsup mlmots 528 : * 529 : do im = 1,kmodel(/1) 530 : imodel = kmodel(im) 531 : segact imodel 532 : if (cmatee.eq.'STATIQUE'.OR.cmatee.eq.'MODAL') then 533 : do isous = 1,imache(/1) 534 : if (imache(isous).eq.imamod.and.conche(isous).eq.conmod) then 535 : mchaml = ichaml(isous) 536 : segact mchaml 537 : n2 = ielval(/1) 538 : do in = 1,n2 539 : melval = ielval(in) 540 : segact melval 541 : if(nomche(in).eq.'MAIA') then 542 : ipt1 = ielche(1,1) 543 : segact ipt1 544 : endif 545 : if(nomche(in).eq.'MAIB') then 546 : ipt1 = ielche(1,1) 547 : segact ipt1 548 : endif 549 : enddo 550 : endif 551 : enddo 552 : endif 553 : enddo 554 : * 555 : segsup mlenti,mlent1,mlent2,mlent3,mlent4,mlent5,mlent6,mlent7 556 : segsup mlent8,mlent9,mlen10 557 : segsup mlream 558 : segdes mmodel 559 : segdes mchelm 560 : 561 : RETURN 562 : END 563 : 564 : 565 : 566 : 567 :
© Cast3M 2003 - All rights reserved.
Disclaimer