Télécharger dyne26.eso

Retour à la liste

Numérotation des lignes :

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

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