Télécharger appui.eso

Retour à la liste

Numérotation des lignes :

  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. -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
  132. 481 CALL LIRMOT(MOTBLO,2,IMOT,0)
  133. IF (IMOT.EQ.1) IDEPL=1
  134. IF (IMOT.EQ.2) IROTA=1
  135. IF (IMOT.NE.0) GOTO 481
  136. C Lecture eventuelle de 'RADI' ou 'DIRE'
  137. C --------------------
  138. IRADIA=0
  139. IDIREC=0
  140. 4480 CALL LIRMOT(MOTBLO(3),2,IMOT,0)
  141. IF (IMOT.EQ.0) THEN
  142. IF (IDEPL.EQ.1) GOTO 44801
  143. IF (IROTA.EQ.1) GOTO 44802
  144. IBDDL=MOTDDL(/2)
  145. IF (IBDDL.NE.0) GOTO 449
  146. IF (IBDDL.EQ.0) GOTO 445
  147. ENDIF
  148. C En DIMENSION 1, les mots-cles 'RADI' et 'DIRE' sont interdits.
  149. IF (IDIM.EQ.1) THEN
  150. INTERR(1)=IDIM
  151. MOTERR(1:4)=MOTBLO(2+IMOT)
  152. CALL ERREUR(971)
  153. GOTO 100
  154. ENDIF
  155. GOTO (44803,44804),IMOT
  156. C Traitement des mots-cles : Mise a jour de MOTDDL
  157. C ----------------------------
  158. C On a trouve le mot DEPLAcement
  159. 44801 IDEPL=0
  160. C Cas particulier pour certains modes de IDIM=1
  161. IF (ISPE1D.EQ.1) THEN
  162. DO i=1,LDEPL
  163. MOTDDL(**)=MODE1D(IADEPL+i)
  164. MOTDDL(**)=MOFO1D(IADEPL+i)
  165. ENDDO
  166. C Cas general
  167. ELSE
  168. DO i=1,LDEPL
  169. MOTDDL(**)=MODEPL(IADEPL+i)
  170. MOTDDL(**)=MODEDU(IADEPL+i)
  171. ENDDO
  172. ENDIF
  173. GOTO 4480
  174. C On a trouve le mot ROTAtion
  175. 44802 IROTA=0
  176. DO i=1,LROTA
  177. MOTDDL(**)=MOROTA(IAROTA+i)
  178. MOTDDL(**)=MORODU(IAROTA+i)
  179. ENDDO
  180. GOTO 4480
  181. C On a trouve le mot RADial
  182. 44803 IRADIA=1
  183. CALL LIROBJ('POINT',KPOINT,1,IRETOU)
  184. IF (IRETOU.EQ.0) GOTO 100
  185. j=(KPOINT-1)*idimp1
  186. DO i=1,IDIM
  187. U1(i)=XCOOR(j+i)
  188. ENDDO
  189. C Lecture du 2nd point de l'axe (en 3D)
  190. IF (IDIM.EQ.3) THEN
  191. CALL LIROBJ('POINT',KPOINT,1,IRETOU)
  192. IF (IRETOU.EQ.0) GOTO 100
  193. j=(KPOINT-1)*idimp1
  194. YL=0.
  195. DO i=1,IDIM
  196. U2(i)=XCOOR(j+i)-U1(i)
  197. YL=YL+U2(i)*U2(i)
  198. ENDDO
  199. C Calcul du vecteur directeur unitaire de l'axe (U2)
  200. IF (YL.LT.EPSI) THEN
  201. CALL ERREUR(237)
  202. GOTO 100
  203. ENDIF
  204. YL=1./SQRT(YL)
  205. DO i=1,IDIM
  206. U2(i)=U2(i)*YL
  207. ENDDO
  208. ENDIF
  209. GOTO 449
  210. C On a trouve le mot DIREction
  211. 44804 IDIREC=1
  212. CALL LIROBJ('POINT',KPOINT,1,IRETOU)
  213. IF (IRETOU.EQ.0) GOTO 100
  214. j=(KPOINT-1)*idimp1
  215. YL=0.
  216. DO i=1,IDIM
  217. XNOR(i)=XCOOR(j+i)
  218. YL=YL+XNOR(i)*XNOR(i)
  219. ENDDO
  220. IF (YL.LT.EPSI) THEN
  221. CALL ERREUR(239)
  222. GOTO 100
  223. ENDIF
  224. YL=1./SQRT(YL)
  225. DO i=1,IDIM
  226. XNOR(i)=XNOR(i)*YL
  227. ENDDO
  228. GOTO 449
  229.  
  230. C Lecture eventuelle de DDLs :
  231. C ------------------------------
  232. C La liste des ddls autorises NOMDD est dans BDATA.ESO
  233. C On doit lire au moins 1 ddl (car sinon MOTDDL est vide !)
  234. 445 LACOND=1
  235. LMOT=9
  236. 446 CALL LIRMOT(NOMDD,LMOT,IMOT,LACOND)
  237. IF (IERR.NE.0) GOTO 100
  238. IF (IMOT.EQ.0) GOTO 449
  239. MOTDDL(**)=NOMDD(IMOT)
  240. MOTDDL(**)=NOMDU(IMOT)
  241. LACOND=0
  242. GOTO 446
  243.  
  244. 449 IBDDL=MOTDDL(/2)
  245. C Verification que le nombre de DDLs a bloquer n'est pas nul
  246. C IF (IBDDL.EQ.0) GOTO 100
  247. C-----------------------------------------------------------------------
  248. C Fin de la lecture des mots (DEPL,ROTA...) ou des DDLs
  249. C-----------------------------------------------------------------------
  250.  
  251. C Recherche du maillage MELEME de type POINT :
  252. C ----------------------------------------------
  253. C On cherche d'abord si on a un POINT que l'on transformera en POI1
  254. C sinon on cherche un maillage que l'on transforme en POI1 si besoin
  255. CALL LIROBJ('POINT',KPOINT,0,IRETOU)
  256. IF (IRETOU.EQ.0) THEN
  257. CALL LIROBJ('MAILLAGE',KOBJET,1,IRETOU)
  258. IF (IRETOU.EQ.0) GOTO 100
  259. MELEME=KOBJET
  260. SEGACT,MELEME
  261. IF (ITYPEL.NE.1) CALL CHANGE(MELEME,1)
  262. NBPOIN=NUM(/2)
  263. ELSE
  264. C On pourrait faire appel a CRELEM(KPOINT)
  265. NBNN=1
  266. NBELEM=1
  267. NBREF=0
  268. NBSOUS=0
  269. SEGINI,MELEME
  270. ITYPEL=1
  271. NUM(1,1)=KPOINT
  272. NBPOIN=1
  273. ENDIF
  274.  
  275. C LECTURE DE LA RAIDEUR DU RESSORT (FLOTTANT)
  276. C -------------------------------------------
  277. CALL LIRREE(RIG,1,IRETOU)
  278. IF (IERR.NE.0) GOTO 110
  279.  
  280. C Determination du nombre de multiplicateurs NNMAT par noeud de MELEME
  281. C NNMAT correspond au nombre de DDLs a bloquer par noeud = nombre de
  282. C multiplicateurs a creer par noeud (1 multiplicateur) = NRIGEL
  283. C Dans les cas RADIal et DIREction, on a une seule matrice par noeud.
  284. C Dans les autres cas, autant de matrices que MOTDDL(/1)/2.
  285. NNMAT=1
  286. IF (IDIREC+IRADIA.EQ.0) NNMAT=IBDDL/2
  287.  
  288. C Initialisation de l'objet RIGIDITE associe aux BLOCAGES
  289. NRIGE=8
  290. NRIGEL=NNMAT
  291. SEGINI,MRIGID
  292. C* IFORIG=IFOMOD
  293. IFORIG=IFOUR
  294. IF (IMILL.EQ.1) THEN
  295. MTYMAT='RIGIDITE'
  296. ELSE IF (IMILL.EQ.2) THEN
  297. MTYMAT='MASSE'
  298. ENDIF
  299. ICHOLE=0
  300. IMGEO1=0
  301. IMGEO2=0
  302. KRIGI=MRIGID
  303.  
  304. C Boucle sur le nombre de DDLs a bloquer
  305. DO IAA=1,NNMAT
  306. C Creation des RAIDEURS associees au IAA-eme multplicateur (DDL)
  307. IRIGEL(1,IAA)=MELEME
  308. IRIGEL(2,IAA)=0
  309. IRIGEL(5,IAA)=NIFOUR
  310. IRIGEL(6,IAA)=0
  311. C** IRIGEL(7,IAA)=0
  312. C** IRIGEL(8,IAA)=0
  313. C Remplissage du tableau des DESCripteurs de RIG
  314. NLIGRP=1
  315. IF (IDIREC+IRADIA.NE.0) NLIGRP=LDEPL
  316. NLIGRD=NLIGRP
  317. SEGINI,DESCR
  318. IRIGEL(3,IAA)=DESCR
  319. IF (IDIREC+IRADIA.EQ.0) THEN
  320. NOELEP(1)=1
  321. NOELED(1)=1
  322. j=2*(IAA-1)
  323. LISINC(1)=MOTDDL(j+1)
  324. LISDUA(1)=MOTDDL(j+2)
  325. ELSE
  326. DO i=1,LDEPL
  327. NOELEP(i)=1
  328. NOELED(i)=1
  329. IF (IROTA.NE.1) THEN
  330. LISINC(i)=MODEPL(i+IADEPL)
  331. LISDUA(i)=MODEDU(i+IADEPL)
  332. ELSE
  333. LISINC(i)=MOROTA(i+IADEPL)
  334. LISDUA(i)=MORODU(i+IADEPL)
  335. ENDIF
  336. ENDDO
  337. ENDIF
  338. SEGDES,DESCR
  339. C** NLIGRP=1
  340. C** IF (IDIREC+IRADIA.NE.0) NLIGRP=IDIM
  341. C** NLIGRD=NLIGRP
  342. NELRIG=NBPOIN
  343. SEGINI,xMATRI
  344. IRIGEL(4,IAA)=xMATRI
  345. COERIG(IAA)=1.
  346.  
  347. C Remplissage de la matrice de rigidite RE :
  348. C Il faut distinguer les cas IRADIA et IDIREC
  349. C IRADIA : Il faut calculer la DIREction puis identique a IDIREC
  350. C IDIREC : La DIRECTION est stockee dans le vecteur norme XNOR
  351. C AUTRES : La matrice est predefinie dans RIG
  352. C Option RADIAL : Calcul prealable de la direction pour chaque noeud
  353. IF (IRADIA.EQ.1) THEN
  354. DO IB=1,NBPOIN
  355. j=(NUM(1,IB)-1)*idimp1
  356. DO i=1,IDIM
  357. XNOR(i)=XCOOR(j+i)-U1(i)
  358. ENDDO
  359. IF (IDIM.EQ.2) THEN
  360. YL=XNOR(1)*XNOR(1)+XNOR(2)*XNOR(2)
  361. IF (YL.LT.EPSI) THEN
  362. CALL ERREUR(238)
  363. GOTO 110
  364. ENDIF
  365. YL=1./SQRT(YL)
  366. XNOR(1)=XNOR(1)*YL
  367. XNOR(2)=XNOR(2)*YL
  368. ELSE
  369. YL=XNOR(1)*U2(1)+XNOR(2)*U2(2)+XNOR(3)*U2(3)
  370. XL=0.
  371. DO i=1,3
  372. XNOR(i)=XNOR(i)-YL*U2(i)
  373. XL=XL+XNOR(i)*XNOR(i)
  374. ENDDO
  375. IF (XL.LT.EPSI) THEN
  376. CALL ERREUR(238)
  377. GOTO 110
  378. ENDIF
  379. XL=1./SQRT(XL)
  380. XNOR(1)=XNOR(1)*XL
  381. XNOR(2)=XNOR(2)*XL
  382. XNOR(3)=XNOR(3)*XL
  383. ENDIF
  384. C XNOR contient la direction normee
  385. * SEGINI,XMATRI
  386. * IMATTT(IB)=XMATRI
  387. RE(1,1,ib)=RIG*XNOR(1)*XNOR(1)
  388. RE(2,1,ib)=RIG*XNOR(1)*XNOR(2)
  389. RE(1,2,ib)=RE(2,1,ib)
  390. RE(2,2,ib)=RIG*XNOR(2)*XNOR(2)
  391. IF (IDIM.EQ.3) THEN
  392. RE(1,3,ib)=RIG*XNOR(1)*XNOR(3)
  393. RE(3,1,ib)=RE(1,3,ib)
  394. RE(2,3,ib)=RIG*XNOR(2)*XNOR(3)
  395. RE(3,2,ib)=RE(2,3,ib)
  396. RE(3,3,ib)=RIG*XNOR(3)*XNOR(3)
  397. ENDIF
  398. * SEGDES,XMATRI
  399. ENDDO
  400. SEGDES,xMATRI
  401. C Option DIRECTION
  402. ELSE IF (IDIREC.EQ.1) THEN
  403. * SEGINI,XMATRI
  404. RE(1,1,1)=RIG*XNOR(1)*XNOR(1)
  405. RE(2,1,1)=RIG*XNOR(1)*XNOR(2)
  406. RE(1,2,1)=RE(2,1,1)
  407. RE(2,2,1)=RIG*XNOR(2)*XNOR(2)
  408. IF (IDIM.EQ.3) THEN
  409. RE(1,3,1)=RIG*XNOR(1)*XNOR(3)
  410. RE(3,1,1)=RE(1,3,1)
  411. RE(2,3,1)=RIG*XNOR(2)*XNOR(3)
  412. RE(3,2,1)=RE(2,3,1)
  413. RE(3,3,1)=RIG*XNOR(3)*XNOR(3)
  414. ENDIF
  415. DO i=2,NBPOIN
  416. do io=1,re(/2)
  417. do iu=1,re(/1)
  418. re(iu,io,i)=re(iu,io,1)
  419. enddo
  420. enddo
  421. ENDDO
  422. SEGDES,XMATRI
  423. * SEGDES,IMATRI
  424. C Autres options :
  425. ELSE
  426. * SEGINI,XMATRI
  427. * IXMATR=XMATRI
  428. * RE(1,1)=RIG
  429. * SEGDES,XMATRI
  430. DO i=1,NBPOIN
  431. RE(1,1,i)=RIG
  432. * IMATTT(i)=IXMATR
  433. ENDDO
  434. SEGDES,xMATRI
  435. ENDIF
  436. ENDDO
  437. C Fin de la boucle sur les IAA DDLs a bloquer
  438.  
  439. SEGDES,MRIGID
  440. CALL ECROBJ('RIGIDITE',KRIGI)
  441.  
  442. 110 SEGDES,MELEME
  443. 100 SEGSUP,MSWBLO
  444.  
  445. RETURN
  446. END
  447.  
  448.  
  449.  
  450.  
  451.  
  452.  
  453.  
  454.  
  455.  

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