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