Télécharger arslur.eso

Retour à la liste

Numérotation des lignes :

  1. C ARSLUR SOURCE CB215821 16/04/15 21:15:03 8907
  2. SUBROUTINE ARSLUR (IPRTRA,SIGMA,IPMAUP,QUAD,EPSI,INVER,
  3. & IPLVAR,IPLVER)
  4.  
  5. ************************************************************************
  6. *
  7. * A R S L U R
  8. *
  9. *
  10. *
  11. * FONCTION:
  12. * ---------
  13. *
  14. * CONSTRUCTION D'UN LISTREEL SOLUTION DES FREQUENCES ET D'UN MLCHPO
  15. * SOLUTION DES MODES CALCULES A PARTIR DES VARIABLES DE SORTIE
  16. * ARPACK
  17. *
  18. *
  19. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  20. * -----------
  21. *
  22. * IPRTRA ENTIER (E) POINTEUR DES OPERATEURS DE TRAVAIL
  23. *
  24. * SIGMA COMPLEX DP (E) VALEUR PROPRE DE SHIFT
  25. *
  26. * INVER LOGIQUE (E) .TRUE. -> PRODUIT SCALAIRE X'KX
  27. * .FALSE. -> PRODUIT SCALAIRE X'MX
  28. *
  29. * IPMAUP ENTIER (E) POINTEUR DES VARIABLES ARPACK
  30. *
  31. * QUAD LOGIQUE (E) PROBLEME QUADRATIQUE OU NON
  32. *
  33. * IPLVAR ENTIER (S) POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  34. * LA SUITE DES FREQUENCES PROPRES RELLES
  35. *
  36. * IPLVER ENTIER (S) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  37. * LA SUITE DES MODES PROPRES REELS
  38. *
  39. * SOUS-PROGRAMMES APPELES:
  40. * ------------------------
  41. *
  42. * MOTS1,MAXIM1,VCH1,ARPSHI,NORMA1,ARPVER
  43. *
  44. *
  45. * AUTEUR, DATE DE CREATION:
  46. * -------------------------
  47. *
  48. * PASCAL BOUDA 11 JUILLET 2015
  49. *
  50. ************************************************************************
  51.  
  52. IMPLICIT INTEGER(I-N)
  53. IMPLICIT REAL*8 (A-H,O-Z)
  54.  
  55. -INC CCOPTIO
  56. -INC SMRIGID
  57. -INC SMVECTD
  58. -INC SMLCHPO
  59. -INC SMLREEL
  60. -INC TARWORK
  61.  
  62.  
  63.  
  64. INTEGER IPRTRA
  65. COMPLEX*16 SIGMA
  66. LOGICAL INVER
  67. INTEGER IPMAUP
  68. LOGICAL QUAD
  69. INTEGER IPLVAR
  70. INTEGER IPLVER
  71.  
  72. INTEGER IPCHO
  73. INTEGER IPVEC
  74. INTEGER IPMODE
  75. INTEGER IPLMOT
  76. INTEGER MOTCLE
  77. INTEGER IPMONO
  78. INTEGER TYPRO
  79. REAL*8 MAXVAL
  80. INTEGER N
  81. COMPLEX*16 VSHIFT,FSHIFT
  82.  
  83. REAL*8 XMX
  84.  
  85. VSHIFT=CMPLX(0.D0,0.D0)
  86. FSHIFT=CMPLX(0.D0,0.D0)
  87.  
  88. MRITRA=IPRTRA
  89. SEGACT MRITRA
  90.  
  91. IPRIGI=RIGI(1)
  92.  
  93. MRIGID=IPRIGI
  94. SEGACT MRIGID
  95. IPCHO=ICHOLE
  96. SEGDES MRIGID
  97.  
  98. MAUP=IPMAUP
  99. SEGACT MAUP
  100. *Dimension du probleme
  101. N=v(/1)
  102.  
  103. *Initialisation de la taille du mlchpo et du listreeel
  104. JG=nev
  105. SEGINI MLREEL
  106. N1=nev
  107. SEGINI MLCHPO
  108.  
  109.  
  110. *Boucle sur le nombre de modes propres calcules
  111. DO i=1,nev
  112.  
  113. *On recupere la valeur propre (reelle) de shift, on la transforme en
  114. *shift "frequence" et on la stocke
  115. VSHIFT=CMPLX(dr(i),REAL(0.D0))
  116.  
  117. IF (IIMPI .GT. 2) THEN
  118. WRITE(IOIMP,*) 'Valeur propre',VSHIFT
  119. ENDIF
  120.  
  121. CALL ARPSHI (FSHIFT,VSHIFT,QUAD,INVER,2)
  122. PROG(i)=REAL(FSHIFT)
  123.  
  124. INC=N
  125. SEGINI MVECTD
  126. *Recuperation du vecteur propre reel
  127. DO j=1,N
  128. VECTBB(j)=v(j,i)
  129. ENDDO
  130.  
  131. IPVEC=MVECTD
  132. SEGDES MVECTD
  133. *Transformation en chpoint
  134. CALL VCH1 (IPCHO,IPVEC,IPMODE,IPRIGI)
  135. SEGSUP MVECTD
  136.  
  137.  
  138. *Calcul de la norme et du residu
  139. TYPRO=iparam(7)
  140. CALL ARPVER (IPRTRA,TYPRO,i,.FALSE.,.TRUE.,
  141. & EPSI,INVER,IPMODE,0,VSHIFT)
  142.  
  143.  
  144. *La normalisation est impossible si le chpoint est nul
  145.  
  146. CALL MOTS1 (IPLMOT,MOTCLE)
  147. CALL MAXIM1 (IPMODE,IPLMOT,MOTCLE,0,MAXVAL)
  148.  
  149. IF (MAXVAL .EQ. REAL(0.D0)) THEN
  150. IPMONO=IPMODE
  151. ELSE
  152. CALL NORMA1 (IPMODE,IPLMOT,MOTCLE,IPMONO)
  153. ENDIF
  154.  
  155. ICHPOI(i)=IPMONO
  156.  
  157. ENDDO
  158.  
  159. IPLVAR=MLREEL
  160. SEGDES MLREEL
  161. IPLVER=MLCHPO
  162. SEGDES MLCHPO
  163. SEGDES MAUP
  164. SEGDES MRITRA
  165.  
  166. END
  167.  
  168.  
  169.  
  170.  

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