Télécharger cctbas.eso

Retour à la liste

Numérotation des lignes :

  1. C CCTBAS SOURCE BP208322 15/10/21 21:15:15 8690
  2. SUBROUTINE CCTBAS(IPSOLU,IPMASS)
  3. C***********************************************************************
  4. C
  5. C C C T B A S
  6. C -----------
  7. C
  8. C SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "VIBRATION"
  9. C
  10. C FONCTION:
  11. C ---------
  12. C
  13. C CREATION D'UNE TABLE DE TYPE BASE_MODALE COMME SORTIE
  14. C DE L'OPERATEUR "VIBRATION" POUR UN PROBLEME NON SYMETRIQUE
  15. C
  16. C ARGUMENTS D'ENTREE:
  17. C ------------------
  18. C
  19. C IPSOLU = POINTEUR SUR L'OBJET SOLUTION
  20. C IPMASS = POINTEUR SUR LA MATRICE MASSE
  21. C
  22. C DESCRIPTION DE LA TABLE BASE_MODALE CREE:
  23. C ----------------------------------------
  24. C
  25. C TAB1 = 'TABLE' 'BASE_MODALE' ( POINTEUR IPTAB1 )
  26. C TAB2 = 'TABLE' 'BASE_DE_MODES' ( POINTEUR IPTAB2 )
  27. C DE MEME STRUCTURE QUE CELLE ISSUE DE LA PROCEDURE
  28. C TRADUIRE.
  29. C TAB3 = 'TABLE' 'MODE' ( POINTEUR IPTAB3 )
  30. C TAB4 = 'TABLE' 'DEPLACEMENTS_GENERALISES' ( POINTEUR IPTAB4 )
  31. C TAB5 = 'TABLE' 'DEPLACEMENTS_GENERALISES_IMAGINAIRES'
  32. C ( POINTEUR IPTAB5 )
  33. C
  34. C ----------------------------------------
  35. C
  36. C TAB1.'SOUSTYPE' = 'BASE_MODALE'
  37. C TAB1.'MODES' = IPTAB2
  38. C
  39. C TAB2.'SOUSTYPE' = 'BASE_DE_MODES'
  40. C TAB2.'MAILLAGE' = IPG1 ( POINTEUR SUR LE
  41. C MAILLAGE EXTRAIT DE LA MATRICE
  42. C MASSE )
  43. C
  44. C PUIS POUR CHAQUE MODE IMOD1 CONTENU DANS L'OBJET SOLUTION
  45. C
  46. C TAB3.'SOUSTYPE' = 'MODE'
  47. C TAB4.'SOUSTYPE' = 'DEPLACEMENTS_GENERALISES'
  48. C
  49. C TAB4.1 = QX DU MODE
  50. C TAB4.2 = QY DU MODE
  51. C TAB4.3 = QZ DU MODE
  52. C
  53. C TAB5.'SOUSTYPE' ='DEPLACEMENTS_GENERALISES_IMAGINAIRES'
  54. C
  55. C TAB5.1 = QX DU MODE
  56. C TAB5.2 = QY DU MODE
  57. C TAB5.3 = QZ DU MODE
  58. C
  59. C
  60. C TAB3.'NUMERO_MODE' = NUME1 (NUMERO DU MODE)
  61. C TAB3.'POINT_REPERE' = IPOIN1 (NUM DUPOINT ASSOCIE)
  62. C AU MODE )
  63. C TAB3.'FREQUENCE' = FREQ1 (REELLE) DU MODE
  64. C TAB3.'MASSE_GENERALISEE' = XMGEN1 (REELLE) DU MODE
  65. C TAB3.'DEPLACEMENTS_GENERALISES' = IPTAB4
  66. C TAB3.'DEFORMEE_MODALE' = IPDEP1 (POINTEUR
  67. C SUR LE CHAMPDE DEPLACEMENTS REEL DU MODE)
  68. C TAB3.'FREQUENCE_IMAGINAIRE' = FREQ1 (IMAGINAIRE) DU MODE
  69. C TAB3.'MASSE_GENERALISEE_IMAGINAIRE = XMGEN1 (IMAGINAIRE) DU MODE
  70. C TAB3.'DEPLACEMENTS_GENERALISES_IMAGINAIRES'
  71. C = IPTAB4
  72. C TAB3.'DEFORMEE_MODALE' = IPDEP1 (POINTEUR
  73. C SUR LECHAMP DE DEPLACEMENTS IMAGINAIRE DU MODE)
  74. C
  75. C TAB2.IMOD1 = IPTAB3
  76. C
  77. C
  78. C AUTEUR, DATE DE CREATION:
  79. C -------------------------
  80. C
  81. C PASCAL BOUDA 10 JUILLET 2015
  82. C
  83. C***********************************************************************
  84. C
  85. IMPLICIT INTEGER(I-N)
  86. IMPLICIT REAL*8 (A-H,O-Z)
  87.  
  88. -INC CCOPTIO
  89. -INC SMSOLUT
  90. -INC SMRIGID
  91. -INC SMTABLE
  92. -INC SMELEME
  93. -INC SMLREEL
  94. -INC SMLENTI
  95. -INC SMCHPOI
  96.  
  97. CHARACTER*8 letyp,charre
  98. LOGICAL boolin,ltelq
  99. CHARACTER *72 ITEX
  100. C
  101. C--- RECUPERATION DU MAILLAGE DANS LA MATRICE MASSE
  102. C
  103. MRIGID=IPMASS
  104. SEGACT MRIGID
  105. NBSOUS=IRIGEL(/2)
  106. IPG1=IRIGEL(1,1)
  107. C
  108. IF (NBSOUS.GT.1) THEN
  109. DO 10 I=2,NBSOUS
  110. IPP2=IRIGEL(1,I)
  111. ltelq=.false.
  112. CALL FUSE(IPG1,IPP2,IRET,ltelq)
  113. IPG1=IRET
  114. 10 CONTINUE
  115. ENDIF
  116. SEGDES MRIGID
  117.  
  118. C--- CREATION DE LA TABLE BASE_DE_MODES
  119. C
  120. CALL CRTABL(IPTAB2)
  121. CALL ECCTAB(IPTAB2,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  122. # 'MOT',0,0.D0,'BASE_DE_MODES',.TRUE.,0)
  123. CALL ECCTAB(IPTAB2,'MOT',0,0.D0,'MAILLAGE',.TRUE.,0,
  124. # 'MAILLAGE',0,0.D0,' ',.TRUE.,IPG1)
  125. C
  126. C--- EXTRACTION DES INFORMATIONS DE L'OBJET SOLUTION
  127.  
  128. MSOLUT=IPSOLU
  129. SEGACT MSOLUT
  130.  
  131. MSOLE1=MSOLIS(4)
  132. * msolis(4) contient la liste des modes calcules
  133. if (msole1.ne.0) then
  134. SEGACT MSOLE1
  135. * Chaque mode a une partie reelle et une partie imaginaire (nulle ou
  136. *non) nombre de mode est donc egal a la moitie de la dimension du
  137. * du tableau de stockage
  138. NBMOD1=MSOLE1.ISOLEN(/1)/2
  139. MSOLE2=MSOLIS(5)
  140. SEGACT MSOLE2
  141.  
  142.  
  143.  
  144.  
  145.  
  146. DO 20 I=1,NBMOD1
  147. ************************************************************
  148. *Les indices impairs correspondent aux parties reelles
  149. IMOD1=2*I-1
  150. *Boucle sur les parties reelles
  151. ************************************************************
  152. C--- CREATION DE LA TABLE MODE
  153. C
  154. CALL CRTABL(IPTAB3)
  155. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  156. # 'MOT',0,0.D0,'MODE',.TRUE.,0)
  157. C
  158. C--- CREATION DE LA TABLE DEPLACEMENTS_GENERALISES
  159. C
  160. CALL CRTABL(IPTAB4)
  161. CALL ECCTAB(IPTAB4,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  162. # 'MOT',0,0.D0,'DEPLACEMENTS_GENERALISES_REELS',.TRUE.,0)
  163. C
  164. C--- CREATION DE LA TABLE DEPLACEMENTS_GENERALISES_IMAGINAIRES
  165. CALL CRTABL(IPTAB5)
  166. CALL ECCTAB(IPTAB5,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  167. # 'MOT',0,0.D0,'DEPLACEMENTS_GENERALISES_IMAGINAIRES',.TRUE.,0)
  168.  
  169. MMODE=MSOLE1.ISOLEN(IMOD1)
  170. CALL TITMOD(MMODE,ITEX)
  171. SEGACT MMODE*MOD
  172. *Recuperation de toutes les informations sur le mode
  173. * -numero
  174. * -frequence reelle
  175. * -deformee reelle
  176. * -deplacements generalises
  177. * -masse generalisee reelle
  178.  
  179. NUME1=IMMODD(1)
  180. FRQ1=FMMODD(1)
  181. XMGEN1=FMMODD(2)
  182. QX1=FMMODD(3)
  183. QY1=FMMODD(4)
  184. QZ1=FMMODD(5)
  185. MELEME=MSOLIS(3)
  186. SEGACT MELEME
  187. IPOIN1=NUM(1,IMOD1)
  188. SEGDES MELEME
  189. C
  190. IPDEP=MSOLE2.ISOLEN(IMOD1)
  191. c ajout du titre au chpoint
  192. MCHPOI=IPDEP
  193. SEGACT MCHPOI*MOD
  194.  
  195. MOCHDE=ITEX
  196. IPDEP=MCHPOI
  197. SEGDES MCHPOI
  198.  
  199.  
  200. SEGDES MMODE
  201.  
  202. C--- REMPLISSAGE DE LA TABLE DEPLACEMENTS_GENERALISES
  203. C
  204. CALL ECCTAB(IPTAB4,'ENTIER',1,0.D0,' ',.TRUE.,0,
  205. # 'FLOTTANT',0,QX1,' ',.TRUE.,0)
  206. CALL ECCTAB(IPTAB4,'ENTIER',2,0.D0,' ',.TRUE.,0,
  207. # 'FLOTTANT',0,QY1,' ',.TRUE.,0)
  208. CALL ECCTAB(IPTAB4,'ENTIER',3,0.D0,' ',.TRUE.,0,
  209. # 'FLOTTANT',0,QZ1,' ',.TRUE.,0)
  210. C
  211. C--- REMPLISSAGE DE LA TABLE MODE
  212. C
  213. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'NUMERO_MODE',.TRUE.,0,
  214. # 'ENTIER',NUME1,0.D0,' ',.TRUE.,0)
  215. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'POINT_REPERE',.TRUE.,0,
  216. # 'POINT',0,0.D0,' ',.TRUE.,IPOIN1)
  217. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'FREQUENCE_REELLE',.TRUE.,0,
  218. # 'FLOTTANT',0,FRQ1,' ',.TRUE.,0)
  219. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'MASSE_GENERALISEE_REELLE',
  220. # .TRUE.,0,'FLOTTANT',0,XMGEN1,' ',.TRUE.,0)
  221. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'DEPLACEMENTS_GENERALISES_REELS',
  222. # .TRUE.,0,'TABLE',0,0.D0,' ',.TRUE.,IPTAB4)
  223. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'DEFORMEE_MODALE_REELLE',.TRUE.,0,
  224. # 'CHPOINT',0,0.D0,' ',.TRUE.,IPDEP)
  225. C
  226. c C--- SUITE DU REMPLISSAGE DE LA TABLE BASE_DE_MODES
  227. c C
  228. c CALL ECCTAB(IPTAB2,'ENTIER',IMOD1,0.D0,' ',.TRUE.,0,
  229. c # 'TABLE',0,0.D0,' ',.TRUE.,IPTAB3)
  230.  
  231.  
  232.  
  233.  
  234. ************************************************************
  235. *Les indices pairs correspondent aux parties imaginaires
  236. IMOD1=2*I
  237. *Boucle sur les parties imaginaires
  238. ************************************************************
  239.  
  240.  
  241. MMODE=MSOLE1.ISOLEN(IMOD1)
  242. *formation du titre de la deformee modale
  243. CALL TITMOD(MMODE,ITEX)
  244. SEGACT MMODE
  245.  
  246. *Recuperation de toutes les informations sur la partie imaginaire
  247. *associe au mode reel recupere au-dessus
  248. * -frequence imaginaire
  249. * -deformee imaginaire
  250. * -deplacements generalises imaginaires
  251. * -masse generalisee imaginaire
  252.  
  253. NUME1=IMMODD(1)
  254. FRQ1=FMMODD(1)
  255. XMGEN1=FMMODD(2)
  256. QX1=FMMODD(3)
  257. QY1=FMMODD(4)
  258. QZ1=FMMODD(5)
  259.  
  260. IPDEP2=MSOLE2.ISOLEN(IMOD1)
  261. c ajout du titre au chpoint
  262. MCHPOI=IPDEP2
  263. SEGACT MCHPOI*MOD
  264. MOCHDE=ITEX
  265. IPDEP2=MCHPOI
  266. SEGDES MCHPOI
  267. SEGDES MMODE
  268.  
  269.  
  270. C--- REMPLISSAGE DE LA TABLE DEPLACEMENTS_GENERALISES_IMAGINAIRES
  271. C
  272. CALL ECCTAB(IPTAB5,'ENTIER',1,0.D0,' ',.TRUE.,0,
  273. # 'FLOTTANT',0,QX1,' ',.TRUE.,0)
  274. CALL ECCTAB(IPTAB5,'ENTIER',2,0.D0,' ',.TRUE.,0,
  275. # 'FLOTTANT',0,QY1,' ',.TRUE.,0)
  276. CALL ECCTAB(IPTAB5,'ENTIER',3,0.D0,' ',.TRUE.,0,
  277. # 'FLOTTANT',0,QZ1,' ',.TRUE.,0)
  278. C
  279. C--- SUITE DU REMPLISSAGE DE LA TABLE MODE
  280.  
  281. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'FREQUENCE_IMAGINAIRE',.TRUE.,0,
  282. # 'FLOTTANT',0,FRQ1,' ',.TRUE.,0)
  283. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'MASSE_GENERALISEE_IMAGINAIRE',
  284. # .TRUE.,0,'FLOTTANT',0,XMGEN1,' ',.TRUE.,0)
  285. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,
  286. # 'DEPLACEMENTS_GENERALISES_IMAGINAIRES',
  287. # .TRUE.,0,'TABLE',0,0.D0,' ',.TRUE.,IPTAB5)
  288. CALL ECCTAB(IPTAB3,'MOT',0,0.D0,'DEFORMEE_MODALE_IMAGINAIRE',
  289. # .TRUE.,0,'CHPOINT',0,0.D0,' ',.TRUE.,IPDEP2)
  290.  
  291.  
  292.  
  293.  
  294. C--- SUITE DU REMPLISSAGE DE LA TABLE BASE_DE_MODES
  295. C
  296. CALL ECCTAB(IPTAB2,'ENTIER',NUME1,0.D0,' ',.TRUE.,0,
  297. # 'TABLE',0,0.D0,' ',.TRUE.,IPTAB3)
  298. C
  299.  
  300.  
  301. 20 CONTINUE
  302.  
  303.  
  304. SEGDES MSOLE1
  305. SEGDES MSOLE2
  306. SEGDES MSOLUT
  307.  
  308. ENDIF
  309.  
  310. C-----CREATION DE LA TABLE FINALE
  311. CALL CRTABL(IPTAB1)
  312. CALL ECCTAB(IPTAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
  313. # 'MOT',0,0.D0,'BASE_MODALE',.TRUE.,0)
  314. CALL ECCTAB(IPTAB1,'MOT',0,0.D0,'MODES',.TRUE.,0,
  315. # 'TABLE',0,0.D0,' ',.TRUE.,IPTAB2)
  316. CALL ECROBJ('TABLE',IPTAB1)
  317. C
  318. END
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  

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