1 : C CORIO3 SOURCE FANDEUR 11/07/19 21:15:51 7042 2 : SUBROUTINE CORIO3(IPMAIL,NDDL,LRE,NBPGAU,IPMINT, 3 : &MELE,MFR,IVAMAT,IVACAR,NMATT,IPMATR,VROT,NUMLIS,IIPDPG) 4 : *---------------------------------------------------------------------* 5 : * __________________________________________________ * 6 : * | | * 7 : * | calcul de la matrice de couplage gyroscopique | * 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 : * vrot vecteur vitesse de rotation * 31 : * * 32 : * sorties : * 33 : * ________ * 34 : * * 35 : * ipmatr pointeur sur la matrice de couplage gyroscopique * 36 : * de la sous-zone * 37 : * * 38 : * Didier COMBESCURE mars 2003 * 39 : *---------------------------------------------------------------------* 40 : IMPLICIT INTEGER(I-N) 41 : IMPLICIT REAL*8(A-H,O-Z) 42 : -INC CCOPTIO 43 : -INC CCHAMP 44 : -INC CCREEL 45 : -INC SMRIGID 46 : -INC SMCHAML 47 : -INC SMELEME 48 : -INC SMCOORD 49 : -INC SMINTE 50 : -INC SMMODEL 51 : c 52 : SEGMENT WRK1 53 : REAL*8 REL(LRE,LRE),XE(3,NBBB) 54 : ENDSEGMENT 55 : c 56 : SEGMENT WRK2 57 : REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE) 58 : ENDSEGMENT 59 : c 60 : SEGMENT WRK5 61 : REAL*8 BLX(NDDL,LRE),BLY(NDDL,LRE),BLZ(NDDL,LRE) 62 : REAL*8 BLT(NDDL,LRE) 63 : ENDSEGMENT 64 : c 65 : SEGMENT MVELCH 66 : REAL*8 VALMAT(NV1) 67 : ENDSEGMENT 68 : c 69 : SEGMENT MPTVAL 70 : INTEGER IPOS(NS),NSOF(NS) 71 : INTEGER IVAL(NCOSOU) 72 : CHARACTER*16 TYVAL(NCOSOU) 73 : ENDSEGMENT 74 : c 75 : DIMENSION VROT(*) 76 : * 77 : MELEME=IPMAIL 78 : c* SEGACT,MELEME 79 : NBNN=NUM(/1) 80 : NBELEM=NUM(/2) 81 : * 82 : NV1=NMATT 83 : SEGINI,MVELCH 84 : * 85 : xMATRI=IPMATR 86 : c* SEGACT,xMATRI 87 : C* NLIGRP=LRE 88 : C* NLIGRD=LRE 89 : 90 : XDPGE=0.D0 91 : YDPGE=0.D0 92 : * 93 : NHRM=NIFOUR 94 : * 95 : MINTE=IPMINT 96 : c* SEGACT,MINTE 97 : 98 : c_______________________________________________________________________ 99 : c 100 : c numero des etiquettes : 101 : c etiquettes de 1 a 98 pour traitement specifique a l element 102 : c dans la zone specifique a chaque element commencant par : 103 : c 5 continue 104 : c element 5 etiquettes 1005 2005 3005 4005 ... 105 : c 44 continue 106 : c element 44 etiquettes 1044 2044 3044 4044 ... 107 : c_______________________________________________________________________ 108 : c 109 : * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9 110 : GOTO ( 99, 99, 99, 21, 99, 21, 99, 21, 99, 21, 99 111 : * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT 112 : & , 99, 99, 11, 11, 11, 11, 99, 99, 99, 99, 99 113 : * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6 114 : & , 11, 11, 11, 11, 99, 99, 99, 99, 99, 99, 99 115 : * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2 116 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 117 : * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO 118 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 119 : * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15 120 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 121 : * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10 122 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 123 : * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4 124 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 125 : * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3 126 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 127 : * HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8 128 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 129 : * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13 130 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 131 : * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8 132 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 133 : * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3 134 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 135 : * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126 136 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 137 : * TE56 PY91 TRH6 138 : & , 99, 99, 99),MELE 139 : c_______________________________________________________________________ 140 : c 141 : c secteur de calcul pour les elements massifs 142 : c_______________________________________________________________________ 143 : c 144 : 11 CONTINUE 145 : DIM3=1.D0 146 : NBNO=NBNN 147 : NBBB=NBNN 148 : SEGINI WRK1,WRK2 149 : DO 1005 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 1004 IGAU=1,NBPGAU 158 : * 158 : CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL, 159 : 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 160 : IF(DJAC.LT.0.) ISDJC=ISDJC+1 161 : IF (DJAC.EQ.0.) THEN 162 : INTERR(1)= IB 162 : CALL ERREUR(259) 163 : GOTO 9011 164 : ENDIF 165 : DJAC=ABS(DJAC)*POIGAU(IGAU) 166 : MPTVAL=IVAMAT 167 : IF (IVAL(1).NE.0) THEN 168 : MELVAL=IVAL(1) 169 : IGMN=MIN(IGAU,VELCHE(/1)) 170 : IBMN=MIN(IB,VELCHE(/2)) 171 : VALMAT(1)=VELCHE(IGMN,IBMN) 172 : ELSE 173 : VALMAT(1)=0.D0 174 : ENDIF 175 : DJAC=DJAC*VALMAT(1) 175 : CALL NTNST(BGENE,DJAC,LRE,NDDL,REL) 176 : C 177 : 1004 CONTINUE 178 : C 179 : C+DC On bouscule la matrice de masse 180 : C 181 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 182 : INTERR(1)=IB 182 : CALL ERREUR(195) 183 : GOTO 9011 184 : ENDIF 185 : c 186 : c remplissage de xmatri 187 : c 187 : CALL MTOGYR(LRE,NDDL,REL,VROT,RE(1,1,ib)) 188 : C 189 : 1005 CONTINUE 190 : 191 : 9011 CONTINUE 192 : SEGSUP WRK1,WRK2 193 : GOTO 510 194 : C 195 : c_______________________________________________________________________ 196 : c 197 : c secteur de calcul pour les elements 2D en mode de Fourier 198 : c_______________________________________________________________________ 199 : c 200 : 21 CONTINUE 201 : DIM3=1.D0 202 : NBNO=NBNN 203 : NBBB=NBNN 204 : SEGINI WRK1,WRK2 205 : DO 2005 IB=1,NBELEM 206 : c 207 : c on cherche les coordonnees des noeuds de l element ib 208 : c 208 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 208 : CALL ZERO (REL,LRE,LRE) 209 : c 210 : c boucle sur les points de gauss 211 : c 212 : ISDJC=0 213 : DO 2004 IGAU=1,NBPGAU 214 : * 214 : CALL NMATST(IGAU,MELE,MFR,NBNN,LRE/2,IFOUR,NIFOUR,NDDL/2, 215 : 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 216 : IF(DJAC.LT.0.) ISDJC=ISDJC+1 217 : IF(DJAC.EQ.0.) THEN 218 : INTERR(1)= IB 218 : CALL ERREUR(259) 219 : GOTO 9021 220 : ENDIF 221 : DJAC=ABS(DJAC)*POIGAU(IGAU) 222 : MPTVAL=IVAMAT 223 : IF (IVAL(1).NE.0) THEN 224 : MELVAL=IVAL(1) 225 : IGMN=MIN(IGAU,VELCHE(/1)) 226 : IBMN=MIN(IB,VELCHE(/2)) 227 : VALMAT(1)=VELCHE(IGMN,IBMN) 228 : ELSE 229 : VALMAT(1)=0.D0 230 : ENDIF 231 : DJAC=DJAC*VALMAT(1) 231 : CALL NTNST(BGENE,DJAC,LRE/2,NDDL/2,REL) 232 : C 233 : 2004 CONTINUE 234 : C 235 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 236 : INTERR(1)=IB 236 : CALL ERREUR(195) 237 : GOTO 9021 238 : ENDIF 239 : c 240 : c remplissage de xmatri 241 : c 242 : IF (NUMLIS.EQ.1) THEN 242 : CALL MTOGY2(LRE/2,NDDL/2,REL,VROT,RE(1,1,ib)) 243 : ELSE 243 : CALL MTOGYF(LRE/2,NDDL/2,REL,VROT,RE(1,1,ib)) 244 : ENDIF 245 : C 246 : 2005 CONTINUE 247 : 248 : 9021 CONTINUE 249 : SEGSUP WRK1,WRK2 250 : GOTO 510 251 : c_______________________________________________________________________ 252 : * 253 : 99 CONTINUE 254 : MOTERR(1:4)=NOMTP(MELE) 255 : MOTERR(5:12)='CORIO3' 255 : CALL ERREUR(86) 256 : * 257 : 510 CONTINUE 258 : SEGSUP,MVELCH 259 : 260 : RETURN 261 : END 262 : 263 :
© Cast3M 2003 - All rights reserved.
Disclaimer