1 : C BSIGMX SOURCE BP208322 13/10/02 21:15:09 7830 2 : subroutine BSIGMX (IMODEL,IVACAR,IVASTR,ncar1,NFOR, 3 : & IVAFOR,ADPG,BDPG,CDPG,IIPDPG,IRETER) 4 : 5 : c 6 : C PROCEDURE UTILISEE DANS LE CAS D'ELEMENTS XFEM 7 : c POUR LE CALCUL DE la force interne (=B^T sigma) 8 : C 9 : C 10 : C********************************************************* 11 : C PARTIE DECLARATIVE 12 : C********************************************************* 13 : 14 : C 15 : IMPLICIT REAL*8(A-H,O-Z) 16 : C 17 : PARAMETER (NDDLMAX=30,NBNIMAX=10) 18 : PARAMETER (NBENRMAX=5) 19 : DIMENSION MLRE(NBENRMAX+1),NCOMPCUM(NBENRMAX+1) 20 : C 21 : -INC CCOPTIO 22 : -INC SMCOORD 23 : -INC SMMODEL 24 : -INC SMCHAML 25 : -INC SMINTE 26 : -INC SMELEME 27 : -INC SMLREEL 28 : -INC CCREEL 29 : C 30 : POINTEUR MCHEX1.MCHELM,MINT1.MINTE,MINT2.MINTE 31 : C 32 : C Segment (type LISTENTI) contenant les informations sur un element 33 : SEGMENT INFO 34 : INTEGER INFELL(JG) 35 : ENDSEGMENT 36 : c 37 : SEGMENT WRK1 38 : REAL*8 XE(3,NBBB) 39 : REAL*8 XSTRS(LHOOK) 40 : REAL*8 XFORC(LRE),XFINC(LRE) 41 : ENDSEGMENT 42 : c 43 : SEGMENT WRK2 44 : REAL*8 SHPWRK(6,NBNO),BGENE(LHOOK,LRE) 45 : REAL*8 LV7WRK(NBENRMA2,2,6,NBBB) 46 : ENDSEGMENT 47 : c 48 : SEGMENT MPTVAL 49 : INTEGER IPOS(NS),NSOF(NS) 50 : INTEGER IVAL(NCOSOU) 51 : CHARACTER*16 TYVAL(NCOSOU) 52 : ENDSEGMENT 53 : C 54 : SEGMENT MRACC 55 : INTEGER TLREEL(NBENRMA2,NBI) 56 : ENDSEGMENT 57 : c 58 : DIMENSION UDPGE(3) 59 : LOGICAL BDPGE 60 : C 61 : * write (*,*) '############################' 62 : * write (*,*) '##### DEBUT DE BSIGMX #####' 63 : * write (*,*) '############################' 64 : IVADIM = 0 65 : C 66 : C********************************************************* 67 : c Introduction du point autour duquel se fait le mouvement 68 : c de la section en defo plane generalisee 69 : C********************************************************* 70 : C 71 : ADPG=XZero 72 : BDPG=XZero 73 : CDPG=XZero 74 : IF (IFOUR.EQ.-3) THEN 75 : IP=IIPDPG 76 : IREF=(IP-1)*(IDIM+1) 77 : XDPGE=XCOOR(IREF+1) 78 : YDPGE=XCOOR(IREF+2) 79 : ELSE 80 : XDPGE=XZero 81 : YDPGE=XZero 82 : ENDIF 83 : C 84 : C 85 : C********************************************************* 86 : c 87 : C RECUPERATION + ACTIVATIONS + VALEURS UTILES 88 : c 89 : C********************************************************* 90 : C SEGACT MMODEL,IMODEL deja actif 91 : c 92 : C++++ Activation au cas ou ++++++++++++++++++++++++++++++ 93 : SEGACT MCOORD 94 : 95 : C++++ Recup + Activation de la geometrie ++++++++++++++++ 96 : MELEME= IMAMOD 97 : c SEGACT MELEME deja actif 98 : C nbre de noeuds par element 99 : NBNN1 = NUM(/1) 100 : C nbre d elements 101 : NBEL1 = NUM(/2) 102 : 103 : C++++ RECUP DES INFOS EF ++++++++++++++++++++++++++++++++ 104 : c + OBTENUES PAR ELQUOI DANS RIGI1 PENDANT PHASE 1 105 : C segment INFO deja actif dans RIGI1 106 : c + rigi1 n appelle pas elquoi, c'est modeli qui l'a fait 107 : c mais du coup, on na pas de segment minte 108 : c (car depend de si pt de g pour rigi, pour sigma....) 109 : c c'est + simple de rappeler elquoi ici 110 : MELE = NEFMOD 110 : call elquoi(MELE,0,3,IPINF,IMODEL) 111 : INFO = IPINF 112 : c MELE = INFELL(1) 113 : c NBPGA2= INFELL(2) 114 : c NBPGAU= INFELL(3) 115 : c NBPGAU= INFELL(4) 116 : c ICARA = INFELL(5) 117 : NGAU1 = INFELL(6) 118 : c LW = INFELL(7) 119 : LRE = INFELL(9) 120 : LHOOK = INFELL(10) 121 : MINT1 = INFELL(11) 122 : segact,MINT1 123 : MINT2 = INFELL(12) 124 : if(MINT2.ne.0) segact,MINT2 125 : MFR = INFELL(13) 126 : IELE = INFELL(14) 127 : NDDL = INFELL(15) 128 : NSTRS = INFELL(16) 129 : c write(6,*)'-> EPSIX infell',(infell(iou),iou=1,16) 130 : 131 : c REM: pour se passer du dimensionnement du nbre d'enrichissement dans 132 : c elquoi et le realiser localement , on pourrait ecrire: 133 : c LRE = NDDLMAX*NBNN1 134 : c NDDL= NDDLMAX 135 : 136 : C sous decoupage et points de Gauss de l element geometrique de base 137 : if(MELE.EQ.263.OR.MELE.EQ.264) then 138 : NGAU2 = MINT2.POIGAU(/1) 139 : endif 140 : c write(*,*) 'dim de MINT2=6,',(MINT2.SHPTOT(/2)),(MINT2.SHPTOT(/3)) 141 : c write(*,*) 'MINT2',(MINT2.QSIGAU(iou),iou=1,NGAU) 142 : c segdes,MINT2 143 : 144 : c nbre maxi de fonction de forme par noeud (fonction std comprise) 145 : c NBNI = NDDL/IDIM inutile! 146 : 147 : 148 : C++++ Recup des infos d enrichissement +++++++++++++++++++ 149 : c recup du MCHEX1 d'enrichissement 150 : NOBMO1 = IVAMOD(/1) 151 : if(NOBMO1.ne.0) then 152 : do iobmo1=1,NOBMO1 153 : if((TYMODE(iobmo1)).eq.'MCHAML') then 154 : MCHEX1 = IVAMOD(iobmo1) 155 : segact,MCHEX1 156 : if((MCHEX1.TITCHE).eq.'ENRICHIS') then 157 : MCHAM1 = MCHEX1.ICHAML(1) 158 : segact,MCHAM1 159 : segdes,MCHEX1 160 : goto 1000 161 : endif 162 : segdes,MCHEX1 163 : endif 164 : enddo 165 : write(*,*) 'Le modele est vide (absence d enrichissement)' 166 : * return 167 : else 168 : write(*,*) 'Il n y a pas de MCHEML enrichissement dans le Modele' 169 : * return 170 : endif 171 : 172 : 1000 continue 173 : c niveau d enrichissement(s) du modele (ddls std u exclus) 174 : c NBENR1= 0 si std, 1 si H seul, 2 si H+F1, 3 si H+F1+F2, etc... 175 : if(NOBMO1.ne.0) then 176 : NBENR1= MCHAM1.IELVAL(/1) 177 : else 178 : NBENR1= 0 179 : endif 180 : c write(*,*) 'niveau d enrichissement(s) du modele',NBENR1 181 : c 182 : C 183 : C 184 : C********************************************************* 185 : C INITIALISATIONS... 186 : C********************************************************* 187 : IRETER = 0 188 : DIM3 = 1.D0 189 : NCOSOU = 0 190 : c 191 : c preparation des tables avec: 192 : 193 : if(NBENR1.ne.0) then 194 : do ienr=1,NBENR1 195 : c -le nombre d'inconnues de chaque sous-zone 196 : c determinee depuis le nombre de fonction de forme 197 : c ienr= 1: U+H(1+1=2), 2: U+H+F1(2+4=6), 3: U+H+F1+F2(6+4=10) 198 : nbniJ = 2 + ((ienr-1)*4) 199 : MLRE(1+ienr) = IDIM*NBNN1*nbniJ 200 : NCOSOU = NCOSOU + (IDIM*nbniJ) 201 : enddo 202 : endif 203 : C Tables + longues car 1er indice correspond au fontion de forme std 204 : MLRE(1) = IDIM*NBNN1*1 205 : NCOSOU = NCOSOU + (IDIM) 206 : 207 : if(NBENR1.lt.(NBENRMAX+1)) then 208 : do ienr=(NBENR1+1),(NBENRMAX) 209 : MLRE(1+ienr) = 0 210 : enddo 211 : endif 212 : c 213 : c ...DU SEGMENT WRK1 214 : NBENRMA2 = NBENRMAX 215 : NBBB = NBNN1 216 : SEGINI,WRK1 217 : 218 : c ...DU SEGMENT WRK2 219 : c NBNO = NBNI 220 : NBNO = LRE/IDIM 221 : SEGINI,WRK2 222 : C 223 : c ...DU SEGMENT MRACC 224 : NBENRMA2 = NBENRMAX 225 : NBI = NBNN1 226 : segini,MRACC 227 : C 228 : C 229 : c ...DU SEGMENT IVAFOR de type MPTVAL 230 : MPTVAL = IVAFOR 231 : * on change NS = IPOS(/1) et NCOSOU = IVAL(/1) (calculé + haut) 232 : NS = 1 + NBENR1 233 : * write(*,*) 'segadj IVAFOR aux dim',NS,NCOSOU 234 : segadj,MPTVAL 235 : c on remplit NSOF avec le nombre de composante par sous-zone 236 : c et NCOMPCUM avec le nombre de composante cumulée 237 : NCUMUL1 = 0 238 : do ienr1=0,NBENR1 239 : NCOMPCUM(1+ienr1) = NCUMUL1 240 : NSOF1 = (MLRE(1+ienr1)) / NBNN1 241 : NSOF(1+ienr1) = NSOF1 242 : NCUMUL1 = NCUMUL1 + NSOF1 243 : enddo 244 : if(NBENR1.lt.(NBENRMAX+1)) then 245 : do ienr=(NBENR1+1),(NBENRMAX) 246 : NCOMPCUM(1+ienr1) = NCUMUL1 247 : enddo 248 : endif 249 : c on recupere les dimensions (MAXI) 250 : MELVAL = IVAL(1) 251 : N1PTEL = VELCHE(/1) 252 : N1EL = VELCHE(/2) 253 : N2PTEL = IELCHE(/1) 254 : N2EL = IELCHE(/2) 255 : c write(*,*) 'MELVAL de taille maxi=',N1PTEL,N1EL,N2PTEL,N2EL 256 : c 257 : 258 : 259 : C********************************************************* 260 : C 261 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> BOUCLE SUR LES ELEMENTS 262 : C 263 : DO 2000 J=1,NBEL1 264 : c write(*,*) '========= EF',J,' /',NBEL1,'=========' 265 : C 266 : C 267 : C********************************************************* 268 : C POUR CHAQUE ELEMENT, ... 269 : C********************************************************* 270 : C 271 : C++++ ON RECUPERE LES COORDONNEES DES NOEUDS DE L ELEMENT 271 : CALL DOXE(XCOOR,IDIM,NBNN1,NUM,J,XE) 272 : C 273 : c 274 : C++++ NBENRJ = niveau d enrichissement de l element ++++ 275 : C =0 si EF std =1 si U+H =2 si U+H+F1 =3 si U+H+F1+F2 276 : NBENRJ=0 277 : if(NBENR1.ne.0) then 278 : do IENR=1,NBENR1 279 : MELVA1 = MCHAM1.IELVAL(IENR) 280 : segact,MELVA1 281 : do I=1,NBNN1 282 : mlree1 = MELVA1.IELCHE(I,J) 283 : C on en profite pour remplir MRACC table de raccourcis pour cet element 284 : TLREEL(IENR,I) = mlree1 285 : if(mlree1.ne.0) then 286 : NBENRJ = max(NBENRJ,IENR) 287 : C et on active la listreel 288 : segact,mlree1 289 : endif 290 : enddo 291 : segdes,MELVA1 292 : enddo 293 : endif 294 : if(NBENRMA2.gt.NBENR1) then 295 : do IENR2=(NBENR1+1),NBENRMA2 296 : do I=1,NBNN1 297 : TLREEL(IENR2,I) = 0 298 : enddo 299 : enddo 300 : endif 301 : C 302 : c 303 : c++++ quelques indices pour dimensionner au plus juste 304 : c nbre total de ddl de l'élément considéré 305 : NLIGRD = MLRE(1+NBENRJ) 306 : NLIGRP = MLRE(1+NBENRJ) 307 : c nbre fonction de forme=((Ni_std+Ni_enrichi)*nbnoeud)=Ninconnues/idim 308 : NBNI = (MLRE(1+NBENRJ)) / IDIM 309 : c write(*,*) 'EF',J,' NBENRJ=',NBENRJ, 310 : c &'donc',NLIGRD,' ddls et ',NBNI,' fonctions de forme' 311 : c 312 : c 313 : c++++ Selon le niveau d enrichissement, 314 : c 315 : C + On copie cet element a la geo correspondante 316 : IPT1 = IPOS(1+NBENRJ) 317 : c si elle n existe pas, il faut la creer 318 : if(IPT1.eq.0) then 319 : NBNN =NBNN1 320 : NBELEM=1 321 : NBSOUS=0 322 : NBREF=0 323 : segini,IPT1 324 : IPT1.ITYPEL = ITYPEL 325 : IPOS(1+NBENRJ)=IPT1 326 : c si elle existe, il faut l agrandir 327 : else 328 : NBNN =NBNN1 329 : NBELEM = (IPT1.NUM(/2)) + 1 330 : NBSOUS=0 331 : NBREF=0 332 : segadj,IPT1 333 : endif 334 : J1 = NBELEM 335 : c copie en cours 336 : do I=1,NBNN1 337 : IPT1.NUM(I,NBELEM) = NUM(I,J) 338 : enddo 339 : 340 : C + On en profite pour créer les MELVA2 si ils n existent pas 341 : MPTVAL = IVAFOR 342 : NCUMUL1 = NCOMPCUM(1+NBENRJ) 343 : NCOMP2 = NSOF(1+NBENRJ) 344 : do icomp2=1,NCOMP2 345 : MELVA2 = IVAL(NCUMUL1+icomp2) 346 : if(MELVA2.eq.0) then 347 : c N1PTEL N1EL,N2PTEL,N2EL = dim MAX : récupérés + haut 348 : segini,MELVA2 349 : IVAL(NCUMUL1+icomp2) = MELVA2 350 : endif 351 : enddo 352 : 353 : c 354 : C++++ MISE A 0 DES FORCES ++++ 355 : C 355 : CALL ZERO(XFINC,1,NLIGRP) 356 : c 357 : c 358 : c rem: il serait probablement interessant au niveau du tems cpu 359 : c d'utiliser moins de pts de Gauss lorsque l element est élastique 360 : c On pourrait par ex. utiliser MINT2 = infell(12) qui contient 361 : c le segment d'integration de l'EF std (QUA4 par ex.) 362 : * if((NBENRJ.eq.0).and.(MINT2.ne.0)) then 363 : * MINTE = MINT2 364 : * NBPGAU= NGAU2 365 : * else 366 : MINTE = MINT1 367 : NBPGAU= NGAU1 368 : * endif 369 : c 370 : NBPTEL=NBPGAU 371 : C 372 : C********************************************************* 373 : C 374 : IDIM1 = IDIM + 1 375 : C>>>>>>>>>> BOUCLE SUR LES POINTS DE GAUSS 376 : C 377 : DO 2500 KGAU=1,NBPGAU 378 : C 379 : C********************************************************* 380 : C Initialisation à 0 381 : C********************************************************* 382 : 383 : c ZERO ne serait-il pas facultatif? 383 : CALL ZERO(SHPWRK,6,NBNO) 384 : XGAU = 0.D0 385 : YGAU = 0.D0 386 : ZGAU = 0.D0 387 : C 388 : i6zz = 3 389 : IF (IDIM.EQ.3) i6zz = 4 390 : C 391 : c do ienr7=1,NBENRMAX 392 : do ienr7=1,NBENRJ 393 : do inod7=1,NBNN1 394 : c do i6=1,6 395 : do i6=1,i6zz 396 : LV7WRK(ienr7,1,i6,inod7) = 0.D0 397 : LV7WRK(ienr7,2,i6,inod7) = 0.D0 398 : enddo 399 : enddo 400 : enddo 401 : 402 : 403 : c********************************************************* 404 : c Calcul des fonction de forme std dans repere local 405 : c********************************************************* 406 : 407 : ccccc BOUCLE SUR LES NOEUDS ccccccccccccccccccccccccccccc 408 : c (et donc sur les Ni std) 409 : DO 2510 I=1,NBNN1 410 : DO 2511 JJ=1,IDIM1 411 : 412 : C++++ Calcul des Ni std 413 : c (rappel: 1:Ni 2:Ni,qsi 3:Ni,eta avec i=1,4) 414 : SHPWRK(JJ,I) = SHPTOT(JJ,I,KGAU) 415 : 2511 CONTINUE 416 : 417 : C++++ Calcul des coordonnees dans le repere global 418 : XGAU = XGAU + (SHPWRK(1,I)*XE(1,I)) 419 : YGAU = YGAU + (SHPWRK(1,I)*XE(2,I)) 420 : IF (IDIM.EQ.3) ZGAU = ZGAU + (SHPWRK(1,I)*XE(3,I)) 421 : 422 : 2510 CONTINUE 423 : ccccc fin de BOUCLE SUR LES NOEUDS ccccccccccccccccccccccc 424 : 425 : 426 : 427 : c********************************************************* 428 : c Passage des fonctions de forme std dans repere global 429 : c********************************************************* 430 : 431 : C++++ CALCUL DES Ni,x Ni,y (i=1,4) + CALCUL DE det(J) 431 : CALL JACOBI(XE,SHPWRK,IDIM,NBNN1,DJAC) 432 : c 433 : C PRISE EN COMPTE DU POIDS D'INTEGRATION 434 : DJAC = ABS(DJAC) * POIGAU(KGAU) 435 : c 436 : C PRISE EN COMPTE DE L EPAISSEUR (cas Contrainte Planes) 437 : IF (IFOUR.EQ.-2)THEN 438 : MPTVAL=IVACAR 439 : IF (IVACAR.NE.0) THEN 440 : MELVAL=IVAL(1) 441 : IF (MELVAL.NE.0) THEN 442 : IGMN=MIN(KGAU,VELCHE(/1)) 443 : IBMN=MIN(J,VELCHE(/2)) 444 : DIM3=VELCHE(IGMN,IBMN) 445 : DJAC=DJAC*DIM3 446 : c ELSE 447 : c DIM3=1.D0 448 : ENDIF 449 : ENDIF 450 : ENDIF 451 : c 452 : c if(J.eq.1.and.KGAU.eq.1) 453 : c &write(*,*) 'Ni(i=1,4)=',(SHPWRK(1,iou),iou=1,NBNN1) 454 : 455 : c********************************************************* 456 : c Si on est pas du tout enrichi on peut sauter une grosse partie 457 : c********************************************************* 458 : if(NBENRJ.eq.0) goto 2999 459 : 460 : c********************************************************* 461 : c Calcul des level set + leurs derivees dans repere global 462 : c********************************************************* 463 : 464 : ccccc BOUCLE SUR LES enrichissements ccccccccccccccccccc 465 : do 2520 ienr=1,NBENRJ 466 : 467 : c MELVA1=MCHAM1.IELVAL(IENR) 468 : c segact,MELVA1 469 : 470 : ccccc BOUCLE SUR LES NOEUDS ccccccccccccccccccccccccccc 471 : DO 2521 I=1,NBNN1 472 : 473 : C++++ Le I eme noeud est-il ienr-enrichi? 474 : mlree1= TLREEL(IENR,I) 475 : if(mlree1.eq.0) goto 2521 476 : 477 : 478 : c Calcul du repere local de fissure(=PSI,PHI) 479 : c (rappel: 1,1:psi 1,2:phi 2,1 psi,x ...etc...) 480 : do 2522 inode=1,NBNN1 481 : c pour le H-enrichissement, on n a pas gardé PSI (inutile) 482 : if(ienr.ne.1) then 483 : c valeur de PSI au inode^ieme noeud 484 : xpsi1 = mlree1.PROG(inode) 485 : c qu on multiplie par la valeur de Ni^std au pt de G considéré 486 : do 2523 jj=1,IDIM1 487 : LV7WRK(ienr,1,JJ,I)= LV7WRK(ienr,1,JJ,I) 488 : & + (SHPWRK(JJ,inode)*xpsi1) 489 : 2523 continue 490 : 491 : C IF (IDIM.EQ.3) LV7WRK(ienr,1,4,I)= LV7WRK(ienr,1,4,I) 492 : C & + (SHPWRK(4,inode)*xpsi1) 493 : c valeur de PHI au inode^ieme noeud 494 : xphi1 = mlree1.PROG(NBNN1+inode) 495 : else 496 : xphi1 = mlree1.PROG(inode) 497 : endif 498 : do 2524 jj=1,IDIM1 499 : LV7WRK(ienr,2,jj,I)= LV7WRK(ienr,2,jj,I) 500 : & + (SHPWRK(jj,inode)*xphi1) 501 : C IF (IDIM.EQ.3) LV7WRK(ienr,2,4,I)= LV7WRK(ienr,2,4,I) 502 : C & + (SHPWRK(4,inode)*xphi1) 503 : 2524 continue 504 : 2522 continue 505 : 506 : 2521 continue 507 : ccccc fin de BOUCLE SUR LES NOEUDS ccccccccccccccccccccccc 508 : 509 : 510 : 2520 CONTINUE 511 : ccccc fin de BOUCLE SUR LES enrichissements cccccccccccccccc 512 : 513 : c on a construit 514 : C LV7WRK(ienr, PSI/PHI, valeur/deriveeparqsi/pareta, iNOEUD) 515 : 516 : 517 : c********************************************************* 518 : c Ajout des fonctions de forme d enrichissement 519 : c + leurs derivees dans repere global 520 : c********************************************************* 520 : CALL SHAPX(XGAU,YGAU,ZGAU,MELE,LV7WRK,NBENRMAX,NBENRJ, 521 : & TLREEL,J,SHPWRK,IRET) 522 : 523 : 524 : c retour a la partie commune aux EF enrichi et non enrichi 525 : 2999 continue 526 : 527 : C********************************************************* 528 : C CALCUL DE B 529 : C********************************************************* 530 : c ZERO ne serait-il pas facultatif? 530 : c call ZERO(BGENE,LHOOK,NLIGRP) 531 : KB=1 532 : C boucle sur tous les Ni 533 : DO 3001 II=1,NBNI 534 : 535 : BGENE(1,KB) = SHPWRK(2,II) 536 : BGENE(2,KB+1) = SHPWRK(3,II) 537 : BGENE(4,KB) = SHPWRK(3,II) 538 : BGENE(4,KB+1) = SHPWRK(2,II) 539 : 540 : IF(IDIM.EQ.3) THEN 541 : BGENE(3,KB+2)=SHPWRK(4,II) 542 : BGENE(5,KB)=SHPWRK(4,II) 543 : BGENE(5,KB+2)=SHPWRK(2,II) 544 : BGENE(6,KB+1)=SHPWRK(4,II) 545 : BGENE(6,KB+2)=SHPWRK(3,II) 546 : ENDIF 547 : 548 : KB = KB + IDIM 549 : 550 : 3001 CONTINUE 551 : C 552 : c 553 : C********************************************************* 554 : C CALCUL DE sigma 555 : C********************************************************* 556 : MPTVAL = IVASTR 557 : DO 3200 ICOMP=1,LHOOK 558 : MELVAL = IVAL(ICOMP) 559 : IGMN = MIN(KGAU,VELCHE(/1)) 560 : IBMN = MIN(J ,VELCHE(/2)) 561 : XSTRS(ICOMP) = VELCHE(IGMN,IBMN) 562 : * XSTRS(ICOMP) = VELCHE(KGAU,J) 563 : 3200 CONTINUE 564 : 565 : 566 : C********************************************************* 567 : C CALCUL DE Fint = B^T * sigma 568 : C********************************************************* 569 : c 569 : CALL ZERO(XFORC,1,NLIGRP) 569 : CALL BSIG(BGENE,XSTRS,LHOOK,NLIGRP,DJAC,XFORC) 570 : c 571 : * rem: matrice d'efficacite presente dans bsigm1.eso non copiée ici 572 : c 573 : c cumul 574 : do ii = 1,NLIGRP 575 : XFINC(ii) = XFINC(ii) + XFORC(ii) 576 : enddo 577 : c 578 : c 579 : 2500 CONTINUE 580 : C FIN DE BOUCLE SUR LES POINTS DE GAUSS <<<<<<<<<<<<<< 581 : C 582 : C 583 : C EXTRACTION DES FORCES AU NOEUD SUPPORT DE LA DEF PLAN GENE 584 : C ON CALCULE LES RESULTANTES DES FORCES SUR CHAQUE ELEMENT 585 : C AU NOEUD NSDPGE 586 : C 587 : NFOFO=NFOR 588 : IF (IFOUR.EQ.-3) THEN 589 : NFOFO=NFOR-3 590 : ADPG=ADPG+XFINC(NBNN1*NFOFO+1) 591 : BDPG=BDPG+XFINC(NBNN1*NFOFO+2) 592 : CDPG=CDPG+XFINC(NBNN1*NFOFO+3) 593 : ELSE IF (IFOUR.EQ. 7.OR.IFOUR.EQ. 8.OR.IFOUR.EQ.9.OR. 594 : . IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN 595 : NFOFO=NFOR-1 596 : ADPG=ADPG+XFINC(NBNN1*NFOFO+1) 597 : ELSE IF (IFOUR.EQ.11) THEN 598 : NFOFO=NFOR-2 599 : ADPG=ADPG+XFINC(NBNN1*NFOFO+1) 600 : BDPG=BDPG+XFINC(NBNN1*NFOFO+2) 601 : ENDIF 602 : c 603 : C 604 : C ON RANGE XFORC DANS le bon MELVAL 605 : c car plusieurs fois la meme composante dans ivafor pour créer des zones 606 : C 607 : MPTVAL = IVAFOR 608 : INITOT = 0 609 : C-->> BOUCLE SUR LES niveaux d'ENRICHISSEMENTS (0:U 1:A 2:BCDE1 3:BCDE2) 610 : DO IENR=0,NBENRJ 611 : *nbre de fonction(s) de ce niveau d'enrichissement (=1 si std ou H, =4 pour F1,2,...) 612 : if(IENR .le. 1) then 613 : NBNIENR = 1 614 : else 615 : NBNIENR = 4 616 : endif 617 : C---->> BOUCLE SUR LES fonctions de forme de ce type d'enrichissement 618 : DO INI=1,NBNIENR 619 : INITOT = INITOT + 1 620 : C------>> BOUCLE SUR LA DIMENSION 621 : DO KDIM=1,IDIM 622 : ICOMP = (INITOT-1)*IDIM + KDIM 623 : c MELVAL = IVAL(ICOMP) 624 : MELVAL = IVAL(NCUMUL1+ICOMP) 625 : C---------->> BOUCLE SUR LES NOEUDS 626 : DO I=1,NBNN1 627 : IQ = ((INITOT-1)*NBNN1*IDIM) + ((I-1)*IDIM) + KDIM 628 : * IBMN=MIN(IB ,VELCHE(/2)) 629 : * VELCHE(KGAU,IBMN) = XFINC(IQ) 630 : VELCHE(I,J1) = XFINC(IQ) 631 : ENDDO 632 : ENDDO 633 : ENDDO 634 : ENDDO 635 : c 636 : c quelques desactivations 637 : do IENR=1,NBENR1 638 : do I=1,NBNN1 639 : mlree1 = TLREEL(IENR,I) 640 : if(mlree1.ne.0) segdes,mlree1 641 : enddo 642 : enddo 643 : c 644 : c 645 : c 646 : 2000 CONTINUE 647 : C FIN DE BOUCLE SUR LES ELEMENTS <<<<<<<<<<<<<<<<<<<<< 648 : c 649 : c 650 : 651 : C********************************************************* 652 : C SUPPRESSION ET DESACTIVATION DE SEGMENTS 653 : C********************************************************* 654 : C 655 : SEGSUP,WRK1,WRK2 656 : SEGSUP,MRACC 657 : 658 : segdes,MINT1 659 : if(MINT2.ne.0) segdes,MINT2 660 : c 661 : c ajustement avant retour des MELVAL contenus dans IVAFOR 662 : c en focntion de la géométrie créée 663 : MPTVAL = IVAFOR 664 : do 3000 ienr1=0,NBENR1 665 : IPT1 = IPOS(1+ienr1) 666 : if(IPT1.eq.0) goto 3000 667 : N1PTEL = IPT1.NUM(/1) 668 : N1EL = IPT1.NUM(/2) 669 : N2PTEL = 1 670 : N2EL = 1 671 : NCUMUL1= NCOMPCUM(1+ienr1) 672 : NCOMP2 = NSOF(1+ienr1) 673 : c write(6,*) '=======ienr1=',ienr1,'/',NBENR1,'======' 674 : c write(6,*) 'de dim geo=',N1PTEL,N1EL 675 : c write(6,*) 'avec',NCOMP2,'composantes apres lindice',NCUMUL1 676 : do icomp2=1,NCOMP2 677 : MELVA2 = IVAL(NCUMUL1+icomp2) 678 : c write(6,*) MELVA2,'=',(MELVA2.VELCHE(iou,N1EL),iou=1,4) 679 : if(MELVA2.ne.0) segadj,MELVA2 680 : enddo 681 : 3000 continue 682 : C 683 : RETURN 684 : END 685 : 686 : 687 : 688 : 689 : 690 : 691 : 692 : 693 : 694 : 695 : 696 :
© Cast3M 2003 - All rights reserved.
Disclaimer