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

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

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

概要

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

入力データ

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

このデータをダウンロード
ZGEEQU Example Program Data

  3                                                             :Value of N

 (-1.34D+00, 2.55D+00) ( 0.28D+10, 3.17D+10) (-6.39D+00,-2.20D+00)
 (-1.70D+00,-1.41D+00) ( 3.31D+10,-0.15D+10) (-0.15D+00, 1.34D+00)
 ( 2.41D-10, 0.39D-10) (-0.56D+00, 1.47D+00) (-0.83D-10,-0.69D-10)

                                                                :End of matrix A

出力結果

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

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

 Matrix A
                          1                       2                       3
 1  ( -1.34E+00,  2.55E+00) (  2.80E+09,  3.17E+10) ( -6.39E+00, -2.20E+00)
 2  ( -1.70E+00, -1.41E+00) (  3.31E+10, -1.50E+09) ( -1.50E-01,  1.34E+00)
 3  (  2.41E-10,  3.90E-11) ( -5.60E-01,  1.47E+00) ( -8.30E-11, -6.90E-11)

 ROWCND = 5.9E-11, COLCND = 1.4E-10, AMAX = 3.5E+10

 Row scale factors
    2.90E-11   2.89E-11   4.93E-01

 Column scale factors
    7.25E+09   1.00E+00   4.02E+09

 Scaled matrix
                      1                   2                   3
 1  ( -0.2816,  0.5359) (  0.0812,  0.9188) ( -0.7439, -0.2561)
 2  ( -0.3562, -0.2954) (  0.9566, -0.0434) ( -0.0174,  0.1555)
 3  (  0.8607,  0.1393) ( -0.2759,  0.7241) ( -0.1642, -0.1365)

ソースコード

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

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


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

!     ZGEEQU 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: zgeequ
      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, colcnd, rowcnd, small
      Integer :: i, ifail, info, j, lda, n
!     .. Local Arrays ..
      Complex (Kind=dp), Allocatable :: a(:, :)
      Real (Kind=dp), Allocatable :: c(:), r(:)
      Character (1) :: clabs(1), rlabs(1)
!     .. Intrinsic Procedures ..
      Intrinsic :: epsilon, radix, real, tiny
!     .. Executable Statements ..
      Write (nout, *) 'ZGEEQU Example Program Results'
      Write (nout, *)
      Flush (nout)
!     Skip heading in data file
      Read (nin, *)
      Read (nin, *) n
      lda = n
      Allocate (a(lda,n), c(n), r(n))

!     Read the N by N matrix A from data file

      Read (nin, *)(a(i,1: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('General', ' ', n, n, a, &
        lda, 'Bracketed', '1P,E10.2', 'Matrix A', 'Integer', rlabs, 'Integer', &
        clabs, 80, 0, ifail)

      Write (nout, *)

!     Compute row and column scaling factors

      Call zgeequ(n, n, a, lda, r, c, rowcnd, colcnd, amax, info)

      If (info>0) Then
        If (info<=n) Then
          Write (nout, 100) 'Row ', info, ' of A is exactly zero'
        Else
          Write (nout, 100) 'Column ', info - n, ' of A is exactly zero'
        End If
      Else

!       Print ROWCND, COLCND, AMAX and the scale factors

        Write (nout, 110) 'ROWCND =', rowcnd, ', COLCND =', colcnd, &
          ', AMAX =', amax
        Write (nout, *)
        Write (nout, *) 'Row scale factors'
        Write (nout, 120) r(1:n)
        Write (nout, *)
        Write (nout, *) 'Column scale factors'
        Write (nout, 120) c(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 ((rowcnd>=thresh) .And. (amax>=small) .And. (amax<=big)) Then
          If (colcnd<thresh) Then

!           Just column scale A
            Do j = 1, n
              Call zdscal(n, c(j), a(1,j), 1)
            End Do

          End If
        Else If (colcnd>=thresh) Then

!         Just row scale A
          Do j = 1, n
            Call nagf_blas_zddscl(n, r, 1, a(1,j), 1)
          End Do

        Else

!         Row and column scale A
          Do j = 1, n
            Call zdscal(n, c(j), a(1,j), 1)
            Call nagf_blas_zddscl(n, r, 1, a(1,j), 1)
          End Do

        End If

!       Print the scaled matrix
        ifail = 0
        Call nagf_file_print_matrix_complex_gen_comp('General', ' ', n, n, a, &
          lda, 'Bracketed', ' ', 'Scaled matrix', 'Integer', rlabs, 'Integer', &
          clabs, 80, 0, ifail)

      End If

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


ご案内
関連情報
Privacy Policy  /  Trademarks