1 : C MASSE2 SOURCE CHAT 11/03/16 21:27:22 6902 2 : SUBROUTINE MASSE2(IPMAIL,NDDL,LRE,NBPGAU,IPMINT, 3 : &MELE,MFR,IVAMAT,IVACAR,NMATT,IPMATR,ILUMP,IIPDPG) 4 : *---------------------------------------------------------------------* 5 : * _________________________________ * 6 : * | | * 7 : * | calcul de la matrice de masse | * 8 : * |________________________________| * 9 : * * 10 : * massif, liquide, 'surface libre ,incompressible * 11 : * * 12 : *---------------------------------------------------------------------* 13 : * * 14 : * entrees : * 15 : * ________ * 16 : * * 17 : * ipmail pointeur sur un segment meleme * 18 : * nddl nombre de degre de liberte /noeud * 19 : * lre nombre de ddl dans la matrice de masse * 20 : * nbpgau nombre de point d'integration pour la masse * 21 : * ipmint pointeur sur un segment minte * 22 : * ipmin1 pointeur sur un segment minte (aux noeuds) * 23 : * mele numero de l'element fini * 24 : * mfr numero de la formulation * * 25 : * ivamat pointeur sur un segment mptval pour le materiau ou * 26 : * pour une matrice de hooke * 27 : * ivacar pointeur sur un segment mptval pour les * 28 : * caracteristiques * 29 : * nmatt nombre de composante de materiau (imat=1) * * 30 : * ilump =1 si l'opérateur LUMP est appelé 31 : * * 32 : * sorties : * 33 : * ________ * 34 : * * 35 : * ipmatr pointeur sur la matrice de masse de la sous-zone * 36 : * * 37 : *---------------------------------------------------------------------* 38 : IMPLICIT INTEGER(I-N) 39 : IMPLICIT REAL*8(A-H,O-Z) 40 : -INC CCOPTIO 41 : -INC CCHAMP 42 : -INC CCREEL 43 : -INC SMRIGID 44 : -INC SMCHAML 45 : -INC SMELEME 46 : -INC SMCOORD 47 : -INC SMINTE 48 : -INC SMMODEL 49 : c 50 : SEGMENT WRK1 51 : REAL*8 REL(LRE,LRE),XE(3,NBBB) 52 : ENDSEGMENT 53 : c 54 : SEGMENT WRK2 55 : REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE) 56 : ENDSEGMENT 57 : c 58 : SEGMENT WRK5 59 : REAL*8 BLX(NDDL,LRE),BLY(NDDL,LRE),BLZ(NDDL,LRE) 60 : REAL*8 BLT(NDDL,LRE) 61 : ENDSEGMENT 62 : c 63 : c 64 : SEGMENT WRK6 65 : REAL*8 PROPEL(1) 66 : REAL*8 OUT(5) 67 : REAL*8 WORK1(24*24) 68 : ENDSEGMENT 69 : c 70 : SEGMENT MVELCH 71 : REAL*8 VALMAT(NV1) 72 : ENDSEGMENT 73 : c 74 : c 75 : SEGMENT MPTVAL 76 : INTEGER IPOS(NS),NSOF(NS) 77 : INTEGER IVAL(NCOSOU) 78 : CHARACTER*16 TYVAL(NCOSOU) 79 : ENDSEGMENT 80 : c 81 : * 82 : MELEME=IPMAIL 83 : NBNN=NUM(/1) 84 : NBELEM=NUM(/2) 85 : * 86 : NV1=NMATT 87 : SEGINI,MVELCH 88 : * 89 : xMATRI=IPMATR 90 : LVAL = (LRE*(LRE+1))/2 91 : NLIGRP=LRE 92 : NLIGRD=LRE 93 : * 94 : * introduction du point autour duquel se fait le mouvement 95 : * de la section en defo plane generalisee 96 : * En 1D : pas de rotation 97 : IF (IFOUR.EQ.-3) THEN 98 : IREF=(IIPDPG-1)*(IDIM+1) 99 : XDPGE=XCOOR(IREF+1) 100 : YDPGE=XCOOR(IREF+2) 101 : ELSE 102 : XDPGE=0.D0 103 : YDPGE=0.D0 104 : ENDIF 105 : * 106 : NHRM=NIFOUR 107 : * 108 : MINTE=IPMINT 109 : 110 : c_______________________________________________________________________ 111 : c 112 : c numero des etiquettes : 113 : c etiquettes de 1 a 98 pour traitement specifique a l element 114 : c dans la zone specifique a chaque element commencant par : 115 : c 5 continue 116 : c element 5 etiquettes 1005 2005 3005 4005 ... 117 : c 44 continue 118 : c element 44 etiquettes 1044 2044 3044 4044 ... 119 : c_______________________________________________________________________ 120 : c 121 : GOTO (99,99,99,4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99, 122 : 199,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,35,35,35,35,35,35, 123 : 299,99,99,99,99,99,99,48,99,99,99,99,48,48,99,99,99,99,99,99, 124 : 399,99,99,99,99,99,99,99, 4, 4, 4, 4, 4,99,99, 4,99,99,99,99, 125 : 499,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 126 : 599,99,99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 127 : 64, 4),MELE 128 : * BCN 129 : IF ((MELE.eq.183).or.(MELE.eq.184)) GOTO 4 130 : * BCN 131 : C= Elements MECANIQUE 1D : M1Dx 132 : IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4 133 : IF (MELE.EQ.260) GOTO 5 134 : 135 : GOTO 99 136 : c_______________________________________________________________________ 137 : c_______________________________________________________________________ 138 : c 139 : c secteur de calcul pour les elements massifs et elements incompressibles 140 : c_______________________________________________________________________ 141 : c 142 : 4 CONTINUE 143 : DIM3=1.D0 144 : NBNO=NBNN 145 : NBBB=NBNN 146 : SEGINI WRK1,WRK2 147 : I195=0 148 : I259=0 149 : DO 3004 IB=1,NBELEM 150 : c 151 : c on cherche les coordonnees des noeuds de l element ib 152 : c 152 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 152 : CALL ZERO (REL,LRE,LRE) 153 : c 154 : c boucle sur les points de gauss 155 : c 156 : ISDJC=0 157 : DO 4004 IGAU=1,NBPGAU 158 : c 159 : c recuperation de l'epaisseur 160 : c 161 : IF (IFOUR.EQ.-2)THEN 162 : MPTVAL=IVACAR 163 : IF (IVACAR.NE.0) THEN 164 : MELVAL=IVAL(1) 165 : IF (MELVAL.NE.0) THEN 166 : IGMN=MIN(IGAU,VELCHE(/1)) 167 : IBMN=MIN(IB,VELCHE(/2)) 168 : DIM3=VELCHE(IGMN,IBMN) 169 : ELSE 170 : DIM3=1.D0 171 : ENDIF 172 : ENDIF 173 : ENDIF 174 : * 174 : CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL, 175 : 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 176 : IF(DJAC.LT.0.) ISDJC=ISDJC+1 177 : IF(DJAC.EQ.0.) I259=IB 178 : DJAC=ABS(DJAC)*POIGAU(IGAU) 179 : MPTVAL=IVAMAT 180 : IF (IVAL(1).NE.0) THEN 181 : MELVAL=IVAL(1) 182 : IGMN=MIN(IGAU,VELCHE(/1)) 183 : IBMN=MIN(IB,VELCHE(/2)) 184 : VALMAT(1)=VELCHE(IGMN,IBMN) 185 : ELSE 186 : VALMAT(1)=0.D0 187 : ENDIF 188 : DJAC=DJAC*VALMAT(1) 188 : CALL NTNST(BGENE,DJAC,LRE,NDDL,REL) 189 : 4004 CONTINUE 190 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB 191 : * SEGINI XMATRI 192 : * IMATTT(IB)=XMATRI 193 : c 194 : c remplissage de xmatri 195 : c 196 : IF ( ILUMP .EQ. 0 ) THEN 196 : CALL REMPMT(REL,LRE,RE(1,1,ib)) 197 : ELSE 198 : c 199 : c cas de l'opérateur LUMP 200 : c 201 : IF (MELE.EQ.4) THEN 202 : * lumping par la méthode physique 202 : CALL LUMP1(REL,LRE,RE(1,1,ib),IFOUR) 203 : ELSE 204 : * lumping par la méthode HRZ 204 : CALL LUMP2(REL,LRE,RE(1,1,ib),IFOUR) 205 : ENDIF 206 : ENDIF 207 : * SEGDES XMATRI 208 : 3004 CONTINUE 209 : IF(I195.NE.0) INTERR(1)=I195 209 : IF(I195.NE.0) CALL ERREUR(195) 210 : IF(I259.NE.0) INTERR(1)=I259 210 : IF(I259.NE.0) CALL ERREUR(259) 211 : SEGDES xMATRI 212 : SEGSUP WRK1,WRK2,MVELCH 213 : GOTO 510 214 : c_______________________________________________________________________ 215 : c_______________________________________________________________________ 216 : c_______________________________________________________________________ 217 : c 218 : c secteur de calcul pour element SHB8 219 : c_______________________________________________________________________ 220 : c 221 : 5 CONTINUE 222 : NBNO=NBNN 223 : NBBB=NBNN 224 : SEGINI WRK1,WRK2,WRK6 225 : DO 3005 IB=1,NBELEM 226 : c 227 : c on cherche les coordonnees des noeuds de l element ib 228 : c 228 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 228 : CALL ZERO (REL,LRE,LRE) 229 : c 230 : * 231 : MPTVAL=IVAMAT 232 : IF (IVAL(1).NE.0) THEN 233 : MELVAL=IVAL(1) 234 : IBMN=MIN(IB,VELCHE(/2)) 235 : VALMAT(1)=VELCHE(1,IBMN) 236 : ELSE 237 : VALMAT(1)=0.D0 238 : ENDIF 239 : 240 : PROPEL(1)=VALMAT(1) 241 : C 242 : C CALCUL DE LA MATRICE DE MASSE 243 : C 243 : call SHB8 (3,XE,DDHOOK,PROPEL,WORK1,REL,OUT) 244 : C 245 : * SEGINI XMATRI 246 : * IMATTT(IB)=XMATRI 247 : c 248 : c remplissage de xmatri 249 : c 249 : CALL REMPMT(REL,LRE,RE(1,1,ib)) 250 : * SEGDES XMATRI 251 : 3005 CONTINUE 252 : 253 : SEGDES xMATRI 254 : SEGSUP WRK1,WRK2,WRK6,MVELCH 255 : GOTO 510 256 : c_______________________________________________________________________ 257 : c_______________________________________________________________________ 258 : c 259 : c secteur de calcul pour les elements liquides 260 : c_______________________________________________________________________ 261 : c 262 : 35 CONTINUE 263 : c 264 : c ces éléments n'ont pas été testé pour l'opérateur LUMP 265 : c 266 : IF ( ILUMP .EQ. 1 ) GOTO 99 267 : c 268 : DIM3=1.D0 269 : NBNO=NBNN 270 : NBBB=NBNN 271 : SEGINI WRK1,WRK2,WRK5 272 : I195=0 273 : DO 3035 IB=1,NBELEM 274 : c 275 : c on cherche les coordonnees des noeuds de l element ib 276 : c 276 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 276 : CALL ZERO (REL,LRE,LRE) 277 : 278 : c 279 : c calcul des termes en p*pi 280 : 281 : ISDJC=0 282 : DO 4035 IGAU=1,NBPGAU 283 : 284 : c calcul des coefficients de normalisation et proprietes materielles 285 : MPTVAL=IVAMAT 286 : DO 6035 IM=1,NMATT 287 : IF (IVAL(IM).NE.0) THEN 288 : MELVAL=IVAL(IM) 289 : IGMN=MIN(IGAU,VELCHE(/1)) 290 : IBMN=MIN(IB,VELCHE(/2)) 291 : VALMAT(IM)=VELCHE(IGMN,IBMN) 292 : ELSE 293 : VALMAT(IM)=0.D0 294 : ENDIF 295 : 6035 CONTINUE 296 : RHO = VALMAT(1) 297 : C = VALMAT(2) 298 : RHOREF= VALMAT(3) 299 : CREF = VALMAT(4) 300 : RLCAR = VALMAT(5) 301 : c 302 : COEFPR= (RHOREF*CREF**2)/RLCAR 303 : COEFPI= RHOREF*RLCAR 304 : VML12 =-(COEFPR*COEFPI)/(RHO*C**2) 305 : VML22 =-(COEFPI**2)/RHO 306 : 307 : c 308 : c recuperation de l'epaisseur 309 : c 310 : IF (IFOUR.EQ.-2)THEN 311 : MPTVAL=IVACAR 312 : IF (IVACAR.NE.0) THEN 313 : MELVAL=IVAL(1) 314 : IF (MELVAL.NE.0) THEN 315 : IGMN=MIN(IGAU,VELCHE(/1)) 316 : IBMN=MIN(IB,VELCHE(/2)) 317 : DIM3=VELCHE(IGMN,IBMN) 318 : ELSE 319 : DIM3=1.D0 320 : ENDIF 321 : ENDIF 322 : ENDIF 322 : CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL, 323 : 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 324 : IF(DJAC.LT.0.) ISDJC=ISDJC+1 325 : DJAC=ABS(DJAC)*POIGAU(IGAU) 325 : CALL NMLNST(BGENE,DJAC,VML12,LRE,NDDL,REL) 326 : 327 : c 328 : c calcul des termes en pi*pi 329 : c 330 : 330 : CALL BLMAST(IGAU,MFR,NBNN,LRE,IFOUR,NDDL,NHRM, 331 : 1 XE,SHPTOT,SHPWRK,BLX,BLY,BLZ,BLT,DJAC) 332 : DJAC=ABS(DJAC)*POIGAU(IGAU) 332 : CALL BMLBST(BLX,BLY,BLZ,BLT,DJAC,VML22,IFOUR,LRE,NDDL,REL) 333 : 4035 CONTINUE 334 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB 335 : 336 : * SEGINI XMATRI 337 : * IMATTT(IB)=XMATRI 338 : c 339 : c remplissage de xmatri 340 : c 340 : CALL REMPMT(REL,LRE,RE(1,1,ib)) 341 : * SEGDES XMATRI 342 : 3035 CONTINUE 343 : IF(I195.NE.0) INTERR(1)=I195 343 : IF(I195.NE.0) CALL ERREUR(195) 344 : SEGDES xMATRI 345 : SEGSUP WRK1,WRK2,WRK5,MVELCH 346 : GOTO 510 347 : c_______________________________________________________________________ 348 : c 349 : c secteur de calcul pour les elements de surface libre 350 : c_______________________________________________________________________ 351 : c 352 : 48 CONTINUE 353 : c 354 : c ces éléments n'ont pas été testé pour l'opérateur LUMP 355 : c 356 : IF ( ILUMP .EQ. 1 ) GOTO 99 357 : c 358 : NBNO=NBNN 359 : NBBB=NBNN 360 : SEGINI WRK1,WRK2 361 : I195=0 362 : DO 3048 IB=1,NBELEM 363 : c 364 : c on cherche les coordonnees des noeuds de l element ib 365 : c 365 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 365 : CALL ZERO (REL,LRE,LRE) 366 : c 367 : c calcul du coefficient de normalisation sur pi 368 : c 369 : MPTVAL=IVAMAT 370 : DO 5048 IM=1,NMATT 371 : MELVAL=IVAL(IM) 372 : IBMN=MIN(IB,VELCHE(/2)) 373 : VALMAT(IM)=VELCHE(1,IBMN) 374 : 5048 CONTINUE 375 : RHOREF=VALMAT(1) 376 : RLCAR = VALMAT(2) 377 : c 378 : COEFPI= RHOREF*RLCAR 379 : VMS =-COEFPI 380 : c 381 : c boucle sur les points de gauss 382 : c 383 : ISDJC=0 384 : DO 4048 IGAU=1,NBPGAU 384 : CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL, 385 : 1 1.D0,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 386 : IF(DJAC.LT.0.) ISDJC=ISDJC+1 387 : DJAC=ABS(DJAC)*POIGAU(IGAU) 387 : CALL NMSNST(BGENE,DJAC,VMS,LRE,NDDL,REL) 388 : 4048 CONTINUE 389 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB 390 : * SEGINI XMATRI 391 : * IMATTT(IB)=XMATRI 392 : c 393 : c remplissage de xmatri 394 : c 394 : CALL REMPMT(REL,LRE,RE(1,1,ib)) 395 : * SEGDES XMATRI 396 : 3048 CONTINUE 397 : IF(I195.NE.0) INTERR(1)=I195 397 : IF(I195.NE.0) CALL ERREUR(195) 398 : SEGDES xMATRI 399 : SEGSUP WRK1,WRK2,MVELCH 400 : GOTO 510 401 : c_______________________________________________________________________ 402 : * 403 : 99 CONTINUE 404 : MOTERR(1:4)=NOMTP(MELE) 405 : MOTERR(5:12)='MASSE2' 405 : CALL ERREUR(86) 406 : * 407 : 510 CONTINUE 408 : RETURN 409 : END 410 : 411 : 412 :
© Cast3M 2003 - All rights reserved.
Disclaimer