Télécharger ccsolu.eso

Retour à la liste

Numérotation des lignes :

  1. C CCSOLU SOURCE BP208322 15/10/21 21:15:14 8690
  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. INTEGER 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 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.  
  151. ENDDO
  152.  
  153. ENDIF
  154.  
  155. 99 CONTINUE
  156.  
  157. ENDDO
  158. *On ecrase les listes non triees par les listes triees
  159. IPLVAL=IP2VAL
  160. IPLVEC=IP2VEC
  161. IPLVAI=IP2VAI
  162. IPLVEI=IP2VEI
  163.  
  164. * **************************************
  165. * ** CONSTRUCTION DE L'OBJET SOLUTION **
  166. * **************************************
  167.  
  168.  
  169. *Boucle sur chacun des modes
  170. DO 100 IB = 1,NBMOD
  171. *on récupère les chpoints reels et imaginaires
  172. IPVECP=IPLVEC.ICHPOI(IB)
  173. IPVECI=IPLVEI.ICHPOI(IB)
  174.  
  175. CALL MUCPRI ( IPVECP, IPMASS, IPMX )
  176. CALL MUCPRI ( IPVECI, IPMASS, IPMY )
  177.  
  178. * On calcule les quotients de rayleigh
  179. CALL CORRSP ( IPMASS, IPVECP, IPMX, IPLMOX,IPLMOY )
  180. CALL XTY1 ( IPVECP, IPMX, IPLMOX,IPLMOY,XMX )
  181. CALL CORRSP ( IPMASS, IPVECP, IPMY, IPLMOX,IPLMOY )
  182. CALL XTY1 ( IPVECP, IPMY, IPLMOX,IPLMOY,XMY )
  183. CALL CORRSP ( IPMASS, IPVECI, IPMX, IPLMOX,IPLMOY )
  184. CALL XTY1 ( IPVECI, IPMX, IPLMOX,IPLMOY,YMX )
  185. CALL CORRSP ( IPMASS, IPVECI, IPMY, IPLMOX,IPLMOY )
  186. CALL XTY1 ( IPVECI, IPMY, IPLMOX,IPLMOY,YMY )
  187.  
  188. *Remplissage de propre qui contient les infos modales
  189. PROPRE(1) = IPLVAL.PROG(IB)
  190. PROPRE(6) = IPLVAI.PROG(IB)
  191. PROPRE(2) = XMX-YMY
  192. PROPRE(7) = YMX+XMY
  193.  
  194. *Calcul des deplcaments generalises
  195. CALL DEPGE2 (IPMASS, IPVECP, IPVECI, PROPRE, IPMX,
  196. & IPLMOX, IPLMOY)
  197. IF ( IERR .NE. 0 ) RETURN
  198. * La partie reelle du mode est stocke dans un objet solution (ipmode)
  199. CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,IB,IPMODE)
  200.  
  201. IF ( IERR .NE. 0 ) RETURN
  202. IF ( IIMPI .EQ. 2 ) CALL ECMODE ( IPMODE )
  203. * On fusionne la partie reelle du mode propre calcule avec l'objet
  204. *solution courant
  205. IF (IB .EQ. 1) THEN
  206. IPSOLU = IPMODE
  207. ELSE
  208. CALL FUSOLU( IPSOLU, IPMODE, IPSOL1 )
  209. IF ( IERR .NE. 0 ) RETURN
  210. CALL DESOLU( IPMODE )
  211. IF ( IERR .NE. 0 ) RETURN
  212. CALL DESOLU( IPSOLU )
  213. IF ( IERR .NE. 0 ) RETURN
  214. IPSOLU = IPSOL1
  215. ENDIF
  216. * La partie imaginR du mode est stockee dans un objet solution (ipmode)
  217. CALL CREMO1 (PROPRE,IPVECI,IPKW2M,INF0,IB,IPMODE)
  218. IF ( IERR .NE. 0 ) RETURN
  219. * On fusionne la partie imaginaire du mode propre calcule avec l'objet
  220. *solution courant
  221. IF ( IIMPI .EQ. 2 ) CALL ECMODE ( IPMODE )
  222. CALL FUSOLU( IPSOLU, IPMODE, IPSOL1 )
  223. IF ( IERR .NE. 0 ) RETURN
  224. CALL DESOLU( IPMODE )
  225. IF ( IERR .NE. 0 ) RETURN
  226. CALL DESOLU( IPSOLU )
  227. IF ( IERR .NE. 0 ) RETURN
  228. IPSOLU = IPSOL1
  229.  
  230. 100 CONTINUE
  231.  
  232. IPMODE = IPSOLU
  233.  
  234. SEGDES IPLVEC,IPLVAL,IPLVEI,IPLVAI
  235. SEGDES IP2VEC,IP2VAL,IP2VEI,IP2VAI
  236.  
  237. *on tue les chpoints de travail ...
  238. CALL DTCHPO(IPMX)
  239. CALL DTCHPO(IPMY)
  240.  
  241. *... les listreel de travail ...
  242. CALL DTLREE(IP2VAL)
  243. CALL DTLREE(IP2VAI)
  244.  
  245. *... et les listchpo de travail
  246. CALL DTLCHP(IP2VEC)
  247. CALL DTLCHP(IP2VEI)
  248.  
  249. RETURN
  250. END
  251.  
  252.  
  253.  
  254.  

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