Télécharger dyne26.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNE26 SOURCE BP208322 15/07/22 21:15:34 8586
  2. SUBROUTINE DYNE26(IBAS,KTKAM,KTLIAB,KTPHI,IA1,IB,ICOMP,
  3. & RIGIDE,ITCARA,LMODYN,ITKM)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Transpose l'information des objets de Castem2000 dans des *
  12. * tableaux de travail. *
  13. * *
  14. * Parametres: *
  15. * *
  16. * e IBAS Table representant une base modale *
  17. * es KTKAM Segment contenant les matrices XK, XASM et XM *
  18. * es KTPHI Segment des deformees modales *
  19. * e KTLIAB Segment des liaisons sur base B *
  20. * es IA1 Compteur *
  21. * e IB Compteur de la sous base *
  22. * es RIGIDE Vrai si l'on a un corps rigide, faux sinon *
  23. * e LMODYN Logique = vrai si table PASAPAS *
  24. * e ITKM >0 si table RAIDEUR_ET_MASSE fournie *
  25. * *
  26. * Auteur, date de creation: *
  27. * *
  28. * Lionel VIVAN, le 24 octobre 1989. *
  29. * *
  30. *--------------------------------------------------------------------*
  31. -INC CCOPTIO
  32. -INC CCREEL
  33. -INC SMCHAML
  34. -INC SMELEME
  35. -INC SMMODEL
  36. *
  37. SEGMENT,MTKAM
  38. REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M)
  39. REAL*8 XOPER(NB1,NB1,NOPER)
  40. ENDSEGMENT
  41. *
  42. SEGMENT,MTPHI
  43. INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  44. INTEGER IAROTA(NSB)
  45. REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  46. ENDSEGMENT
  47. *
  48. SEGMENT,MTLIAB
  49. INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  50. REAL*8 XPALB(NLIAB,NXPALB)
  51. REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  52. ENDSEGMENT
  53. *
  54. segment mtbas
  55. integer itbmod,lsstru(np1),nsstru
  56. endsegment
  57. *
  58. LOGICAL L0,L1,RIGIDE,LMODYN
  59. CHARACTER*4 NOMTRI(6),NOMAXI(6),NOMPLA(3)
  60. CHARACTER*8 CMOT,TYPRET,MORIGI,CHARRE
  61. REAL*8 XAXROT(3),XROTA(2,3)
  62. *
  63. * si IFOMOD = -1 : modele PLAN
  64. * si IFOMOD = 0 : modele AXIS
  65. * si IFOMOD = 1 : modele FOUR
  66. * si IFOMOD = 2 : modele TRID
  67. *
  68. * Les noms de composante sont
  69. * - en modele PLAN : UX, UY, RT
  70. * - en modele AXIS : UX, UY, RZ
  71. * - en modele FOUR 1 : UR, UZ, UT, RT
  72. * - en modele TRID : UX, UY, UZ, RX, RY, RZ
  73. *
  74. DATA NOMTRI/'UX ','UY ','UZ ','RX ','RY ','RZ '/
  75. DATA NOMAXI/'UR ','UT ','UZ ','RR ','RT ','RZ '/
  76. DATA NOMPLA/'UX ','UY ','RZ '/
  77. *
  78. MTKAM = KTKAM
  79. MTPHI = KTPHI
  80. MTLIAB = KTLIAB
  81. *
  82. NLIAB = IPALB(/1)
  83. NPLB = JPLIB(/1)
  84. NSB = XPHILB(/1)
  85. NPLSB = XPHILB(/2)
  86. NA2 = XPHILB(/3)
  87. IDIMB = XPHILB(/4)
  88. DEUXPI = 2.D0 * XPI
  89. *
  90. IORSB(IB) = IA1 + 1
  91. IAROTA(IB) = 0
  92. IROT = 0
  93. IN = 0
  94.  
  95.  
  96. ************************************************************************
  97. * Aiguillage pour le cas
  98. ************************************************************************
  99.  
  100. if (lmodyn) goto 40
  101.  
  102.  
  103. ************************************************************************
  104. * table BASE_MODALE
  105. ************************************************************************
  106.  
  107. 10 CONTINUE
  108. IN = IN + 1
  109. TYPRET = ' '
  110. CALL ACCTAB(IBAS,'ENTIER',IN,X0,' ',L0,IP0,
  111. & TYPRET,I1,X1,CHARRE,L1,IBAMOD)
  112. IF (IERR.NE.0) RETURN
  113. * -on a bien un objet de type table
  114. IF (IBAMOD.NE.0) THEN
  115. IF (TYPRET.EQ.'TABLE ') THEN
  116.  
  117. IA1 = IA1 + 1
  118.  
  119. * remplissage de XM et XK diagonale depuis la table BASE_MODALE
  120. * sauf si deja fait car on a une table RAIDEUR_ET_MASSE !
  121. IF(ITKM.LE.0) THEN
  122. CALL ACCTAB(IBAMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
  123. & 'FLOTTANT',I1,XMASSE,' ',L1,IP1)
  124. IF (IERR.NE.0) RETURN
  125. XM(IA1,1) = XMASSE
  126. CALL ACCTAB(IBAMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  127. & 'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  128. IF (IERR.NE.0) RETURN
  129. OMEGA = XFREQ * DEUXPI
  130. XK(IA1,1) = XMASSE * OMEGA * OMEGA
  131. IF (IIMPI.EQ.333) THEN
  132. WRITE(IOIMP,*)'DYNE26 : XM(',IA1,') =',XMASSE
  133. WRITE(IOIMP,*)'DYNE26 : XK(',IA1,') =',XK(IA1,1)
  134. ENDIF
  135. ENDIF
  136.  
  137. * si liaison_B existe, remplissage de IPLSB, XPHILB, IAROTA, INMSB...
  138. IF (NLIAB.NE.0) THEN
  139. CALL ACCTAB(IBAMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  140. & 'CHPOINT',I1,X1,' ',L1,ICDM)
  141. IF (IERR.NE.0) RETURN
  142. DO 12 ID = 1,IDIMB
  143. IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  144. CMOT = NOMAXI(ID)
  145. ELSE
  146. IF (IFOMOD.EQ.-1) THEN
  147. CMOT = NOMPLA(ID)
  148. ELSE
  149. CMOT = NOMTRI(ID)
  150. ENDIF
  151. ENDIF
  152. IF (IIMPI.EQ.333)
  153. & WRITE(IOIMP,*)'DYNE26 : composante a extraire :',CMOT
  154. ICOMP = 0
  155. DO 14 IP = 1,NPLB
  156. IPOINT = JPLIB(IP)
  157. * On extrait du chpoint ICDM au point IPOINT de composante CMOT
  158. CALL EXTRA9(ICDM,IPOINT,CMOT,KERRE,XVAL)
  159. ICOMP = ICOMP + 1
  160. * on ajuste la taille si necessaire
  161. IF(ICOMP.GT.NPLSB) THEN
  162. NPLSB=ICOMP
  163. SEGADJ MTPHI
  164. ENDIF
  165. IPLSB(IP) = ICOMP
  166. * suite a la modif dans extra9, car on attribue une valeur meme
  167. * si le point n'existe pas dans le chpoint
  168. IF (XVAL.NE.0.) THEN
  169. IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN
  170. call erreur (783)
  171. RETURN
  172. ENDIF
  173. IBASB(IP) = IB
  174. ELSEIF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) THEN
  175. IBASB(IP) = IB
  176. ENDIF
  177. XPHILB(IB,ICOMP,IN,ID) = XVAL
  178. IF (IIMPI.EQ.333) THEN
  179. WRITE(IOIMP,*)'DYNE26 : IPLSB(',IP,') =',IPLSB(IP)
  180. WRITE(IOIMP,*)'DYNE26 : IBASB(',IP,') =',IBASB(IP)
  181. XVA2 = XPHILB(IB,ICOMP,IN,ID)
  182. WRITE(IOIMP,*)'DYNE26 : XPHILB(',IB,ICOMP,IN,ID,') =',XVA2
  183. ENDIF
  184. 14 CONTINUE
  185. 12 CONTINUE
  186. ENDIF
  187.  
  188. * Prise en compte d'un mode de rotation de corps rigide
  189. MORIGI = ' '
  190. CALL ACCTAB(IBAMOD,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0,
  191. & MORIGI,I1,X1,CMOT,L1,IP1)
  192. IF (IERR.NE.0) RETURN
  193. IF (MORIGI.EQ.'MOT') THEN
  194. IF (CMOT(1:4).EQ.'VRAI') THEN
  195. CALL ACCTAB(IBAMOD,'MOT',I0,X0,'CENTRE_DE_GRAVITE',
  196. & L0,IP0,'POINT',I1,X1,' ',L1,ICDG)
  197. IF (IERR.NE.0) RETURN
  198. IAROTA(IB)=IA1
  199. IROT = IN
  200. ENDIF
  201. ENDIF
  202. GOTO 10
  203. ELSE
  204. CALL ERREUR(491)
  205. RETURN
  206. ENDIF
  207. ENDIF
  208. * -fin du cas ou on a bien un objet de type table
  209. INMSB(IB) = IN - 1
  210.  
  211.  
  212. ************************************************************************
  213. * table PASAPAS
  214. ************************************************************************
  215.  
  216. 40 if (lmodyn) then
  217. *
  218. mtbas = ibas
  219. mmodel = itbmod
  220. segact mmodel
  221. mchelm = itcara
  222. segact mchelm
  223. n1 = imache(/1)
  224. IN = 0
  225.  
  226. do 41 ik =1,kmodel(/1)
  227. imodel = kmodel(ik)
  228. if (lsstru(ik).ne.ib) goto 41
  229. IN = IN + 1
  230. segact imodel
  231. jdefo = 0
  232. jmass = 0
  233. jfreq = 0
  234. jgrav = 0
  235. do 46 inc = 1,n1
  236. meleme = imache(inc)
  237. if (meleme.ne.imamod) goto 46
  238. if (conche(inc).ne.conmod) goto 46
  239. segact meleme
  240. mchaml = ichaml(inc)
  241. segact mchaml
  242. n2 = ielval(/1)
  243.  
  244. do io = 1,n2
  245. if (nomche(io)(1:4).eq.'DEFO') then
  246. jdefo = io
  247. melval = ielval(io)
  248. segact melval
  249. else if (nomche(io)(1:4).eq.'MASS') then
  250. jmass =io
  251. melval = ielval(io)
  252. segact melval
  253. else if (nomche(io)(1:4).eq.'FREQ') then
  254. jfreq = io
  255. melval = ielval(io)
  256. segact melval
  257. else if (nomche(io)(1:4).eq.'CGRA') then
  258. jgrav = io
  259. melval = ielval(io)
  260. segact melval
  261. else
  262. endif
  263. if (jdefo.gt.0.and.jmass.gt.0.and.jfreq.gt.0.and.
  264. &jgrav.gt.0) goto 47
  265. enddo
  266. if (jdefo.gt.0.and.jmass.gt.0.and.jfreq.gt.0) goto 47
  267. 46 continue
  268. if (jdefo.eq.0.and.jmass.eq.0.and.jfreq.eq.0) then
  269. write(6,*) 'pas de caracteristiques modele ',ik, conmod
  270. return
  271. endif
  272. 47 continue
  273. do ip =1,num(/2)
  274. IA1 = IA1 + 1
  275. melval = ielval(jmass)
  276. xmasse = velche(1,ip)
  277. XM(IA1,1) = XMASSE
  278.  
  279. melval = ielval(jfreq)
  280. xfreq = velche(1,ip)
  281. OMEGA = XFREQ * DEUXPI
  282. XK(IA1,1) = XMASSE * OMEGA * OMEGA
  283.  
  284. melval = ielval(jdefo)
  285. icdm = ielche(1,ip)
  286.  
  287. **
  288. * Prise en compte d'un mode de rotation de corps rigide
  289. if (jgrav.gt.0) then
  290. melval = ielval(jgrav)
  291. ICDG = ielche(1,ip)
  292. IAROTA(IB)=IA1
  293. IROT = IN
  294. endif
  295. enddo
  296. *
  297. *
  298. IF (IIMPI.EQ.333) THEN
  299. WRITE(IOIMP,*)'DYNE26 : XM(',IA1,') =',XMASSE
  300. WRITE(IOIMP,*)'DYNE26 : XK(',IA1,') =',XK(IA1,1)
  301. ENDIF
  302. IF (NLIAB.NE.0) THEN
  303. DO 42 ID = 1,IDIMB
  304. IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  305. CMOT = NOMAXI(ID)
  306. ELSE
  307. IF (IFOMOD.EQ.-1) THEN
  308. CMOT = NOMPLA(ID)
  309. ELSE
  310. CMOT = NOMTRI(ID)
  311. ENDIF
  312. ENDIF
  313. IF (IIMPI.EQ.333) THEN
  314. WRITE(IOIMP,*)'DYNE26 : composante a extraire :',CMOT
  315. ENDIF
  316. ICOMP = 0
  317. DO 44 IP = 1,NPLB
  318. IPOINT = JPLIB(IP)
  319. *
  320. * On extrait du chpoint ICDM au point IPOINT de composante CMOT
  321. *
  322. CALL EXTRA9(ICDM,IPOINT,CMOT,KERRE,XVAL)
  323. ICOMP = ICOMP + 1
  324. *
  325. * on ajuste la taille si necessaire
  326. * MP
  327. IF(ICOMP.GT.NPLSB) THEN
  328. NPLSB=ICOMP
  329. SEGADJ MTPHI
  330. ENDIF
  331. IPLSB(IP) = ICOMP
  332. * suite e la modif dans extra9, car on attribue une valeur meme
  333. * si le point n'existe pas dans le chpoint
  334. IF (XVAL.NE.0.) THEN
  335. IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN
  336. call erreur (783)
  337. RETURN
  338. ENDIF
  339. IBASB(IP) = IB
  340. ELSE
  341. IF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) IBASB(IP) = IB
  342. ENDIF
  343. *
  344. XPHILB(IB,ICOMP,IN,ID) = XVAL
  345. IF (IIMPI.EQ.333) THEN
  346. WRITE(IOIMP,*)'DYNE26 : IPLSB(',IP,') =',IPLSB(IP)
  347. WRITE(IOIMP,*)'DYNE26 : IBASB(',IP,') =',IBASB(IP)
  348. XVA2 = XPHILB(IB,ICOMP,IN,ID)
  349. WRITE(IOIMP,*)'DYNE26 : XPHILB(',IB,ICOMP,IN,ID,') =',XVA2
  350. ENDIF
  351.  
  352. 44 CONTINUE
  353. 42 CONTINUE
  354. ENDIF
  355. *
  356.  
  357. 41 continue
  358. INMSB(IB) = IN
  359. IN = IN + 1
  360.  
  361. endif
  362. ****** fin du cas table PASAPAS ****************************************
  363.  
  364.  
  365. ************************************************************************
  366. * Remplissage des fausses deformees modales de rotations
  367. ************************************************************************
  368.  
  369. 50 continue
  370. IF (IAROTA(IB).NE.0) THEN
  371. RIGIDE = .TRUE.
  372. MERR = 0
  373. NPLUS = IN + 1
  374. IF (NPLUS.GT.NA2) THEN
  375. * On reajuste le dimension NA2 de XPHILB
  376. NA2 = NPLUS
  377. SEGADJ MTPHI
  378. ENDIF
  379. DO 18 IP=1,NPLB
  380. IPOINT=JPLIB(IP)
  381. IPOS=IPLSB(IP)
  382. IBBAS= IBASB(IP)
  383. IF (IBBAS.EQ.IB) THEN
  384. DO 20 ID=(IDIM+1),IDIMB
  385. XAXROT(ID-IDIM) = XPHILB(IB,IPOS,IROT,ID)
  386. 20 CONTINUE
  387. * En tridimensionnel l'axe de rotation est le vecteur propre de rotation
  388. * On norme l axe du plan de rotation
  389. CALL DYNE41(XAXROT,MERR,IDIM)
  390. * En bidimensionnel l'axe de rotation est fixe
  391. * Calcul des fausses deformees modales de rotation
  392. CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR)
  393. DO 22 ID =1,IDIMB
  394. XPHILB(IB,IPOS,IN,ID) = XROTA(1,ID)
  395. XPHILB(IB,IPOS,IN+1,ID)= XROTA(2,ID)
  396. 22 CONTINUE
  397. ENDIF
  398. 18 CONTINUE
  399. ENDIF
  400.  
  401. IF (IIMPI.EQ.333) THEN
  402. WRITE(IOIMP,*)'DYNE26 : INMSB(',IB,') =',INMSB(IB)
  403. WRITE(IOIMP,*)'DYNE26 : IORSB(',IB,') =',IORSB(IB)
  404. WRITE(IOIMP,*)'DYNE26 : IAROTA(',IB,') =',IAROTA(IB)
  405. ENDIF
  406. *
  407. END
  408.  
  409.  
  410.  
  411.  

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