Télécharger arpack.eso

Retour à la liste

Numérotation des lignes :

  1. C ARPACK SOURCE BP208322 19/04/29 21:15:04 10213
  2. SUBROUTINE ARPACK (IPRIG1,IPRIG2,IPRIG3,IPSOLU,FSHIFT,NVAL,CHOIX,
  3. & INSYM,LAGDUA)
  4.  
  5. ************************************************************************
  6. *
  7. * A R P A C K
  8. * -----------
  9. *
  10. * SOUS-PROGRAMME ASSOCIE A L'OPTION "IRAM" DE L'OPERATEUR
  11. * "VIBRATION".
  12. *
  13. * FONCTION:
  14. * ---------
  15. *
  16. * DETERMINER UNE SERIE DE MODES PROPRES AVEC LA LIBRAIRIE ARPACK
  17. *
  18. *
  19. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  20. * -----------
  21. *
  22. *
  23. * IPRIG1 ENTIER (E) POINTEUR D'UN MRIGID
  24. *
  25. * IPRIG2 ENTIER (E) POINTEUR D'UN MRIGID
  26. *
  27. * IPRIG3 ENTIER (E) POINTEUR D'UN MRIGID
  28. *
  29. * IPSOLU ENTIER (S) POINTEUR OBJET SOLUTION
  30. *
  31. * FSHIFT COMPLEXE DP (E) FREQUENCE DE SHIFT
  32. *
  33. * NVAL ENTIER (E) NOMBRE DE MODES A CALCULER
  34. *
  35. * CHOIX CHAINE*2 (E) VALEURS PROPRES VOULUES
  36. * LM - VP DE MODULE MAX
  37. * SM - VP DE MODULE MIN
  38. * LR - VP DE PARTIE R MAX
  39. * SR - VP DE PARTIE R MIN
  40. * LI - VP DE PARTIE I MAX
  41. * SI - VP DE PARTIE I MIN
  42. * LA - VP MAX
  43. * SA - VP MIN
  44. * BE - VP DE CHAQUE COTE
  45. *
  46. * INSYM ENTIER (S) PROBLEME SYMETRIQUE OU NON
  47. *
  48. * LAGDUA ENTIER (E) NB DE M DE LAGRANGE DUALISES
  49. *
  50. * SOUS-PROGRAMMES APPELES:
  51. * ------------------------
  52. *
  53. * WHICH1,QZTRIR,NBINC,ACHECK,ARPSHI,ARPSOL,ARPSOQ
  54. *
  55. * AUTEUR, DATE DE CREATION:
  56. * -------------------------
  57. *
  58. * PASCAL BOUDA 29 JUIN 2015
  59. *
  60. * LANGAGE:
  61. * --------
  62. *
  63. * FORTRAN 77 & 90
  64. *
  65. ***********************************************************************
  66.  
  67. IMPLICIT INTEGER(I-N)
  68. IMPLICIT REAL*8 (A-H,O-Z)
  69.  
  70.  
  71. -INC PPARAM
  72. -INC CCOPTIO
  73. -INC SMRIGID
  74.  
  75. INTEGER IPRIG1
  76. INTEGER IPRIG2
  77. INTEGER IPRIG3
  78.  
  79. INTEGER LAGDUA
  80. INTEGER IPSOLU
  81. COMPLEX*16 FSHIFT
  82. INTEGER NVAL
  83. CHARACTER*2 CHOIX
  84. INTEGER INSYM
  85.  
  86. INTEGER IPRIGI
  87. INTEGER IPMASS
  88. INTEGER IPAMOR
  89. INTEGER NK,NM,NA
  90. LOGICAL FLAG
  91. LOGICAL INVER
  92. LOGICAL PIRE
  93. LOGICAL CHOLE
  94. REAL*8 EPSI
  95. COMPLEX*16 SIGMA,ZERO
  96. LOGICAL SYM
  97. LOGICAL QUAD
  98.  
  99. ZERO=CMPLX(0.D0,0.D0)
  100.  
  101. **********************************
  102. ** TOLERANCE SUR LES EIGENPAIRS **
  103. **********************************
  104.  
  105. EPSI=1.D-08
  106. c EPSI=1.D-10
  107.  
  108.  
  109. **********************************
  110.  
  111. *Identification du degre du probleme: lineaire, quadratique
  112. IF (IPRIG3 .EQ. 0) THEN
  113. QUAD=.FALSE.
  114. IF (IIMPI .GT. 2) THEN
  115. WRITE(IOIMP,*) 'LE PROBLEME EST LINEAIRE'
  116. ENDIF
  117. ELSE
  118. QUAD=.TRUE.
  119. IF (IIMPI .GT. 2) THEN
  120. WRITE(IOIMP,*) 'LE PROBLEME EST QUADRATIQUE'
  121. ENDIF
  122. ENDIF
  123.  
  124. *Determination de la matrice de masse, de rigidite et eventuellement
  125. *d'amortissement
  126. IF (.NOT. QUAD) THEN
  127. CALL WHICH1 (IPRIG1,IPRIG2,IPRIGI,IPMASS)
  128. IF (IERR .NE. 0) RETURN
  129. ELSE
  130. IPRIGI=IPRIG1
  131. IPMASS=IPRIG2
  132. IPAMOR=IPRIG3
  133. CALL QZTRIR (IPMASS,IPRIGI,IPAMOR)
  134. IF (IERR .NE. 0) RETURN
  135. ENDIF
  136. *Calcul du nombre d'inconnues + triangularisation si necessaire
  137. CALL NBINC (IPRIGI,NK)
  138. IF (IERR.NE.0) RETURN
  139. CALL NBINC (IPMASS,NM)
  140. IF (IERR.NE.0) RETURN
  141.  
  142. IF (QUAD) THEN
  143. CALL NBINC (IPAMOR,NA)
  144. IF (IERR.NE.0) RETURN
  145. ENDIF
  146. IF(IIMPI.GE.1) THEN
  147. WRITE(IOIMP,*) 'NOMBRE DE VALEURS PROPRES DEMANDEES=',NVAL
  148. WRITE(IOIMP,*) 'SHIFT EN FREQUENCE=', REAL(FSHIFT)
  149. ENDIF
  150.  
  151. *Verification de la solvabilite du probleme
  152. CALL ACHECK(IPRIGI,IPMASS,QUAD,SYM,FSHIFT,NK,FLAG,
  153. & INVER,PIRE,CHOLE,EPSI)
  154. IF (IERR.NE.0) RETURN
  155.  
  156. *Valeur du insym depend du type de probleme resolu
  157. IF (SYM) THEN
  158. INSYM=0
  159. IF (IIMPI.GE.1) WRITE(IOIMP,*) 'LE PROBLEME EST SYMETRIQUE'
  160. ELSE
  161. INSYM=1
  162. IF (IIMPI.GE.1) WRITE(IOIMP,*)'LE PROBLEME N EST PAS SYMETRIQUE'
  163. ENDIF
  164.  
  165. * Conversion du shift "frequence" en shift "valeur propre";
  166. CALL ARPSHI (FSHIFT,SIGMA,QUAD,1)
  167. IF (IERR.NE.0) RETURN
  168.  
  169. * 27/07/2015 : La resolution avec shift complexe n'est pas implementee
  170. * Mise a zero de la partie imaginaire du shift
  171. SIGMA=CMPLX(REAL(SIGMA),0.D0)
  172.  
  173. IF (FLAG) THEN
  174.  
  175. IF (.NOT. QUAD) THEN
  176. c RESOLUTION DU PB AUX VALEURS PROPRES LINEAIRE
  177. CALL ARPSOL (SIGMA,CHOIX,QUAD,NVAL,IPRIGI,IPMASS,LAGDUA,NK,NM,
  178. & INVER,PIRE,SYM,CHOLE,IPSOLU,EPSI)
  179.  
  180. ELSE
  181. c RESOLUTION DU PB AUX VALEURS PROPRES QUADRATIQUE
  182. CALL ARPSOQ (SIGMA,CHOIX,QUAD,NVAL,IPRIGI,IPMASS,IPAMOR,
  183. & LAGDUA,NK,NM,INVER,SYM,CHOLE,IPSOLU,EPSI)
  184. ENDIF
  185. IF (IERR.NE.0) RETURN
  186.  
  187. ENDIF
  188.  
  189. END
  190.  
  191.  
  192.  

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