balbak Subroutine

private subroutine balbak(Nm, n, Low, Igh, Scale, m, z)

Form the eigenvectors of a real general matrix from the eigenvectors of matrix output from BALANC.

This subroutine is a translation of the ALGOL procedure BALBAK, NUM. MATH. 13, 293-304(1969) by Parlett and Reinsch. HANDBOOK FOR AUTO. COMP., Vol.II-LINEAR ALGEBRA, 315-326(1971).

This subroutine forms the eigenvectors of a REAL GENERAL matrix by back transforming those of the corresponding balanced matrix determined by BALANC.

On Input

    NM must be set to the row dimension of the two-dimensional
      array parameter, Z, as declared in the calling program
      dimension statement.  NM is an INTEGER variable.

    N is the number of components of the vectors in matrix Z.
      N is an INTEGER variable.  N must be less than or equal
      to NM.

    LOW and IGH are INTEGER variables determined by  BALANC.

    SCALE contains information determining the permutations and
      scaling factors used by  BALANC.  SCALE is a one-dimensional
      REAL array, dimensioned SCALE(N).

    M is the number of columns of Z to be back transformed.
      M is an INTEGER variable.

    Z contains the real and imaginary parts of the eigen-
      vectors to be back transformed in its first M columns.
      Z is a two-dimensional REAL array, dimensioned Z(NM,M).

On Output

    Z contains the real and imaginary parts of the
      transformed eigenvectors in its first M columns.

 Questions and comments should be directed to B. S. Garbow,
 Applied Mathematics Division, ARGONNE NATIONAL LABORATORY

References

  • B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow, Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen- system Routines - EISPACK Guide, Springer-Verlag, 1976.

Revision History

  • Author: Smith, B. T., et al.
  • 760101 DATE WRITTEN
  • 890831 Modified array declarations. (WRB)
  • 890831 REVISION DATE from Version 3.2
  • 891214 Prologue converted to Version 4.0 format. (BAB)
  • 920501 Reformatted the REFERENCES section. (WRB)

Arguments

Type IntentOptional Attributes Name
integer :: Nm
integer :: n
integer :: Low
integer :: Igh
real(kind=wp) :: Scale(*)
integer :: m
real(kind=wp) :: z(Nm,*)

Called by

proc~~balbak~~CalledByGraph proc~balbak eispack_module::balbak proc~rg eispack_module::rg proc~rg->proc~balbak proc~compute_eigenvalues_and_eigenvectors eispack_module::compute_eigenvalues_and_eigenvectors proc~compute_eigenvalues_and_eigenvectors->proc~rg proc~compute_real_eigenvalues_and_normalized_eigenvectors eispack_module::compute_real_eigenvalues_and_normalized_eigenvectors proc~compute_real_eigenvalues_and_normalized_eigenvectors->proc~compute_eigenvalues_and_eigenvectors proc~eispack_test eispack_module::eispack_test proc~eispack_test->proc~compute_eigenvalues_and_eigenvectors

Source Code

 subroutine balbak(Nm, n, Low, Igh, Scale, m, z)

    implicit none

    integer :: i, j, k, m, n, ii, Nm, Igh, Low
    real(wp) :: Scale(*), z(Nm, *)
    real(wp) :: s

    if (m /= 0) then
       if (Igh /= Low) then

          do i = Low, Igh
             s = Scale(i)
             ! LEFT HAND EIGENVECTORS ARE BACK TRANSFORMED
             ! IF THE FOREGOING STATEMENT IS REPLACED BY
             ! S=1.0_wp/SCALE(I).
             do j = 1, m
                z(i, j) = z(i, j)*s
             enddo

          enddo
       endif
       ! FOR I=LOW-1 STEP -1 UNTIL 1,
       ! IGH+1 STEP 1 UNTIL N DO --
       do ii = 1, n
          i = ii
          if (i < Low .or. i > Igh) then
             if (i < Low) i = Low - ii
             k = Scale(i)
             if (k /= i) then

                do j = 1, m
                   s = z(i, j)
                   z(i, j) = z(k, j)
                   z(k, j) = s
                enddo
             endif
          endif

       enddo
    endif

 end subroutine balbak