Contents


NAME

     sgebak - form the right or left eigenvectors of a real  gen-
     eral  matrix  by  backward  transformation  on  the computed
     eigenvectors of the balanced matrix output by SGEBAL

SYNOPSIS

     SUBROUTINE SGEBAK(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)

     CHARACTER * 1 JOB, SIDE
     INTEGER N, ILO, IHI, M, LDV, INFO
     REAL SCALE(*), V(LDV,*)

     SUBROUTINE SGEBAK_64(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)

     CHARACTER * 1 JOB, SIDE
     INTEGER*8 N, ILO, IHI, M, LDV, INFO
     REAL SCALE(*), V(LDV,*)

  F95 INTERFACE
     SUBROUTINE GEBAK(JOB, SIDE, [N], ILO, IHI, SCALE, [M], V, [LDV],
            [INFO])

     CHARACTER(LEN=1) :: JOB, SIDE
     INTEGER :: N, ILO, IHI, M, LDV, INFO
     REAL, DIMENSION(:) :: SCALE
     REAL, DIMENSION(:,:) :: V

     SUBROUTINE GEBAK_64(JOB, SIDE, [N], ILO, IHI, SCALE, [M], V, [LDV],
            [INFO])

     CHARACTER(LEN=1) :: JOB, SIDE
     INTEGER(8) :: N, ILO, IHI, M, LDV, INFO
     REAL, DIMENSION(:) :: SCALE
     REAL, DIMENSION(:,:) :: V

  C INTERFACE
     #include <sunperf.h>

     void sgebak(char job, char side, int n, int  ilo,  int  ihi,
               float  *scale,  int  m,  float  *v,  int  ldv, int
               *info);

     void sgebak_64(char job, char side, long n, long  ilo,  long
               ihi,  float  *scale,  long  m, float *v, long ldv,
               long *info);

PURPOSE

     sgebak forms the right or left eigenvectors of a  real  gen-
     eral  matrix  by  backward  transformation  on  the computed
     eigenvectors of the balanced matrix output by SGEBAL.

ARGUMENTS

     JOB (input)
               Specifies  the  type  of  backward  transformation
               required:   = 'N', do nothing, return immediately;
               = 'P', do backward transformation for  permutation
               only;  = 'S', do backward transformation for scal-
               ing only; = 'B', do backward  transformations  for
               both  permutation  and  scaling.   JOB must be the
               same as the argument JOB supplied to SGEBAL.

     SIDE (input)
               = 'R':  V contains right eigenvectors;
               = 'L':  V contains left eigenvectors.

     N (input) The number of rows of the matrix V.  N >= 0.

     ILO (input)
               The integers ILO and IHI determined by SGEBAL.   1
               <=  ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if
               N=0.

     IHI (input)
               See the description for ILO.

     SCALE (input)
               Details of the permutation and scaling factors, as
               returned by SGEBAL.

     M (input) The number of columns of the matrix V.  M >= 0.

     V (input/output)
               On entry, the matrix of right or left eigenvectors
               to  be  transformed,  as  returned  by  SHSEIN  or
               STREVC.   On  exit,  V  is  overwritten   by   the
               transformed eigenvectors.

     LDV (input)
               The leading dimension  of  the  array  V.  LDV  >=
               max(1,N).

     INFO (output)
               = 0:  successful exit
               < 0:  if INFO = -i, the i-th argument had an ille-
               gal value.