Télécharger appui.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales