1 : C BSIGM1 SOURCE CHAT 11/03/16 21:15:48 6902 2 : SUBROUTINE BSIGM1(IPMAIL,LRE,NSTRS,NBPGAU,MELE,MFR,IVASTR, 3 : & IPMINT,IVACAR,IPORE,LHOOK,NFOR,IVAFOR,ADPG,BDPG,CDPG 4 : & , IIPDPG,NCAR1) 5 : *---------------------------------------------------------------------- 6 : * ______________________________ * 7 : * | | * 8 : * | CALCUL DES FORCES AUX NOEUDS| * 9 : * |______________________________| * 10 : * * 11 : * massif, poreux, incompressibles * 12 : * * 13 : *---------------------------------------------------------------------* 14 : * * 15 : * ENTREES : * 16 : * ________ * 17 : * * 18 : * IPMAIL Pointeur sur un segment MELEME ACTIF E/S * 19 : * LRE Nombre de ddl dans la matrice de rigidite * 20 : * NSTRS Nombre de composante de contraintes/deformations * 21 : * NBPGAU Nombre de points d'integration pour les contraintes * 22 : * MELE Numero de l'element fini * 23 : * MFR Numero de la formulation * 24 : * IVASTR pointeur sur un segment MPTVAL contenant les * 25 : * les melvals de contraints * 26 : * IPMINT Pointeur sur un segment MINTE ACTIF E/S * 27 : * IVACAR pointeur sur un segment MPTVAL de caracteristiques * 28 : * IPORE Nombre de fonctions de forme * 29 : * LHOOK Taille de la matrice de hooke * 30 : * NFOR Nombre de composantes de forces * 31 : * * 32 : * SORTIES : * 33 : * ________ * 34 : * * 35 : * IVAFOR pointeur sur un segment MPTVAL contenant les * 36 : * les melvals de forces * 37 : * * 38 : * ADPG forces aux noeud support des * 39 : * BDPG deformations planes generalisees * 40 : * CDPG * 41 : * * 42 : *---------------------------------------------------------------------* 43 : IMPLICIT INTEGER(I-N) 44 : IMPLICIT REAL*8(A-H,O-Z) 45 : 46 : -INC CCOPTIO 47 : -INC CCREEL 48 : -INC CCHAMP 49 : -INC CCGEOME 50 : 51 : -INC SMCHAML 52 : -INC SMCHPOI 53 : -INC SMELEME 54 : -INC SMCOORD 55 : -INC SMMODEL 56 : -INC SMINTE 57 : C 58 : SEGMENT MWRK1 59 : REAL*8 XFORC(LRE), XFINC(LRE),XSTRS(NSTRS), XE(3,NBBB) 60 : REAL*8 SHPWRK(6,NBNO), BGENE(LHOOK,LRE) 61 : ENDSEGMENT 62 : * 63 : SEGMENT MWRK3 64 : REAL*8 BPSS(3,3),XEL(3,NBBB) 65 : ENDSEGMENT 66 : * 67 : SEGMENT MWRK5 68 : REAL*8 XGENE(NSTN,LRN) 69 : ENDSEGMENT 70 : * 71 : segment mwrk67 72 : real*8 valcar(nca1) 73 : endsegment 74 : * 75 : SEGMENT MPTVAL 76 : INTEGER IPOS(NS) ,NSOF(NS) 77 : INTEGER IVAL(NCOSOU) 78 : CHARACTER*16 TYVAL(NCOSOU) 79 : ENDSEGMENT 80 : * 81 : CHARACTER*8 CMATE,CELEM 82 : DIMENSION A(4,60),BB(3,60),xatef1(3,3) 83 : logical drend 84 : * 85 : MELEME=IPMAIL 86 : NBNN=NUM(/1) 87 : NBELEM=NUM(/2) 88 : * 89 : IDECAP=0 90 : NHRM=NIFOUR 91 : IELE=NUMGEO(MELE) 92 : * 93 : MINTE=IPMINT 94 : C_______________________________________________________________________ 95 : C 96 : C NUMERO DES ETIQUETTES : 97 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT 98 : C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR : 99 : C 5 CONTINUE 100 : C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ... 101 : C 44 CONTINUE 102 : C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ... 103 : C_______________________________________________________________________ 104 : C 105 : GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99, 106 : 1 99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 107 : 2 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 108 : 3 99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4,99,99, 4,99,99,79,79, 109 : 4 79,79,79,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 110 : 5 99,99,99,99,99,99,99,80,80,80, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 111 : 6 4, 4),MELE 112 : * 113 : IF (MELE.EQ.183.OR.MELE.EQ.184.OR. 114 : . MELE.EQ.193.OR.MELE.EQ.194) GOTO 4 115 : IF(MELE.GE.173.AND.MELE.LE.182) GO TO 173 116 : * 117 : GOTO 99 118 : C_______________________________________________________________________ 119 : C 120 : C SECTEUR DE CALCUL POUR LES ELEMENTS MASSIFS ET ELEMENTS INCOMPRESSIBLES 121 : C_______________________________________________________________________ 122 : C 123 : 4 CONTINUE 124 : DIM3=1.D0 125 : NBNO=NBNN 126 : NBBB=NBNN 127 : C 128 : C INTRODUCTION DES COORD DU POINT AUTOUR DUQUEL SE FAIT LE 129 : C MOUVEMENT DE LA SECTION EN DEFO PLANE GENERALISEE 130 : C Pas de rotation en 1D 131 : C ET INITIALISATION DES FORCES AU NOEUD SUPPORT DE LA DEFO 132 : C PLANE GENERALISEE 133 : C 134 : ADPG=XZero 135 : BDPG=XZero 136 : CDPG=XZero 137 : IF (IFOUR.EQ.-3)THEN 138 : IP=IIPDPG 139 : IREF=(IP-1)*(IDIM+1) 140 : XDPGE=XCOOR(IREF+1) 141 : YDPGE=XCOOR(IREF+2) 142 : ELSE 143 : XDPGE=XZero 144 : YDPGE=XZero 145 : ENDIF 146 : C 147 : SEGINI MWRK1 148 : mwrk67=0 149 : 150 : DO 3004 IB=1,NBELEM 151 : C 152 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 153 : C 153 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 154 : C 155 : C MISE A 0 DES FORCES 156 : C 156 : CALL ZERO(XFINC,1,LRE) 157 : C 158 : C CALCUL DES COEFF DE MODIFICATION DE LA MATRICE B-BARRE (INCOMPRES) 159 : C 160 : IF (MFR.EQ.31) THEN 160 : CALL BBCALC(XE,MELE,NBNN,IDIM,NBPGAU, 161 : 1 POIGAU,QSIGAU,ETAGAU,DZEGAU,NSTRS, 162 : 2 LRE,IFOUR,A,BB,NHRM,SHPTOT,SHPWRK,XDPGE,YDPGE) 163 : ENDIF 164 : C 165 : C BOUCLE SUR LES POINTS DE GAUSS 166 : C 167 : ISDJC=0 168 : DO 5004 IGAU=1,NBPGAU 169 : C 170 : C RECUPERATION DE L'EPAISSEUR 171 : C 172 : IF (IFOUR.EQ.-2)THEN 173 : MPTVAL=IVACAR 174 : IF (IVACAR.NE.0) THEN 175 : MELVAL=IVAL(1) 176 : IF (MELVAL.NE.0) THEN 177 : IGMN=MIN(IGAU,VELCHE(/1)) 178 : IBMN=MIN(IB,VELCHE(/2)) 179 : DIM3=VELCHE(IGMN,IBMN) 180 : ELSE 181 : DIM3=1.D0 182 : ENDIF 183 : ENDIF 184 : ENDIF 185 : * 185 : CALL BMATST(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU, 186 : 1 MELE,MFR,NBNN,LRE,IFOUR,NSTRS,NHRM,DIM3, 187 : 2 XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 188 : 189 : IF (DJAC.EQ.0.D0) THEN 190 : INTERR(1)=IB 190 : CALL ERREUR(259) 191 : GOTO 9904 192 : ENDIF 193 : IF (DJAC.LT.0.D0) ISDJC=ISDJC+1 194 : DJAC=ABS(DJAC)*POIGAU(IGAU) 195 : 196 : C En cas d'elements incompressibles : BGENE selon la methode B-BARRE 197 : IF (MFR.EQ.31) THEN 197 : CALL BBAR(IGAU,NBPGAU, POIGAU,QSIGAU,ETAGAU,DZEGAU, 198 : & MELE,NBNN,LRE,IFOUR,NSTRS,XE,DJAC,A,BB,BGENE) 199 : ENDIF 200 : C 201 : C ON CHERCHE LES CONTRAINTES 202 : C 203 : MPTVAL=IVASTR 204 : DO 6004 ICOMP=1,NSTRS 205 : MELVAL=IVAL(ICOMP) 206 : IGMN=MIN(IGAU,VELCHE(/1)) 207 : IBMN=MIN(IB ,VELCHE(/2)) 208 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 209 : 6004 CONTINUE 210 : C 211 : C CALCUL DE B*SIGMA 212 : C 213 : * initialise 213 : CALL ZERO(XFORC,1,LRE) 214 : * contribution point d integration 214 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 215 : * matrice d'efficacite 216 : drend = .false. 217 : MPTVAL=IVACAR 218 : IF (IVACAR.GT.0) THEN 219 : segact mptval 220 : nca1 = ival(/1) 221 : if (mwrk67.eq.0) segini mwrk67 222 : if (nca1.ne.valcar(/1)) segadj mwrk67 223 : celem = 'MASSIF ' 224 : IF(IVAL(NCAR1).GT.0.OR.IVAL(NCAR1+1).GT.0) THEN 225 : DO 9008 IM= 1,IVAL(/1) 226 : IF (IVAL(IM).GT.0) THEN 227 : MELVAL=IVAL(IM) 228 : IF (TYVAL(IM).EQ.'REAL*8') THEN 229 : IBMN=MIN(IB ,VELCHE(/2)) 230 : IGMN=MIN(IGAU,VELCHE(/1)) 231 : VALCAR(IM)=VELCHE(IGMN,IBMN) 232 : ELSE 233 : IBMN=MIN(IB ,IELCHE(/2)) 234 : IGMN=MIN(IGAU,IELCHE(/1)) 235 : VALCAR(IM)=IELCHE(IGMN,IBMN) 236 : ENDIF 237 : ELSE 238 : VALCAR(IM)=0.D0 239 : ENDIF 240 : 9008 CONTINUE 241 : nstep = 2 242 : if (ifour.eq.2) nstep = 3 243 : if (ival(ncar1).gt.0.and.tyval(ncar1).eq.'REAL*8') then 244 : drend = .true. 245 : do i = 1,nstep 246 : do j = 1, nstep 247 : xatef1(i,j) = 0.d0 248 : enddo 249 : xatef1(i,i) = valcar(ncar1) 250 : enddo 251 : endif 252 : if (ival(ncar1).eq.0.and.tyval(ncar1+1).eq.'REAL*8') then 253 : drend = .false. 254 : do i = 1,nstep 255 : do j = 1, nstep 256 : xatef1(i,j) = 0.d0 257 : enddo 258 : xatef1(1,1) = valcar(ncar1+7) 259 : xatef1(2,2) = valcar(ncar1+8) 260 : if (nstep.eq.3) xatef1(3,3) = valcar(ncar1+9) 261 : enddo 262 : endif 262 : call effi3(valcar,tyval,nca1,ncar1,xforc,lre,ib,igau,xatef1, 263 : & nstep,drend,celem) 264 : ENDIF 265 : ENDIF 266 : * stocke 267 : do ii = 1,LRE 268 : xfinc(ii) = xfinc(ii) + xforc(ii) 269 : enddo 270 : * 271 : 5004 CONTINUE 272 : 273 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 274 : INTERR(1)=IB 274 : CALL ERREUR(195) 275 : GOTO 9904 276 : ENDIF 277 : C 278 : C EXTRACTION DES FORCES AU NOEUD SUPPORT DE LA DEF PLAN GENE 279 : C ON CALCULE LES RESULTANTES DES FORCES SUR CHAQUE ELEMENT 280 : C AU NOEUD NSDPGE 281 : C 282 : NFOFO=NFOR 283 : IF (IFOUR.EQ.-3) THEN 284 : NFOFO=NFOR-3 285 : ADPG=ADPG+XFINC(NBNN*NFOFO+1) 286 : BDPG=BDPG+XFINC(NBNN*NFOFO+2) 287 : CDPG=CDPG+XFINC(NBNN*NFOFO+3) 288 : ELSE IF (IFOUR.EQ. 7.OR.IFOUR.EQ. 8.OR.IFOUR.EQ.9.OR. 289 : . IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN 290 : NFOFO=NFOR-1 291 : ADPG=ADPG+XFINC(NBNN*NFOFO+1) 292 : ELSE IF (IFOUR.EQ.11) THEN 293 : NFOFO=NFOR-2 294 : ADPG=ADPG+XFINC(NBNN*NFOFO+1) 295 : BDPG=BDPG+XFINC(NBNN*NFOFO+2) 296 : ENDIF 297 : C 298 : C ON RANGE XFORC DANS MELVAL 299 : C 300 : IE=0 301 : MPTVAL=IVAFOR 302 : DO 7004 IGAU=1,NBNN 303 : DO 7004 ICOMP=1,NFOFO 304 : IE=IE+1 305 : MELVAL=IVAL(ICOMP) 306 : IBMN=MIN(IB ,VELCHE(/2)) 307 : VELCHE(IGAU,IBMN)=XFINC(IE) 308 : 7004 CONTINUE 309 : 3004 CONTINUE 310 : 311 : 9904 CONTINUE 312 : SEGSUP MWRK1 313 : if (mwrk67.ne.0) segsup mwrk67 314 : GOTO 510 315 : C__________________________________________________________________ 316 : C_______________________________________________________________________ 317 : C 318 : C MILIEUX POREUX 319 : C_______________________________________________________________________ 320 : C 321 : 79 CONTINUE 322 : C 323 : C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS 324 : C NBNO = NOMBRE DE FONCTIONS DE FORME 325 : C 326 : DIM3=1.D0 327 : NBNO=IPORE 328 : NBBB=NBNN 329 : LRN = NBNO-NBBB 330 : LRB=LRE-LRN 331 : * 332 : NSTN=1 333 : SEGINI MWRK1,MWRK5 334 : C 335 : DO 3079 IB=1,NBELEM 336 : C 337 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 338 : C 338 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 339 : C 340 : C MISE A 0 DES FORCES 341 : C 341 : CALL ZERO(XFORC,1,LRE) 342 : C 343 : C BOUCLE SUR LES POINTS DE GAUSS 344 : C 345 : ISDJC=0 346 : DO 5079 IGAU=1,NBPGAU 347 : C 348 : C RECUPERATION DE L'EPAISSEUR 349 : C 350 : IF (IFOUR.EQ.-2)THEN 351 : MPTVAL=IVACAR 352 : IF (IVACAR.NE.0) THEN 353 : MELVAL=IVAL(1) 354 : IF (MELVAL.NE.0) THEN 355 : IGMN=MIN(IGAU,VELCHE(/1)) 356 : IBMN=MIN(IB,VELCHE(/2)) 357 : DIM3=VELCHE(IGMN,IBMN) 358 : ELSE 359 : DIM3=1.D0 360 : ENDIF 361 : ENDIF 362 : ENDIF 363 : C 363 : CALL BNPORE(IGAU,NBNO,NBBB,LRE,IFOUR,LHOOK,NSTN,NHRM, 364 : . DIM3,XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,1) 365 : IF (DJAC.EQ.0.D0) THEN 366 : INTERR(1)=IB 366 : CALL ERREUR(259) 367 : GOTO 9979 368 : ENDIF 369 : IF(DJAC.LT.0.) ISDJC=ISDJC+1 370 : DJAC=ABS(DJAC)*POIGAU(IGAU) 371 : C 372 : C ON CHERCHE LES CONTRAINTES 373 : C 374 : MPTVAL=IVASTR 375 : DO 6079 ICOMP=1,NSTRS 376 : MELVAL=IVAL(ICOMP) 377 : IGMN=MIN(IGAU,VELCHE(/1)) 378 : IBMN=MIN(IB ,VELCHE(/2)) 379 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 380 : 6079 CONTINUE 381 : C 382 : C CALCUL DE B*SIGMA 383 : C 383 : CALL BSIG(BGENE,XSTRS,LHOOK,LRE,DJAC,XFORC) 384 : 385 : * ON AJOUTE LES TERMES EN FP 386 : * SIGNE - POUR ETRE COHERENT AVEC RIGI 387 : * 388 : r_z = XSTRS(NSTRS)*DJAC 389 : DO 6179 J=1,LRN 390 : JJ=LRB+J 391 : XFORC(JJ)=XFORC(JJ) - r_z*XGENE(1,J) 392 : 6179 CONTINUE 393 : * 394 : 5079 CONTINUE 395 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 396 : INTERR(1)=IB 396 : CALL ERREUR(195) 397 : GOTO 9979 398 : ENDIF 399 : C 400 : C ON RANGE XFORC DANS MELVAL 401 : C D'ABORD LES FORCES PUIS LES DEBITS 402 : C 403 : IE=0 404 : MPTVAL=IVAFOR 405 : DO 7079 IGAU=1,NBNN 406 : DO 7079 ICOMP=1,NFOR-1 407 : IE=IE+1 408 : MELVAL=IVAL(ICOMP) 409 : VELCHE(IGAU,IB)=XFORC(IE) 410 : 7079 CONTINUE 411 : * 412 : DO 7179 IGAU=1,NBSOM(IELE) 413 : IE=IE+1 414 : MELVAL=IVAL(NFOR) 415 : IGAV = IBSOM(NSPOS(IELE)+IGAU-1) 416 : VELCHE(IGAV,IB)=XFORC(IE) 417 : 7179 CONTINUE 418 : * 419 : 3079 CONTINUE 420 : 421 : 9979 CONTINUE 422 : SEGSUP MWRK1,MWRK5 423 : GOTO 510 424 : C_______________________________________________________________________ 425 : C__________________________________________________________________ 426 : C 427 : C MILIEUX POREUX - SUITE 428 : C_______________________________________________________________________ 429 : C 430 : 173 CONTINUE 431 : C 432 : C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS 433 : C NBNO = NOMBRE DE FONCTIONS DE FORME 434 : C 435 : DIM3=1.D0 436 : NBNO=IPORE 437 : NBBB=NBNN 438 : IF(MELE.GE.173.AND.MELE.LE.177) THEN 439 : IDECAP = 2 440 : ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN 441 : IDECAP = 3 442 : ENDIF 443 : * 444 : NSTN=IDECAP 445 : LPP = NBNO-NBBB 446 : LRN=IDECAP*LPP 447 : LRB=LRE-LRN 448 : 449 : SEGINI MWRK1,MWRK5 450 : C 451 : DO 3173 IB=1,NBELEM 452 : C 453 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 454 : C 454 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 455 : C 456 : C MISE A 0 DES FORCES 457 : C 457 : CALL ZERO(XFORC,1,LRE) 458 : C 459 : C BOUCLE SUR LES POINTS DE GAUSS 460 : C 461 : ISDJC=0 462 : DO 5173 IGAU=1,NBPGAU 463 : C 464 : C RECUPERATION DE L'EPAISSEUR 465 : C 466 : IF (IFOUR.EQ.-2)THEN 467 : MPTVAL=IVACAR 468 : IF (IVACAR.NE.0) THEN 469 : MELVAL=IVAL(1) 470 : IF (MELVAL.NE.0) THEN 471 : IGMN=MIN(IGAU,VELCHE(/1)) 472 : IBMN=MIN(IB,VELCHE(/2)) 473 : DIM3=VELCHE(IGMN,IBMN) 474 : ELSE 475 : DIM3=1.D0 476 : ENDIF 477 : ENDIF 478 : ENDIF 479 : C 479 : CALL BNQORE(IGAU,NBNO,NBBB,LRE,IFOUR,LHOOK,NSTN,NHRM, 480 : & DIM3,XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,IDECAP,1) 481 : IF (DJAC.EQ.0.D0) THEN 482 : INTERR(1)=IB 482 : CALL ERREUR(259) 483 : GOTO 99173 484 : ENDIF 485 : IF(DJAC.LT.0.) ISDJC=ISDJC+1 486 : DJAC=ABS(DJAC)*POIGAU(IGAU) 487 : C 488 : C ON CHERCHE LES CONTRAINTES 489 : C 490 : MPTVAL=IVASTR 491 : DO 6173 ICOMP=1,NSTRS 492 : MELVAL=IVAL(ICOMP) 493 : IGMN=MIN(IGAU,VELCHE(/1)) 494 : IBMN=MIN(IB ,VELCHE(/2)) 495 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 496 : 6173 CONTINUE 497 : C 498 : C CALCUL DE B*SIGMA 499 : C 499 : CALL BSIG(BGENE,XSTRS,LHOOK,LRE,DJAC,XFORC) 500 : * 501 : * ON AJOUTE LES TERMES EN FP 502 : * SIGNE - POUR ETRE COHERENT AVEC RIGI 503 : * 504 : DO 6273 IPR=1,IDECAP 505 : IPR1=(IPR-1)*LPP 506 : IPR2=NSTRS-IDECAP+IPR 507 : r_z = XSTRS(IPR2) * DJAC 508 : DO 6373 J=1,LPP 509 : JJ=LRB+IPR1+J 510 : XFORC(JJ)=XFORC(JJ)- r_z * XGENE(IPR,IPR1+J) 511 : 6373 CONTINUE 512 : 6273 CONTINUE 513 : * 514 : 5173 CONTINUE 515 : 516 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 517 : INTERR(1)=IB 517 : CALL ERREUR(195) 518 : GOTO 99173 519 : ENDIF 520 : C 521 : C ON RANGE XFORC DANS MELVAL 522 : C D'ABORD LES FORCES PUIS LES DEBITS 523 : C 524 : IE=0 525 : MPTVAL=IVAFOR 526 : DO 7173 IGAU=1,NBNN 527 : DO 7173 ICOMP=1,NFOR-IDECAP 528 : IE=IE+1 529 : MELVAL=IVAL(ICOMP) 530 : VELCHE(IGAU,IB)=XFORC(IE) 531 : 7173 CONTINUE 532 : * 533 : DO 7273 IPR=1,IDECAP 534 : IPR1=NFOR-IDECAP+IPR 535 : DO 7373 IGAU=1,NBSOM(IELE) 536 : IE=IE+1 537 : MELVAL=IVAL(IPR1) 538 : IGAV = IBSOM(NSPOS(IELE)+IGAU-1) 539 : VELCHE(IGAV,IB)=XFORC(IE) 540 : 7373 CONTINUE 541 : 7273 CONTINUE 542 : * 543 : 3173 CONTINUE 544 : * 545 : 99173 CONTINUE 546 : SEGSUP MWRK1,MWRK5 547 : GOTO 510 548 : C__________________________________________________________________ 549 : C_______________________________________________________________________ 550 : C 551 : C JOINTS EN FORMULATION MILIEUX POREUX 552 : C_______________________________________________________________________ 553 : C 554 : 80 CONTINUE 555 : C 556 : C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS 557 : C NBNO = NOMBRE DE FONCTIONS DE FORME 558 : C 559 : NBNO=IPORE 560 : NBBB=NBNN 561 : LRN=(NBNO-NBBB)*3/2 562 : LRB=LRE-LRN 563 : NSTN=1 564 : NFAC=(3*NBBB-NBNO)/2 565 : NMIL=LRN-NBSOM(IELE) 566 : SEGINI MWRK1,MWRK3,MWRK5 567 : I195=0 568 : I259=0 569 : C 570 : DO 3080 IB=1,NBELEM 571 : C 572 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 573 : C 573 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 574 : C 575 : C CALCUL DES AXES LOCAUX ET DES CORDONNES LOCALES 576 : C 576 : CALL JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOUR,XEL,BPSS) 577 : C 578 : C MISE A 0 DES FORCES 579 : C 579 : CALL ZERO(XFORC,1,LRE) 580 : C 581 : C BOUCLE SUR LES POINTS DE GAUSS 582 : C 583 : ISDJC=0 584 : DO 5080 IGAU=1,NBPGAU 585 : C 585 : CALL BNPORJ(IGAU,NBNO,NBBB,LRE,IFOUR,LHOOK,NSTN,XE,XEL, 586 : . SHPTOT,SHPWRK,BPSS,BGENE,XGENE,DJAC,1) 587 : IF (DJAC.EQ.0.) THEN 588 : INTERR(1)=IB 588 : CALL ERREUR(259) 589 : GOTO 9980 590 : ENDIF 591 : IF(DJAC.LT.0.) ISDJC=ISDJC+1 592 : DJAC=ABS(DJAC)*POIGAU(IGAU) 593 : C 594 : C ON CHERCHE LES CONTRAINTES 595 : C 596 : MPTVAL=IVASTR 597 : DO 6080 ICOMP=1,NSTRS 598 : MELVAL=IVAL(ICOMP) 599 : IGMN=MIN(IGAU,VELCHE(/1)) 600 : IBMN=MIN(IB ,VELCHE(/2)) 601 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 602 : 6080 CONTINUE 603 : C 604 : C CALCUL DE B*SIGMA 605 : C 605 : CALL BSIG(BGENE,XSTRS,LHOOK,LRE,DJAC,XFORC) 606 : * 607 : * ON AJOUTE LES TERMES EN FP 608 : * SIGNE - POUR ETRE COHERENT AVEC RIGI 609 : * 610 : r_z = XSTRS(NSTRS)*DJAC 611 : DO 6180 J=1,LRN 612 : JJ=LRB+J 613 : XFORC(JJ)=XFORC(JJ)-XGENE(1,J)*r_z 614 : 6180 CONTINUE 615 : 616 : 5080 CONTINUE 617 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 618 : INTERR(1)=IB 618 : CALL ERREUR(195) 619 : GOTO 9980 620 : ENDIF 621 : C 622 : C ON RANGE XFORC DANS MELVAL 623 : C D'ABORD LES FORCES PUIS LES DEBITS 624 : C 625 : IE=0 626 : MPTVAL=IVAFOR 627 : DO 7080 IGAU=1,NFAC 628 : DO 7080 ICOMP=1,NFOR-1 629 : IE=IE+1 630 : MELVAL=IVAL(ICOMP) 631 : VELCHE(IGAU,IB)=XFORC(IE) 632 : 7080 CONTINUE 633 : * 634 : * debits ( d'abord sommets puis mileux des cotes ad-hoc ) 635 : * 636 : MELVAL=IVAL(NFOR) 637 : DO 7180 IGAU=1,NBSOM(IELE) 638 : IE=IE+1 639 : IGAV = IBSOM(NSPOS(IELE)+IGAU-1) 640 : C* VELCHE(IGAV,IB)=XFORC(IE)*0.D0 641 : VELCHE(IGAV,IB)=0.D0 642 : 7180 CONTINUE 643 : * 644 : DO 7181 IGAU=1,NMIL 645 : IE=IE+1 646 : IGAV = NBBB - NMIL +IGAU 647 : VELCHE(IGAV,IB)=XFORC(IE) 648 : 7181 CONTINUE 649 : * 650 : 3080 CONTINUE 651 : 652 : 9980 CONTINUE 653 : SEGSUP MWRK1,MWRK3,MWRK5 654 : GOTO 510 655 : C 656 : 99 CONTINUE 657 : MOTERR(1:4)=NOMTP(MELE) 658 : MOTERR(5:12)='BSIGMA' 658 : CALL ERREUR(86) 659 : C 660 : 510 CONTINUE 661 : 662 : RETURN 663 : END 664 : 665 : 666 :
© Cast3M 2003 - All rights reserved.
Disclaimer