1 : C APPUI SOURCE CHAT 09/10/09 21:15:43 6519 2 : 3 : C======================================================================= 4 : C= A P P U I = 5 : C= --------- = 6 : C= = 7 : C= OPERATEUR CAST3M 'APPUI' : = 8 : C= -------------------------- = 9 : C= RIG1 = 'APPUI' | MOT1 ... MOTn | RAI1 MAI1 ; = 10 : C= | 'DEPL' | = 11 : C= | 'ROTA' | = 12 : C= Cet operateur fabrique des appuis (ressort de raideur RAI1) ou = 13 : C= des masses additionnelles (de valeur RAI1) en un point ou sur = 14 : C= tous les points d'un maillage et pour un ou plusieurs ddl. = 15 : C= = 16 : C= ARGUMENTS : = 17 : C= ----------- = 18 : C= MAI1 (MAILLAGE/POINT) Lieu d'application du ressort/masse = 19 : C= RAI1 (FLOTTANT) Valeur de la raideur/masse = 20 : C= MOT1...MOTn (MOT) DDL concernes par le ressort/masse = 21 : C= Le mot 'DEPL' (resp. 'ROTA') indique que tous les ddls de depla- = 22 : C= cement (resp. rotation) sont concernes par le ressort/masse. = 23 : C= = 24 : C= RESULTAT : = 25 : C= ---------- = 26 : C= RIG1 (RIGIDITE) Rigidite associee aux appuis/masses = 27 : C======================================================================= 28 : 29 : SUBROUTINE APPUI (IMILL) 30 : 31 : IMPLICIT INTEGER(I-N) 32 : IMPLICIT REAL*8 (A-H,O-Z) 33 : 34 : -INC CCOPTIO 35 : -INC CCHAMP 36 : -INC SMELEME 37 : -INC SMCOORD 38 : -INC SMRIGID 39 : 40 : SEGMENT MSWBLO 41 : CHARACTER*4 MOTDDL(0) 42 : ENDSEGMENT 43 : 44 : DIMENSION XNOR(3),U1(3),U2(3) 45 : 46 : CHARACTER*4 MOTBLO(4) 47 : CHARACTER*4 MODEPL(6),MODEDU(6) 48 : CHARACTER*4 MORODU(5),MOROTA(5) 49 : CHARACTER*4 MODE1D(2),MOFO1D(2) 50 : 51 : DATA EPSI / 1.D-12 / 52 : DATA LMOBLO / 4 / 53 : DATA MOTBLO / 'DEPL','ROTA','RADI','DIRE' / 54 : DATA MODEPL / 'UX ','UY ','UZ ','UR ','UZ ','UT ' / 55 : DATA MODEDU / 'FX ','FY ','FZ ','FR ','FZ ','FT ' / 56 : DATA MOROTA / 'RX ','RY ','RZ ','RT ','RS ' / 57 : DATA MORODU / 'MX ','MY ','MZ ','MT ','MS ' / 58 : C Tableaux MODE1D et MOFO1D sont utilises pour certains modes 1D 59 : DATA MODE1D / 'UX ','UZ ' / 60 : DATA MOFO1D / 'FX ','FZ ' / 61 : 62 : C Quelques initialisations selon le type de probleme 63 : idimp1=IDIM+1 64 : C Cas IDIM = 1 : 65 : C ISPE1D = 1 si IDIM=1 et IFOUR=9 ou 10, car les noms de DDL primaux et 66 : C variables duales ne sont pas dans l'ordre "classique" (un traitement 67 : C specifique est alors necessaire). 68 : ISPE1D=0 69 : C Deformations planes ou contraintes planes ou defo. plane gene : 70 : IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN 71 : LDEPL=2 72 : IADEPL=0 73 : LROTA=1 74 : IAROTA=2 75 : C Axisymetrique : 76 : ELSE IF (IFOUR.EQ.0) THEN 77 : LDEPL=2 78 : IADEPL=3 79 : LROTA=1 80 : IAROTA=3 81 : C Fourier : 82 : ELSE IF (IFOUR.EQ.1) THEN 83 : LDEPL=3 84 : IADEPL=3 85 : LROTA=1 86 : IAROTA=3 87 : C Tridimensionnel : 88 : ELSE IF (IFOUR.EQ.2) THEN 89 : LDEPL=3 90 : LROTA=3 91 : IADEPL=0 92 : IAROTA=0 93 : C Massif 1D (IDIM=1) : 94 : ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN 95 : IF (IFOUR.LE.6) THEN 96 : LDEPL=1 97 : IADEPL=0 98 : ELSE IF (IFOUR.GE.7.AND.IFOUR.LE.10) THEN 99 : LDEPL=2 100 : IADEPL=0 101 : IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) ISPE1D=1 102 : ELSE IF (IFOUR.EQ.11) THEN 103 : LDEPL=3 104 : IADEPL=0 105 : ELSE IF (IFOUR.EQ.15) THEN 106 : LDEPL=2 107 : IADEPL=3 108 : ELSE 109 : LDEPL=1 110 : IADEPL=3 111 : ENDIF 112 : LROTA=0 113 : IAROTA=0 114 : C Autres cas : 115 : ELSE 116 : LDEPL=0 117 : IADEPL=0 118 : LROTA=0 119 : IAROTA=0 120 : ENDIF 121 : 122 : C Initialisation de la liste des ddls MOTDDL (segment MSWBLO) 123 : SEGINI,MSWBLO 124 : 125 : C----------------------------------------------------------------------- 126 : C Lecture eventuelle des MOTS autres que des DDLS 127 : C----------------------------------------------------------------------- 128 : C Lecture eventuelle de 'DEPL' et/ou 'ROTA' 129 : C -------------------- 130 : IDEPL=0 131 : IROTA=0 131 : 481 CALL LIRMOT(MOTBLO,2,IMOT,0) 132 : IF (IMOT.EQ.1) IDEPL=1 133 : IF (IMOT.EQ.2) IROTA=1 134 : IF (IMOT.NE.0) GOTO 481 135 : C Lecture eventuelle de 'RADI' ou 'DIRE' 136 : C -------------------- 137 : IRADIA=0 138 : IDIREC=0 138 : 4480 CALL LIRMOT(MOTBLO(3),2,IMOT,0) 139 : IF (IMOT.EQ.0) THEN 140 : IF (IDEPL.EQ.1) GOTO 44801 141 : IF (IROTA.EQ.1) GOTO 44802 142 : IBDDL=MOTDDL(/2) 143 : IF (IBDDL.NE.0) GOTO 449 144 : IF (IBDDL.EQ.0) GOTO 445 145 : ENDIF 146 : C En DIMENSION 1, les mots-cles 'RADI' et 'DIRE' sont interdits. 147 : IF (IDIM.EQ.1) THEN 148 : INTERR(1)=IDIM 149 : MOTERR(1:4)=MOTBLO(2+IMOT) 149 : CALL ERREUR(971) 150 : GOTO 100 151 : ENDIF 152 : GOTO (44803,44804),IMOT 153 : C Traitement des mots-cles : Mise a jour de MOTDDL 154 : C ---------------------------- 155 : C On a trouve le mot DEPLAcement 156 : 44801 IDEPL=0 157 : C Cas particulier pour certains modes de IDIM=1 158 : IF (ISPE1D.EQ.1) THEN 159 : DO i=1,LDEPL 160 : MOTDDL(**)=MODE1D(IADEPL+i) 161 : MOTDDL(**)=MOFO1D(IADEPL+i) 162 : ENDDO 163 : C Cas general 164 : ELSE 165 : DO i=1,LDEPL 166 : MOTDDL(**)=MODEPL(IADEPL+i) 167 : MOTDDL(**)=MODEDU(IADEPL+i) 168 : ENDDO 169 : ENDIF 170 : GOTO 4480 171 : C On a trouve le mot ROTAtion 172 : 44802 IROTA=0 173 : DO i=1,LROTA 174 : MOTDDL(**)=MOROTA(IAROTA+i) 175 : MOTDDL(**)=MORODU(IAROTA+i) 176 : ENDDO 177 : GOTO 4480 178 : C On a trouve le mot RADial 179 : 44803 IRADIA=1 179 : CALL LIROBJ('POINT',KPOINT,1,IRETOU) 180 : IF (IRETOU.EQ.0) GOTO 100 181 : j=(KPOINT-1)*idimp1 182 : DO i=1,IDIM 183 : U1(i)=XCOOR(j+i) 184 : ENDDO 185 : C Lecture du 2nd point de l'axe (en 3D) 186 : IF (IDIM.EQ.3) THEN 186 : CALL LIROBJ('POINT',KPOINT,1,IRETOU) 187 : IF (IRETOU.EQ.0) GOTO 100 188 : j=(KPOINT-1)*idimp1 189 : YL=0. 190 : DO i=1,IDIM 191 : U2(i)=XCOOR(j+i)-U1(i) 192 : YL=YL+U2(i)*U2(i) 193 : ENDDO 194 : C Calcul du vecteur directeur unitaire de l'axe (U2) 195 : IF (YL.LT.EPSI) THEN 195 : CALL ERREUR(237) 196 : GOTO 100 197 : ENDIF 198 : YL=1./SQRT(YL) 199 : DO i=1,IDIM 200 : U2(i)=U2(i)*YL 201 : ENDDO 202 : ENDIF 203 : GOTO 449 204 : C On a trouve le mot DIREction 205 : 44804 IDIREC=1 205 : CALL LIROBJ('POINT',KPOINT,1,IRETOU) 206 : IF (IRETOU.EQ.0) GOTO 100 207 : j=(KPOINT-1)*idimp1 208 : YL=0. 209 : DO i=1,IDIM 210 : XNOR(i)=XCOOR(j+i) 211 : YL=YL+XNOR(i)*XNOR(i) 212 : ENDDO 213 : IF (YL.LT.EPSI) THEN 213 : CALL ERREUR(239) 214 : GOTO 100 215 : ENDIF 216 : YL=1./SQRT(YL) 217 : DO i=1,IDIM 218 : XNOR(i)=XNOR(i)*YL 219 : ENDDO 220 : GOTO 449 221 : 222 : C Lecture eventuelle de DDLs : 223 : C ------------------------------ 224 : C La liste des ddls autorises NOMDD est dans BDATA.ESO 225 : C On doit lire au moins 1 ddl (car sinon MOTDDL est vide !) 226 : 445 LACOND=1 227 : LMOT=9 227 : 446 CALL LIRMOT(NOMDD,LMOT,IMOT,LACOND) 228 : IF (IERR.NE.0) GOTO 100 229 : IF (IMOT.EQ.0) GOTO 449 230 : MOTDDL(**)=NOMDD(IMOT) 231 : MOTDDL(**)=NOMDU(IMOT) 232 : LACOND=0 233 : GOTO 446 234 : 235 : 449 IBDDL=MOTDDL(/2) 236 : C Verification que le nombre de DDLs a bloquer n'est pas nul 237 : C IF (IBDDL.EQ.0) GOTO 100 238 : C----------------------------------------------------------------------- 239 : C Fin de la lecture des mots (DEPL,ROTA...) ou des DDLs 240 : C----------------------------------------------------------------------- 241 : 242 : C Recherche du maillage MELEME de type POINT : 243 : C ---------------------------------------------- 244 : C On cherche d'abord si on a un POINT que l'on transformera en POI1 245 : C sinon on cherche un maillage que l'on transforme en POI1 si besoin 245 : CALL LIROBJ('POINT',KPOINT,0,IRETOU) 246 : IF (IRETOU.EQ.0) THEN 246 : CALL LIROBJ('MAILLAGE',KOBJET,1,IRETOU) 247 : IF (IRETOU.EQ.0) GOTO 100 248 : MELEME=KOBJET 249 : SEGACT,MELEME 249 : IF (ITYPEL.NE.1) CALL CHANGE(MELEME,1) 250 : NBPOIN=NUM(/2) 251 : ELSE 252 : C On pourrait faire appel a CRELEM(KPOINT) 253 : NBNN=1 254 : NBELEM=1 255 : NBREF=0 256 : NBSOUS=0 257 : SEGINI,MELEME 258 : ITYPEL=1 259 : NUM(1,1)=KPOINT 260 : NBPOIN=1 261 : ENDIF 262 : 263 : C LECTURE DE LA RAIDEUR DU RESSORT (FLOTTANT) 264 : C ------------------------------------------- 264 : CALL LIRREE(RIG,1,IRETOU) 265 : IF (IERR.NE.0) GOTO 110 266 : 267 : C Determination du nombre de multiplicateurs NNMAT par noeud de MELEME 268 : C NNMAT correspond au nombre de DDLs a bloquer par noeud = nombre de 269 : C multiplicateurs a creer par noeud (1 multiplicateur) = NRIGEL 270 : C Dans les cas RADIal et DIREction, on a une seule matrice par noeud. 271 : C Dans les autres cas, autant de matrices que MOTDDL(/1)/2. 272 : NNMAT=1 273 : IF (IDIREC+IRADIA.EQ.0) NNMAT=IBDDL/2 274 : 275 : C Initialisation de l'objet RIGIDITE associe aux BLOCAGES 276 : NRIGE=8 277 : NRIGEL=NNMAT 278 : SEGINI,MRIGID 279 : C* IFORIG=IFOMOD 280 : IFORIG=IFOUR 281 : IF (IMILL.EQ.1) THEN 282 : MTYMAT='RIGIDITE' 283 : ELSE IF (IMILL.EQ.2) THEN 284 : MTYMAT='MASSE' 285 : ENDIF 286 : ICHOLE=0 287 : IMGEO1=0 288 : IMGEO2=0 289 : KRIGI=MRIGID 290 : 291 : C Boucle sur le nombre de DDLs a bloquer 292 : DO IAA=1,NNMAT 293 : C Creation des RAIDEURS associees au IAA-eme multplicateur (DDL) 294 : IRIGEL(1,IAA)=MELEME 295 : IRIGEL(2,IAA)=0 296 : IRIGEL(5,IAA)=NIFOUR 297 : IRIGEL(6,IAA)=0 298 : C** IRIGEL(7,IAA)=0 299 : C** IRIGEL(8,IAA)=0 300 : C Remplissage du tableau des DESCripteurs de RIG 301 : NLIGRP=1 302 : IF (IDIREC+IRADIA.NE.0) NLIGRP=LDEPL 303 : NLIGRD=NLIGRP 304 : SEGINI,DESCR 305 : IRIGEL(3,IAA)=DESCR 306 : IF (IDIREC+IRADIA.EQ.0) THEN 307 : NOELEP(1)=1 308 : NOELED(1)=1 309 : j=2*(IAA-1) 310 : LISINC(1)=MOTDDL(j+1) 311 : LISDUA(1)=MOTDDL(j+2) 312 : ELSE 313 : DO i=1,LDEPL 314 : NOELEP(i)=1 315 : NOELED(i)=1 316 : IF (IROTA.NE.1) THEN 317 : LISINC(i)=MODEPL(i+IADEPL) 318 : LISDUA(i)=MODEDU(i+IADEPL) 319 : ELSE 320 : LISINC(i)=MOROTA(i+IADEPL) 321 : LISDUA(i)=MORODU(i+IADEPL) 322 : ENDIF 323 : ENDDO 324 : ENDIF 325 : SEGDES,DESCR 326 : C** NLIGRP=1 327 : C** IF (IDIREC+IRADIA.NE.0) NLIGRP=IDIM 328 : C** NLIGRD=NLIGRP 329 : NELRIG=NBPOIN 330 : SEGINI,xMATRI 331 : IRIGEL(4,IAA)=xMATRI 332 : COERIG(IAA)=1. 333 : 334 : C Remplissage de la matrice de rigidite RE : 335 : C Il faut distinguer les cas IRADIA et IDIREC 336 : C IRADIA : Il faut calculer la DIREction puis identique a IDIREC 337 : C IDIREC : La DIRECTION est stockee dans le vecteur norme XNOR 338 : C AUTRES : La matrice est predefinie dans RIG 339 : C Option RADIAL : Calcul prealable de la direction pour chaque noeud 340 : IF (IRADIA.EQ.1) THEN 341 : DO IB=1,NBPOIN 342 : j=(NUM(1,IB)-1)*idimp1 343 : DO i=1,IDIM 344 : XNOR(i)=XCOOR(j+i)-U1(i) 345 : ENDDO 346 : IF (IDIM.EQ.2) THEN 347 : YL=XNOR(1)*XNOR(1)+XNOR(2)*XNOR(2) 348 : IF (YL.LT.EPSI) THEN 348 : CALL ERREUR(238) 349 : GOTO 110 350 : ENDIF 351 : YL=1./SQRT(YL) 352 : XNOR(1)=XNOR(1)*YL 353 : XNOR(2)=XNOR(2)*YL 354 : ELSE 355 : YL=XNOR(1)*U2(1)+XNOR(2)*U2(2)+XNOR(3)*U2(3) 356 : XL=0. 357 : DO i=1,3 358 : XNOR(i)=XNOR(i)-YL*U2(i) 359 : XL=XL+XNOR(i)*XNOR(i) 360 : ENDDO 361 : IF (XL.LT.EPSI) THEN 361 : CALL ERREUR(238) 362 : GOTO 110 363 : ENDIF 364 : XL=1./SQRT(XL) 365 : XNOR(1)=XNOR(1)*XL 366 : XNOR(2)=XNOR(2)*XL 367 : XNOR(3)=XNOR(3)*XL 368 : ENDIF 369 : C XNOR contient la direction normee 370 : * SEGINI,XMATRI 371 : * IMATTT(IB)=XMATRI 372 : RE(1,1,ib)=RIG*XNOR(1)*XNOR(1) 373 : RE(2,1,ib)=RIG*XNOR(1)*XNOR(2) 374 : RE(1,2,ib)=RE(2,1,ib) 375 : RE(2,2,ib)=RIG*XNOR(2)*XNOR(2) 376 : IF (IDIM.EQ.3) THEN 377 : RE(1,3,ib)=RIG*XNOR(1)*XNOR(3) 378 : RE(3,1,ib)=RE(1,3,ib) 379 : RE(2,3,ib)=RIG*XNOR(2)*XNOR(3) 380 : RE(3,2,ib)=RE(2,3,ib) 381 : RE(3,3,ib)=RIG*XNOR(3)*XNOR(3) 382 : ENDIF 383 : * SEGDES,XMATRI 384 : ENDDO 385 : SEGDES,xMATRI 386 : C Option DIRECTION 387 : ELSE IF (IDIREC.EQ.1) THEN 388 : * SEGINI,XMATRI 389 : RE(1,1,1)=RIG*XNOR(1)*XNOR(1) 390 : RE(2,1,1)=RIG*XNOR(1)*XNOR(2) 391 : RE(1,2,1)=RE(2,1,1) 392 : RE(2,2,1)=RIG*XNOR(2)*XNOR(2) 393 : IF (IDIM.EQ.3) THEN 394 : RE(1,3,1)=RIG*XNOR(1)*XNOR(3) 395 : RE(3,1,1)=RE(1,3,1) 396 : RE(2,3,1)=RIG*XNOR(2)*XNOR(3) 397 : RE(3,2,1)=RE(2,3,1) 398 : RE(3,3,1)=RIG*XNOR(3)*XNOR(3) 399 : ENDIF 400 : DO i=2,NBPOIN 401 : do io=1,re(/2) 402 : do iu=1,re(/1) 403 : re(iu,io,i)=re(iu,io,1) 404 : enddo 405 : enddo 406 : ENDDO 407 : SEGDES,XMATRI 408 : * SEGDES,IMATRI 409 : C Autres options : 410 : ELSE 411 : * SEGINI,XMATRI 412 : * IXMATR=XMATRI 413 : * RE(1,1)=RIG 414 : * SEGDES,XMATRI 415 : DO i=1,NBPOIN 416 : RE(1,1,i)=RIG 417 : * IMATTT(i)=IXMATR 418 : ENDDO 419 : SEGDES,xMATRI 420 : ENDIF 421 : ENDDO 422 : C Fin de la boucle sur les IAA DDLs a bloquer 423 : 424 : SEGDES,MRIGID 424 : CALL ECROBJ('RIGIDITE',KRIGI) 425 : 426 : 110 SEGDES,MELEME 427 : 100 SEGSUP,MSWBLO 428 : 429 : RETURN 430 : END 431 : 432 : 433 : 434 : 435 : 436 : 437 :
© Cast3M 2003 - All rights reserved.
Disclaimer