複素非対称固有値問題: 正方非対称行列 : (固有値と実シュール形)

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

概要

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

行列のSchur分解を行います。

\begin{displaymath}
A = \left(
\begin{array}{rrrr}
-3.97 - 5.04i & -4.11 + 3....
...81 - 1.59i & 3.25 + 1.33i & 1.57 - 3.44i
\end{array} \right).
\end{displaymath}

入力データ

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

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

  4                                                            :Value of N

(-3.97, -5.04)  (-4.11,  3.70)  (-0.34,  1.01)  ( 1.29, -0.86)
( 0.34, -1.50)  ( 1.52, -0.43)  ( 1.88, -5.38)  ( 3.36,  0.65)
( 3.31, -3.85)  ( 2.50,  3.45)  ( 0.88, -1.08)  ( 0.64, -1.48)
(-1.10,  0.82)  ( 1.81, -1.59)  ( 3.25,  1.33)  ( 1.57, -3.44) :End of matrix A

出力結果

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

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

 Matrix A
                    1                 2                 3                 4
 1  (-3.9700,-5.0400) (-4.1100, 3.7000) (-0.3400, 1.0100) ( 1.2900,-0.8600)
 2  ( 0.3400,-1.5000) ( 1.5200,-0.4300) ( 1.8800,-5.3800) ( 3.3600, 0.6500)
 3  ( 3.3100,-3.8500) ( 2.5000, 3.4500) ( 0.8800,-1.0800) ( 0.6400,-1.4800)
 4  (-1.1000, 0.8200) ( 1.8100,-1.5900) ( 3.2500, 1.3300) ( 1.5700,-3.4400)

 Eigenvalues
    1   (-6.0004,-6.9998)
    2   (-5.0000, 2.0060)
    3   ( 7.9982,-0.9964)
    4   ( 3.0023,-3.9998)

ソースコード

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

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

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

このソースコードをダウンロード
    Module zgees_mod

!     ZGEES Example Program Module:
!           Parameters and User-defined Routines

!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public :: select
    Contains
      Function select(w)
!       .. Use Statements ..
        Use lapack_precision, Only: dp
!       .. Implicit None Statement ..
        Implicit None
!       .. Function Return Value ..
        Logical :: select
!       .. Scalar Arguments ..
        Complex (Kind=dp), Intent (In) :: w
!       .. Intrinsic Procedures ..
        Intrinsic :: real
!       .. Executable Statements ..
        Continue

!       Dummy function - it is not called by ZGEES when sorting is not required.
        select = (real(w)>0._dp)

        Return
      End Function
    End Module
    Program zgees_example

!     ZGEES Example Program Text

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

!     .. Use Statements ..
      Use blas_interfaces, Only: zgemm
      Use lapack_example_aux, Only: nagf_file_print_matrix_complex_gen_comp
      Use lapack_interfaces, Only: zgees, zlange
      Use lapack_precision, Only: dp
      Use zgees_mod, Only: select
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter :: nb = 64, nin = 5, nout = 6
!     .. Local Scalars ..
      Complex (Kind=dp) :: alpha, beta
      Real (Kind=dp) :: norm
      Integer :: i, ifail, info, lda, ldc, ldd, ldvs, lwork, n, sdim
!     .. Local Arrays ..
      Complex (Kind=dp), Allocatable :: a(:, :), c(:, :), d(:, :), vs(:, :), &
        w(:), work(:)
      Complex (Kind=dp) :: wdum(1)
      Real (Kind=dp), Allocatable :: rwork(:)
      Logical :: dummy(1)
      Character (1) :: clabs(1), rlabs(1)
!     .. Intrinsic Procedures ..
      Intrinsic :: cmplx, epsilon, max, nint, real
!     .. Executable Statements ..
      Write (nout, *) 'ZGEES Example Program Results'
      Write (nout, *)
      Flush (nout)
!     Skip heading in data file
      Read (nin, *)
      Read (nin, *) n
      lda = n
      ldc = n
      ldd = n
      ldvs = n
      Allocate (a(lda,n), vs(ldvs,n), c(ldc,n), d(ldd,n), w(n), rwork(n))

!     Use routine workspace query to get optimal workspace.
      lwork = -1
      Call zgees('Vectors (Schur)', 'No sort', select, n, a, lda, sdim, w, vs, &
        ldvs, wdum, lwork, rwork, dummy, info)

!     Make sure that there is enough workspace for block size nb.
      lwork = max((nb+1)*n, nint(real(wdum(1))))
      Allocate (work(lwork))

!     Read in the matrix A
      Read (nin, *)(a(i,1:n), i=1, n)

!     Copy A into D
      d(1:n, 1:n) = a(1:n, 1:n)

!     Print matrix A
!     ifail: behaviour on error exit
!            =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
      ifail = 0
      Call nagf_file_print_matrix_complex_gen_comp('General', ' ', n, n, a, &
        lda, 'Bracketed', 'F7.4', 'Matrix A', 'Integer', rlabs, 'Integer', &
        clabs, 80, 0, ifail)

      Write (nout, *)
      Flush (nout)

!     Find the Schur factorization of A
      Call zgees('Vectors (Schur)', 'No sort', select, n, a, lda, sdim, w, vs, &
        ldvs, work, lwork, rwork, dummy, info)

      If (info>0) Then
        Write (nout, 100) 'Failure in ZGEES. INFO =', info
      Else

!       Compute A - Z*T*Z^H from the factorization of A and store in matrix D
        alpha = cmplx(1, kind=dp)
        beta = cmplx(0, kind=dp)
        Call zgemm('N', 'N', n, n, n, alpha, vs, ldvs, a, lda, beta, c, ldc)
        alpha = cmplx(-1, kind=dp)
        beta = cmplx(1, kind=dp)
        Call zgemm('N', 'C', n, n, n, alpha, c, ldc, vs, ldvs, beta, d, ldd)

!       Find norm of matrix D and print warning if it is too large
        norm = zlange('O', ldd, n, d, ldd, rwork)
        If (norm>epsilon(1.0E0_dp)**0.5_dp) Then
          Write (nout, *) 'Norm of A-(Z*T*Z^H) is much greater than 0.'
          Write (nout, *) 'Schur factorization has failed.'
        Else
!         Print eigenvalues.
          Write (nout, *) 'Eigenvalues'
          Write (nout, 110)(i, w(i), i=1, n)
        End If
      End If

100   Format (1X, A, I4)
110   Format (1X, I4, 2X, ' (', F7.4, ',', F7.4, ')', :)
    End Program


ご案内
関連情報
© 譌・譛ャ繝九Η繝シ繝。繝ェ繧ォ繝ォ繧「繝ォ繧エ繝ェ繧コ繝�繧コ繧ー繝ォ繝シ繝玲�ェ蠑丈シ夂、セ 2025
Privacy Policy  /  Trademarks