概要
本サンプルはFortran言語によりLAPACKルーチンZHBGSTを利用するサンプルプログラムです。
入力データ
(本ルーチンの詳細はZHBGST のマニュアルページを参照)| このデータをダウンロード |
ZHBGST Example Program Data
4 2 1 :Values of N, KA and KB
'L' :Value of UPLO
(-1.13, 0.00)
( 1.94, 2.10) (-1.91, 0.00)
(-1.40,-0.25) (-0.82, 0.89) (-1.87, 0.00)
(-0.67,-0.34) (-1.10, 0.16) ( 0.50, 0.00) :End of matrix A
( 9.89, 0.00)
( 1.08, 1.73) ( 1.69, 0.00)
(-0.04,-0.29) ( 2.65, 0.00)
(-0.33,-2.24) ( 2.17, 0.00) :End of matrix B
出力結果
(本ルーチンの詳細はZHBGST のマニュアルページを参照)ソースコード
(本ルーチンの詳細はZHBGST のマニュアルページを参照)※本サンプルソースコードのご利用手順は「サンプルのコンパイル及び実行方法」をご参照下さい。
| このソースコードをダウンロード |
Program zhbgst_example
! ZHBGST Example Program Text
! Copyright 2017, Numerical Algorithms Group Ltd. http://www.nag.com
! .. Use Statements ..
Use lapack_interfaces, Only: dsterf, zhbgst, zhbtrd, zpbstf
Use lapack_precision, Only: dp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Integer :: i, info, j, ka, kb, ldab, ldbb, ldx, n
Character (1) :: uplo
! .. Local Arrays ..
Complex (Kind=dp), Allocatable :: ab(:, :), bb(:, :), work(:), x(:, :)
Real (Kind=dp), Allocatable :: d(:), e(:), rwork(:)
! .. Intrinsic Procedures ..
Intrinsic :: max, min
! .. Executable Statements ..
Write (nout, *) 'ZHBGST Example Program Results'
! Skip heading in data file
Read (nin, *)
Read (nin, *) n, ka, kb
ldab = ka + 1
ldbb = kb + 1
ldx = n
Allocate (ab(ldab,n), bb(ldbb,n), work(n), x(ldx,n), d(n), e(n-1), &
rwork(n))
! Read A and B from data file
Read (nin, *) uplo
If (uplo=='U') Then
Do i = 1, n
Read (nin, *)(ab(ka+1+i-j,j), j=i, min(n,i+ka))
End Do
Do i = 1, n
Read (nin, *)(bb(kb+1+i-j,j), j=i, min(n,i+kb))
End Do
Else If (uplo=='L') Then
Do i = 1, n
Read (nin, *)(ab(1+i-j,j), j=max(1,i-ka), i)
End Do
Do i = 1, n
Read (nin, *)(bb(1+i-j,j), j=max(1,i-kb), i)
End Do
End If
! Compute the split Cholesky factorization of B
Call zpbstf(uplo, n, kb, bb, ldbb, info)
Write (nout, *)
If (info>0) Then
Write (nout, *) 'B is not positive definite.'
Else
! Reduce the problem to standard form C*y = lambda*y, storing
! the result in A
Call zhbgst('N', uplo, n, ka, kb, ab, ldab, bb, ldbb, x, ldx, work, &
rwork, info)
! Reduce C to tridiagonal form T = (Q**H)*C*Q
Call zhbtrd('N', uplo, n, ka, ab, ldab, d, e, x, ldx, work, info)
! Calculate the eigenvalues of T (same as C)
Call dsterf(n, d, e, info)
If (info>0) Then
Write (nout, *) 'Failure to converge.'
Else
! Print eigenvalues
Write (nout, *) 'Eigenvalues'
Write (nout, 100) d(1:n)
End If
End If
100 Format (3X, (8F8.4))
End Program
