1 : C KCENT3 SOURCE BP208322 12/03/08 21:15:00 7294 2 : SUBROUTINE KCENT3(IPMAIL,NDDL,LRE,NBPGAU,IPMINT, 3 : &MELE,MFR,IVAMAT,IVACAR,NMATT,IPMATR,VROT,IIPDPG) 4 : *---------------------------------------------------------------------* 5 : * _______________________________________________ * 6 : * | | * 7 : * | calcul de la matrice de raideur centrifuge | * 8 : * |_____________________________________________| * 9 : * * 10 : * massif * 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 : * iprota pointeur sur un point (vecteur vitesse de rotation) * 31 : * * 32 : * sorties : * 33 : * ________ * 34 : * * 35 : * ipmatr pointeur sur la matrice de masse de la sous-zone * 36 : * * 37 : * Didier COMBESCURE mars 2003 * 38 : *---------------------------------------------------------------------* 39 : IMPLICIT INTEGER(I-N) 40 : IMPLICIT REAL*8(A-H,O-Z) 41 : -INC CCOPTIO 42 : -INC CCHAMP 43 : -INC CCREEL 44 : -INC SMRIGID 45 : -INC SMCHAML 46 : -INC SMELEME 47 : -INC SMCOORD 48 : -INC SMINTE 49 : -INC SMMODEL 50 : c 51 : SEGMENT WRK1 52 : REAL*8 REL(LRE,LRE),XE(3,NBBB) 53 : ENDSEGMENT 54 : c 55 : SEGMENT WRK2 56 : REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE) 57 : ENDSEGMENT 58 : c 59 : SEGMENT WRK5 60 : REAL*8 BLX(NDDL,LRE),BLY(NDDL,LRE),BLZ(NDDL,LRE) 61 : REAL*8 BLT(NDDL,LRE) 62 : ENDSEGMENT 63 : c 64 : c 65 : SEGMENT MVELCH 66 : REAL*8 VALMAT(NV1) 67 : ENDSEGMENT 68 : c 69 : c 70 : SEGMENT MPTVAL 71 : INTEGER IPOS(NS),NSOF(NS) 72 : INTEGER IVAL(NCOSOU) 73 : CHARACTER*16 TYVAL(NCOSOU) 74 : ENDSEGMENT 75 : c 76 : DIMENSION VROT(*) 77 : DIMENSION ROME(3,3) 78 : C ,RELB(LRE,LRE) 79 : * 80 : MELEME=IPMAIL 81 : NBNN=NUM(/1) 82 : NBELEM=NUM(/2) 83 : * 84 : NV1=NMATT 85 : SEGINI,MVELCH 86 : * 87 : xMATRI=IPMATR 88 : LVAL = (LRE*(LRE+1))/2 89 : NLIGRP=LRE 90 : NLIGRD=LRE 91 : 92 : XDPGE=0.D0 93 : YDPGE=0.D0 94 : 95 : * 96 : NHRM=NIFOUR 97 : * 98 : MINTE=IPMINT 99 : * 100 : * Remplissage de ROME depuis VROT qui est constant dans tout le modele 101 : ROME(1,1) = (-1.D0)*((VROT(2)**2) + (VROT(3)**2)) 102 : ROME(2,2) = (-1.D0)*((VROT(1)**2) + (VROT(3)**2)) 103 : ROME(3,3) = (-1.D0)*((VROT(1)**2) + (VROT(2)**2)) 104 : ROME(1,2) = VROT(1)*VROT(2) 105 : ROME(1,3) = VROT(1)*VROT(3) 106 : ROME(2,3) = VROT(2)*VROT(3) 107 : ROME(2,1) = ROME(1,2) 108 : ROME(3,1) = ROME(1,3) 109 : ROME(3,2) = ROME(2,3) 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 : * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9 122 : GOTO ( 99, 99, 99, 11, 99, 11, 99, 11, 99, 11, 99 123 : * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT 124 : & , 99, 99, 11, 11, 11, 11, 99, 99, 99, 99, 99 125 : * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6 126 : & , 11, 11, 11, 11, 99, 99, 99, 99, 99, 99, 99 127 : * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2 128 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 129 : * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO 130 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 131 : * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15 132 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 133 : * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10 134 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 135 : * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4 136 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 137 : * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3 138 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 139 : * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8 140 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 141 : * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13 142 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 143 : * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8 144 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 145 : * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3 146 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 147 : * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126 148 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 149 : * TE56 PY91 TRH6 150 : & , 99, 99, 99),MELE 151 : c_______________________________________________________________________ 152 : c_______________________________________________________________________ 153 : c 154 : c secteur de calcul pour les elements massifs 155 : c_______________________________________________________________________ 156 : c 157 : 11 CONTINUE 158 : DIM3=1.D0 159 : NBNO=NBNN 160 : NBBB=NBNN 161 : SEGINI WRK1,WRK2 162 : I195=0 163 : I259=0 164 : DO 3004 IB=1,NBELEM 165 : c 166 : c on cherche les coordonnees des noeuds de l element ib 167 : c 167 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 167 : CALL ZERO (REL,LRE,LRE) 167 : C CALL ZERO (RELB,LRE,LRE) 168 : c 169 : c boucle sur les points de gauss 170 : c 171 : ISDJC=0 172 : DO 4004 IGAU=1,NBPGAU 173 : * 173 : CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL, 174 : 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 175 : IF(DJAC.LT.0.) ISDJC=ISDJC+1 176 : IF(DJAC.EQ.0.) I259=IB 177 : DJAC=ABS(DJAC)*POIGAU(IGAU) 178 : MPTVAL=IVAMAT 179 : IF (IVAL(1).NE.0) THEN 180 : MELVAL=IVAL(1) 181 : IGMN=MIN(IGAU,VELCHE(/1)) 182 : IBMN=MIN(IB,VELCHE(/2)) 183 : VALMAT(1)=VELCHE(IGMN,IBMN) 184 : ELSE 185 : VALMAT(1)=0.D0 186 : ENDIF 187 : DJAC=DJAC*VALMAT(1) 187 : CALL NTNST(BGENE,DJAC,LRE,NDDL,REL) 188 : C 189 : 4004 CONTINUE 190 : C 191 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB 192 : * SEGINI XMATRI 193 : * IMATTT(IB)=XMATRI 194 : C 195 : C On bouscule la matrice de masse 196 : C 196 : c CALL MTOKCE(LRE,NDDL,REL,VROT,RE(1,1,ib)) 196 : CALL MTOKCE(LRE,NDDL,REL,ROME,RE(1,1,ib)) 196 : C CALL REMPMT(REL,LRE,RE) 197 : C 198 : * SEGDES XMATRI 199 : 3004 CONTINUE 200 : IF(I195.NE.0) INTERR(1)=I195 200 : IF(I195.NE.0) CALL ERREUR(195) 201 : IF(I259.NE.0) INTERR(1)=I259 201 : IF(I259.NE.0) CALL ERREUR(259) 202 : SEGDES xMATRI 203 : SEGSUP WRK1,WRK2,MVELCH 204 : GOTO 510 205 : C 206 : c_______________________________________________________________________ 207 : * 208 : 99 CONTINUE 209 : MOTERR(1:4)=NOMTP(MELE) 210 : MOTERR(5:12)='KCENT3' 210 : CALL ERREUR(86) 211 : * 212 : 510 CONTINUE 213 : RETURN 214 : END 215 : c 216 : 217 : 218 : 219 : 220 :
© Cast3M 2003 - All rights reserved.
Disclaimer