1 : C RIGI3 SOURCE CHAT 11/03/16 21:30:53 6902 2 : SUBROUTINE RIGI3(MATE,MELE,IPMAIL,IPMINT,IPMIN1,NBPGAU,LRE, 3 : & NSTRS,IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT, 4 : & LHOOK,NMATT,LW,NPINT,IPMATR,IIPDPG) 5 : *---------------------------------------------------------------------* 6 : * __________________________ * 7 : * | | * 8 : * | CALCUL DE LA RIGIDITE | * 9 : * |________________________| * 10 : * * 11 : * coq3,dkt,coq4,coq8,coq2,dst 12 : * * 13 : *---------------------------------------------------------------------* 14 : * * 15 : * ENTREES : * 16 : * ________ * 17 : * * 18 : * MATE Numero du materiau * 19 : * MELE Numero de l'element fini * 20 : * IPMAIL Pointeur sur un segment MELEME * 21 : * IPMINT Pointeur sur un segment MINTE aux points de Gauss * 22 : * IPMIN1 pointeur sur un segment MINTE aux noeuds * 23 : * NBPGAU Nombre de point d'integration pour la rigidite * 24 : * LRE Nombre de ddl dans la matrice de rigidite * 25 : * NSTRS Nombre de composante de contraintes/deformations * 26 : * IVAMAT Pointeur sur un segment MPTVAL pour le materiau ou * 27 : * pour une matrice de hooke * 28 : * IVACAR Pointeur sur un segment MPTVAL pour les caracteri- * 29 : * stiques * 30 : * CMATE Nom du materiau * 31 : * MFR Numero de la formulation element fini * 32 : * NBGMAT Taille maxi des melval du materiau (pt de gauss) * 33 : * NELMAT Taille maxi des melval du materiau (No d'element) * 34 : * IMAT (2 il y a une matrice de HOOKE,1 non ) * 35 : * NMATT Nombre de composante de materiau (IMAT=1) * 36 : * NPINT Nombre de points d'integration dans l'epaisseur 37 : * dans le cas des elements de coque integres 38 : * 39 : * * 40 : * SORTIES : * 41 : * ________ * 42 : * * 43 : * IPMATR pointeur sur la rigidite de la sous-zone * 44 : * * 45 : *---------------------------------------------------------------------* 46 : IMPLICIT INTEGER(I-N) 47 : IMPLICIT REAL*8(A-H,O-Z) 48 : * 49 : -INC CCOPTIO 50 : -INC CCHAMP 51 : -INC CCREEL 52 : *- 53 : -INC SMCHAML 54 : -INC SMINTE 55 : -INC SMELEME 56 : -INC SMRIGID 57 : -INC SMMODEL 58 : -INC SMCOORD 59 : -INC SMLREEL 60 : * 61 : SEGMENT WRK1 62 : REAL*8 DDHOOK(LHOOK,LHOOK) ,DDHOMU(LHOOK,LHOOK) 63 : REAL*8 REL(LRE,LRE) , XE(3,NBBB) 64 : ENDSEGMENT 65 : * 66 : SEGMENT WRK2 67 : REAL*8 SHPWRK(6,NBNO) ,BGENE(LHOOK,LRE) 68 : ENDSEGMENT 69 : * 70 : SEGMENT WRK3 71 : REAL*8 WORK(LW) 72 : ENDSEGMENT 73 : * 74 : SEGMENT WRK4 75 : REAL*8 BPSS(3,3) ,XEL(3,NBBB) 76 : ENDSEGMENT 77 : * 78 : SEGMENT WRK5 79 : REAL*8 BGENE1(LHOOK,LRE),POIG(NBPGA1) 80 : ENDSEGMENT 81 : * 82 : SEGMENT,MVELCH 83 : REAL*8 VALMAT(NV1) 84 : ENDSEGMENT 85 : * 86 : SEGMENT MPTVAL 87 : INTEGER IPOS(NS) ,NSOF(NS) 88 : INTEGER IVAL(NCOSOU) 89 : CHARACTER*16 TYVAL(NCOSOU) 90 : ENDSEGMENT 91 : * 92 : CHARACTER*8 CMATE 93 : * 94 : * INITIALISATION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT 95 : * EN DEFORMATION PLANE GENERALISEE 96 : * 97 : * write(6,*) 'entree dans rigi3 lhook',lhook 98 : IF (IFOUR.EQ.-3)THEN 99 : IP=IIPDPG 100 : C* SEGACT MCOORD 101 : IREF=(IP-1)*(IDIM+1) 102 : XDPGE=XCOOR(IREF+1) 103 : YDPGE=XCOOR(IREF+2) 104 : ELSE 105 : XDPGE=0.D0 106 : YDPGE=0.D0 107 : ENDIF 108 : * 109 : MELEME=IPMAIL 110 : NBNN=NUM(/1) 111 : NBELEM=NUM(/2) 112 : * 113 : NV1=NMATT 114 : SEGINI,MVELCH 115 : * 116 : XMATRI=IPMATR 117 : C* NLIGRP=LRE 118 : C* NLIGRD=LRE 119 : * 120 : NHRM=NIFOUR 121 : * 122 : MINTE=IPMINT 123 : IRTD=1 124 : C 125 : C_______________________________________________________________________ 126 : C 127 : C NUMERO DES ETIQUETTES : 128 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT 129 : C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR : 130 : C 5 CONTINUE 131 : C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ... 132 : C 44 CONTINUE 133 : C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ... 134 : C_______________________________________________________________________ 135 : C 136 : GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 137 : 1 99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99, 138 : 2 41,99,99,44,28,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99, 139 : 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 140 : 4 99,99,99,99,99,99,99,99,99,99,99,99,93,99,99,99,99),MELE 141 : GOTO 99 142 : C_______________________________________________________________________ 143 : C 144 : C ELEMENT COQ3 145 : C_______________________________________________________________________ 146 : C 147 : 27 CONTINUE 148 : NBBB=NBNN 149 : SEGINI WRK1,WRK3 150 : C 151 : C BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS 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 ON CHERCHE LES COEFF DES MAT DE HOOKE 159 : C 160 : MPTVAL=IVAMAT 161 : IF(IMAT.EQ.2) THEN 162 : IF (IB.LE.NELMAT.OR.NBGMAT.GT.1) THEN 163 : MELVAL=IVAL(1) 164 : IBMN=MIN(IB ,IELCHE(/2)) 165 : MLREEL=IELCHE(1,IBMN) 166 : SEGACT MLREEL 166 : CALL DOHOOO(PROG,LHOOK,DDHOOK) 167 : * write(6,*)((ddhook(IU,io),iu=1,4),io=1,4) 168 : SEGDES MLREEL 169 : ENDIF 170 : ELSE IF (IMAT.EQ.1) THEN 171 : DO 9027 IM=1,NMATT 172 : IF (IVAL(IM).NE.0) THEN 173 : MELVAL=IVAL(IM) 174 : IBMN=MIN(IB ,VELCHE(/2)) 175 : VALMAT(IM)=VELCHE(1,IBMN) 176 : ELSE 177 : VALMAT(IM)=0.D0 178 : ENDIF 179 : 9027 CONTINUE 180 : IF (IB.LE.NELMAT.OR.NBGMAT.GT.1) 180 : 1 CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD) 181 : * write(6,*)((ddhook(IU,io),iu=1,4),io=1,4) 182 : ENDIF 183 : C 184 : C CHERCHER LES EPAISSEUR ET EXCENTREMENT 185 : C 186 : MPTVAL=IVACAR 187 : MELVAL=IVAL(1) 188 : IBMN=MIN(IB,VELCHE(/2)) 189 : EPAIST=VELCHE(1,IBMN) 190 : IF (IVAL(2).NE.0) THEN 191 : MELVAL=IVAL(2) 192 : IBMN=MIN(IB,VELCHE(/2)) 193 : EXCEN =VELCHE(1,IBMN) 194 : IF (EXCEN.NE.0.D0) THEN 194 : CALL ERREUR(474) 195 : GO TO 9927 196 : ENDIF 197 : ELSE 198 : EXCEN=0.D0 199 : ENDIF 200 : C 201 : C ON CALCULE SA RAIDEUR 202 : C 202 : CALL COQ3RI(REL,XE,EPAIST,DDHOOK,WORK) 203 : C 204 : 4027 CONTINUE 205 : C 206 : C REMPLISSAGE DE XMATRI 207 : C 207 : CALL REMPMT(REL,LRE,RE(1,1,ib)) 208 : 3027 CONTINUE 209 : 210 : IF(IRTD.EQ.0) THEN 211 : MOTERR(1:8)=CMATE 212 : MOTERR(9:16)=NOMFR(MFR/2+1) 213 : INTERR(1)=IFOUR 213 : CALL ERREUR(81) 214 : ENDIF 215 : 9927 CONTINUE 216 : SEGSUP WRK1,WRK3 217 : GOTO 510 218 : C_______________________________________________________________________ 219 : C 220 : C ELEMENT DKT 221 : C_______________________________________________________________________ 222 : C 223 : 28 CONTINUE 224 : NBNO=NBNN 225 : NBBB=NBNN 226 : SEGINI WRK1,WRK2,WRK4 227 : IF(NPINT.NE.0)THEN 228 : NBPGA1=NBPGAU/NPINT 229 : IF(NBGMAT.NE.1)THEN 230 : NBPGEP=NPINT 231 : ELSE 232 : NBPGEP=1 233 : ENDIF 234 : SEGINI WRK5 235 : DO 1028 IG=1,NBPGA1 236 : POIG(IG)=POIGAU(IG) 237 : 1028 CONTINUE 237 : Ccccc CALL POIDNW(NPINT,NBPGA1,2,POIG) 237 : CALL SIMPSN(NPINT,NBPGA1,2,POIG) 238 : ENDIF 239 : C 240 : DO 3028 IB=1,NBELEM 241 : C 242 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 243 : C 243 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 244 : C 244 : CALL VPAST(XE,BPSS) 245 : C BPSS STOCKE LA MATRICE DE PASSAGE 245 : CALL VCORLC (XE,XEL,BPSS) 245 : CALL ZERO (REL,LRE,LRE) 246 : C 247 : C ON CHERCHE LES EPAISEURS ET ON LES MOYENNE, 248 : C LES EXCENTREMENTS ET ON LES MOYENNE. 249 : C 250 : MPTVAL=IVACAR 251 : MELVAL=IVAL(1) 252 : EPAIST=0.D0 253 : IF (MELVAL.NE.0) THEN 254 : DO IGAU=1,NBPGAU 255 : IGMN=MIN(IGAU,VELCHE(/1)) 256 : IBMN=MIN(IB,VELCHE(/2)) 257 : EPAIST=EPAIST+VELCHE(IGMN,IBMN) 258 : ENDDO 259 : EPAIST=EPAIST/NBPGAU 260 : ENDIF 261 : * 262 : MELVAL=IVAL(2) 263 : EXCEN=0.D0 264 : IF (MELVAL.NE.0) THEN 265 : DO IGAU=1,NBPGAU 266 : IGMN=MIN(IGAU,VELCHE(/1)) 267 : IBMN=MIN(IB,VELCHE(/2)) 268 : EXCEN=EXCEN+VELCHE(IGMN,IBMN) 269 : ENDDO 270 : EXCEN=EXCEN/NBPGAU 271 : ENDIF 272 : C 273 : IF(NPINT.EQ.0)THEN 274 : C 275 : C COQUE GLOBAL 276 : C 277 : C BOUCLE SUR LES POINTS DE GAUSS 278 : C 279 : DO 1128 IGAU=1,NBPGAU 280 : * 280 : CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU, 281 : & MELE,MFR,NBNO,LRE,IFOUR,NSTRS,0,1.D0,XEL, 282 : & SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 283 : DJAC=DJAC*POIGAU(IGAU) 284 : C 285 : C ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT 286 : C 287 : IF (EXCEN.NE.0.) THEN 288 : DO 1528 IJL=1,3 289 : DO 1528 IJC=1,LRE 290 : BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC) 291 : 1528 CONTINUE 292 : ENDIF 293 : C 294 : C ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE 295 : C 296 : MPTVAL=IVAMAT 297 : IF(IMAT.EQ.2) THEN 298 : IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN 299 : MELVAL=IVAL(1) 300 : IBMN=MIN(IB ,IELCHE(/2)) 301 : IGMN=MIN(IGAU,IELCHE(/1)) 302 : MLREEL=IELCHE(IGMN,IBMN) 303 : SEGACT MLREEL 303 : CALL DOHOOO(PROG,LHOOK,DDHOOK) 304 : SEGDES MLREEL 305 : ENDIF 305 : CALL BDBS1(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL,MFR,IFOUR,MATE, 306 : 1 IGAU,IMAT,EXCEN) 307 : ELSE IF (IMAT.EQ.1) THEN 308 : * 309 : DO 9028 IM=1,NMATT 310 : IF (IVAL(IM).NE.0) THEN 311 : MELVAL=IVAL(IM) 312 : IBMN=MIN(IB ,VELCHE(/2)) 313 : IGMN=MIN(IGAU,VELCHE(/1)) 314 : VALMAT(IM)=VELCHE(IGMN,IBMN) 315 : ELSE 316 : VALMAT(IM)=0.D0 317 : ENDIF 318 : 9028 CONTINUE 319 : IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) 319 : 1 CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD) 319 : CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU) 319 : CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE, 320 : 1 IGAU,IMAT,EXCEN) 321 : ENDIF 322 : 1128 CONTINUE 323 : C 324 : ELSE 325 : C 326 : C COQUE INTEGREE 327 : C 328 : C BOUCLE SUR LES POINTS DE GAUSS DE LA SURFACE 329 : C 330 : DO 1101 IGAU=1,NBPGA1 331 : * 331 : CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU, 332 : & MELE,MFR,NBNO,LRE,IFOUR,LHOOK,0,1.D0,XEL, 333 : & SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 334 : C 335 : C ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT 336 : C 337 : IF (EXCEN.NE.0.) THEN 338 : DO 1501 IJL=1,3 339 : DO 1501 IJC=1,LRE 340 : BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC) 341 : 1501 CONTINUE 342 : ENDIF 343 : C 344 : C BOUCLE SUR LES NAPPES DANS L'EPAISSEUR 345 : C 346 : DO 1102 INAP=1,NBPGEP 347 : C 348 : IGAU1=(INAP-1)*NBPGA1+IGAU 349 : C 350 : C CALCUL DE LA MATRICE B CORRESPONDANT AUX DEFORMATIONS 3D 351 : C 352 : IF(NBGMAT.EQ.1.AND.NPINT.NE.1)THEN 353 : ZZZ2 = SQRT( (EPAIST**3.D0)/12.D0 ) 354 : ZZZ1 = SQRT( EPAIST ) 355 : DO 1503 IJL=1,3 356 : DO 1503 IJC=1,LRE 357 : BGENE1(IJL,IJC) =ZZZ1*BGENE(IJL,IJC) 358 : BGENE1(IJL+3,IJC)=ZZZ2*BGENE(IJL+3,IJC) 359 : 1503 CONTINUE 360 : DJAC1=DJAC*POIG(IGAU1) 361 : ELSE 362 : ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0) 363 : DO 1502 IJL=1,3 364 : DO 1502 IJC=1,LRE 365 : BGENE1(IJL,IJC)=BGENE(IJL,IJC) 366 : BGENE1(IJL+3,IJC)=ZZZ*BGENE(IJL+3,IJC) 367 : 1502 CONTINUE 368 : DJAC1=DJAC*POIGAU(IGAU1)*(EPAIST/2.D0) 369 : ENDIF 370 : C 371 : C ON CHERCHE LA MATRICE DE HOOKE 372 : C 373 : MPTVAL=IVAMAT 374 : IF(IMAT.EQ.2) THEN 375 : IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN 376 : MELVAL=IVAL(1) 377 : IBMN=MIN(IB ,IELCHE(/2)) 378 : IGMN=MIN(IGAU1,IELCHE(/1)) 379 : MLREEL=IELCHE(IGMN,IBMN) 380 : SEGACT MLREEL 380 : CALL DHDKTI(PROG,LHOOK,DDHOOK) 381 : SEGDES MLREEL 382 : * write(6,*)((ddhook(IU,io),iu=1,6),io=1,6) 383 : ENDIF 384 : ELSE IF (IMAT.EQ.1) THEN 385 : DO 9001 IM=1,NMATT 386 : IF (IVAL(IM).NE.0) THEN 387 : MELVAL=IVAL(IM) 388 : IBMN=MIN(IB ,VELCHE(/2)) 389 : IGMN=MIN(IGAU1,VELCHE(/1)) 390 : VALMAT(IM)=VELCHE(IGMN,IBMN) 391 : ELSE 392 : VALMAT(IM)=0.D0 393 : ENDIF 394 : 9001 CONTINUE 395 : IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) 395 : 1 CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD) 396 : * write(6,*)((ddhook(IU,io),iu=1,6),io=1,6) 397 : ENDIF 397 : CALL BDBS1(BGENE1,DJAC1,DDHOOK,LRE,LHOOK,REL,MFR,IFOUR,MATE, 398 : 1 IGAU,IMAT,EXCEN) 399 : 1102 CONTINUE 400 : 1101 CONTINUE 401 : ENDIF 402 : REL(6,6)=REL(5,5)*1.D-7 403 : REL(12,12)=REL(6,6) 404 : REL(18,18)=REL(6,6) 405 : ICOM=0 406 : IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT' 407 : 1 .OR. IMAT.EQ.2) ICOM=1 407 : CALL TRANSK(REL,BPSS,LRE,3,ICOM) 408 : C 409 : C REMPLISSAGE DE XMATRI 410 : C 410 : CALL REMPMT(REL,LRE,RE(1,1,IB)) 411 : 3028 CONTINUE 412 : IF(IRTD.EQ.0) THEN 413 : MOTERR(1:8)=CMATE 414 : MOTERR(9:16)=NOMFR(MFR/2+1) 415 : INTERR(1)=IFOUR 415 : CALL ERREUR(81) 416 : ENDIF 417 : SEGSUP WRK1,WRK2,WRK4 418 : IF(NPINT.NE.0)SEGSUP WRK5 419 : GOTO 510 420 : C_______________________________________________________________________ 421 : C 422 : C ELEMENT COQ8 423 : C_______________________________________________________________________ 424 : C 425 : 41 CONTINUE 426 : NBBB=NBNN 427 : NBNO=NBNN 428 : SEGINI WRK1,WRK2,WRK3 429 : MINTE1=IPMIN1 430 : SEGACT MINTE1 431 : NBPGA1=MINTE1.SHPTOT(/3) 432 : NBN1 =MINTE1.SHPTOT(/2) 433 : C 434 : C BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS 435 : C 436 : DO 3041 IB=1,NBELEM 437 : C 438 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 439 : C 439 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 440 : C 440 : CALL ZERO (REL,LRE,LRE) 441 : C 442 : C ON CHERCHE LES EPAISSEURS ET LES EXCENTREMENTS. 443 : C 444 : MPTVAL=IVACAR 445 : DO 4041 IGAU=1,NBPGAU 446 : MELVAL=IVAL(1) 447 : IGMN=MIN(IGAU,VELCHE(/1)) 448 : IBMN=MIN(IB,VELCHE(/2)) 449 : WORK(IGAU) =VELCHE(IGMN,IBMN) 450 : IF (IVAL(2).NE.0) THEN 451 : MELVAL=IVAL(2) 452 : IGMN=MIN(IGAU,VELCHE(/1)) 453 : IBMN=MIN(IB,VELCHE(/2)) 454 : WORK(10+IGAU)=VELCHE(IGMN,IBMN) 455 : ELSE 456 : WORK(10+IGAU)=0.D0 457 : ENDIF 458 : 4041 CONTINUE 459 : C 460 : C DETERMINATION DES AXES LOCAUX AUX NOEUDS 461 : C 461 : CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,WORK(21),IRR) 462 : C 463 : C BOUCLE SUR LES POINTS DE GAUSS 464 : C 465 : DO 3042 IGAU=1,NBPGAU 466 : E3=DZEGAU(IGAU) 466 : CALL BCOQ8E(IGAU,XE,NBNN,WORK(1),WORK(11),BGENE,DJAC, 467 : 1 E3,SHPTOT,WORK(21),IRR) 468 : C 469 : C GESTION D'ERREUR: IRR=0 CORRESPOND A UN VECTEUR NUL (CF. CROSS2) 470 : C IRR=-1 CORRESPOND A UN JACOBIEN NUL(CF. SHLJAC) 471 : C 472 : IF(IRR.EQ.0) THEN 472 : CALL ERREUR(241) 473 : GOTO 9941 474 : ELSE IF(IRR.EQ.-1)THEN 474 : CALL ERREUR(240) 475 : GOTO 9941 476 : ENDIF 477 : C 478 : DJAC=ABS(DJAC)*POIGAU(IGAU) 479 : C 480 : C ON CHERCHE LES COEFF DES MAT DE HOOKE 481 : C 482 : MPTVAL=IVAMAT 483 : IF(IMAT.EQ.2) THEN 484 : IF ((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN 485 : MELVAL=IVAL(1) 486 : IBMN=MIN(IB ,IELCHE(/2)) 487 : IGMN=MIN(IGAU,IELCHE(/1)) 488 : MLREEL=IELCHE(IGMN,IBMN) 489 : SEGACT MLREEL 489 : CALL DOHOOO(PROG,LHOOK,DDHOOK) 490 : SEGDES MLREEL 491 : ENDIF 492 : ELSE IF (IMAT.EQ.1) THEN 493 : DO 9041 IM=1,NMATT 494 : IF (IVAL(IM).NE.0) THEN 495 : MELVAL=IVAL(IM) 496 : IBMN=MIN(IB ,VELCHE(/2)) 497 : IGMN=MIN(IGAU,VELCHE(/1)) 498 : VALMAT(IM)=VELCHE(IGMN,IBMN) 499 : ELSE 500 : VALMAT(IM)=0.D0 501 : ENDIF 502 : 9041 CONTINUE 503 : IF((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) 503 : 1 CALL DOHCOE (VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD) 504 : ENDIF 505 : C 506 : C ON CALCULE SA RAIDEUR 507 : C 507 : CALL COQ8RI(BGENE,DJAC,DDHOOK,LRE,NBPGAU,IGAU,NBNN,REL) 508 : C 509 : 3042 CONTINUE 510 : C 511 : C REMPLISSAGE DE XMATRI 512 : C 512 : CALL REMPMT(REL,LRE,RE(1,1,IB)) 513 : 3041 CONTINUE 514 : c 515 : IF(IRTD.EQ.0) THEN 516 : MOTERR(1:8)=CMATE 517 : MOTERR(9:16)=NOMFR(MFR/2+1) 518 : INTERR(1)=IFOUR 518 : CALL ERREUR(81) 519 : ENDIF 520 : 9941 CONTINUE 521 : SEGSUP WRK1,WRK2,WRK3 522 : SEGDES MINTE1 523 : GOTO 510 524 : C_______________________________________________________________________ 525 : C 526 : C SECTEUR DE CALCUL POUR LE COQ2 527 : C_______________________________________________________________________ 528 : C 529 : 44 CONTINUE 530 : DIM3=1.D0 531 : NBNO=NBNN 532 : NBBB=NBNN 533 : SEGINI WRK1,WRK2 534 : DO 3044 IB=1,NBELEM 535 : C 536 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 537 : C 537 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 538 : C 538 : CALL ZERO (REL,LRE,LRE) 539 : C 540 : C BOUCLE SUR LES POINTS DE GAUSS 541 : C 542 : DO 4044 IGAU=1,NBPGAU 543 : MPTVAL=IVACAR 544 : MELVAL=IVAL(1) 545 : IBMN=MIN(IB,VELCHE(/2)) 546 : EPAIST=VELCHE(1,IBMN) 547 : IF (IVAL(2).NE.0) THEN 548 : MELVAL=IVAL(2) 549 : IBMN=MIN(IB,VELCHE(/2)) 550 : EXCEN =VELCHE(1,IBMN) 551 : ELSE 552 : EXCEN=0.D0 553 : ENDIF 554 : IF (IFOUR.EQ.-2) THEN 555 : IF (IVAL(3).NE.0) THEN 556 : MELVAL=IVAL(3) 557 : IBMN=MIN(IB,VELCHE(/2)) 558 : DIM3 =VELCHE(1,IBMN) 559 : ELSE 560 : DIM3=1.D0 561 : ENDIF 562 : ENDIF 563 : C 564 : C APPEL A BCOQ2 ... 565 : C 565 : CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU, 566 : . EXCEN,DIM3,IRRT,XDPGE,YDPGE) 567 : C 568 : C GESTION D'ERREUR 569 : C LES ERREURS PREVUES SONT LONGEUR DE L'ELEMENT =0 OU RAYON 570 : C AU POINT D'INTEGRATION =0 OU RAPPORT R/L TROP PETIT (INFERIEUR 571 : C A 1.E-3). 572 : C 573 : IF(IRRT.EQ.1) THEN 574 : INTERR(1)=IB 574 : CALL ERREUR(255) 575 : GOTO 9944 576 : ELSE IF (IRRT.EQ.2) THEN 577 : INTERR(1)=IB 577 : CALL ERREUR(256) 578 : GOTO 9944 579 : ENDIF 580 : C 581 : MPTVAL=IVAMAT 582 : IF(IMAT.EQ.2) THEN 583 : IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN 584 : MELVAL=IVAL(1) 585 : IBMN=MIN(IB ,IELCHE(/2)) 586 : IGMN=MIN(IGAU,IELCHE(/1)) 587 : MLREEL=IELCHE(IGMN,IBMN) 588 : SEGACT MLREEL 588 : CALL DOHOOO(PROG,LHOOK,DDHOOK) 589 : SEGDES MLREEL 590 : ENDIF 590 : CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL) 591 : ELSE IF (IMAT.EQ.1) THEN 592 : * 593 : DO 9044 IM=1,NMATT 594 : IF (IVAL(IM).NE.0) THEN 595 : MELVAL=IVAL(IM) 596 : IBMN=MIN(IB ,VELCHE(/2)) 597 : IGMN=MIN(IGAU,VELCHE(/1)) 598 : VALMAT(IM)=VELCHE(IGMN,IBMN) 599 : ELSE 600 : VALMAT(IM)=0.D0 601 : ENDIF 602 : 9044 CONTINUE 603 : IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) 603 : 1 CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD) 603 : CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU) 603 : CALL BDBST(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL) 604 : ENDIF 605 : 4044 CONTINUE 606 : C 607 : C REMPLISSAGE DE XMATRI 608 : C 608 : CALL REMPMT(REL,LRE,RE(1,1,IB)) 609 : 3044 CONTINUE 610 : C 611 : C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR... 612 : IF(IRTD.EQ.0) THEN 613 : MOTERR(1:8)=CMATE 614 : MOTERR(9:16)=NOMFR(MFR/2+1) 615 : INTERR(1)=IFOUR 615 : CALL ERREUR(81) 616 : ENDIF 617 : 9944 CONTINUE 618 : SEGSUP WRK1,WRK2 619 : GOTO 510 620 : C_______________________________________________________________________ 621 : C 622 : C SECTEUR DE CALCUL POUR LE COQ4 623 : C_______________________________________________________________________ 624 : C 625 : 49 CONTINUE 626 : NBNO=NBNN 627 : NBBB=NBNN 628 : SEGINI WRK1,WRK2,WRK4 629 : c 630 : c ... Si le matériau n'est pas isotrope, dans le cas général les 631 : c tensions et le cisaillement NE sont PAS découplées. Ce qui veut 632 : c dire qu'on n'a pas le droit de les intégrer différemment ... 633 : c 634 : DO 3049 IB=1,NBELEM 635 : C 636 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 637 : C 637 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 638 : C 638 : CALL ZERO (REL,LRE,LRE) 638 : CALL CQ4LOC(XE,XEL,BPSS,IRRT,1) 639 : C IRRT=1 NODI TROPPO VICINI 640 : IF(IRRT.EQ.1) THEN 641 : INTERR(1)=IB 641 : CALL ERREUR(323) 642 : GOTO 9949 643 : ELSE IF(IRRT.EQ.3) THEN 644 : IRRT = 0 645 : NOPLAN = 1 646 : ELSE 647 : NOPLAN = 0 648 : ENDIF 649 : C 650 : C BOUCLE SUR LES POINTS DE GAUSS 651 : C 652 : MPTVAL=IVACAR 653 : MELVAL=IVAL(1) 654 : IBMN=MIN(IB,VELCHE(/2)) 655 : EPAIST=VELCHE(1,IBMN) 656 : IF (IVAL(2).NE.0) THEN 657 : MELVAL=IVAL(2) 658 : IBMN=MIN(IB,VELCHE(/2)) 659 : EXCEN =VELCHE(1,IBMN) 660 : ELSE 661 : EXCEN=0.D0 662 : ENDIF 663 : DO 4049 IGAU=1,NBPGAU 664 : C 665 : C APPEL A BCOQ4 666 : C 667 : if(cmate.eq.'ISOTROPE') then 667 : CALL BCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT, 668 : + 0) 669 : else 669 : CALL BCOQ4O(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT, 670 : + 0) 671 : endif 672 : DJAC=DJAC*POIGAU(IGAU) 673 : C IRRT=1 JACOBIANO <= 0 674 : IF(IRRT.EQ.1) THEN 675 : INTERR(1)=IB 675 : CALL ERREUR(321) 676 : GOTO 9949 677 : ENDIF 678 : C 679 : MPTVAL=IVAMAT 680 : IF(IMAT.EQ.2) THEN 681 : IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN 682 : MELVAL=IVAL(1) 683 : IBMN=MIN(IB ,IELCHE(/2)) 684 : IGMN=MIN(IGAU,IELCHE(/1)) 685 : MLREEL=IELCHE(IGMN,IBMN) 686 : SEGACT MLREEL 686 : CALL DOHOOO(PROG,LHOOK,DDHOOK) 687 : SEGDES MLREEL 688 : ENDIF 688 : CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL) 689 : ELSE IF (IMAT.EQ.1) THEN 690 : * 691 : DO 9049 IM=1,NMATT 692 : IF (IVAL(IM).NE.0) THEN 693 : MELVAL=IVAL(IM) 694 : IBMN=MIN(IB ,VELCHE(/2)) 695 : IGMN=MIN(IGAU,VELCHE(/1)) 696 : VALMAT(IM)=VELCHE(IGMN,IBMN) 697 : ELSE 698 : VALMAT(IM)=0.D0 699 : ENDIF 700 : 9049 CONTINUE 701 : IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) 701 : 1 CALL DOHCIS(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD) 701 : CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU) 702 : if(cmate.eq.'ISOTROPE') then 702 : CALL COQ4RI (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL) 703 : else 703 : CALL COQ4RJ (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL) 704 : endif 705 : ENDIF 706 : 4049 CONTINUE 707 : C 708 : REL(6,6)=REL(5,5)*1.D-7 709 : REL(12,12)=REL(6,6) 710 : REL(18,18)=REL(6,6) 711 : REL(24,24)=REL(6,6) 712 : ICOM=0 713 : IF(ABS(EXCEN).GT.XPETIT .OR.CMATE.EQ.'COMPOSIT' 714 : 1 .OR. IMAT.EQ.2) ICOM=1 714 : CALL TRANSK(REL,BPSS,LRE,4,ICOM) 715 : C 716 : C REMPLISSAGE DE XMATRI 717 : C 717 : CALL REMPMT(REL,LRE,RE(1,1,IB)) 718 : 3049 CONTINUE 719 : C 720 : C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR... 721 : IF(IRTD.EQ.0) THEN 722 : MOTERR(1:8)=CMATE 723 : MOTERR(9:16)=NOMFR(MFR/2+1) 724 : INTERR(1)=IFOUR 724 : CALL ERREUR(81) 725 : ENDIF 726 : 9949 CONTINUE 727 : SEGSUP WRK1,WRK2,WRK4 728 : GOTO 510 729 : C_______________________________________________________________________ 730 : C 731 : C ELEMENT DST 732 : C_______________________________________________________________________ 733 : C 734 : 93 CONTINUE 735 : NBNO=NBNN 736 : NBBB=NBNN 737 : SEGINI WRK1,WRK2,WRK3,WRK4 738 : IF(CMATE.NE.'ISOTROPE')THEN 739 : MPTVAL=IVAMAT 740 : IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN 741 : MELVAL=IVAL(7) 742 : ELSE 743 : MELVAL=IVAL(2) 744 : ENDIF 745 : NBGCOS=VELCHE(/1) 746 : ENDIF 747 : DO 3093 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 VPAST(XE,BPSS) 752 : C BPSS STOCKE LA MATRICE DE PASSAGE 752 : CALL VCORLC (XE,XEL,BPSS) 752 : CALL ZERO (REL,LRE,LRE) 753 : C 754 : C BOUCLE SUR LES POINTS DE GAUSS 755 : C 756 : DO 1193 IGAU=1,NBPGAU 757 : MPTVAL=IVACAR 758 : MELVAL=IVAL(1) 759 : IBMN =MIN(IB,VELCHE(/2)) 760 : EPAIST=VELCHE(1,IBMN) 761 : IF (IVAL(2).NE.0) THEN 762 : MELVAL=IVAL(2) 763 : IBMN =MIN(IB,VELCHE(/2)) 764 : EXCEN =VELCHE(1,IBMN) 765 : ELSE 766 : EXCEN=0.D0 767 : ENDIF 768 : * 769 : * Dans le cas des matériaux orthotropes, les déformations sont d'abord 770 : * calculées dans le repère d'orthotropie (les formules utilisées par les 771 : * routines RCDST et BMFDST ne sont valables que dans ce repère); elles 772 : * sont ensuite exprimées dans le repère local de l'élément. 773 : * 774 : IF(CMATE.NE.'ISOTROPE')THEN 775 : IF(IGAU.LE.NBGCOS)THEN 776 : IF(IMAT.EQ.2)THEN 777 : MPTVAL=IVAMAT 778 : MELVAL=IVAL(2) 779 : IBMN=MIN(IB ,VELCHE(/2)) 780 : IGMN=MIN(IGAU,VELCHE(/1)) 781 : COSA=VELCHE(IGMN,IBMN) 782 : MELVAL=IVAL(3) 783 : IBMN=MIN(IB ,VELCHE(/2)) 784 : IGMN=MIN(IGAU,VELCHE(/1)) 785 : SINA=VELCHE(IGMN,IBMN) 786 : ENDIF 787 : ENDIF 788 : ENDIF 789 : C 790 : C ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE 791 : C 792 : MPTVAL=IVAMAT 793 : IF(IMAT.EQ.2) THEN 794 : IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT. 795 : + OR.NBGMAT.GT.1)) THEN 796 : MELVAL=IVAL(1) 797 : IBMN=MIN(IB ,IELCHE(/2)) 798 : IGMN=MIN(IGAU,IELCHE(/1)) 799 : MLREEL=IELCHE(IGMN,IBMN) 800 : SEGACT MLREEL 800 : CALL DOHOOO(PROG,LHOOK,DDHOMU) 801 : SEGDES MLREEL 802 : IF(CMATE.EQ.'ORTHOTRO') 802 : + CALL CHGREP1(COSA,SINA,DDHOMU,LHOOK) 803 : ENDIF 804 : ELSE IF (IMAT.EQ.1) THEN 805 : * 806 : DO 9093 IM=1,NMATT 807 : IF (IVAL(IM).NE.0) THEN 808 : MELVAL=IVAL(IM) 809 : IBMN=MIN(IB ,VELCHE(/2)) 810 : IGMN=MIN(IGAU,VELCHE(/1)) 811 : VALMAT(IM)=VELCHE(IGMN,IBMN) 812 : ELSE 813 : VALMAT(IM)=0.D0 814 : ENDIF 815 : 9093 CONTINUE 816 : IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) 816 : 1 CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD) 816 : CALL HOOKMU(EPAIST,0.D0,NSTRS,DDHOOK,DDHOMU) 817 : ENDIF 818 : * 818 : CALL ZERO(BGENE,NSTRS,LRE) 819 : IF(CMATE.NE.'ISOTROPE')THEN 820 : IF(IGAU.LE.NBGCOS)THEN 821 : IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN 822 : COSA=VALMAT(7) 823 : SINA=VALMAT(8) 824 : ENDIF 825 : DO 1393 INO=1,NBNN 826 : XX=COSA*XEL(1,INO)+SINA*XEL(2,INO) 827 : YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO) 828 : XE(1,INO)=XX 829 : XE(2,INO)=YY 830 : 1393 CONTINUE 831 : ENDIF 832 : CC 833 : C TERMES DE LA MATRICE DE RIGIDITE RELATIFS 834 : C AUX CISAILLEMENTS TRANSVERSES 835 : C 835 : CALL RCDST(XE,NSTRS,LRE,DDHOMU, 836 : 1 WORK(1),WORK(10),WORK(19),REL,BGENE,1) 837 : 838 : C TERMES DE LA MATRICE B RELATIFS AUX EFFETS 839 : C DE MEMBRANE ET DE FLEXION 840 : C 840 : CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK, 841 : 1 WORK(1),WORK(10),WORK(19),BGENE,DUM) 842 : * 843 : DO 10 NPOI=1,3 844 : SHPWRK(1,NPOI)=SHPTOT(1,NPOI,IGAU) 845 : SHPWRK(2,NPOI)=SHPTOT(2,NPOI,IGAU) 846 : SHPWRK(3,NPOI)=SHPTOT(3,NPOI,IGAU) 847 : 10 CONTINUE 847 : CALL JACOBI(XEL,SHPWRK,2,3,DJAC) 847 : CALL ROTB(BGENE,NSTRS,COSA,SINA) 848 : ELSE 849 : C 850 : C TERMES DE LA MATRICE DE RIGIDITE RELATIFS 851 : C AUX CISAILLEMENTS TRANSVERSES 852 : C 852 : CALL RCDST(XEL,NSTRS,LRE,DDHOMU, 853 : 1 WORK(1),WORK(10),WORK(19),REL,BGENE,1) 854 : C 855 : C TERMES DE LA MATRICE B RELATIFS AUX EFFETS 856 : C DE MEMBRANE ET DE FLEXION 857 : C 857 : CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK, 858 : 1 WORK(1),WORK(10),WORK(19),BGENE,DJAC) 859 : ENDIF 860 : DJAC=DJAC*POIGAU(IGAU) 861 : C 862 : C ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT 863 : C 864 : IF (EXCEN.NE.0.) THEN 865 : DO 1593 IJL=1,3 866 : DO 1593 IJC=1,LRE 867 : BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC) 868 : 1593 CONTINUE 869 : ENDIF 870 : C 870 : CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE, 871 : 1 IGAU,IMAT,EXCEN) 872 : 1193 CONTINUE 873 : REL(6,6)=REL(5,5)*1.D-7 874 : REL(12,12)=REL(6,6) 875 : REL(18,18)=REL(6,6) 876 : ICOM=0 877 : IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT' 878 : 1 .OR. IMAT.EQ.2) ICOM=1 878 : CALL TRANSK(REL,BPSS,LRE,3,ICOM) 879 : C 880 : C REMPLISSAGE DE XMATRI 881 : C 881 : CALL REMPMT(REL,LRE,RE(1,1,IB)) 882 : 3093 CONTINUE 883 : C 884 : 9993 CONTINUE 885 : SEGSUP WRK1,WRK2,WRK3,WRK4 886 : GOTO 510 887 : * 888 : C======================================================================= 889 : C========= ERREUR : CAS NON PREVUS ===================================== 890 : C======================================================================= 891 : 99 CONTINUE 892 : MOTERR(1:4)=NOMTP(MELE) 893 : MOTERR(9:12)='RIGI3' 893 : CALL ERREUR(86) 894 : * 895 : 510 CONTINUE 896 : SEGSUP,MVELCH 897 : * SEGDES XMATRI 898 : 899 : RETURN 900 : END 901 : 902 : 903 :
© Cast3M 2003 - All rights reserved.
Disclaimer