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

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