概要
本サンプルはFortran言語によりLAPACKルーチンZTGSENを利用するサンプルプログラムです。
入力データ
（本ルーチンの詳細はZTGSEN のマニュアルページを参照）| このデータをダウンロード |
ZTGSEN Example Program Data 4 :Value of N ( 4.0, 4.0) ( 1.0, 1.0) ( 1.0, 1.0) ( 2.0,-1.0) ( 0.0, 0.0) ( 2.0, 1.0) ( 1.0, 1.0) ( 1.0, 1.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 2.0,-1.0) ( 1.0, 1.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 6.0,-2.0) :End of matrix A ( 2.0, 0.0) ( 1.0, 1.0) ( 1.0, 1.0) ( 3.0,-1.0) ( 0.0, 0.0) ( 1.0, 0.0) ( 2.0, 1.0) ( 1.0, 1.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 1.0, 0.0) ( 1.0, 1.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 2.0, 0.0) :End of matrix B ( 1.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 1.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 1.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 1.0, 0.0) :End of matrix Q ( 1.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 1.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 1.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 0.0, 0.0) ( 1.0, 0.0) :End of matrix Z F T T F :End of SELECT
出力結果
（本ルーチンの詳細はZTGSEN のマニュアルページを参照）| この出力例をダウンロード |
ZTGSEN Example Program Results
Reordered Schur matrix A
1 2 3 4
1 ( 4.6904, 2.3452) (-2.1563, 0.1192) ( 1.9599,-0.5174) ( 1.8091,-1.2060)
2 ( 0.0000, 0.0000) ( 2.0084,-1.0042) ( 0.9161,-0.2762) ( 1.8574,-0.5326)
3 ( 0.0000, 0.0000) ( 0.0000, 0.0000) ( 1.6985, 1.6985) ( 0.1270, 0.7231)
4 ( 0.0000, 0.0000) ( 0.0000, 0.0000) ( 0.0000, 0.0000) ( 6.0000,-2.0000)
Reordered Schur matrix B
1 2 3 4
1 ( 2.3452, 0.0000) (-0.6181, 1.8237) ( 0.9290, 0.5409) ( 2.7136,-1.5076)
2 ( 0.0000, 0.0000) ( 1.0042, 0.0000) ( 1.2251,-1.1857) ( 1.8541,-0.2929)
3 ( 0.0000, 0.0000) ( 0.0000, 0.0000) ( 0.8492, 0.0000) ( 0.1435, 0.9053)
4 ( 0.0000, 0.0000) ( 0.0000, 0.0000) ( 0.0000, 0.0000) ( 2.0000, 0.0000)
Basis of left deflating invariant subspace
1 2
1 ( 0.9045, 0.3015) (-0.0033,-0.2397)
2 ( 0.3015, 0.0000) ( 0.2497, 0.7157)
3 ( 0.0000, 0.0000) ( 0.0549, 0.6042)
4 ( 0.0000, 0.0000) ( 0.0000, 0.0000)
Basis of right deflating invariant subspace
1 2
1 ( 0.7071, 0.0000) (-0.5607, 0.0000)
2 ( 0.7071, 0.0000) ( 0.5607, 0.0000)
3 ( 0.0000, 0.0000) ( 0.0552, 0.6067)
4 ( 0.0000, 0.0000) ( 0.0000, 0.0000)
Norm estimate of projection onto left eigenspace for selected cluster
8.90E+00
Norm estimate of projection onto right eigenspace for selected cluster
7.02E+00
F-norm based upper bound on Difu
2.18E-01
F-norm based upper bound on Difl
2.62E-01
ソースコード
（本ルーチンの詳細はZTGSEN のマニュアルページを参照）※本サンプルソースコードのご利用手順は「サンプルのコンパイル及び実行方法」をご参照下さい。
| このソースコードをダウンロード |
Program ztgsen_example
! ZTGSEN Example Program Text
! Copyright 2017, Numerical Algorithms Group Ltd. http://www.nag.com
! .. Use Statements ..
Use lapack_example_aux, Only: nagf_file_print_matrix_complex_gen_comp
Use lapack_interfaces, Only: ztgsen
Use lapack_precision, Only: dp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Real (Kind=dp) :: pl, pr
Integer :: i, ifail, ijob, info, lda, ldb, ldq, ldz, liwork, lwork, m, n
Logical :: wantq, wantz
! .. Local Arrays ..
Complex (Kind=dp), Allocatable :: a(:, :), alpha(:), b(:, :), beta(:), &
q(:, :), work(:), z(:, :)
Real (Kind=dp) :: dif(2)
Integer, Allocatable :: iwork(:)
Logical, Allocatable :: select(:)
Character (1) :: clabs(1), rlabs(1)
! .. Executable Statements ..
Write (nout, *) 'ZTGSEN Example Program Results'
Write (nout, *)
Flush (nout)
! Skip heading in data file
Read (nin, *)
Read (nin, *) n
lda = n
ldb = n
ldq = n
ldz = n
liwork = (n*n)/2 + 2
lwork = n*n
Allocate (a(lda,n), alpha(n), b(ldb,n), beta(n), q(ldq,n), work(lwork), &
z(ldz,n), iwork(liwork), select(n))
! Read A, B, Q, Z and the logical array SELECT from data file
Read (nin, *)(a(i,1:n), i=1, n)
Read (nin, *)(b(i,1:n), i=1, n)
Read (nin, *)(q(i,1:n), i=1, n)
Read (nin, *)(z(i,1:n), i=1, n)
Read (nin, *) select(1:n)
! Set ijob, wantq and wantz
ijob = 4
wantq = .True.
wantz = .True.
! Reorder the Schur factors A and B and update the matrices
! Q and Z
Call ztgsen(ijob, wantq, wantz, select, n, a, lda, b, ldb, alpha, beta, &
q, ldq, z, ldz, m, pl, pr, dif, work, lwork, iwork, liwork, info)
If (info/=0) Then
Write (nout, 100) info
Write (nout, *)
Flush (nout)
End If
! Print reordered generalized Schur form
! 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', 'Reordered Schur matrix A', 'Integer', &
rlabs, 'Integer', clabs, 80, 0, ifail)
Write (nout, *)
Flush (nout)
ifail = 0
Call nagf_file_print_matrix_complex_gen_comp('General', ' ', n, n, b, &
ldb, 'Bracketed', 'F7.4', 'Reordered Schur matrix B', 'Integer', &
rlabs, 'Integer', clabs, 80, 0, ifail)
! Print deflating subspaces
Write (nout, *)
Flush (nout)
ifail = 0
Call nagf_file_print_matrix_complex_gen_comp('General', ' ', n, m, q, &
ldq, 'Bracketed', 'F7.4', 'Basis of left deflating invariant subspace' &
, 'Integer', rlabs, 'Integer', clabs, 80, 0, ifail)
Write (nout, *)
Flush (nout)
ifail = 0
Call nagf_file_print_matrix_complex_gen_comp('General', ' ', n, m, z, &
ldz, 'Bracketed', 'F7.4', &
'Basis of right deflating invariant subspace', 'Integer', rlabs, &
'Integer', clabs, 80, 0, ifail)
! Print norm estimates and F-norm upper bounds
Write (nout, *)
Write (nout, 110) 'Norm estimate of projection onto', &
' left eigenspace for selected cluster', 1.0E0_dp/pl
Write (nout, *)
Write (nout, 110) 'Norm estimate of projection onto', &
' right eigenspace for selected cluster', 1.0E0_dp/pr
Write (nout, *)
Write (nout, 110) 'F-norm based upper bound on', ' Difu', dif(1)
Write (nout, *)
Write (nout, 110) 'F-norm based upper bound on', ' Difl', dif(2)
100 Format (' Reordering could not be completed. INFO = ', I3)
110 Format (1X, 2A, /, 1X, 1P, E10.2)
End Program