Télécharger la plaquette Cast3M


fr en

Télécharger arpshi.eso

Retour à la liste

Numérotation des lignes : 

arpshi

  1. C ARPSHI    SOURCE    CB215821  25/04/08    21:15:03     12227          
  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,RFREQ,RVPROP,RIMAG,RPROP
  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.           RFREQ = REAL(FREQ)
  105.           RIMAG = AIMAG(FREQ)
  106.           THETAF=ATAN2(RIMAG,RFREQ)
  107.  
  108.           MODV=(2.D0*XPI*MODF)**2
  109.           THETAV=2.D0*THETAF
  110.  
  111.           X=MODV*COS(THETAV)
  112.           Y=MODV*SIN(THETAV)
  113.  
  114.           VPROPR=CMPLX(X,Y)
  115.  
  116.  
  117. *       valeur propre connue: on calcule la frequence
  118.         ELSEIF (SENS .EQ. 2) THEN
  119.  
  120.           MODV=ABS(VPROPR)
  121.           RPROP = REAL(VPROPR)
  122.           RIMAG = AIMAG(VPROPR)
  123.           THETAV= ATAN2(RIMAG,RPROP  )
  124.  
  125.           MODF=SQRT(MODV)/(2.D0*XPI)
  126.           THETAF=THETAV/2.D0
  127.  
  128.           X=MODF*COS(THETAF)
  129.           Y=MODF*SIN(THETAF)
  130.  
  131.           FREQ=CMPLX(X,Y)
  132.  
  133. *       valeur propre connue: on calcule la frequence avec convention
  134. *       pour rester reel
  135.         ELSEIF (SENS .EQ. 3) THEN
  136.  
  137.           VRE=REAL(VPROPR)
  138. *         on ne doit demander le sens 3 que pour des pb aux vp
  139. *         hermitiens a valeurs propres reelles : on teste Im(lambda)=0
  140.           THETA=ABS(AIMAG(VPROPR)/VRE)
  141.           TOL=SQRT(XZPREC)
  142.           IF(THETA.gt.TOL) CALL ERREUR(5)
  143.           X=SQRT(ABS(VRE))/(2.D0*XPI)
  144.           X=SIGN(X,VRE)
  145.           FREQ=CMPLX(X,0.d0)
  146.  
  147.  
  148.         ELSE        
  149.           CALL ERREUR(5)
  150.  
  151.         ENDIF
  152.  
  153.  
  154.       ENDIF
  155.  
  156.       END
  157.  
  158.  
  159.  
  160.  
  161.  

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