計算ルーチン: 複素エルミート正定値行列の平衡化と条件数を小さくする目的で行と列のスケーリングを計算する

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

ホーム > LAPACKサンプルプログラム目次 > 計算ルーチン > 複素エルミート正定値行列の平衡化と条件数を小さくする目的で行と列のスケーリングを計算する

概要

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

入力データ

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

このデータをダウンロード
ZPOEQU Example Program Data
   4                                                            :Value of N
 ( 3.23, 0.00) ( 1.51,-1.92) ( 1.90D+05, 0.84D+05) ( 0.42D+00, 2.50D+00)
               ( 3.58, 0.00) (-0.23D+05, 1.11D+05) (-1.18D+00, 1.37D+00)
                             ( 4.09D+10, 0.00D+00) ( 2.33D+05,-0.14D+05)
                                                   ( 4.29D+00, 0.00D+00)
                                                                :End of matrix A

出力結果

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

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

 Matrix A
                          1                       2                       3
 1  (  3.23E+00,  0.00E+00) (  1.51E+00, -1.92E+00) (  1.90E+05,  8.40E+04)
 2                          (  3.58E+00,  0.00E+00) ( -2.30E+04,  1.11E+05)
 3                                                  (  4.09E+10,  0.00E+00)
 4
 
                          4
 1  (  4.20E-01,  2.50E+00)
 2  ( -1.18E+00,  1.37E+00)
 3  (  2.33E+05, -1.40E+04)
 4  (  4.29E+00,  0.00E+00)

 SCOND = 8.9E-06, AMAX = 4.1E+10

 Diagonal scaling factors
     5.6E-01    5.3E-01    4.9E-06    4.8E-01

 Scaled matrix
                      1                   2                   3
 1  (  1.0000,  0.0000) (  0.4441, -0.5646) (  0.5227,  0.2311)
 2                      (  1.0000,  0.0000) ( -0.0601,  0.2901)
 3                                          (  1.0000,  0.0000)
 4
 
                      4
 1  (  0.1128,  0.6716)
 2  ( -0.3011,  0.3496)
 3  (  0.5562, -0.0334)
 4  (  1.0000,  0.0000)

ソースコード

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

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


このソースコードをダウンロード
    Program zpoequ_example

!     ZPOEQU Example Program Text

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

!     .. Use Statements ..
      Use blas_interfaces, Only: zdscal
      Use lapack_example_aux, Only: nagf_blas_zddscl, &
        nagf_file_print_matrix_complex_gen_comp
      Use lapack_interfaces, Only: zpoequ
      Use lapack_precision, Only: dp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Real (Kind=dp), Parameter :: one = 1.0_dp
      Real (Kind=dp), Parameter :: thresh = 0.1_dp
      Integer, Parameter :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=dp) :: amax, big, scond, small
      Integer :: i, ifail, info, j, lda, n
!     .. Local Arrays ..
      Complex (Kind=dp), Allocatable :: a(:, :)
      Real (Kind=dp), Allocatable :: s(:)
      Character (1) :: clabs(1), rlabs(1)
!     .. Intrinsic Procedures ..
      Intrinsic :: epsilon, radix, real, tiny
!     .. Executable Statements ..
      Write (nout, *) 'ZPOEQU Example Program Results'
      Write (nout, *)
      Flush (nout)
!     Skip heading in data file
      Read (nin, *)
      Read (nin, *) n
      lda = n
      Allocate (a(lda,n), s(n))

!     Read the upper triangular part of the matrix A from data file

      Read (nin, *)(a(i,i:n), i=1, n)

!     Print the 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('Upper', 'Non-unit', n, n, &
        a, lda, 'Bracketed', '1P,E10.2', 'Matrix A', 'Integer', rlabs, &
        'Integer', clabs, 80, 0, ifail)

      Write (nout, *)

!     Compute diagonal scaling factors

      Call zpoequ(n, a, lda, s, scond, amax, info)

      If (info>0) Then
        Write (nout, 100) 'Diagonal element', info, ' of A is non positive'
      Else

!       Print SCOND, AMAX and the scale factors

        Write (nout, 110) 'SCOND =', scond, ', AMAX =', amax
        Write (nout, *)
        Write (nout, *) 'Diagonal scaling factors'
        Write (nout, 120) s(1:n)
        Write (nout, *)
        Flush (nout)

!       Compute values close to underflow and overflow

        small = tiny(1.0E0_dp)/(epsilon(1.0E0_dp)*real(radix(1.0E0_dp),kind=dp &
          ))
        big = one/small
        If ((scond<thresh) .Or. (amax<small) .Or. (amax>big)) Then

!         Scale A
          Do j = 1, n
            Call zdscal(j, s(j), a(1,j), 1)
            Call nagf_blas_zddscl(j, s, 1, a(1,j), 1)
          End Do

!         Print the scaled matrix

          ifail = 0
          Call nagf_file_print_matrix_complex_gen_comp('Upper', 'Non-unit', n, &
            n, a, lda, 'Bracketed', 'F8.4', 'Scaled matrix', 'Integer', rlabs, &
            'Integer', clabs, 80, 0, ifail)

        End If
      End If

100   Format (1X, A, I4, A)
110   Format (1X, 2(A,1P,E8.1))
120   Format ((1X,1P,7E11.1))
    End Program


ご案内
関連情報
Privacy Policy  /  Trademarks