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

DGEEQU Example Program Data

  4                                         :Value of N

  1.80D+10   2.88D+10   2.05D+00  -8.90D+09
  5.25D+00  -2.95D+00  -9.50D-09  -3.80D+00
  1.58D+00  -2.69D+00  -2.90D-10  -1.04D+00
 -1.11D+00  -6.60D-01  -5.90D-11   8.00D-01 :End of matrix A

 DGEEQU Example Program Results

 Matrix A
               1            2            3            4
 1    1.8000E+10   2.8800E+10   2.0500E+00  -8.9000E+09
 2    5.2500E+00  -2.9500E+00  -9.5000E-09  -3.8000E+00
 3    1.5800E+00  -2.6900E+00  -2.9000E-10  -1.0400E+00
 4   -1.1100E+00  -6.6000E-01  -5.9000E-11   8.0000E-01

 ROWCND = 3.9E-11, COLCND = 1.8E-09, AMAX = 2.9E+10

 Row scale factors
    3.47E-11   1.90E-01   3.72E-01   9.01E-01

 Column scale factors
    1.00E+00   1.00E+00   5.53E+08   1.38E+00

 Scaled matrix
             1          2          3          4
 1      0.6250     1.0000     0.0393    -0.4269
 2      1.0000    -0.5619    -1.0000    -1.0000
 3      0.5874    -1.0000    -0.0596    -0.5341
 4     -1.0000    -0.5946    -0.0294     0.9957

    Program dgeequ_example

!     DGEEQU Example Program Text

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

!     .. Use Statements ..
      Use blas_interfaces, Only: dscal
      Use lapack_example_aux, Only: nagf_blas_ddscl, &
        nagf_file_print_matrix_real_gen
      Use lapack_interfaces, Only: dgeequ
      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 ..
      Real (Kind=dp), Allocatable :: a(:, :), c(:), r(:)
!     .. Intrinsic Procedures ..
      Intrinsic :: epsilon, radix, real, tiny
!     .. Executable Statements ..
      Write (nout, *) 'DGEEQU 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_real_gen('General', ' ', n, n, a, lda, &
        'Matrix A', ifail)
      Write (nout, *)

!     Compute row and column scaling factors

      Call dgeequ(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 dscal(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_ddscl(n, r, 1, a(1,j), 1)
          End Do

        Else

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

        End If

!       Print the scaled matrix
        ifail = 0
        Call nagf_file_print_matrix_real_gen('General', ' ', n, n, a, lda, &
          'Scaled matrix', 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