1 : C BSIGM2 SOURCE CHAT 11/03/16 21:15:51 6902 2 : SUBROUTINE BSIGM2(IPMAIL,LRE,NSTRS,IVASTR,LW,NBPGAU,IVACAR,CMATE, 3 : & NBPTEL,MELE,MFR,IPMINT,IPMIN1,IVAMAT,NMATT,NBGMAT,NELMAT,IMAT, 4 : & NPINT,NFORC,IVAFOR,ADPG,BDPG,CDPG,IIPDPG) 5 : *---------------------------------------------------------------------- 6 : * _______________________________ * 7 : * | | * 8 : * | CALCUL DES FORCES AUX NOEUDS| * 9 : * |______________________________| * 10 : * * 11 : * coq3,dkt,coq4,coq8,coq2 ,dst, jot3, joi4, joi2, joi3 * 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 : * IVASTR pointeur sur un segment MPTVAL contenant les * 22 : * les melvals de contraints * 23 : * LW Dimension du tableau de travail de l'element * 24 : * NBPGAU Nombre de points d'integration pour les contraintes * 25 : * IVACAR Pointeur sur les chamelems de caracteristiques * 26 : * NBPTEL Nombre de points par element * 27 : * MELE Numero de l'element fini * 28 : * MFR Numero de la formulation 29 : * IPMINT Pointeur sur un segment MINTE ACTIF E/S * 30 : * IPMIN1 Pointeur sur un segment MINTE (aux noeuds) * 31 : * NPINT Nombre de points d'integration dans l'epaisseur 32 : * dans le cas des elements de coque integres 33 : * * 34 : * SORTIES : * 35 : * ________ * 36 : * * 37 : * IVAFOR pointeur sur un segment MPTVAL contenant les * 38 : * les melvals de forces * 39 : * * 40 : * ICHPO1 pointeur sur le petit chpoint cree à l'usage de * 41 : * la deformation plane generalisee * 42 : *---------------------------------------------------------------------* 43 : IMPLICIT INTEGER(I-N) 44 : IMPLICIT REAL*8(A-H,O-Z) 45 : * 46 : * 47 : -INC CCOPTIO 48 : -INC CCHAMP 49 : 50 : -INC SMCHAML 51 : -INC SMCHPOI 52 : -INC SMELEME 53 : -INC SMCOORD 54 : -INC SMMODEL 55 : -INC SMINTE 56 : -INC SMLREEL 57 : C 58 : SEGMENT WRK1 59 : REAL*8 XFORC(LRE), XSTRS(NSTRS), XE(3,NBBB) 60 : REAL*8 DDHOOK(NSTRS,NSTRS),DDHOMU(NSTRS,NSTRS) 61 : ENDSEGMENT 62 : * 63 : SEGMENT WRK2 64 : REAL*8 SHPWRK(6,NBNO), BGENE(NSTRS,LRE) 65 : ENDSEGMENT 66 : * 67 : SEGMENT WRK3 68 : REAL*8 WORK(LW) 69 : ENDSEGMENT 70 : * 71 : SEGMENT WRK4 72 : REAL*8 BPSS(3,3), XEL(3,NBBB), XFOLO(LRE) 73 : ENDSEGMENT 74 : * 75 : SEGMENT WRK5 76 : REAL*8 BGENE1(3,LRE) 77 : ENDSEGMENT 78 : * 79 : SEGMENT MPTVAL 80 : INTEGER IPOS(NS) ,NSOF(NS) 81 : INTEGER IVAL(NCOSOU) 82 : CHARACTER*16 TYVAL(NCOSOU) 83 : ENDSEGMENT 84 : * 85 : SEGMENT,MVELCH 86 : REAL*8 VALMAT(NV1) 87 : ENDSEGMENT 88 : CHARACTER*8 CMATE 89 : * 90 : MELEME=IPMAIL 91 : C* SEGACT MELEME 92 : NBNN=NUM(/1) 93 : NBELEM=NUM(/2) 94 : * 95 : * INITIALISATION DES COORDONNES DU POINT AUTOUR DUQUEL SE FAIT 96 : * LE MOUVEMENT EN DEFORMATION PLANE GENERALISEE 97 : * ET INITIALISATION DES FORCES AU NOEUD SUPPORT DE LA DEFO 98 : * PLANE GENERALISEE 99 : * 100 : C PPJ IF (IFOUR.EQ.-3)THEN 101 : IF (IFOUR.EQ.-3.AND.MFR.NE.35)THEN 102 : IP=IIPDPG 103 : SEGACT MCOORD 104 : IREF=(IP-1)*(IDIM+1) 105 : XDPGE=XCOOR(IREF+1) 106 : YDPGE=XCOOR(IREF+2) 107 : ADPG=0.D0 108 : BDPG=0.D0 109 : CDPG=0.D0 110 : ELSE 111 : XDPGE=0.D0 112 : YDPGE=0.D0 113 : ENDIF 114 : * 115 : NHRM=NIFOUR 116 : * 117 : MINTE=IPMINT 118 : IF(MELE.EQ.93)THEN 119 : NV1=NMATT 120 : SEGINI MVELCH 121 : ENDIF 122 : C_______________________________________________________________________ 123 : C 124 : C NUMERO DES ETIQUETTES : 125 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT 126 : C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR : 127 : C 5 CONTINUE 128 : C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ... 129 : C 44 CONTINUE 130 : C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ... 131 : C_______________________________________________________________________ 132 : C 133 : GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 134 : 1 99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99, 135 : 2 41,99,99,44,99,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99, 136 : 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 137 : 4 99,99,99,99,85,86,87,88,99,99,99,99,93,99,99,99,99),MELE 138 : 139 : GOTO(168,169,170,171,172),MELE-167 140 : IF(MELE.EQ.258) GOTO 258 141 : GOTO 99 142 : 143 : C_______________________________________________________________________ 144 : C 145 : C ELEMENT COQ3 146 : C_______________________________________________________________________ 147 : C 148 : 27 CONTINUE 149 : NBBB=NBNN 150 : LW=151 151 : SEGINI WRK1,WRK3 152 : C 153 : DO 3027 IB=1,NBELEM 154 : C 155 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 156 : C 156 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 157 : C 158 : C MISE A ZERO DES FORCES INTERNES 159 : C 159 : CALL ZERO(XFORC,1,LRE) 160 : C 161 : C ON CHERCHE LES CONTRAINTES 162 : C 163 : MPTVAL=IVASTR 164 : DO 7027 ICOMP=1,NSTRS 165 : MELVAL=IVAL(ICOMP) 166 : IBMN=MIN(IB ,VELCHE(/2)) 167 : XSTRS(ICOMP)=VELCHE(1,IBMN) 168 : 7027 CONTINUE 169 : C 170 : C ON CALCULE B*EFFORTS 171 : C 171 : CALL BSIGCO(XE,XSTRS,XFORC,WORK,WORK,WORK(82),WORK(88), 172 : * WORK(92),WORK(119),WORK(128),WORK(134),WORK(143),WORK(143), 173 : * WORK(146),WORK(149)) 174 : C 175 : C RANGEMENT DANS MELVAL 176 : C 177 : IE=0 178 : MPTVAL=IVAFOR 179 : DO 9027 IGAU=1,NBNN 180 : DO 9027 ICOMP=1,6 181 : IE=IE+1 182 : MELVAL=IVAL(ICOMP) 183 : IBMN=MIN(IB ,VELCHE(/2)) 184 : VELCHE(IGAU,IBMN)=XFORC(IE) 185 : 9027 CONTINUE 186 : C 187 : 3027 CONTINUE 188 : SEGSUP WRK1,WRK3 189 : GOTO 510 190 : C_______________________________________________________________________ 191 : C 192 : C ELEMENT DKT 193 : C_______________________________________________________________________ 194 : C 195 : 28 CONTINUE 196 : NBNO=NBNN 197 : NBBB=NBNN 198 : IF(NPINT.NE.0)THEN 199 : SEGINI WRK1,WRK3,WRK4,WRK5 200 : NSTRS=6 201 : SEGINI WRK2 202 : NSTRS=4 203 : ELSE 204 : SEGINI WRK1,WRK2,WRK3,WRK4 205 : ENDIF 206 : C 207 : DO 3028 IB=1,NBELEM 208 : C 209 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 210 : C 210 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 211 : C 212 : C 213 : C MISE A ZERO DES FORCES INTERNES 214 : C 214 : CALL ZERO(XFORC,1,LRE) 215 : C 215 : CALL VPAST(XE,BPSS) 216 : C BPSS STOCKE LA MATRICOMPE DE PASSAGE 216 : CALL VCORLC (XE,XEL,BPSS) 216 : CALL TRPOSE(BPSS) 217 : C 218 : C ON CHERCHE LES EPAISEURS ET ON LES MOYENNE, 219 : C LES EXCENTREMENTS ET ON LES MOYENNE. 220 : C 221 : MPTVAL=IVACAR 222 : C 223 : EPAIST=0.D0 224 : MELVAL=IVAL(1) 225 : IF (MELVAL.NE.0) THEN 226 : DO IGAU=1,NBPGAU 227 : IGMN=MIN(IGAU,VELCHE(/1)) 228 : IBMN=MIN(IB,VELCHE(/2)) 229 : EPAIST=EPAIST+VELCHE(IGMN,IBMN) 230 : ENDDO 231 : EPAIST=EPAIST/NBPGAU 232 : ENDIF 233 : * 234 : EXCEN=0.D0 235 : MELVAL=IVAL(2) 236 : IF (MELVAL.NE.0) THEN 237 : DO IGAU=1,NBPGAU 238 : IGMN=MIN(IGAU,VELCHE(/1)) 239 : IBMN=MIN(IB,VELCHE(/2)) 240 : EXCEN=EXCEN+VELCHE(IGMN,IBMN) 241 : ENDDO 242 : EXCEN=EXCEN/NBPGAU 243 : ENDIF 244 : C 245 : IF(NPINT.EQ.0)THEN 246 : C 247 : C COQUE GLOBAL 248 : C 249 : C BOUCLE SUR LES POINTS DE GAUSS 250 : C 251 : DO 6028 IGAU=1,NBPGAU 252 : * 252 : CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU, 253 : & MELE,MFR,NBNO,LRE,IFOUR,NSTRS,0,1.D0,XEL, 254 : & SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 255 : DJAC=DJAC*POIGAU(IGAU) 256 : * 257 : * ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT 258 : * 259 : IF (EXCEN.NE.0.) THEN 260 : DO 1528 IJL=1,3 261 : DO 1528 IJC=1,LRE 262 : BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC) 263 : 1528 CONTINUE 264 : ENDIF 265 : C 266 : C ON CHERCHE LES CONTRAINTES 267 : C 268 : MPTVAL=IVASTR 269 : DO 7028 ICOMP=1,NSTRS 270 : MELVAL=IVAL(ICOMP) 271 : IGMN=MIN(IGAU,VELCHE(/1)) 272 : IBMN=MIN(IB ,VELCHE(/2)) 273 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 274 : 7028 CONTINUE 275 : C 276 : C ON CALCULE B*EFFORTS 277 : C 277 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 278 : 6028 CONTINUE 279 : C 280 : ELSE 281 : C 282 : C COQUE INTEGREE 283 : C 284 : NBPGA1=NBPGAU/NPINT 285 : C 286 : C BOUCLE SUR LES POINTS DE GAUSS DE LA SURFACE 287 : C 288 : DO 6001 IGAU=1,NBPGA1 289 : * 289 : CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU, 290 : & MELE,MFR,NBNO,LRE,IFOUR,6,0,1.D0,XEL,SHPTOT, 291 : & SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 292 : * 293 : * ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT 294 : * 295 : IF (EXCEN.NE.0.) THEN 296 : DO 1501 IJL=1,3 297 : DO 1501 IJC=1,LRE 298 : BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC) 299 : 1501 CONTINUE 300 : ENDIF 301 : C 302 : C BOUCLE SUR LES NAPPES 303 : C 304 : DO 6002 INAP=1,NPINT 305 : IGAU1=(INAP-1)*NBPGA1+IGAU 306 : C 307 : C ON CHERCHE LES CONTRAINTES 308 : C 309 : MPTVAL=IVASTR 310 : DO 7001 ICOMP=1,NSTRS 311 : MELVAL=IVAL(ICOMP) 312 : IGMN=MIN(IGAU1,VELCHE(/1)) 313 : IBMN=MIN(IB ,VELCHE(/2)) 314 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 315 : 7001 CONTINUE 316 : XSTRS(3)=XSTRS(4) 317 : C 318 : C CALCUL DE LA MATRICE B CORRESPONDANT AUX CONTRAINTES 3D 319 : C 320 : ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0) 321 : DO 1502 IJL=1,3 322 : DO 1502 IJC=1,LRE 323 : BGENE1(IJL,IJC)=BGENE(IJL,IJC)+ZZZ*BGENE(IJL+3,IJC) 324 : 1502 CONTINUE 325 : DJAC1=DJAC*POIGAU(IGAU1)*(EPAIST/2.D0) 326 : C 327 : C ON CALCULE B*EFFORTS 328 : C 328 : CALL BSIG(BGENE1,XSTRS,3,LRE,DJAC1,XFORC) 329 : 6002 CONTINUE 330 : 6001 CONTINUE 331 : ENDIF 332 : C 333 : C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL 334 : C 334 : CALL MATVEC(XFORC,XFOLO,BPSS,6) 335 : IE=0 336 : MPTVAL=IVAFOR 337 : DO 9028 IGAU=1,NBNN 338 : DO 9028 ICOMP=1,6 339 : IE=IE+1 340 : MELVAL=IVAL(ICOMP) 341 : IBMN=MIN(IB ,VELCHE(/2)) 342 : VELCHE(IGAU,IBMN)=XFOLO(IE) 343 : 9028 CONTINUE 344 : 3028 CONTINUE 345 : SEGSUP WRK1,WRK2,WRK3,WRK4 346 : IF(NPINT.NE.0)SEGSUP WRK5 347 : GOTO 510 348 : 349 : C_______________________________________________________________________ 350 : C 351 : C ELEMENTS COQ6 ET COQ8 352 : C_______________________________________________________________________ 353 : C 354 : 41 CONTINUE 355 : NBBB=NBNN 356 : SEGINI WRK1,WRK3 357 : MINTE1=IPMIN1 358 : SEGACT MINTE1 359 : NBPGA1=MINTE1.SHPTOT(/3) 360 : NBN1 =MINTE1.SHPTOT(/2) 361 : C 362 : C BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS 363 : C 364 : DO 3041 IB=1,NBELEM 365 : C 366 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 367 : C 367 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 368 : C 369 : C MISE A ZERO DES FORCES INTERNES 370 : C 370 : CALL ZERO(XFORC,1,LRE) 371 : 372 : C ON CHERCHE LES EPAISSEURS ET LES EXCENTREMENTS, 373 : C ON LES MOYENNE SUR L'ELEMENT. 374 : C 375 : MPTVAL=IVACAR 376 : EPAIST=0.D0 377 : MELVAL=IVAL(1) 378 : IF (MELVAL.NE.0) THEN 379 : DO IGAU=1,NBPTEL 380 : IGMN=MIN(IGAU,VELCHE(/1)) 381 : IBMN=MIN(IB ,VELCHE(/2)) 382 : EPAIST=EPAIST+VELCHE(IGMN,IBMN) 383 : ENDDO 384 : EPAIST=EPAIST/NBPTEL 385 : ENDIF 386 : EXCEN=0.D0 387 : MELVAL=IVAL(2) 388 : IF (MELVAL.NE.0) THEN 389 : DO IGAU=1,NBPTEL 390 : IGMN=MIN(IGAU,VELCHE(/1)) 391 : IBMN=MIN(IB ,VELCHE(/2)) 392 : EXCEN=EXCEN+VELCHE(IGMN,IBMN) 393 : ENDDO 394 : EXCEN=EXCEN/NBPTEL 395 : ENDIF 395 : CALL ZERO(XFORC,1,LRE) 396 : C 397 : C ON CHERCHE LES CONTRAINTES 398 : C 399 : IE=1 400 : MPTVAL=IVASTR 401 : DO 7041 IGAU=1,NBPGAU 402 : DO 7041 ICOMP=1,NSTRS 403 : MELVAL=IVAL(ICOMP) 404 : IGMN=MIN(IGAU,VELCHE(/1)) 405 : IBMN=MIN(IB ,VELCHE(/2)) 406 : WORK(IE)=VELCHE(IGMN,IBMN) 407 : IE=IE+1 408 : 7041 CONTINUE 409 : C 410 : C ON CALCULE B*SIGMA 411 : C 411 : CALL CQ8BSE(XE,NBNN,NBPGAU,LRE,EPAIST,EXCEN,DZEGAU, 412 : * POIGAU,SHPTOT,MINTE1.SHPTOT,WORK(1),XFORC,IRRT) 413 : 414 : IF(IRRT.EQ.0) THEN 415 : INTERR(1)=IB 415 : CALL ERREUR(241) 416 : GOTO 9941 417 : ELSE IF(IRRT.EQ.-1) THEN 418 : INTERR(1)=IB 418 : CALL ERREUR(240) 419 : GOTO 9941 420 : ENDIF 421 : C 422 : C RANGEMENT DANS MELVAL 423 : C 424 : IE=0 425 : MPTVAL=IVAFOR 426 : DO 9041 IGAU=1,NBNN 427 : DO 9041 ICOMP=1,6 428 : IE=IE+1 429 : MELVAL=IVAL(ICOMP) 430 : IBMN=MIN(IB ,VELCHE(/2)) 431 : VELCHE(IGAU,IBMN)=XFORC(IE) 432 : 9041 CONTINUE 433 : 3041 CONTINUE 434 : 435 : 9941 CONTINUE 436 : SEGSUP WRK1,WRK3 437 : SEGDES MINTE1 438 : GOTO 510 439 : 440 : C_______________________________________________________________________ 441 : C 442 : C ELEMENT COQ2 443 : C_______________________________________________________________________ 444 : C 445 : 44 CONTINUE 446 : DIM3=1.D0 447 : NBNO=NBNN 448 : NBBB=NBNN 449 : SEGINI WRK1,WRK2 450 : C 451 : DO 3044 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 ZERO DES FORCES INTERNES 457 : C 457 : CALL ZERO(XFORC,1,LRE) 458 : C 459 : C BOUCLE SUR LES POINTS DE GAUSS 460 : C 461 : DO 6044 IGAU=1,NBPGAU 462 : MPTVAL=IVACAR 463 : MELVAL=IVAL(2) 464 : IF (MELVAL.NE.0) THEN 465 : IBMN=MIN(IB ,VELCHE(/2)) 466 : EXCEN=VELCHE(1,IBMN) 467 : ELSE 468 : EXCEN=0.D0 469 : ENDIF 470 : IF(IFOUR.EQ.-2) THEN 471 : MELVAL=IVAL(3) 472 : IF (MELVAL.NE.0) THEN 473 : IGMN=MIN(IGAU ,VELCHE(/1)) 474 : IBMN=MIN(IB ,VELCHE(/2)) 475 : DIM3=VELCHE(IGMN,IBMN) 476 : ELSE 477 : DIM3=1.D0 478 : ENDIF 479 : ENDIF 480 : * 480 : CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU, 481 : . EXCEN,DIM3,IRRT,XDPGE,YDPGE) 482 : IF (IRRT.EQ.1) THEN 483 : INTERR(1)=IB 483 : CALL ERREUR(255) 484 : GOTO 9944 485 : ELSE IF(IRRT.EQ.2) THEN 486 : INTERR(1)=IB 486 : CALL ERREUR(256) 487 : GOTO 9944 488 : ENDIF 489 : C 490 : C ON CHERCHE LES CONTRAINTES - 491 : C 492 : MPTVAL=IVASTR 493 : DO 7044 ICOMP=1,NSTRS 494 : MELVAL=IVAL(ICOMP) 495 : IGMN=MIN(IGAU,VELCHE(/1)) 496 : IBMN=MIN(IB ,VELCHE(/2)) 497 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 498 : 7044 CONTINUE 499 : C 500 : C ON CALCULE B*EFFORTS 501 : C 501 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 502 : 6044 CONTINUE 503 : C 504 : C EXTRACTION DES FORCES AU NOEUD SUPPORT DE LA DEF PLAN GENE 505 : C ON CALCULE LES RESULTANTES DES FORCES SUR CHAQUE ELEMENT 506 : C AU NOEUD NSDPGE 507 : C 508 : C PPJ IF (IFOUR.EQ.-3) THEN 509 : IF (IFOUR.EQ.-3.AND.MFR.NE.35) THEN 510 : ADPG=ADPG+XFORC(NBNN*3+1) 511 : BDPG=BDPG+XFORC(NBNN*3+2) 512 : CDPG=CDPG+XFORC(NBNN*3+3) 513 : ENDIF 514 : C 515 : C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL 516 : C 517 : MPTVAL=IVAFOR 518 : IF(IFOUR.GT.0) THEN 519 : DO 9044 IGAU=1,2 520 : IE=(IGAU-1)*4 521 : C 522 : MELVAL=IVAL(1) 523 : IGMN=MIN(IGAU,VELCHE(/1)) 524 : IBMN=MIN(IB ,VELCHE(/2)) 525 : VELCHE(IGMN,IBMN)= XFORC(IE+1) 526 : C 527 : MELVAL=IVAL(2) 528 : IGMN=MIN(IGAU,VELCHE(/1)) 529 : IBMN=MIN(IB ,VELCHE(/2)) 530 : VELCHE(IGMN,IBMN)= XFORC(IE+2) 531 : C 532 : MELVAL=IVAL(3) 533 : IGMN=MIN(IGAU,VELCHE(/1)) 534 : IBMN=MIN(IB ,VELCHE(/2)) 535 : VELCHE(IGMN,IBMN)= XFORC(IE+3) 536 : C 537 : MELVAL=IVAL(4) 538 : IGMN=MIN(IGAU,VELCHE(/1)) 539 : IBMN=MIN(IB ,VELCHE(/2)) 540 : VELCHE(IGMN,IBMN)= XFORC(IE+4) 541 : 9044 CONTINUE 542 : ELSE IF(IFOUR.LE.0) THEN 543 : DO 9144 IGAU=1,2 544 : IE=(IGAU-1)*3 545 : C 546 : MELVAL=IVAL(1) 547 : IGMN=MIN(IGAU,VELCHE(/1)) 548 : IBMN=MIN(IB ,VELCHE(/2)) 549 : VELCHE(IGMN,IBMN)= XFORC(IE+1) 550 : C 551 : MELVAL=IVAL(2) 552 : IGMN=MIN(IGAU,VELCHE(/1)) 553 : IBMN=MIN(IB ,VELCHE(/2)) 554 : VELCHE(IGMN,IBMN)= XFORC(IE+2) 555 : C 556 : MELVAL=IVAL(3) 557 : IGMN=MIN(IGAU,VELCHE(/1)) 558 : IBMN=MIN(IB ,VELCHE(/2)) 559 : VELCHE(IGMN,IBMN)= XFORC(IE+3) 560 : 9144 CONTINUE 561 : ENDIF 562 : 3044 CONTINUE 563 : C 564 : 9944 CONTINUE 565 : SEGSUP WRK1,WRK2 566 : GOTO 510 567 : 568 : C_______________________________________________________________________ 569 : C 570 : C ELEMENT COQ4 571 : C_______________________________________________________________________ 572 : C 573 : 49 CONTINUE 574 : NBNO=NBNN 575 : NBBB=NBNN 576 : SEGINI WRK1,WRK2,WRK4 577 : C 578 : DO 3049 IB=1,NBELEM 579 : C 580 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 581 : C 581 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 582 : C 583 : C MISE A ZERO DES FORCES INTERNES 584 : C 584 : CALL ZERO(XFORC,1,LRE) 585 : C 586 : C RIFERIMENTO LOCALE 587 : C 587 : CALL CQ4LOC(XE,XEL,BPSS,IERT,1) 588 : IF (IERT .EQ. 3) THEN 589 : NOPLAN = 1 590 : ELSE 591 : NOPLAN = 0 592 : END IF 592 : CALL TRPOSE(BPSS) 593 : MPTVAL=IVACAR 594 : MELVAL=IVAL(2) 595 : IF (MELVAL.NE.0) THEN 596 : IBMN=MIN(IB ,VELCHE(/2)) 597 : EXCEN=VELCHE(1,IBMN) 598 : ELSE 599 : EXCEN=0.D0 600 : ENDIF 601 : C 602 : C BOUCLE SUR LES POINTS DE GAUSS 603 : C 604 : DO 6049 IGAU=1,NBPGAU 605 : if(cmate.eq.'ISOTROPE') then 605 : CALL BCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IERT,0) 606 : else 606 : CALL BCOQ4O(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IERT,0) 607 : endif 608 : IF (IERT.NE.0) THEN 609 : INTERR(1)=IB 609 : CALL ERREUR (321) 610 : GOTO 9949 611 : ENDIF 612 : C 613 : C ON CHERCHE LES CONTRAINTES - 614 : C 615 : MPTVAL=IVASTR 616 : DO 7049 ICOMP=1,NSTRS 617 : MELVAL=IVAL(ICOMP) 618 : IGMN=MIN(IGAU,VELCHE(/1)) 619 : IBMN=MIN(IB ,VELCHE(/2)) 620 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 621 : 7049 CONTINUE 622 : C 623 : C ON CALCULE B*EFFORTS 624 : C 625 : DJAC=DJAC*POIGAU(IGAU) 625 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 626 : 6049 CONTINUE 627 : C 628 : C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL 629 : C 629 : CALL MATVEC(XFORC,XFOLO,BPSS,8) 630 : 631 : MPTVAL=IVAFOR 632 : IE=0 633 : DO 9049 NODE=1,4 634 : DO 9049 ICOMP=1,6 635 : IE=IE+1 636 : MELVAL=IVAL(ICOMP) 637 : IBMN=MIN(IB ,VELCHE(/2)) 638 : VELCHE(NODE,IBMN)=XFOLO(IE) 639 : 9049 CONTINUE 640 : 3049 CONTINUE 641 : 642 : 9949 CONTINUE 643 : SEGSUP WRK1,WRK2,WRK4 644 : GOTO 510 645 : C_______________________________________________________________________ 646 : C 647 : C ELEMENT JOINT JOI2 648 : C_______________________________________________________________________ 649 : C 650 : 85 CONTINUE 651 : NBNO=NBNN 652 : NBBB=NBNN 653 : SEGINI WRK1,WRK2,WRK4 654 : C 655 : DO 3085 IB=1,NBELEM 656 : C 657 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 658 : C 658 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 659 : C 660 : C MISE A ZERO DES FORCES INTERNES 661 : C 661 : CALL ZERO(XFORC,1,LRE) 662 : C 663 : C REPERE LOCAL 664 : C 664 : CALL JO2LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 665 : C 666 : C BOUCLE SUR LES POINTS DE GAUSS 667 : C 668 : DO 6085 IGAU=1,NBPGAU 668 : CALL BJO2(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK, 669 : . BGENE,DJAC,IERT) 670 : IF (IERT.NE.0) THEN 671 : INTERR(1)=IB 671 : CALL ERREUR (162) 672 : GOTO 9985 673 : ENDIF 674 : C 675 : C EN AXISYMETRIE, MULTIPLICATION PAR LE RAYON DE COURBURE 676 : C (LE RAYON DE COURBURE DOIT ETRE CALCULE AVEC LES COORDONNEES 677 : C GLOCALES CAR ON FAIT UNE INTEGRATION SUR LA CIRCONFERENCE DE LA 678 : C STRUCTURE CYLINDRIQUE DANS LE REPERE GLOBAL). 679 : C 680 : IF (IFOUR.EQ.0) THEN 681 : NUMSUP=NBNO/2 682 : RAYON=0.D0 683 : DO 6285 IRAY=1,NUMSUP 684 : RAYON=RAYON+SHPTOT(1,IRAY,IGAU)*XE(1,IRAY) 685 : 6285 CONTINUE 686 : DJAC=DJAC*RAYON 687 : ENDIF 688 : C 689 : C ON CHERCHE LES CONTRAINTES - 690 : C 691 : MPTVAL=IVASTR 692 : DO 7085 ICOMP=1,NSTRS 693 : MELVAL=IVAL(ICOMP) 694 : IGMN=MIN(IGAU,VELCHE(/1)) 695 : IBMN=MIN(IB ,VELCHE(/2)) 696 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 697 : 7085 CONTINUE 698 : C 699 : C ON CALCULE B*EFFORTS 700 : C 701 : DJAC=DJAC*POIGAU(IGAU) 701 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 702 : 6085 CONTINUE 703 : C 704 : C RANGEMENT DANS MELVAL 705 : C 706 : IE=0 707 : MPTVAL=IVAFOR 708 : C 709 : C NODE=4= NOMBRE DE NOEUDS 710 : C ICOMP=2= NOMBRE DE COMPOSANTES DE CONTRAINTES PAR NOEUD 711 : C 712 : DO 9085 NODE=1,4 713 : DO 9085 ICOMP=1,2 714 : IE=IE+1 715 : MELVAL=IVAL(ICOMP) 716 : IBMN=MIN(IB ,VELCHE(/2)) 717 : VELCHE(NODE,IBMN)=XFORC(IE) 718 : 9085 CONTINUE 719 : 3085 CONTINUE 720 : 721 : 9985 CONTINUE 722 : SEGSUP WRK1,WRK2,WRK4 723 : GOTO 510 724 : 725 : C_______________________________________________________________________ 726 : C 727 : C ELEMENT JOINT JGI2 728 : C_______________________________________________________________________ 729 : C 730 : 170 CONTINUE 731 : NBNO=NBNN 732 : NBBB=NBNN 733 : SEGINI WRK1,WRK2,WRK4 734 : C 735 : DO IB=1,NBELEM 736 : C 737 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 738 : C 738 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 739 : C 740 : C MISE A ZERO DES FORCES INTERNES 741 : C 741 : CALL ZERO(XFORC,1,LRE) 742 : C 743 : C REPERE LOCAL 744 : C 744 : CALL JO2LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 745 : C 746 : C BOUCLE SUR LES POINTS DE GAUSS 747 : C 748 : DO IGAU=1,NBPGAU 749 : C 750 : C ON CHERCHE L EPAISSEUR DU JOINT 751 : C 752 : EPAIST=0.D0 753 : MPTVAL=IVACAR 754 : MELVAL=IVAL(1) 755 : IF (MELVAL.NE.0) THEN 756 : IGMN=MIN(IGAU,VELCHE(/1)) 757 : IBMN=MIN(IB,VELCHE(/2)) 758 : EPAIST=VELCHE(IGMN,IBMN) 759 : ENDIF 760 : C 760 : CcPPj CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK, 761 : CcPPj. EPAIST,BGENE,DJAC,XDPGE,YDPGE,IERT) 761 : CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,SHPWRK, 762 : . EPAIST,BGENE,DJAC,XDPGE,YDPGE,IERT) 763 : IF (IERT.NE.0) THEN 764 : INTERR(1)=IB 764 : CALL ERREUR (612) 765 : GOTO 99170 766 : ENDIF 767 : C???????????????? 768 : C EN AXISYMETRIE, MULTIPLICATION PAR LE RAYON DE COURBURE 769 : C (LE RAYON DE COURBURE DOIT ETRE CALCULE AVEC LES COORDONNEES 770 : C GLOCALES CAR ON FAIT UNE INTEGRATION SUR LA CIRCONFERENCE DE LA 771 : C STRUCTURE CYLINDRIQUE DANS LE REPERE GLOBAL). 772 : C???????????????? 773 : IF (IFOUR.EQ.0) THEN 774 : NUMSUP=NBNO/2 775 : RAYON=0.D0 776 : DO IRAY=1,NUMSUP 777 : RAYON=RAYON+SHPTOT(1,IRAY,IGAU)*XE(1,IRAY) 778 : ENDDO 779 : DJAC=DJAC*RAYON 780 : ENDIF 781 : C 782 : C ON CHERCHE LES CONTRAINTES - 783 : C 784 : MPTVAL=IVASTR 785 : DO ICOMP=1,NSTRS 786 : MELVAL=IVAL(ICOMP) 787 : IGMN=MIN(IGAU,VELCHE(/1)) 788 : IBMN=MIN(IB ,VELCHE(/2)) 789 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 790 : ENDDO 791 : C 792 : C ON CALCULE B*EFFORTS 793 : C 794 : DJAC=DJAC*POIGAU(IGAU) 794 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 795 : ENDDO 796 : C 797 : C EXTRACTION DES FORCES AU NOEUD SUPPORT DE LA DEF PLAN GENE 798 : C ON CALCULE LES RESULTANTES DES FORCES SUR CHAQUE ELEMENT 799 : C AU NOEUD NSDPGE 800 : C 801 : NFOFO=NFORC 802 : IF (IFOUR.EQ.-3) THEN 803 : NFOFO=NFORC-3 804 : ADPG=ADPG+XFORC(NBNN*NFOFO+1) 805 : BDPG=BDPG+XFORC(NBNN*NFOFO+2) 806 : CDPG=CDPG+XFORC(NBNN*NFOFO+3) 807 : ENDIF 808 : C 809 : C RANGEMENT DANS MELVAL 810 : C 811 : IE=0 812 : MPTVAL=IVAFOR 813 : C 814 : C NODE=4= NOMBRE DE NOEUDS 815 : C ICOMP=2= NOMBRE DE COMPOSANTES DE CONTRAINTES PAR NOEUD 816 : C 817 : DO NODE=1,NBNN 818 : DO ICOMP=1,NFOFO 819 : IE=IE+1 820 : MELVAL=IVAL(ICOMP) 821 : IBMN=MIN(IB ,VELCHE(/2)) 822 : VELCHE(NODE,IBMN)=XFORC(IE) 823 : ENDDO 824 : ENDDO 825 : ENDDO 826 : 827 : 99170 CONTINUE 828 : SEGSUP WRK1,WRK2,WRK4 829 : GOTO 510 830 : C+PPj 831 : C_______________________________________________________________________ 832 : C 833 : C ELEMENT JOINT JCT3 en 2D cisaillement 834 : C_______________________________________________________________________ 835 : C 836 : 168 CONTINUE 837 : NBNO=NBNN 838 : NBBB=NBNN 839 : SEGINI WRK1,WRK2,WRK4 840 : C 841 : DO IB=1,NBELEM 842 : C 843 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 844 : C 844 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 845 : C 846 : C MISE A ZERO DES FORCES INTERNES 847 : C 847 : CALL ZERO(XFORC,1,LRE) 848 : C 849 : C REPERE LOCAL 850 : C 850 : CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 851 : C 852 : C BOUCLE SUR LES POINTS DE GAUSS 853 : C 854 : DO IGAU=1,NBPGAU 854 : CALL BJT3C(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK, 855 : . BGENE,DJAC,IERT) 856 : IF (IERT.NE.0) THEN 857 : INTERR(1)=IB 857 : CALL ERREUR (611) 858 : GOTO 99168 859 : ENDIF 860 : C 861 : C ON CHERCHE LES CONTRAINTES - 862 : C 863 : MPTVAL=IVASTR 864 : DO ICOMP=1,NSTRS 865 : MELVAL=IVAL(ICOMP) 866 : IGMN=MIN(IGAU,VELCHE(/1)) 867 : IBMN=MIN(IB ,VELCHE(/2)) 868 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 869 : ENDDO 870 : C 871 : C ON CALCULE B*EFFORTS 872 : C 873 : DJAC=DJAC*POIGAU(IGAU) 873 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 874 : ENDDO 875 : C 876 : C RANGEMENT DANS MELVAL 877 : C 878 : IE=0 879 : MPTVAL=IVAFOR 880 : C 881 : DO NODE=1,NBNN 882 : DO ICOMP=1,NFORC 883 : IE=IE+1 884 : MELVAL=IVAL(ICOMP) 885 : IBMN=MIN(IB ,VELCHE(/2)) 886 : VELCHE(NODE,IBMN)=XFORC(IE) 887 : ENDDO 888 : ENDDO 889 : ENDDO 890 : 891 : 99168 CONTINUE 892 : SEGSUP WRK1,WRK2,WRK4 893 : GOTO 510 894 : C_______________________________________________________________________ 895 : C 896 : C ELEMENT JOINT JGT3 GENERALISE 897 : C_______________________________________________________________________ 898 : C 899 : 171 CONTINUE 900 : NBNO=NBNN 901 : NBBB=NBNN 902 : SEGINI WRK1,WRK2,WRK4 903 : C 904 : DO IB=1,NBELEM 905 : C 906 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 907 : C 907 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 908 : C 909 : C MISE A ZERO DES FORCES INTERNES 910 : C 910 : CALL ZERO(XFORC,1,LRE) 911 : C 912 : C REPERE LOCAL 913 : C 913 : CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 914 : C 915 : C BOUCLE SUR LES POINTS DE GAUSS 916 : C 917 : DO IGAU=1,NBPGAU 918 : C 919 : C ON CHERCHE L'EPAISSEUR DU JOINT 920 : C 921 : EPAIST=0.D0 922 : MPTVAL=IVACAR 923 : MELVAL=IVAL(1) 924 : IF (MELVAL.NE.0) THEN 925 : IGMN=MIN(IGAU,VELCHE(/1)) 926 : IBMN=MIN(IB,VELCHE(/2)) 927 : EPAIST=VELCHE(IGMN,IBMN) 928 : ENDIF 929 : C 930 : C ON CALCULE B 931 : C 931 : CcPPj CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK, 931 : CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,SHPWRK, 932 : . EPAIST,BGENE,DJAC,IERT) 933 : IF (IERT.NE.0) THEN 934 : INTERR(1)=IB 934 : CALL ERREUR (611) 935 : GOTO 99171 936 : ENDIF 937 : C 938 : C ON CHERCHE LES CONTRAINTES - 939 : C 940 : MPTVAL=IVASTR 941 : DO ICOMP=1,NSTRS 942 : MELVAL=IVAL(ICOMP) 943 : IGMN=MIN(IGAU,VELCHE(/1)) 944 : IBMN=MIN(IB ,VELCHE(/2)) 945 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 946 : ENDDO 947 : C 948 : C ON CALCULE B*EFFORTS 949 : C 950 : DJAC=DJAC*POIGAU(IGAU) 950 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 951 : ENDDO 952 : C 953 : C RANGEMENT DANS MELVAL 954 : C 955 : IE=0 956 : MPTVAL=IVAFOR 957 : C 958 : DO NODE=1,NBNN 959 : DO ICOMP=1,NFORC 960 : IE=IE+1 961 : MELVAL=IVAL(ICOMP) 962 : IBMN=MIN(IB ,VELCHE(/2)) 963 : VELCHE(NODE,IBMN)=XFORC(IE) 964 : ENDDO 965 : ENDDO 966 : ENDDO 967 : 968 : 99171 CONTINUE 969 : SEGSUP WRK1,WRK2,WRK4 970 : GOTO 510 971 : C+PPj 972 : C_______________________________________________________________________ 973 : C 974 : C ELEMENT JOINT JCI4 en 2D cisaillement 975 : C_______________________________________________________________________ 976 : C 977 : 169 CONTINUE 978 : NBNO=NBNN 979 : NBBB=NBNN 980 : SEGINI WRK1,WRK2,WRK4 981 : C 982 : DO IB=1,NBELEM 983 : C 984 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 985 : C 985 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 986 : C 987 : C 988 : C MISE A ZERO DES FORCES INTERNES 989 : C 989 : CALL ZERO(XFORC,1,LRE) 990 : C 991 : C REPERE LOCAL 992 : C 992 : CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 993 : C 994 : C BOUCLE SUR LES POINTS DE GAUSS 995 : C 996 : DO IGAU=1,NBPGAU 996 : CALL BJO4C(IGAU,XEL,BPSS,SHPTOT,SHPWRK,BGENE,DJAC,IERT) 997 : IF (IERT.NE.0) THEN 998 : INTERR(1)=IB 998 : CALL ERREUR (611) 999 : GOTO 99169 1000 : ENDIF 1001 : C 1002 : C ON CHERCHE LES CONTRAINTES - 1003 : C 1004 : MPTVAL=IVASTR 1005 : DO ICOMP=1,NSTRS 1006 : MELVAL=IVAL(ICOMP) 1007 : IGMN=MIN(IGAU,VELCHE(/1)) 1008 : IBMN=MIN(IB ,VELCHE(/2)) 1009 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 1010 : ENDDO 1011 : C 1012 : C ON CALCULE B*EFFORTS 1013 : C 1014 : DJAC=DJAC*POIGAU(IGAU) 1014 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 1015 : ENDDO 1016 : C 1017 : C RANGEMENT DANS MELVAL 1018 : C 1019 : IE=0 1020 : MPTVAL=IVAFOR 1021 : C 1022 : C NODE=8= NOMBRE DE NOEUDS 1023 : C ICOMP=3= NOMBRE DE COMPOSANTES DE CONTRAINTES PAR NOEUD 1024 : C 1025 : DO NODE=1,NBNN 1026 : DO ICOMP=1,NFORC 1027 : IE=IE+1 1028 : MELVAL=IVAL(ICOMP) 1029 : IBMN=MIN(IB ,VELCHE(/2)) 1030 : VELCHE(NODE,IBMN)=XFORC(IE) 1031 : ENDDO 1032 : ENDDO 1033 : ENDDO 1034 : 1035 : 99169 CONTINUE 1036 : SEGSUP WRK1,WRK2,WRK4 1037 : GOTO 510 1038 : C_______________________________________________________________________ 1039 : C 1040 : C ELEMENT JOINT JGI4 GENERALISE 1041 : C_______________________________________________________________________ 1042 : C 1043 : 172 CONTINUE 1044 : NBNO=NBNN 1045 : NBBB=NBNN 1046 : SEGINI WRK1,WRK2,WRK4 1047 : C 1048 : DO IB=1,NBELEM 1049 : C 1050 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 1051 : C 1051 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 1052 : C 1053 : C MISE A ZERO DES FORCES INTERNES 1054 : C 1054 : CALL ZERO(XFORC,1,LRE) 1055 : C 1056 : C REPERE LOCAL 1057 : C 1057 : CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 1058 : C 1059 : C BOUCLE SUR LES POINTS DE GAUSS 1060 : C 1061 : DO IGAU=1,NBPGAU 1062 : C 1063 : C ON CHERCHE L'EPAISSEUR DU JOINT 1064 : C 1065 : EPAIST=0.D0 1066 : MPTVAL=IVACAR 1067 : MELVAL=IVAL(1) 1068 : IF (MELVAL.NE.0) THEN 1069 : IGMN=MIN(IGAU,VELCHE(/1)) 1070 : IBMN=MIN(IB,VELCHE(/2)) 1071 : EPAIST=VELCHE(IGMN,IBMN) 1072 : ENDIF 1073 : C 1074 : C ON CALCULE B 1075 : C 1075 : CcPPj CALL BJO4G(IGAU,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,IERT) 1075 : CALL BJO4G(IGAU,XE,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,BGENE,DJAC, 1076 : . IERT) 1077 : IF (IERT.NE.0) THEN 1078 : INTERR(1)=IB 1078 : CALL ERREUR (611) 1079 : GOTO 99172 1080 : ENDIF 1081 : C 1082 : C ON CHERCHE LES CONTRAINTES - 1083 : C 1084 : MPTVAL=IVASTR 1085 : DO ICOMP=1,NSTRS 1086 : MELVAL=IVAL(ICOMP) 1087 : IGMN=MIN(IGAU,VELCHE(/1)) 1088 : IBMN=MIN(IB ,VELCHE(/2)) 1089 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 1090 : ENDDO 1091 : C 1092 : C ON CALCULE B*EFFORTS 1093 : C 1094 : DJAC=DJAC*POIGAU(IGAU) 1094 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 1095 : ENDDO 1096 : C 1097 : C RANGEMENT DANS MELVAL 1098 : C 1099 : IE=0 1100 : MPTVAL=IVAFOR 1101 : C 1102 : C NODE=8= NOMBRE DE NOEUDS 1103 : C ICOMP=3= NOMBRE DE COMPOSANTES DE CONTRAINTES PAR NOEUD 1104 : C 1105 : DO NODE=1,NBNN 1106 : DO ICOMP=1,NFORC 1107 : IE=IE+1 1108 : MELVAL=IVAL(ICOMP) 1109 : IBMN=MIN(IB ,VELCHE(/2)) 1110 : VELCHE(NODE,IBMN)=XFORC(IE) 1111 : ENDDO 1112 : ENDDO 1113 : ENDDO 1114 : 1115 : 99172 CONTINUE 1116 : SEGSUP WRK1,WRK2,WRK4 1117 : GOTO 510 1118 : C+PPj 1119 : 1120 : C_______________________________________________________________________ 1121 : C 1122 : C ELEMENT JOINT (JOI3) IMPLEMENTATION SANS TEST DE PLANEITE 1123 : C ET SANS REPERE LOCAL 1124 : C_______________________________________________________________________ 1125 : C 1126 : 86 CONTINUE 1127 : NBNO=NBNN 1128 : NBBB=NBNN 1129 : SEGINI WRK1,WRK2,WRK4 1130 : C 1131 : DO 3086 IB=1,NBELEM 1132 : C 1133 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 1134 : C 1134 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 1135 : C 1136 : C MISE A ZERO DES FORCES INTERNES 1137 : C 1137 : CALL ZERO(XFORC,1,LRE) 1138 : C 1139 : C BOUCLE SUR LES POINTS DE GAUSS 1140 : C 1141 : DO 6086 IGAU=1,NBPGAU 1142 : C 1142 : CALL JO3LOC(XE,SHPTOT,IGAU,NBNN,BPSS) 1143 : C 1143 : CALL BJO3(IGAU,MFR,IFOUR,NIFOUR,XE,BPSS,SHPTOT,SHPWRK, 1144 : . BGENE,DJAC,IERT) 1145 : IF (IERT.NE.0) THEN 1146 : INTERR(1)=IB 1146 : CALL ERREUR (612) 1147 : GOTO 9986 1148 : ENDIF 1149 : C 1150 : C EN AXISYMETRIE, MULTIPLICATION PAR LE RAYON DE COURBURE 1151 : C (LE RAYON DE COURBURE DOIT ETRE CALCULE AVEC LES COORDONNEES 1152 : C GLOCALES CAR ON FAIT UNE INTEGRATION SUR LA CIRCONFERENCE DE LA 1153 : C STRUCTURE CYLINDRIQUE DANS LE REPERE GLOBAL). 1154 : C 1155 : IF (IFOUR.EQ.0) THEN 1156 : NUMSUP=NBNO/2 1157 : RAYON=0.D0 1158 : DO 6286 IRAY=1,NUMSUP 1159 : RAYON=RAYON+SHPTOT(1,IRAY,IGAU)*XE(1,IRAY) 1160 : 6286 CONTINUE 1161 : DJAC=DJAC*RAYON 1162 : ENDIF 1163 : C 1164 : C ON CHERCHE LES CONTRAINTES - 1165 : C 1166 : MPTVAL=IVASTR 1167 : DO 7086 ICOMP=1,NSTRS 1168 : MELVAL=IVAL(ICOMP) 1169 : IGMN=MIN(IGAU,VELCHE(/1)) 1170 : IBMN=MIN(IB ,VELCHE(/2)) 1171 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 1172 : 7086 CONTINUE 1173 : C 1174 : C ON CALCULE B*EFFORTS 1175 : C 1176 : DJAC=DJAC*POIGAU(IGAU) 1176 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 1177 : 6086 CONTINUE 1178 : C 1179 : C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL 1180 : C 1181 : IE=0 1182 : MPTVAL=IVAFOR 1183 : C 1184 : C NODE=6= NOMBRE DE NOEUDS 1185 : C ICOMP=2= NOMBRE DE COMPOSANTES DE CONTRAINTES PAR NOEUD 1186 : C 1187 : DO 9086 NODE=1,6 1188 : DO 9086 ICOMP=1,2 1189 : IE=IE+1 1190 : MELVAL=IVAL(ICOMP) 1191 : IBMN=MIN(IB ,VELCHE(/2)) 1192 : VELCHE(NODE,IBMN)=XFORC(IE) 1193 : 9086 CONTINUE 1194 : 3086 CONTINUE 1195 : 1196 : 9986 CONTINUE 1197 : SEGSUP WRK1,WRK2,WRK4 1198 : GOTO 510 1199 : 1200 : C_______________________________________________________________________ 1201 : C 1202 : C ELEMENT JOINT JOT3 1203 : C_______________________________________________________________________ 1204 : C 1205 : 87 CONTINUE 1206 : NBNO=NBNN 1207 : NBBB=NBNN 1208 : SEGINI WRK1,WRK2,WRK4 1209 : C 1210 : DO 3087 IB=1,NBELEM 1211 : C 1212 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 1213 : C 1213 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 1214 : C 1215 : C MISE A ZERO DES FORCES INTERNES 1216 : C 1216 : CALL ZERO(XFORC,1,LRE) 1217 : C 1218 : C REPERE LOCAL 1219 : C 1219 : CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 1220 : C 1221 : C BOUCLE SUR LES POINTS DE GAUSS 1222 : C 1223 : DO 6087 IGAU=1,NBPGAU 1223 : CALL BJT3(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK, 1224 : . BGENE,DJAC,IERT) 1225 : IF (IERT.NE.0) THEN 1226 : INTERR(1)=IB 1226 : CALL ERREUR (611) 1227 : GOTO 9987 1228 : ENDIF 1229 : C 1230 : C ON CHERCHE LES CONTRAINTES - 1231 : C 1232 : MPTVAL=IVASTR 1233 : DO 7087 ICOMP=1,NSTRS 1234 : MELVAL=IVAL(ICOMP) 1235 : IGMN=MIN(IGAU,VELCHE(/1)) 1236 : IBMN=MIN(IB ,VELCHE(/2)) 1237 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 1238 : 7087 CONTINUE 1239 : C 1240 : C ON CALCULE B*EFFORTS 1241 : C 1242 : DJAC=DJAC*POIGAU(IGAU) 1242 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 1243 : 6087 CONTINUE 1244 : C 1245 : C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL 1246 : C 1247 : C EXPRESSION DE XFORC DANS LE REPERE GLOBAL 1248 : C 1249 : C TRANSPOSEE DE BPSS = INVERSE DE BPSS ( MATRICE ORTHOGONALE ) 1250 : C DONC : TRPOSE(BPSS) = MATRICE DE PASSAGE DU REPERE LOCAL 1251 : C AU REPERE GLOBAL 1252 : C 1252 : CCCCC CALL TRPOSE(BPSS) 1252 : CCCCC CALL MATVEC(XFORC,XFOLO,BPSS,8) 1253 : IE=0 1254 : MPTVAL=IVAFOR 1255 : C 1256 : C NODE=6= NOMBRE DE NOEUDS 1257 : C ICOMP=3= NOMBRE DE COMPOSANTES DE CONTRAINTES PAR NOEUD 1258 : C 1259 : DO 9087 NODE=1,6 1260 : DO 9087 ICOMP=1,3 1261 : IE=IE+1 1262 : MELVAL=IVAL(ICOMP) 1263 : IBMN=MIN(IB ,VELCHE(/2)) 1264 : VELCHE(NODE,IBMN)=XFORC(IE) 1265 : 9087 CONTINUE 1266 : 3087 CONTINUE 1267 : 1268 : 9987 CONTINUE 1269 : SEGSUP WRK1,WRK2,WRK4 1270 : GOTO 510 1271 : C_______________________________________________________________________ 1272 : C 1273 : C ELEMENT JOINT JOI4 1274 : C_______________________________________________________________________ 1275 : C 1276 : 88 CONTINUE 1277 : NBNO=NBNN 1278 : NBBB=NBNN 1279 : SEGINI WRK1,WRK2,WRK4 1280 : C 1281 : DO 3088 IB=1,NBELEM 1282 : C 1283 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 1284 : C 1284 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 1285 : C 1286 : C MISE A ZERO DES FORCES INTERNES 1287 : C 1287 : CALL ZERO(XFORC,1,LRE) 1288 : C 1289 : C REPERE LOCAL 1290 : C 1290 : CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL) 1291 : C 1292 : C BOUCLE SUR LES POINTS DE GAUSS 1293 : C 1294 : DO 6088 IGAU=1,NBPGAU 1294 : CALL BJO4(IGAU,XEL,BPSS,SHPTOT,SHPWRK,BGENE,DJAC,IERT) 1295 : IF (IERT.NE.0) THEN 1296 : INTERR(1)=IB 1296 : CALL ERREUR (611) 1297 : GOTO 9988 1298 : ENDIF 1299 : C 1300 : C ON CHERCHE LES CONTRAINTES - 1301 : C 1302 : MPTVAL=IVASTR 1303 : DO 7088 ICOMP=1,NSTRS 1304 : MELVAL=IVAL(ICOMP) 1305 : IGMN=MIN(IGAU,VELCHE(/1)) 1306 : IBMN=MIN(IB ,VELCHE(/2)) 1307 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 1308 : 7088 CONTINUE 1309 : C 1310 : C ON CALCULE B*EFFORTS 1311 : C 1312 : DJAC=DJAC*POIGAU(IGAU) 1312 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 1313 : 6088 CONTINUE 1314 : C 1315 : C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL 1316 : C 1317 : C EXPRESSION DE XFORC DANS LE REPERE GLOBAL 1318 : C 1319 : C TRANSPOSEE DE BPSS = INVERSE DE BPSS ( MATRICE ORTHOGONALE ) 1320 : C DONC : TRPOSE(BPSS) = MATRICE DE PASSAGE DU REPERE LOCAL 1321 : C AU REPERE GLOBAL 1322 : C 1322 : CCCCC CALL TRPOSE(BPSS) 1322 : CCCCC CALL MATVEC(XFORC,XFOLO,BPSS,8) 1323 : IE=0 1324 : MPTVAL=IVAFOR 1325 : C 1326 : C NODE=8= NOMBRE DE NOEUDS 1327 : C ICOMP=3= NOMBRE DE COMPOSANTES DE CONTRAINTES PAR NOEUD 1328 : C 1329 : DO 9088 NODE=1,8 1330 : DO 9088 ICOMP=1,3 1331 : IE=IE+1 1332 : MELVAL=IVAL(ICOMP) 1333 : IBMN=MIN(IB ,VELCHE(/2)) 1334 : VELCHE(NODE,IBMN)=XFORC(IE) 1335 : 9088 CONTINUE 1336 : 3088 CONTINUE 1337 : 1338 : 9988 CONTINUE 1339 : SEGSUP WRK1,WRK2,WRK4 1340 : GOTO 510 1341 : C_______________________________________________________________________ 1342 : C 1343 : C ELEMENT DST 1344 : C_______________________________________________________________________ 1345 : C 1346 : 93 CONTINUE 1347 : LHOOK=NSTRS 1348 : NBNO=NBNN 1349 : NBBB=NBNN 1350 : SEGINI WRK1,WRK2,WRK3,WRK4 1351 : IF(CMATE.NE.'ISOTROPE')THEN 1352 : MPTVAL=IVAMAT 1353 : IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN 1354 : MELVAL=IVAL(7) 1355 : ELSE 1356 : MELVAL=IVAL(2) 1357 : ENDIF 1358 : NBGCOS=VELCHE(/1) 1359 : ENDIF 1360 : C 1361 : DO 3093 IB=1,NBELEM 1362 : C 1363 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 1364 : C 1364 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 1365 : C 1366 : C MISE A ZERO DES FORCES INTERNES 1367 : C 1367 : CALL ZERO(XFORC,1,LRE) 1368 : C 1368 : CALL VPAST(XE,BPSS) 1369 : C BPSS STOCKE LA MATRICOMPE DE PASSAGE 1369 : CALL VCORLC (XE,XEL,BPSS) 1369 : CALL TRPOSE(BPSS) 1370 : C ON CHERCHE LES EPAISEURS ET ON LES MOYENNE, 1371 : C LES EXCENTREMENTS ET ON LES MOYENNE. 1372 : C 1373 : MPTVAL=IVACAR 1374 : C 1375 : EPAIST=0.D0 1376 : MELVAL=IVAL(1) 1377 : IF (MELVAL.NE.0) THEN 1378 : DO IGAU=1,NBPGAU 1379 : IGMN=MIN(IGAU,VELCHE(/1)) 1380 : IBMN=MIN(IB,VELCHE(/2)) 1381 : EPAIST=EPAIST+VELCHE(IGMN,IBMN) 1382 : ENDDO 1383 : EPAIST=EPAIST/NBPGAU 1384 : ENDIF 1385 : * 1386 : EXCEN=0.D0 1387 : MELVAL=IVAL(2) 1388 : IF (MELVAL.NE.0) THEN 1389 : DO IGAU=1,NBPGAU 1390 : IGMN=MIN(IGAU,VELCHE(/1)) 1391 : IBMN=MIN(IB,VELCHE(/2)) 1392 : EXCEN=EXCEN+VELCHE(IGMN,IBMN) 1393 : ENDDO 1394 : EXCEN=EXCEN/NBPGAU 1395 : ENDIF 1396 : C 1397 : C BOUCLE SUR LES POINTS DE GAUSS 1398 : C 1399 : DO 6093 IGAU=1,NBPGAU 1400 : * 1401 : IF(CMATE.NE.'ISOTROPE')THEN 1402 : IF(IGAU.LE.NBGCOS)THEN 1403 : IF(IMAT.EQ.2)THEN 1404 : MPTVAL=IVAMAT 1405 : MELVAL=IVAL(2) 1406 : IBMN=MIN(IB ,VELCHE(/2)) 1407 : IGMN=MIN(IGAU,VELCHE(/1)) 1408 : COSA=VELCHE(IGMN,IBMN) 1409 : MELVAL=IVAL(3) 1410 : IBMN=MIN(IB ,VELCHE(/2)) 1411 : IGMN=MIN(IGAU,VELCHE(/1)) 1412 : SINA=VELCHE(IGMN,IBMN) 1413 : ENDIF 1414 : ENDIF 1415 : ENDIF 1416 : C 1417 : C ON CHERCHE LA MATRICE DE HOOKE 1418 : C 1419 : MPTVAL=IVAMAT 1420 : IF(IMAT.EQ.2) THEN 1421 : MELVAL=IVAL(1) 1422 : IBMN=MIN(IB ,IELCHE(/2)) 1423 : IGMN=MIN(IGAU,IELCHE(/1)) 1424 : MLREEL=IELCHE(IGMN,IBMN) 1425 : IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT. 1426 : + OR.NBGMAT.GT.1)) THEN 1427 : SEGACT MLREEL 1427 : CALL DOHOOO(PROG,LHOOK,DDHOMU) 1428 : SEGDES MLREEL 1429 : IF(CMATE.EQ.'ORTHOTRO') 1429 : + CALL CHGREP1(COSA,SINA,DDHOMU,LHOOK) 1430 : ENDIF 1431 : ELSE IF (IMAT.EQ.1) THEN 1432 : DO 9193 IM=1,NMATT 1433 : IF (IVAL(IM).NE.0) THEN 1434 : MELVAL=IVAL(IM) 1435 : IBMN=MIN(IB ,VELCHE(/2)) 1436 : IGMN=MIN(IGAU,VELCHE(/1)) 1437 : VALMAT(IM)=VELCHE(IGMN,IBMN) 1438 : ELSE 1439 : VALMAT(IM)=0.D0 1440 : ENDIF 1441 : 9193 CONTINUE 1442 : IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) 1442 : 1 CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD) 1442 : CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU) 1443 : ENDIF 1443 : CALL ZERO(BGENE,NSTRS,LRE) 1444 : IF(CMATE.NE.'ISOTROPE')THEN 1445 : IF(IGAU.LE.NBGCOS)THEN 1446 : IF(IMAT.EQ.1)THEN 1447 : COSA=VALMAT(7) 1448 : SINA=VALMAT(8) 1449 : ENDIF 1450 : DO 1393 INO=1,NBNN 1451 : XX=COSA*XEL(1,INO)+SINA*XEL(2,INO) 1452 : YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO) 1453 : XE(1,INO)=XX 1454 : XE(2,INO)=YY 1455 : 1393 CONTINUE 1456 : ENDIF 1457 : C 1458 : C TERMES DE LA MATRICE DE RIGIDITE RELATIFS 1459 : C AUX CISAILLEMENTS TRANSVERSES 1460 : C 1460 : CALL RCDST(XE,NSTRS,LRE,DDHOMU, 1461 : 1 WORK(1),WORK(10),WORK(19),REL,BGENE,1) 1462 : C 1463 : C TERMES DE LA MATRICE B RELATIFS AUX EFFETS 1464 : C DE MEMBRANE ET DE FLEXION 1465 : C 1465 : CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK, 1466 : 1 WORK(1),WORK(10),WORK(19),BGENE,DUM) 1467 : * 1467 : CALL ROTB(BGENE,NSTRS,COSA,SINA) 1468 : * 1469 : DO 10 NPOI=1,3 1470 : SHPWRK(1,NPOI)=SHPTOT(1,NPOI,IGAU) 1471 : SHPWRK(2,NPOI)=SHPTOT(2,NPOI,IGAU) 1472 : SHPWRK(3,NPOI)=SHPTOT(3,NPOI,IGAU) 1473 : 10 CONTINUE 1473 : CALL JACOBI(XEL,SHPWRK,2,3,DJAC) 1474 : ELSE 1475 : C 1476 : C TERMES DE LA MATRICE B RELATIFS AUX CISAILLEMENTS TRANSVERSES 1477 : C 1477 : CALL RCDST(XEL,NSTRS,LRE,DDHOMU, 1478 : 1 WORK(1),WORK(10),WORK(19),REL,BGENE,1) 1479 : C 1480 : C TERMES DE LA MATRICE B RELATIFS AUX EFFETS 1481 : C DE MEMBRANE ET DE FLEXION 1482 : C 1482 : CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK, 1483 : 1 WORK(1),WORK(10),WORK(19),BGENE,DJAC) 1484 : ENDIF 1485 : DJAC=DJAC*POIGAU(IGAU) 1486 : * 1487 : * ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT 1488 : * 1489 : DO 1593 IJL=1,3 1490 : DO 1593 IJC=1,LRE 1491 : BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC) 1492 : 1593 CONTINUE 1493 : C 1494 : C ON CHERCHE LES CONTRAINTES 1495 : C 1496 : MPTVAL=IVASTR 1497 : DO 7093 ICOMP=1,NSTRS 1498 : MELVAL=IVAL(ICOMP) 1499 : IGMN=MIN(IGAU,VELCHE(/1)) 1500 : IBMN=MIN(IB ,VELCHE(/2)) 1501 : XSTRS(ICOMP)=VELCHE(IGMN,IBMN) 1502 : 7093 CONTINUE 1503 : * 1504 : * TRANSFORMATION DES CONTRAINTES DU REPERE LOCAL AU REPERE 1505 : * D'ORTHOTROPIE 1506 : * 1507 : IF(CMATE.EQ.'ORTHOTRO') 1507 : 1 CALL CHGREP2(COSA,SINA,XSTRS,1,1) 1508 : C 1509 : C ON CALCULE B*EFFORTS 1510 : C 1510 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,DJAC,XFORC) 1511 : 6093 CONTINUE 1512 : C 1513 : C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL 1514 : C 1514 : CALL MATVEC(XFORC,XFOLO,BPSS,6) 1515 : IE=0 1516 : MPTVAL=IVAFOR 1517 : DO 9093 IGAU=1,NBNN 1518 : DO 9093 ICOMP=1,6 1519 : IE=IE+1 1520 : MELVAL=IVAL(ICOMP) 1521 : IBMN=MIN(IB ,VELCHE(/2)) 1522 : VELCHE(IGAU,IBMN)=XFOLO(IE) 1523 : 9093 CONTINUE 1524 : 3093 CONTINUE 1525 : 1526 : 9993 CONTINUE 1527 : SEGSUP WRK1,WRK2,WRK3,WRK4,MVELCH 1528 : GOTO 510 1529 : 1530 : C_______________________________________________________________________ 1531 : C 1532 : C ELEMENTS CIFL MACRO ELEMENT CISAILLEMENT FLEXION 1533 : C_______________________________________________________________________ 1534 : C 1535 : 258 CONTINUE 1536 : NBNO=NBNN 1537 : NBBB=NBNN 1538 : SEGINI WRK1,WRK2,WRK4 1539 : C 1540 : DO IB=1,NBELEM 1541 : C 1542 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 1543 : C 1543 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 1544 : C 1545 : C MISE A ZERO DES FORCES INTERNES 1546 : C 1546 : CALL ZERO(XFORC,1,LRE) 1547 : C 1548 : C PASSAGE DES AXES GLOBAUX AUX AXES LOCAUX 1549 : C 1549 : CALL MURLOC(XE,NBNN,NSTRS,LRE,BPSS,XH,BGENE) 1550 : C 1551 : C ON CHERCHE LES CONTRAINTES - 1552 : C 1553 : MPTVAL=IVASTR 1554 : DO ICOMP=1,NSTRS 1555 : MELVAL=IVAL(ICOMP) 1556 : IBMN=MIN(IB ,VELCHE(/2)) 1557 : XSTRS(ICOMP)=VELCHE(1,IBMN) 1558 : ENDDO 1559 : C 1560 : C ON CALCULE B*EFFORTS 1561 : C 1561 : CALL BSIG(BGENE,XSTRS,NSTRS,LRE,1.D0,XFORC) 1562 : C 1563 : C RANGEMENT DANS MELVAL 1564 : C 1565 : IE=0 1566 : MPTVAL=IVAFOR 1567 : C 1568 : C ON RANGE LES FORCES (FX1,FY1,MZ1,FX2,FY2,MZ2,FM,MM) 1569 : C 1570 : MELVAL=IVAL(1) 1571 : VELCHE(1,IB)=XFORC(1) 1572 : VELCHE(3,IB)=XFORC(4) 1573 : MELVAL=IVAL(2) 1574 : VELCHE(1,IB)=XFORC(2) 1575 : VELCHE(3,IB)=XFORC(5) 1576 : MELVAL=IVAL(3) 1577 : VELCHE(1,IB)=XFORC(3) 1578 : VELCHE(3,IB)=XFORC(6) 1579 : MELVAL=IVAL(4) 1580 : VELCHE(2,IB)=XFORC(7) 1581 : MELVAL=IVAL(5) 1582 : VELCHE(2,IB)=XFORC(8) 1583 : ENDDO 1584 : SEGSUP WRK1,WRK2,WRK4 1585 : GOTO 510 1586 : C_______________________________________________________________________ 1587 : * 1588 : 99 CONTINUE 1589 : MOTERR(1:4)=NOMTP(MELE) 1590 : MOTERR(5:12)='BSIGM2' 1590 : CALL ERREUR(86) 1591 : * 1592 : 510 CONTINUE 1593 : RETURN 1594 : END 1595 : 1596 : 1597 :
© Cast3M 2003 - All rights reserved.
Disclaimer