計算ルーチン: 実シルヴェスタ行列方程式 AX + XB = C を解く

DTRSYL Example Program Data
  4  4                        :Values of M and N
  0.10   0.50   0.68  -0.21
 -0.50   0.10  -0.24   0.67
  0.00   0.00   0.19  -0.35
  0.00   0.00   0.00  -0.72   :End of matrix A
 -0.99  -0.17   0.39   0.58
  0.00   0.48  -0.84  -0.15
  0.00   0.00   0.75   0.25
  0.00   0.00  -0.25   0.75   :End of matrix B
  0.63  -0.56   0.08  -0.23
 -0.45  -0.31   0.27   1.21
  0.20  -0.35   0.41   0.84
  0.49  -0.05  -0.52  -0.08   :End of matrix C

 DTRSYL Example Program Results

 Solution Matrix
          1       2       3       4
 1  -0.4209  0.1764  0.2438 -0.9577
 2   0.5600 -0.8337 -0.7221  0.5386
 3  -0.1246 -0.3392  0.6221  0.8691
 4  -0.2865  0.4113  0.5535  0.3174

    Program dtrsyl_example

!     DTRSYL 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: dtrsyl
      Use lapack_precision, Only: dp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=dp) :: scale
      Integer :: i, ifail, info, lda, ldb, ldc, m, n, sign
!     .. Local Arrays ..
      Real (Kind=dp), Allocatable :: a(:, :), b(:, :), c(:, :)
!     .. Executable Statements ..
      Write (nout, *) 'DTRSYL Example Program Results'
      Write (nout, *)
      Flush (nout)
!     Skip heading in data file
      Read (nin, *)
      Read (nin, *) m, n
      lda = m
      ldb = n
      ldc = m
      sign = 1
      Allocate (a(lda,m), b(ldb,n), c(ldc,n))

!     Read A, B and C from data file

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

!     Solve the Sylvester equation A*X + X*B = C for X
      Call dtrsyl('No transpose', 'No transpose', sign, m, n, a, lda, b, ldb, &
        c, ldc, scale, info)
      If (info==1) Then
        Write (nout, 100)
        Write (nout, *)
      End If

      Flush (nout)

!     Print X
!     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', ifail)

100   Format (/, ' A and B have common or very close eigenvalues.', /, ' Pe', &
        'rturbed values were used to solve the equations')
    End Program