1 : C GYRO3 SOURCE CHAT 11/03/16 21:24:40 6902 2 : SUBROUTINE GYRO3(IPMAIL,LRE,LW,MELE,IVAMAT,NMATT,IVACAR, 3 : &NCARR,IVECT,ISOUS,NBPGAU,IPMINT,IPMIN2,NDDL,MATE,CMATE, 4 : &LHOOK,IPMATR,IIPDPG) 5 : *---------------------------------------------------------------------* 6 : * _________________________________________________ * 7 : * | | * 8 : * | calcul de la matrice de couplage gyroscopique | * 9 : * | Matrice classique dans le repere inertiel | * 10 : * |________________________________________________| * 11 : * * 12 : * poutre,timo,tuyau * 13 : * * 14 : *---------------------------------------------------------------------* 15 : * * 16 : * entrees : * 17 : * ________ * 18 : * * 19 : * ipmail pointeur sur un segment meleme * 20 : * lre nombre de ddl dans la matrice de masse * 21 : * lw dimension du tableau de travail de l'element * 22 : * mele numero de l'element fini * 23 : * ivamat pointeur sur un segment mptval pour le materiau * 24 : * nmatt nombre de composante de materiau (imat=1) * 25 : * ivacar pointeur sur un segment mptval pour les caracteri- * 26 : * stiques * 27 : * ncarr nombre de caracteristiques geometriques * 28 : * ivect flag indiquant si on a entree les axes locaux * 29 : * isous numero de la sous-zone * 30 : * nbpgau nombre de point d'integration pour la masse * 31 : * ipmint pointeur sur un segment minte * 32 : * ipmin1 pointeur sur un segment minte (aux noeuds) * 33 : * nddl nombre de degre de liberte /noeud * 34 : * mate numero du materiau * 35 : * cmate nom du materiau * 36 : * vrot vecteur vitesse de rotation * 37 : * * 38 : * sorties : * 39 : * ________ * 40 : * * 41 : * ipmatr pointeur sur la matrice d'amortissement * 42 : * de la sous-zone * 43 : * * 44 : * Didier COMBESCURE mars 2003 * 45 : * * 46 : *---------------------------------------------------------------------* 47 : IMPLICIT INTEGER(I-N) 48 : IMPLICIT REAL*8(A-H,O-Z) 49 : -INC CCOPTIO 50 : -INC CCHAMP 51 : -INC CCREEL 52 : *- 53 : -INC SMRIGID 54 : -INC SMCHAML 55 : -INC SMELEME 56 : -INC SMCOORD 57 : -INC SMINTE 58 : -INC SMMODEL 59 : C 60 : SEGMENT WRK1 61 : REAL*8 REL(LRE,LRE),XE(3,NBBB) 62 : ENDSEGMENT 63 : C 64 : SEGMENT WRK2 65 : REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE) 66 : ENDSEGMENT 67 : C 68 : SEGMENT WRK3 69 : REAL*8 DDHOOK(LHOOK,LHOOK) 70 : REAL*8 WORK(LW) 71 : ENDSEGMENT 72 : C 73 : SEGMENT WRK4 74 : REAL*8 BPSS(3,3),XEL(3,NBBB) 75 : ENDSEGMENT 76 : C 77 : SEGMENT WRK6 78 : REAL*8 RHOMAT(6,6) 79 : ENDSEGMENT 80 : C 81 : SEGMENT MVELCH 82 : REAL*8 VALMAT(NV1) 83 : ENDSEGMENT 84 : C 85 : SEGMENT MPTVAL 86 : INTEGER IPOS(NS),NSOF(NS) 87 : INTEGER IVAL(NCOSOU) 88 : CHARACTER*16 TYVAL(NCOSOU) 89 : ENDSEGMENT 90 : * 91 : DIMENSION CRIGI(12),CMASS(12) 92 : CHARACTER*8 CMATE 93 : * 94 : MELEME=IPMAIL 95 : NBNN=NUM(/1) 96 : NBELEM=NUM(/2) 97 : * 98 : NV1=NMATT 99 : SEGINI,MVELCH 100 : * 101 : xMATRI=IPMATR 102 : LVAL = (LRE*(LRE+1))/2 103 : NLIGRP=LRE 104 : NLIGRD=LRE 105 : * 106 : NHRM=NIFOUR 107 : * 108 : MINTE=IPMINT 109 : MINTE2=IPMIN2 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,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 122 : 199,99,99,99,99,99,27,99,27,99,99,99,99,99,99,99,99,99,99,99, 123 : 299,27,99,99,99,27,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 124 : 399,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 125 : 499,99,99,27,99,99,99,99,99,99,99,99,99,99,99,99,99),MELE 126 : GOTO 99 127 : C_______________________________________________________________________ 128 : C_______________________________________________________________________ 129 : C 130 : C ELEMENTS POUTRES 131 : C_______________________________________________________________________ 132 : C 133 : 27 CONTINUE 134 : C 135 : C CAS DES POUTRES - TUYAUX 136 : C 137 : NBBB=NBNN 138 : SEGINI WRK1,WRK3 139 : * 140 : * cas du materiau section 141 : * 142 : NBGMAT = 0 143 : NELMAT = 0 144 : IF(CMATE.EQ.'SECTION') THEN 145 : MPTVAL=IVAMAT 146 : DO IM=1,NMATT 147 : IF(IVAL(IM).NE.0)THEN 148 : MELVAL=IVAL(IM) 149 : NBGMAT=MAX(NBGMAT,IELCHE(/1)) 150 : NELMAT=MAX(NELMAT,IELCHE(/2)) 151 : END IF 152 : END DO 153 : ENDIF 154 : C 155 : C BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS 156 : C 157 : DO 3027 IB=1,NBELEM 158 : C 159 : C ON CHERCHE LES COORDONNEES DE L ELEMENT IB 160 : C 160 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 161 : C 162 : C 163 : C CAS DES POUTRES 164 : C -------------- 165 : C ON STOCKE DES CARACTERISTIQUES GEOMETRIQUES ET MATERIELLES DANS WORK 166 : C 167 : 5029 CONTINUE 168 : C 169 : C ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB ( GEOMETRIE ET MASSE 170 : C 171 : C 172 : NCARR1=NCARR 173 : IF(IVECT.EQ.1) NCARR1=NCARR-1 173 : CALL ZERO(WORK,NCARR1,1) 174 : DO 4029 IGAU=1,NBNN 175 : MPTVAL=IVACAR 176 : DO 6029 IC=1,NCARR1 177 : MELVAL=IVAL(IC) 178 : IF (IVAL(IC).NE.0) THEN 179 : IBMN=MIN(IB,VELCHE(/2)) 180 : IGMN=MIN(IGAU,VELCHE(/1)) 181 : WORK(IC)=WORK(IC)+VELCHE(IGMN,IBMN) 182 : ELSE 183 : WORK(IC)=0.D0 184 : ENDIF 185 : IF (IGAU.EQ.NBNN) WORK(IC)=WORK(IC)/NBNN 186 : 6029 CONTINUE 187 : 4029 CONTINUE 188 : C 189 : C CAS OU ON A LU LE MOT VECTEUR 190 : C 191 : IF (IVECT.EQ.1) THEN 192 : IF (IVAL(NCARR).NE.0) THEN 193 : MELVAL=IVAL(NCARR) 194 : IBMN=MIN(IB,IELCHE(/2)) 195 : IP=IELCHE(1,IBMN) 196 : IREF=(IP-1)*(IDIM+1) 197 : DO 6129 IC=1,IDIM 198 : WORK(NCARR+IC-1)=XCOOR(IREF+IC) 199 : 6129 CONTINUE 200 : ELSE 201 : DO 6229 IC=1,IDIM 202 : WORK(NCARR+IC-1)=0. 203 : 6229 CONTINUE 204 : ENDIF 205 : ENDIF 206 : C 207 : MPTVAL=IVAMAT 208 : C 209 : C CAS DES POUTRES ET TUYAU 210 : C 211 : MELVAL=IVAL(1) 212 : IF(CMATE.NE.'SECTION') THEN 213 : IBMN=MIN(IB,VELCHE(/2)) 214 : C 215 : WORK(11)=VELCHE(1,IBMN) 216 : C 217 : C CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE 218 : C -------------- EQUIVALENTE 219 : C 219 : IF(MELE.EQ.42) CALL TUYCAG(WORK,KERRE,1) 220 : ELSE 221 : * 222 : * cas formulation section 223 : * 224 : IBMN=MIN(IB,IELCHE(/2)) 225 : IPMODL=IELCHE(1,IBMN) 226 : MELVAL=IVAL(2) 227 : IBMN=MIN(IB,IELCHE(/2)) 228 : IPMAT=IELCHE(1,IBMN) 229 : IF (IB.LE.NELMAT.OR.NBGMAT.GT.1)THEN 229 : CALL FRIGIE(IPMODL,IPMAT,CRIGI,CMASS) 229 : CALL DOGTIF(CMASS,CMATE,IFOUR,LHOOK,DDHOOK,IRTD) 230 : ENDIF 231 : ENDIF 232 : C 233 : C ON CALCULE LA MATRICE DE COUPLAGE GYROSCOPIQUE 234 : C 235 : IF (MELE.EQ.84) THEN 236 : IF(CMATE.NE.'SECTION') THEN 236 : CALL TIMGYR(REL,LRE,WORK,XE,WORK(12),KERRE) 237 : ELSE 237 : CALL TIFGYR(REL,LRE,WORK,XE,WORK(12),LHOOK, 238 : & DDHOOK,KERRE) 239 : ENDIF 240 : ELSE 240 : CALL POUGYR(REL,LRE,WORK,XE,WORK(12),KERRE) 241 : ENDIF 242 : C 243 : IF(KERRE.EQ.0) GO TO 4027 244 : INTERR(1)=ISOUS 245 : INTERR(2)=IB 246 : SEGSUP WRK1,WRK3,MVELCH 246 : CALL ERREUR(128) 247 : SEGSUP xMATRI 248 : GO TO 510 249 : C 250 : 4027 CONTINUE 251 : * SEGINI XMATRI 252 : * IMATTT(IB)=XMATRI 253 : DO 4028 IIIA=1,LRE 254 : DO 4028 IIIB=1,LRE 255 : RE(IIIA,IIIB,ib)=REL(IIIA,IIIB) 256 : 4028 CONTINUE 257 : C 258 : * SEGDES XMATRI 259 : 3027 CONTINUE 260 : SEGDES xMATRI 261 : SEGSUP WRK1,WRK3,MVELCH 262 : GO TO 510 263 : C_______________________________________________________________________ 264 : * 265 : 99 CONTINUE 266 : MOTERR(1:4)=NOMTP(MELE) 267 : MOTERR(5:12)='GYRO2' 267 : CALL ERREUR(86) 268 : * 269 : 510 CONTINUE 270 : RETURN 271 : END 272 : C 273 : 274 : 275 :
© Cast3M 2003 - All rights reserved.
Disclaimer