C KCENT3 SOURCE PV090527 26/04/30 21:15:43 12529 SUBROUTINE KCENT3(IPMAIL,NDDL,LRE,NBPGAU,IPMINT, &MELE,MFR,IVAMAT,IVACAR,NMATT,IPMATR,VROT,IIPDPG) *---------------------------------------------------------------------* * _______________________________________________ * * | | * * | calcul de la matrice de raideur centrifuge | * * |_____________________________________________| * * * * massif * * * *---------------------------------------------------------------------* * * * entrees : * * ________ * * * * ipmail pointeur sur un segment meleme * * nddl nombre de degre de liberte /noeud * * lre nombre de ddl dans la matrice de masse * * nbpgau nombre de point d'integration pour la masse * * ipmint pointeur sur un segment minte * * ipmin1 pointeur sur un segment minte (aux noeuds) * * mele numero de l'element fini * * mfr numero de la formulation * * * ivamat pointeur sur un segment mptval pour le materiau ou * * pour une matrice de hooke * * ivacar pointeur sur un segment mptval pour les * * caracteristiques * * nmatt nombre de composante de materiau (imat=1) * * iprota pointeur sur un point (vecteur vitesse de rotation) * * * * sorties : * * ________ * * * * ipmatr pointeur sur la matrice de masse de la sous-zone * * * * Didier COMBESCURE mars 2003 * *---------------------------------------------------------------------* IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCHAMP -INC CCREEL -INC SMRIGID -INC SMCHAML -INC SMELEME -INC SMCOORD -INC SMINTE -INC SMMODEL -INC TMPTVAL SEGMENT WRK1 REAL*8 REL(LRE,LRE),XE(3,NBBB) ENDSEGMENT c SEGMENT WRK2 REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE) ENDSEGMENT c SEGMENT WRK5 REAL*8 BLX(NDDL,LRE),BLY(NDDL,LRE),BLZ(NDDL,LRE) REAL*8 BLT(NDDL,LRE) ENDSEGMENT c SEGMENT MVELCH REAL*8 VALMAT(NV1) ENDSEGMENT DIMENSION VROT(*) DIMENSION ROME(3,3) C ,RELB(LRE,LRE) MELEME=IPMAIL NBNN=NUM(/1) NBELEM=NUM(/2) * NV1=NMATT SEGINI,MVELCH * xMATRI=IPMATR LVAL = (LRE*(LRE+1))/2 NLIGRP=LRE NLIGRD=LRE XDPGE=0.D0 YDPGE=0.D0 NHRM=NIFOUR * MINTE=IPMINT * * Remplissage de ROME depuis VROT qui est constant dans tout le modele ROME(1,1) = (-1.D0)*((VROT(2)**2) + (VROT(3)**2)) ROME(2,2) = (-1.D0)*((VROT(1)**2) + (VROT(3)**2)) ROME(3,3) = (-1.D0)*((VROT(1)**2) + (VROT(2)**2)) ROME(1,2) = VROT(1)*VROT(2) ROME(1,3) = VROT(1)*VROT(3) ROME(2,3) = VROT(2)*VROT(3) ROME(2,1) = ROME(1,2) ROME(3,1) = ROME(1,3) ROME(3,2) = ROME(2,3) c_______________________________________________________________________ c c numero des etiquettes : c etiquettes de 1 a 98 pour traitement specifique a l element c dans la zone specifique a chaque element commencant par : c 5 continue c element 5 etiquettes 1005 2005 3005 4005 ... c 44 continue c element 44 etiquettes 1044 2044 3044 4044 ... c_______________________________________________________________________ c * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9 GOTO ( 99, 99, 99, 11, 99, 11, 99, 11, 99, 11, 99 * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT & , 99, 99, 11, 11, 11, 11, 99, 99, 99, 99, 99 * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6 & , 11, 11, 11, 11, 99, 99, 99, 99, 99, 99, 99 * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2 & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15 & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10 & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4 & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3 & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8 & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13 & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8 & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3 & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126 & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 * TE56 PY91 TRH6 & , 99, 99, 99),MELE c_______________________________________________________________________ GOTO 99 c_______________________________________________________________________ c c secteur de calcul pour les elements massifs c_______________________________________________________________________ c 11 CONTINUE DIM3=1.D0 NBNO=NBNN NBBB=NBNN SEGINI WRK1,WRK2 I195=0 I259=0 DO 3004 IB=1,NBELEM c c on cherche les coordonnees des noeuds de l element ib c CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) CALL ZERO (REL,LRE,LRE) C CALL ZERO (RELB,LRE,LRE) c c boucle sur les points de gauss c ISDJC=0 DO 4004 IGAU=1,NBPGAU * CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL, 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) IF(DJAC.LT.0.) ISDJC=ISDJC+1 IF(DJAC.EQ.0.) I259=IB DJAC=ABS(DJAC)*POIGAU(IGAU) MPTVAL=IVAMAT MELVAL=IVAL(1) IF (MELVAL.NE.0) THEN IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) VALMAT(1)=VELCHE(IGMN,IBMN) ELSE VALMAT(1)=0.D0 ENDIF DJAC=DJAC*VALMAT(1) CALL NTNST(BGENE,DJAC,LRE,NDDL,REL) C 4004 CONTINUE C IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB * SEGINI XMATRI * IMATTT(IB)=XMATRI C C On bouscule la matrice de masse C c CALL MTOKCE(LRE,NDDL,REL,VROT,RE(1,1,ib)) CALL MTOKCE(LRE,NDDL,REL,ROME,RE(1,1,ib)) C CALL REMPMT(REL,LRE,RE) C * SEGDES XMATRI 3004 CONTINUE IF(I195.NE.0) INTERR(1)=I195 IF(I195.NE.0) CALL ERREUR(195) IF(I259.NE.0) INTERR(1)=I259 IF(I259.NE.0) CALL ERREUR(259) SEGDES xMATRI SEGSUP WRK1,WRK2,MVELCH GOTO 510 C c_______________________________________________________________________ * 99 CONTINUE MOTERR(1:4)=NOMTP(MELE) MOTERR(5:12)='KCENT3' CALL ERREUR(86) * 510 CONTINUE RETURN END