Télécharger cctbas.eso

Retour à la liste

Numérotation des lignes :

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

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