概要
本サンプルはFortran言語によりLAPACKルーチンZHEGVDを利用するサンプルプログラムです。
一般化エルミート固有値問題

及び


ZHEGVの例題プログラムは一般化エルミート固有値問題の解き方を示します。
入力データ
(本ルーチンの詳細はZHEGVD のマニュアルページを参照)1 2 3 4 5 6 7 8 9 10 11 12 13
このデータをダウンロード |
ZHEGVD Example Program Data 4 :Value of N (-7.36, 0.00) ( 0.77, -0.43) (-0.64, -0.92) ( 3.01, -6.97) ( 3.49, 0.00) ( 2.19, 4.45) ( 1.90, 3.73) ( 0.12, 0.00) ( 2.88, -3.17) (-2.54, 0.00) :End of matrix A ( 3.23, 0.00) ( 1.51, -1.92) ( 1.90, 0.84) ( 0.42, 2.50) ( 3.58, 0.00) (-0.23, 1.11) (-1.18, 1.37) ( 4.09, 0.00) ( 2.33, -0.14) ( 4.29, 0.00) :End of matrix B
出力結果
(本ルーチンの詳細はZHEGVD のマニュアルページを参照)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
この出力例をダウンロード |
ZHEGVD Example Program Results Eigenvalues -61.7321 -6.6195 0.0725 43.1883 Eigenvectors 1 2 3 4 1 0.3903 -0.1560 2.2909 -0.1943 0.0000 -0.0404 0.0000 -0.0690 2 -0.1814 -0.1552 -0.5042 0.3884 0.0114 -0.3651 -0.7120 0.0000 3 0.0438 0.5364 -1.2701 0.0657 0.0338 0.0000 -0.4547 -0.2095 4 -0.2221 -0.1298 0.5706 0.2924 -0.2272 -0.1880 1.3132 -0.0675 Estimate of reciprocal condition number for B 2.5E-03 Error estimates (relative to machine precision) for the eigenvalues: 2.4E+04 2.8E+03 2.3E+02 1.7E+04 for the eigenvectors: 4.7E+02 1.0E+03 1.0E+03 4.9E+02
ソースコード
(本ルーチンの詳細はZHEGVD のマニュアルページを参照)※本サンプルソースコードのご利用手順は「サンプルのコンパイル及び実行方法」をご参照下さい。
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 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
このソースコードをダウンロード |
Program zhegvd_example ! ZHEGVD 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 Use lapack_interfaces, Only: ddisna, zhegvd, zlanhe, ztrcon Use lapack_precision, Only: dp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Real (Kind=dp), Parameter :: one = 1.0E+0_dp Integer, Parameter :: nb = 64, nin = 5, nout = 6 ! .. Local Scalars .. Complex (Kind=dp) :: scal Real (Kind=dp) :: anorm, bnorm, eps, rcond, rcondb, t1, t2 Integer :: i, ifail, info, k, lda, ldb, liwork, lrwork, lwork, n ! .. Local Arrays .. Complex (Kind=dp), Allocatable :: a(:, :), b(:, :), work(:) Complex (Kind=dp) :: cdum(1) Real (Kind=dp), Allocatable :: eerbnd(:), rcondz(:), rwork(:), w(:), & zerbnd(:) Real (Kind=dp) :: rdum(1) Integer :: idum(1) Integer, Allocatable :: iwork(:) ! .. Intrinsic Procedures .. Intrinsic :: abs, conjg, epsilon, max, maxloc, nint, real ! .. Executable Statements .. Write (nout, *) 'ZHEGVD Example Program Results' Write (nout, *) ! Skip heading in data file Read (nin, *) Read (nin, *) n lda = n ldb = n Allocate (a(lda,n), b(ldb,n), eerbnd(n), rcondz(n), w(n), zerbnd(n)) ! Use routine workspace query to get optimal workspace. lwork = -1 liwork = -1 lrwork = -1 Call zhegvd(2, 'Vectors', 'Upper', n, a, lda, b, ldb, w, cdum, lwork, & rdum, lrwork, idum, liwork, info) ! Make sure that there is enough workspace for block size nb. lwork = max((nb+2+n)*n, nint(real(cdum(1)))) lrwork = max(1+(5+2*n)*n, nint(rdum(1))) liwork = max(3+5*n, idum(1)) Allocate (work(lwork), rwork(lrwork), iwork(liwork)) ! Read the upper triangular parts of the matrices A and B Read (nin, *)(a(i,i:n), i=1, n) Read (nin, *)(b(i,i:n), i=1, n) ! Compute the one-norms of the symmetric matrices A and B anorm = zlanhe('One norm', 'Upper', n, a, lda, rwork) bnorm = zlanhe('One norm', 'Upper', n, b, ldb, rwork) ! Solve the generalized Hermitian eigenvalue problem ! A*B*x = lambda*x (itype = 2) Call zhegvd(2, 'Vectors', 'Upper', n, a, lda, b, ldb, w, work, lwork, & rwork, lrwork, iwork, liwork, info) If (info==0) Then ! Print solution Write (nout, *) 'Eigenvalues' Write (nout, 100) w(1:n) Flush (nout) ! Normalize the eigenvectors, largest element real Do i = 1, n rwork(1:n) = abs(a(1:n,i)) k = maxloc(rwork(1:n), 1) scal = conjg(a(k,i))/abs(a(k,i)) a(1:n, i) = a(1:n, i)*scal End Do ! 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('General', ' ', n, n, a, lda, & 'Eigenvectors', ifail) ! Call ZTRCON to estimate the reciprocal condition ! number of the Cholesky factor of B. Note that: ! cond(B) = 1/rcond**2 Call ztrcon('One norm', 'Upper', 'Non-unit', n, b, ldb, rcond, work, & rwork, info) ! Print the reciprocal condition number of B rcondb = rcond**2 Write (nout, *) Write (nout, *) 'Estimate of reciprocal condition number for B' Write (nout, 110) rcondb Flush (nout) ! Get the machine precision, eps, and if rcondb is not less ! than eps**2, compute error estimates for the eigenvalues and ! eigenvectors eps = epsilon(1.0E0_dp) If (rcond>=eps) Then ! Call DDISNA to estimate reciprocal condition ! numbers for the eigenvectors of (A*B - lambda*I) Call ddisna('Eigenvectors', n, n, w, rcondz, info) ! Compute the error estimates for the eigenvalues and ! eigenvectors t1 = one/rcond t2 = anorm*bnorm Do i = 1, n eerbnd(i) = (t2+abs(w(i))/rcondb) zerbnd(i) = t1*(t2/rcondz(i)+t1) End Do ! Print the approximate error bounds for the eigenvalues ! and vectors Write (nout, *) Write (nout, *) 'Error estimates (relative to machine precision)' Write (nout, *) 'for the eigenvalues:' Write (nout, 110) eerbnd(1:n) Write (nout, *) Write (nout, *) 'for the eigenvectors:' Write (nout, 110) zerbnd(1:n) Else Write (nout, *) Write (nout, *) 'B is very ill-conditioned, error ', & 'estimates have not been computed' End If Else If (info>n) Then i = info - n Write (nout, 120) 'The leading minor of order ', i, & ' of B is not positive definite' Else Write (nout, 130) 'Failure in ZHEGVD. INFO =', info End If 100 Format (3X, (6F11.4)) 110 Format (4X, 1P, 6E11.1) 120 Format (1X, A, I4, A) 130 Format (1X, A, I4) End Program