計算ルーチン: 実値一般化シルベスター方程式を解く

DTGSYL Example Program Data
  4  4                        :Values of M and N
  4.0   1.0   1.0   2.0
  0.0   3.0   4.0   1.0
  0.0   1.0   3.0   1.0
  0.0   0.0   0.0   6.0   :End of matrix A
  1.0   1.0   1.0   1.0
  0.0   3.0   4.0   1.0
  0.0   1.0   3.0   1.0
  0.0   0.0   0.0   4.0   :End of matrix B
  2.0   1.0   1.0   3.0
  0.0   1.0   2.0   1.0
  0.0   0.0   1.0   1.0
  0.0   0.0   0.0   2.0   :End of matrix D
  1.0   1.0   1.0   2.0
  0.0   1.0   4.0   1.0
  0.0   0.0   1.0   1.0
  0.0   0.0   0.0   1.0   :End of matrix E
 -4.0   7.0   1.0  12.0
 -9.0   2.0  -2.0  -2.0
 -4.0   2.0  -2.0   8.0
 -7.0   7.0  -6.0  19.0   :End of matrix C
 -7.0   5.0   0.0   7.0
 -5.0   1.0  -8.0   0.0
 -1.0   2.0  -3.0   5.0
 -3.0   2.0   0.0   5.0   :End of matrix F

 DTGSYL Example Program Results

 Solution matrix R
             1          2          3          4
 1      1.0000     1.0000     1.0000     1.0000
 2     -1.0000     2.0000    -1.0000    -1.0000
 3     -1.0000     1.0000     3.0000     1.0000
 4     -1.0000     1.0000    -1.0000     4.0000

 Solution matrix L
             1          2          3          4
 1      4.0000    -1.0000     1.0000    -1.0000
 2      1.0000     3.0000    -1.0000     1.0000
 3     -1.0000     1.0000     2.0000    -1.0000
 4      1.0000    -1.0000     1.0000     1.0000

 SCALE =   1.00E+00

    Program dtgsyl_example

!     DTGSYL Example Program Text

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

!     .. Use Statements ..
      Use lapack_example_aux, Only: nagf_file_print_matrix_real_gen
      Use lapack_interfaces, Only: dtgsyl
      Use lapack_precision, Only: dp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=dp) :: dif, scale
      Integer :: i, ifail, ijob, info, lda, ldb, ldc, ldd, lde, ldf, lwork, m, &
        n
!     .. Local Arrays ..
      Real (Kind=dp), Allocatable :: a(:, :), b(:, :), c(:, :), d(:, :), &
        e(:, :), f(:, :), work(:)
      Integer, Allocatable :: iwork(:)
!     .. Executable Statements ..
      Write (nout, *) 'DTGSYL Example Program Results'
      Write (nout, *)
      Flush (nout)
!     Skip heading in data file
      Read (nin, *)
      Read (nin, *) m, n
      lda = m
      ldb = n
      ldc = m
      ldd = m
      lde = n
      ldf = m
      lwork = 1
      Allocate (a(lda,m), b(ldb,n), c(ldc,n), d(ldd,m), e(lde,n), f(ldf,n), &
        work(lwork), iwork(m+n+6))

!     Read A, B, D, E, C and F from data file

      Read (nin, *)(a(i,1:m), i=1, m)
      Read (nin, *)(b(i,1:n), i=1, n)
      Read (nin, *)(d(i,1:m), i=1, m)
      Read (nin, *)(e(i,1:n), i=1, n)
      Read (nin, *)(c(i,1:n), i=1, m)
      Read (nin, *)(f(i,1:n), i=1, m)

!     Solve the Sylvester equations
!         A*R - L*B = scale*C and D*R - L*E = scale*F
!     for R and L.
      ijob = 0

      Call dtgsyl('No transpose', ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, &
        e, lde, f, ldf, scale, dif, work, lwork, iwork, info)

      If (info>=1) Then
        Write (nout, 100)
        Write (nout, *)
        Flush (nout)
      End If

!     Print the solution matrices R and L

!     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', ' ', m, n, c, ldc, &
        'Solution matrix R', ifail)

      Write (nout, *)
      Flush (nout)

      ifail = 0
      Call nagf_file_print_matrix_real_gen('General', ' ', m, n, f, ldf, &
        'Solution matrix L', ifail)

      Write (nout, *)
      Write (nout, 110) 'SCALE = ', scale

100   Format (/, ' (A,D) and (B,E) have common or very close eigenval', &
        'ues.', /, ' Perturbed values were used to solve the equations')
110   Format (1X, A, 1P, E10.2)
    End Program