概要
本サンプルはFortran言語によりLAPACKルーチンZGEESを利用するサンプルプログラムです。
行列のSchur分解を行います。
入力データ
(本ルーチンの詳細は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