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.  
  49. -INC PPARAM
  50. -INC CCOPTIO
  51. -INC CCREEL
  52.  
  53. COMPLEX*16 FREQ
  54. COMPLEX*16 VPROPR
  55. LOGICAL QUAD
  56. INTEGER SENS
  57.  
  58. REAL*8 MODV,MODF,THETAV,THETAF
  59. REAL*8 X,Y,VRE
  60. COMPLEX*16 ZERO,J
  61.  
  62. ZERO=CMPLX(0.D0,0.D0)
  63. J=CMPLX(0.D0,1.D0)
  64.  
  65.  
  66. *on utilise la notation exponentielle pour faciliter les calculs
  67. *l'objectif est de calculer
  68. *
  69. * - lambda=(2*pi*f)^2 si le problemeest lineaire*
  70. * - lambda=jw=j*(2*pi*f) si le probleme est quadratique
  71. *
  72. *le module et l'argument de l'inconnue sont calcules separement.
  73. *la solution est unique grace a la fonction atan2 qui renvoie
  74. *l'argument dans le bon cadran
  75.  
  76. ****************************
  77. *** PROBLEME QUADRATIQUE ***
  78. ****************************
  79.  
  80. IF (QUAD) THEN
  81.  
  82. * frequence connue: on calcule la valeur propre
  83. IF (SENS .EQ. 1) THEN
  84. VPROPR=2.D0*XPI*J*FREQ
  85.  
  86. * valeur propre connue: on calcule la frequence
  87. ELSEIF (SENS .EQ. 2) THEN
  88. FREQ=VPROPR/(2.D0*XPI*J)
  89.  
  90. ELSE
  91. CALL ERREUR(5)
  92.  
  93. ENDIF
  94.  
  95. *************************
  96. *** PROBLEME LINEAIRE ***
  97. *************************
  98. ELSE
  99.  
  100. * frequence connue: on calcule la valeur propre
  101. IF (SENS .EQ. 1) THEN
  102.  
  103. MODF=ABS(FREQ)
  104. THETAF=ATAN2(AIMAG(FREQ),REAL(FREQ))
  105.  
  106. MODV=(2.D0*XPI*MODF)**2
  107. THETAV=2.D0*THETAF
  108.  
  109. X=MODV*COS(THETAV)
  110. Y=MODV*SIN(THETAV)
  111.  
  112. VPROPR=CMPLX(X,Y)
  113.  
  114.  
  115. * valeur propre connue: on calcule la frequence
  116. ELSEIF (SENS .EQ. 2) THEN
  117.  
  118. MODV=ABS(VPROPR)
  119. THETAV=ATAN2(AIMAG(VPROPR),REAL(VPROPR))
  120.  
  121. MODF=SQRT(MODV)/(2.D0*XPI)
  122. THETAF=THETAV/2.D0
  123.  
  124. X=MODF*COS(THETAF)
  125. Y=MODF*SIN(THETAF)
  126.  
  127. FREQ=CMPLX(X,Y)
  128.  
  129. * valeur propre connue: on calcule la frequence avec convention
  130. * pour rester reel
  131. ELSEIF (SENS .EQ. 3) THEN
  132.  
  133. VRE=REAL(VPROPR)
  134. * on ne doit demander le sens 3 que pour des pb aux vp
  135. * hermitiens a valeurs propres reelles : on teste Im(lambda)=0
  136. THETA=ABS(AIMAG(VPROPR)/VRE)
  137. TOL=SQRT(XZPREC)
  138. IF(THETA.gt.TOL) CALL ERREUR(5)
  139. X=SQRT(ABS(VRE))/(2.D0*XPI)
  140. X=SIGN(X,VRE)
  141. FREQ=CMPLX(X,0.d0)
  142.  
  143.  
  144. ELSE
  145. CALL ERREUR(5)
  146.  
  147. ENDIF
  148.  
  149.  
  150. ENDIF
  151.  
  152. END
  153.  
  154.  
  155.  
  156.  

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