Télécharger ccsolu.eso

Retour à la liste

Numérotation des lignes :

  1. C CCSOLU SOURCE CB215821 17/07/20 21:15:03 9511
  2. SUBROUTINE CCSOLU (W2,IPLVAL,IPLVAI,IPLVEC,IPLVEI,
  3. & IPKW2M,IPMASS,IPSOLU,INF0)
  4.  
  5. ************************************************************************
  6. *
  7. * C C S O L U
  8. *
  9. *
  10. *
  11. * FONCTION:
  12. * ---------
  13. *
  14. * CONSTRUCTION D'UN OBJET SOLUTION, A PARTIR DES LISTES DES
  15. * FREQUENCES PROPRES ET DES MODES PROPRES POUR UN PROBLEME NON
  16. * SYMETRIQUE
  17. *
  18. * NB: LES LISTES SONT SUPPOSES NON TRIEES, UN TRI EST FAIT PAR
  19. * ORDRE DE CROISSANCE DE LA PARTIE REELE DES FREQUENCES PROPRES
  20. *
  21. * SOUS PROGRAMME INSPIRE DU CRSOLU ADAPTE AU CAS COMPLEXE
  22. *
  23. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  24. * -----------
  25. *
  26. * W2 REEL DP (E) FREQUENCE DE SHIFT
  27. *
  28. * IPLVAL ENTIER (E) POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  29. * LA SUITE DES FREQUENCES PROPRES REELLES
  30. *
  31. * IPLVAI ENTIER (E) POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  32. * LA SUITE DES FREQUENCES PROPRES IMAGINAIRES
  33. *
  34. * IPLVEC ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  35. * LA SUITE DES MODES PROPRES REELS
  36. *
  37. * IPLVEI ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  38. * LA SUITE DES MODES PROPRES IMAGINAIRES
  39. *
  40. * IPKW2M, IPMASS (E) MATRICES DE RIGIDITE (DECALEE) ET DE MASSE
  41. *
  42. *
  43. * IPSOLU ENTIER (S) POINTEUR SUR LA SOLUTION CREE
  44. *
  45. *
  46. * AUTEUR, DATE DE CREATION:
  47. * -------------------------
  48. *
  49. * PASCAL BOUDA 8 JUILLET 2015
  50. *
  51. ************************************************************************
  52.  
  53.  
  54. IMPLICIT INTEGER(I-N)
  55. IMPLICIT REAL*8 (A-H,O-Z)
  56.  
  57. -INC CCOPTIO
  58. -INC SMLCHPO
  59. -INC SMCHPOI
  60. -INC SMLREEL
  61. -INC SMLMOTS
  62. -INC CCREEL
  63. -INC SMSOLUT
  64.  
  65.  
  66. PARAMETER (LPROPR = 10)
  67.  
  68.  
  69. POINTEUR IPLVEC.MLCHPO, IPLVAL.MLREEL
  70. POINTEUR IPLVEI.MLCHPO, IPLVAI.MLREEL
  71. *pointeurs de travail
  72. POINTEUR IP2VEC.MLCHPO, IP2VAL.MLREEL
  73. POINTEUR IP2VEI.MLCHPO, IP2VAI.MLREEL
  74.  
  75.  
  76. INTEGER NBMOD, IPKW2M, IPMASS, IPSOLU
  77.  
  78.  
  79. POINTEUR IPLMOX.MLMOTS, IPLMOY.MLMOTS
  80. INTEGER IPMX,IPMY, IPMODE, IPSOL1
  81.  
  82. REAL*8 PROPRE(LPROPR)
  83.  
  84. * PROPRE(1) = PARTIE REELLE DU MODE PRORPE,
  85. * PROPRE(2) = (X)T.|B|.(X) , (X) 'CHPOINT' SOLUTION
  86. * PROPRE(3,4,5) DEPL.GEN. REELS SELON X,Y,Z
  87. * PROPRE(6)= PARTIE IMAGINAIRE DU MODE PROPRE
  88. * PROPRE(7)=PARTIE IM. DE XT.|B|.X
  89. * PROPRE(8,9,10) PARTIE IM DES DEP. GEN.
  90.  
  91. REAL*8 XMX, XMY, YMY, YMX
  92.  
  93. REAL*8 BUVAP1,BUVAP2
  94. INTEGER BUVEP1,BUVEP2
  95. INTEGER i,j
  96.  
  97.  
  98.  
  99. * *******************
  100. * ** TRI DES MODES **
  101. * *******************
  102.  
  103. SEGACT IPLVEC*MOD
  104. SEGACT IPLVAL*MOD
  105. SEGACT IPLVEI*MOD
  106. SEGACT IPLVAI*MOD
  107. *Recuparation du nombre de modes
  108. NBMOD=IPLVAL.PROG(/1)
  109.  
  110. *Initialisation des segements de travail
  111. JG=NBMOD
  112. SEGINI IP2VAL
  113. SEGINI IP2VAI
  114.  
  115. N1=NBMOD
  116. SEGINI IP2VEC
  117. SEGINI IP2VEI
  118.  
  119. *Boucle sur tous les modes existants
  120. DO 99 i=1,NBMOD
  121. *A chaque iteration, on ajoute un mode en bout de liste
  122. IP2VAL.PROG(i)=IPLVAL.PROG(i)
  123. IP2VAI.PROG(i)=IPLVAI.PROG(i)
  124. IP2VEC.ICHPOI(i)=IPLVEC.ICHPOI(i)
  125. IP2VEI.ICHPOI(i)=IPLVEI.ICHPOI(i)
  126.  
  127. IF (i .NE. 1) THEN
  128. *Boucle de tri: tant que la partie reelle de la frequence propre du
  129. *mode est inferieure a celle qui la precede,on la decale vers la gauche
  130. DO j=1,i-1
  131.  
  132. IF (IP2VAL.PROG(i-j+1).LE.IP2VAL.PROG(i-j)) THEN
  133. BUVAP1=IP2VAL.PROG(i-j+1)
  134. BUVAP2=IP2VAI.PROG(i-j+1)
  135. BUVEP1=IP2VEC.ICHPOI(i-j+1)
  136. BUVEP2=IP2VEI.ICHPOI(i-j+1)
  137.  
  138. IP2VAL.PROG(i-j+1)=IP2VAL.PROG(i-j)
  139. IP2VAI.PROG(i-j+1)=IP2VAI.PROG(i-j)
  140. IP2VEC.ICHPOI(i-j+1)=IP2VEC.ICHPOI(i-j)
  141. IP2VEI.ICHPOI(i-j+1)=IP2VEI.ICHPOI(i-j)
  142.  
  143. IP2VAL.PROG(i-j)=BUVAP1
  144. IP2VAI.PROG(i-j)=BUVAP2
  145. IP2VEC.ICHPOI(i-j)=BUVEP1
  146. IP2VEI.ICHPOI(i-j)=BUVEP2
  147. ELSE
  148. GOTO 99
  149. ENDIF
  150. ENDDO
  151. ENDIF
  152. 99 CONTINUE
  153. *On ecrase les listes non triees par les listes triees
  154. IPLVAL=IP2VAL
  155. IPLVEC=IP2VEC
  156. IPLVAI=IP2VAI
  157. IPLVEI=IP2VEI
  158.  
  159. * **************************************
  160. * ** CONSTRUCTION DE L'OBJET SOLUTION **
  161. * **************************************
  162. *Boucle sur chacun des modes
  163. DO 100 IB = 1,NBMOD
  164. *on récupère les chpoints reels et imaginaires
  165. IPVECP=IPLVEC.ICHPOI(IB)
  166. IPVECI=IPLVEI.ICHPOI(IB)
  167.  
  168. CALL MUCPRI ( IPVECP, IPMASS, IPMX )
  169. CALL MUCPRI ( IPVECI, IPMASS, IPMY )
  170.  
  171. * On calcule les quotients de rayleigh
  172. CALL CORRSP ( IPMASS, IPVECP, IPMX, IPLMOX,IPLMOY )
  173. CALL XTY1 ( IPVECP, IPMX, IPLMOX,IPLMOY,XMX )
  174. CALL CORRSP ( IPMASS, IPVECP, IPMY, IPLMOX,IPLMOY )
  175. CALL XTY1 ( IPVECP, IPMY, IPLMOX,IPLMOY,XMY )
  176. CALL CORRSP ( IPMASS, IPVECI, IPMX, IPLMOX,IPLMOY )
  177. CALL XTY1 ( IPVECI, IPMX, IPLMOX,IPLMOY,YMX )
  178. CALL CORRSP ( IPMASS, IPVECI, IPMY, IPLMOX,IPLMOY )
  179. CALL XTY1 ( IPVECI, IPMY, IPLMOX,IPLMOY,YMY )
  180.  
  181. *Remplissage de propre qui contient les infos modales
  182. PROPRE(1) = IPLVAL.PROG(IB)
  183. PROPRE(6) = IPLVAI.PROG(IB)
  184. PROPRE(2) = XMX - YMY
  185. PROPRE(7) = YMX + XMY
  186.  
  187. *Calcul des deplcaments generalises
  188. CALL DEPGE2 (IPMASS, IPVECP, IPVECI, PROPRE, IPMX,
  189. & IPLMOX, IPLMOY)
  190. IF ( IERR .NE. 0 ) RETURN
  191. * La partie reelle du mode est stocke dans un objet solution (ipmode)
  192. CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,IB,IPMODE)
  193.  
  194. IF ( IERR .NE. 0 ) RETURN
  195. IF ( IIMPI .EQ. 2 ) CALL ECMODE ( IPMODE )
  196. * On fusionne la partie reelle du mode propre calcule avec l'objet
  197. * solution courant
  198. IF (IB .EQ. 1) THEN
  199. IPSOLU = IPMODE
  200. ELSE
  201. CALL FUSOLU( IPSOLU, IPMODE, IPSOL1 )
  202. IF ( IERR .NE. 0 ) RETURN
  203. CALL DESOLU( IPMODE )
  204. IF ( IERR .NE. 0 ) RETURN
  205. CALL DESOLU( IPSOLU )
  206. IF ( IERR .NE. 0 ) RETURN
  207. IPSOLU = IPSOL1
  208. ENDIF
  209. * La partie imaginR du mode est stockee dans un objet solution (ipmode)
  210. CALL CREMO1 (PROPRE,IPVECI,IPKW2M,INF0,IB,IPMODE)
  211. IF ( IERR .NE. 0 ) RETURN
  212. * On fusionne la partie imaginaire du mode propre calcule avec l'objet
  213. * solution courant
  214. IF ( IIMPI .EQ. 2 ) CALL ECMODE ( IPMODE )
  215. CALL FUSOLU( IPSOLU, IPMODE, IPSOL1 )
  216. IF ( IERR .NE. 0 ) RETURN
  217. CALL DESOLU( IPMODE )
  218. IF ( IERR .NE. 0 ) RETURN
  219. CALL DESOLU( IPSOLU )
  220. IF ( IERR .NE. 0 ) RETURN
  221. IPSOLU = IPSOL1
  222.  
  223. 100 CONTINUE
  224.  
  225. IPMODE = IPSOLU
  226.  
  227. SEGDES IPLVEC,IPLVAL,IPLVEI,IPLVAI
  228. SEGDES IP2VEC,IP2VAL,IP2VEI,IP2VAI
  229.  
  230. *on tue les chpoints de travail ...
  231. CALL DTCHPO(IPMX)
  232. CALL DTCHPO(IPMY)
  233.  
  234. *... les listreel de travail ...
  235. CALL DTLREE(IP2VAL)
  236. CALL DTLREE(IP2VAI)
  237.  
  238. *... et les listchpo de travail
  239. CALL DTLCHP(IP2VEC)
  240. CALL DTLCHP(IP2VEI)
  241.  
  242. RETURN
  243. END
  244.  
  245.  

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