実対称固有値問題: 対称行列 : (Relatively Robust Representations)

LAPACKサンプルソースコード : 使用ルーチン名:DSYEVR

概要

本サンプルはFortran言語によりLAPACKルーチンDSYEVRを利用するサンプルプログラムです。

対称行列の指標が $ [2, 3]$の範囲に含まれる固有値と対応する固有ベクトルを求めます。

\begin{displaymath}
A = \left(
\begin{array}{rrrr}
1 & 2 & 3 & 4 \\
2 & 2 &...
... 4 \\
3 & 3 & 3 & 4 \\
4 & 4 & 4 & 4
\end{array} \right).
\end{displaymath}

必要で利用されたワークスペースの情報も合わせて出力されます。

入力データ

(本ルーチンの詳細はDSYEVR のマニュアルページを参照)
1
2
3
4
5
6
7
8

このデータをダウンロード
DSYEVR Example Program Data

  4    2    3        :Values of N, IL and IU

  1.0  2.0  3.0  4.0
       2.0  3.0  4.0
            3.0  4.0
                 4.0 :End of matrix A

出力結果

(本ルーチンの詳細はDSYEVR のマニュアルページを参照)
1
2
3
4
5
6
7
8
9
10
11
12

この出力例をダウンロード
 DSYEVR Example Program Results

 Selected eigenvalues
    -0.5146 -0.2943
Warning: Floating invalid operation occurred
Warning: Floating divide by zero occurred
 Selected eigenvectors
          1       2
 1  -0.5144  0.2767
 2   0.4851 -0.6634
 3   0.5420  0.6504
 4  -0.4543 -0.2457

ソースコード

(本ルーチンの詳細はDSYEVR のマニュアルページを参照)

※本サンプルソースコードのご利用手順は「サンプルのコンパイル及び実行方法」をご参照下さい。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

このソースコードをダウンロード
    Program dsyevr_example

!     DSYEVR Example Program Text

!     Copyright 2017, Numerical Algorithms Group Ltd. http://www.nag.com

!     .. Use Statements ..
      Use lapack_example_aux, Only: nagf_file_print_matrix_real_gen
      Use lapack_interfaces, Only: dsyevr
      Use lapack_precision, Only: dp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Real (Kind=dp), Parameter :: zero = 0.0E+0_dp
      Integer, Parameter :: nb = 64, nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=dp) :: abstol, vl, vu
      Integer :: i, ifail, il, info, iu, lda, ldz, liwork, lwork, m, n
!     .. Local Arrays ..
      Real (Kind=dp), Allocatable :: a(:, :), w(:), work(:), z(:, :)
      Real (Kind=dp) :: dummy(1)
      Integer :: idum(1)
      Integer, Allocatable :: isuppz(:), iwork(:)
!     .. Intrinsic Procedures ..
      Intrinsic :: max, nint
!     .. Executable Statements ..
      Write (nout, *) 'DSYEVR Example Program Results'
      Write (nout, *)
!     Skip heading in data file and read N and the lower and upper
!     indices of the smallest and largest eigenvalues to be found
      Read (nin, *)
      Read (nin, *) n, il, iu
      lda = n
      ldz = n
      m = n
      Allocate (a(lda,n), w(n), z(ldz,m), isuppz(2*m))

!     Use routine workspace query to get optimal workspace.
      lwork = -1
      liwork = -1
      Call dsyevr('Vectors', 'I', 'Upper', n, a, lda, vl, vu, il, iu, abstol, &
        m, w, z, ldz, isuppz, dummy, lwork, idum, liwork, info)

!     Make sure that there is enough workspace for block size nb.
      lwork = max((nb+6)*n, nint(dummy(1)))
      liwork = max(10*n, idum(1))
      Allocate (work(lwork), iwork(liwork))

!     Read the upper triangular part of the matrix A from data file

      Read (nin, *)(a(i,i:n), i=1, n)

!     Set the absolute error tolerance for eigenvalues.  With ABSTOL
!     set to zero, the default value is used instead

      abstol = zero

!     Solve the symmetric eigenvalue problem
      Call dsyevr('Vectors', 'I', 'Upper', n, a, lda, vl, vu, il, iu, abstol, &
        m, w, z, ldz, isuppz, work, lwork, iwork, liwork, info)

      If (info==0) Then

!       Print solution

        Write (nout, *) 'Selected eigenvalues'
        Write (nout, 100) w(1:m)
        Flush (nout)

!       ifail: behaviour on error exit
!              =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
        ifail = 0
        Call nagf_file_print_matrix_real_gen('General', ' ', n, m, z, ldz, &
          'Selected eigenvectors', ifail)

      Else
        Write (nout, 110) 'Failure in DSYEVR. INFO =', info
      End If

100   Format (3X, (8F8.4))
110   Format (1X, A, I5)
    End Program


ご案内
関連情報
© 日本ニューメリカルアルゴリズムズグループ株式会社 2024
Privacy Policy  /  Trademarks