Télécharger arpshi.eso

Retour à la liste

Numérotation des lignes :

  1. C ARPSHI SOURCE BP208322 19/04/29 21:15:06 10213
  2. SUBROUTINE ARPSHI (FREQ,VPROPR,QUAD,SENS)
  3.  
  4.  
  5.  
  6.  
  7. ***********************************************************************
  8. *
  9. * A R P S H I
  10. *
  11. * FONCTION:
  12. * ---------
  13. *
  14. * PASSAGE D'UNE FREQUENCE (Hz) A UNE VALEUR PROPRE SOLUTION DE
  15. * [A - VPROPR*B] X = 0
  16. * ET VICE VERSA
  17. *
  18. *
  19. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  20. * -----------
  21. *
  22. *
  23. * FREQ COMPLEXE DP (E/S) FREQUENCE
  24. *
  25. * VPROPR COMPLEXE DP (E/S) VALEUR PROPRE
  26. *
  27. * QUAD LOGIQUE (E) PROBLEME QUADRATIQUE OU NON
  28. *
  29. * SENS ENTIER (E) SENS DE CONVERSION
  30. * = 1 : FREQ -> VPROPR
  31. * = 2 : VPROPR -> FREQ
  32. * = 3 : VPROPR -> FREQ avec convention pour garder une
  33. * frequence propre reelle :
  34. * v<0 => f<0
  35. *
  36. * SOUS-PROGRAMMES APPELES:
  37. * ------------------------
  38. *
  39. * NEANT
  40. *
  41. * AUTEUR, DATE DE CREATION:
  42. * -------------------------
  43. *
  44. * PASCAL BOUDA 17 JUIN 2015
  45. *
  46. ************************************************************************
  47.  
  48. -INC CCOPTIO
  49. -INC CCREEL
  50.  
  51. COMPLEX*16 FREQ
  52. COMPLEX*16 VPROPR
  53. LOGICAL QUAD
  54. INTEGER SENS
  55.  
  56. REAL*8 MODV,MODF,THETAV,THETAF
  57. REAL*8 X,Y,VRE
  58. COMPLEX*16 ZERO,J
  59.  
  60. ZERO=CMPLX(0.D0,0.D0)
  61. J=CMPLX(0.D0,1.D0)
  62.  
  63.  
  64. *on utilise la notation exponentielle pour faciliter les calculs
  65. *l'objectif est de calculer
  66. *
  67. * - lambda=(2*pi*f)^2 si le problemeest lineaire*
  68. * - lambda=jw=j*(2*pi*f) si le probleme est quadratique
  69. *
  70. *le module et l'argument de l'inconnue sont calcules separement.
  71. *la solution est unique grace a la fonction atan2 qui renvoie
  72. *l'argument dans le bon cadran
  73.  
  74. ****************************
  75. *** PROBLEME QUADRATIQUE ***
  76. ****************************
  77.  
  78. IF (QUAD) THEN
  79.  
  80. * frequence connue: on calcule la valeur propre
  81. IF (SENS .EQ. 1) THEN
  82. VPROPR=2.D0*XPI*J*FREQ
  83.  
  84. * valeur propre connue: on calcule la frequence
  85. ELSEIF (SENS .EQ. 2) THEN
  86. FREQ=VPROPR/(2.D0*XPI*J)
  87.  
  88. ELSE
  89. CALL ERREUR(5)
  90.  
  91. ENDIF
  92.  
  93. *************************
  94. *** PROBLEME LINEAIRE ***
  95. *************************
  96. ELSE
  97.  
  98. * frequence connue: on calcule la valeur propre
  99. IF (SENS .EQ. 1) THEN
  100.  
  101. MODF=ABS(FREQ)
  102. THETAF=ATAN2(AIMAG(FREQ),REAL(FREQ))
  103.  
  104. MODV=(2.D0*XPI*MODF)**2
  105. THETAV=2.D0*THETAF
  106.  
  107. X=MODV*COS(THETAV)
  108. Y=MODV*SIN(THETAV)
  109.  
  110. VPROPR=CMPLX(X,Y)
  111.  
  112.  
  113. * valeur propre connue: on calcule la frequence
  114. ELSEIF (SENS .EQ. 2) THEN
  115.  
  116. MODV=ABS(VPROPR)
  117. THETAV=ATAN2(AIMAG(VPROPR),REAL(VPROPR))
  118.  
  119. MODF=SQRT(MODV)/(2.D0*XPI)
  120. THETAF=THETAV/2.D0
  121.  
  122. X=MODF*COS(THETAF)
  123. Y=MODF*SIN(THETAF)
  124.  
  125. FREQ=CMPLX(X,Y)
  126.  
  127. * valeur propre connue: on calcule la frequence avec convention
  128. * pour rester reel
  129. ELSEIF (SENS .EQ. 3) THEN
  130.  
  131. VRE=REAL(VPROPR)
  132. * on ne doit demander le sens 3 que pour des pb aux vp
  133. * hermitiens a valeurs propres reelles : on teste Im(lambda)=0
  134. THETA=ABS(AIMAG(VPROPR)/VRE)
  135. TOL=SQRT(XZPREC)
  136. IF(THETA.gt.TOL) CALL ERREUR(5)
  137. X=SQRT(ABS(VRE))/(2.D0*XPI)
  138. X=SIGN(X,VRE)
  139. FREQ=CMPLX(X,0.d0)
  140.  
  141.  
  142. ELSE
  143. CALL ERREUR(5)
  144.  
  145. ENDIF
  146.  
  147.  
  148. ENDIF
  149.  
  150. END
  151.  
  152.  
  153.  
  154.  

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