Original Version

1 files changed, 220 insertions, 0 deletions

diff --git a/2.3-1/src/fortran/lapack/zggbak.f b/2.3-1/src/fortran/lapack/zggbak.f
new file mode 100644
index 00000000..ad6dd032
--- /dev/null
+++ b/2.3-1/src/fortran/lapack/zggbak.f
@@ -0,0 +1,220 @@
+      SUBROUTINE ZGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
+     $                   LDV, INFO )
+*
+*  -- LAPACK routine (version 3.1) --
+*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+*     November 2006
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOB, SIDE
+      INTEGER            IHI, ILO, INFO, LDV, M, N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   LSCALE( * ), RSCALE( * )
+      COMPLEX*16         V( LDV, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZGGBAK forms the right or left eigenvectors of a complex generalized
+*  eigenvalue problem A*x = lambda*B*x, by backward transformation on
+*  the computed eigenvectors of the balanced pair of matrices output by
+*  ZGGBAL.
+*
+*  Arguments
+*  =========
+*
+*  JOB     (input) CHARACTER*1
+*          Specifies the type of backward transformation required:
+*          = 'N':  do nothing, return immediately;
+*          = 'P':  do backward transformation for permutation only;
+*          = 'S':  do backward transformation for scaling only;
+*          = 'B':  do backward transformations for both permutation and
+*                  scaling.
+*          JOB must be the same as the argument JOB supplied to ZGGBAL.
+*
+*  SIDE    (input) CHARACTER*1
+*          = 'R':  V contains right eigenvectors;
+*          = 'L':  V contains left eigenvectors.
+*
+*  N       (input) INTEGER
+*          The number of rows of the matrix V.  N >= 0.
+*
+*  ILO     (input) INTEGER
+*  IHI     (input) INTEGER
+*          The integers ILO and IHI determined by ZGGBAL.
+*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+*
+*  LSCALE  (input) DOUBLE PRECISION array, dimension (N)
+*          Details of the permutations and/or scaling factors applied
+*          to the left side of A and B, as returned by ZGGBAL.
+*
+*  RSCALE  (input) DOUBLE PRECISION array, dimension (N)
+*          Details of the permutations and/or scaling factors applied
+*          to the right side of A and B, as returned by ZGGBAL.
+*
+*  M       (input) INTEGER
+*          The number of columns of the matrix V.  M >= 0.
+*
+*  V       (input/output) COMPLEX*16 array, dimension (LDV,M)
+*          On entry, the matrix of right or left eigenvectors to be
+*          transformed, as returned by ZTGEVC.
+*          On exit, V is overwritten by the transformed eigenvectors.
+*
+*  LDV     (input) INTEGER
+*          The leading dimension of the matrix V. LDV >= max(1,N).
+*
+*  INFO    (output) INTEGER
+*          = 0:  successful exit.
+*          < 0:  if INFO = -i, the i-th argument had an illegal value.
+*
+*  Further Details
+*  ===============
+*
+*  See R.C. Ward, Balancing the generalized eigenvalue problem,
+*                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LEFTV, RIGHTV
+      INTEGER            I, K
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, ZDSCAL, ZSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters
+*
+      RIGHTV = LSAME( SIDE, 'R' )
+      LEFTV = LSAME( SIDE, 'L' )
+*
+      INFO = 0
+      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
+     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( ILO.LT.1 ) THEN
+         INFO = -4
+      ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
+         INFO = -4
+      ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
+     $   THEN
+         INFO = -5
+      ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
+         INFO = -5
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -8
+      ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
+         INFO = -10
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZGGBAK', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+      IF( M.EQ.0 )
+     $   RETURN
+      IF( LSAME( JOB, 'N' ) )
+     $   RETURN
+*
+      IF( ILO.EQ.IHI )
+     $   GO TO 30
+*
+*     Backward balance
+*
+      IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
+*
+*        Backward transformation on right eigenvectors
+*
+         IF( RIGHTV ) THEN
+            DO 10 I = ILO, IHI
+               CALL ZDSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
+   10       CONTINUE
+         END IF
+*
+*        Backward transformation on left eigenvectors
+*
+         IF( LEFTV ) THEN
+            DO 20 I = ILO, IHI
+               CALL ZDSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
+   20       CONTINUE
+         END IF
+      END IF
+*
+*     Backward permutation
+*
+   30 CONTINUE
+      IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
+*
+*        Backward permutation on right eigenvectors
+*
+         IF( RIGHTV ) THEN
+            IF( ILO.EQ.1 )
+     $         GO TO 50
+            DO 40 I = ILO - 1, 1, -1
+               K = RSCALE( I )
+               IF( K.EQ.I )
+     $            GO TO 40
+               CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
+   40       CONTINUE
+*
+   50       CONTINUE
+            IF( IHI.EQ.N )
+     $         GO TO 70
+            DO 60 I = IHI + 1, N
+               K = RSCALE( I )
+               IF( K.EQ.I )
+     $            GO TO 60
+               CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
+   60       CONTINUE
+         END IF
+*
+*        Backward permutation on left eigenvectors
+*
+   70    CONTINUE
+         IF( LEFTV ) THEN
+            IF( ILO.EQ.1 )
+     $         GO TO 90
+            DO 80 I = ILO - 1, 1, -1
+               K = LSCALE( I )
+               IF( K.EQ.I )
+     $            GO TO 80
+               CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
+   80       CONTINUE
+*
+   90       CONTINUE
+            IF( IHI.EQ.N )
+     $         GO TO 110
+            DO 100 I = IHI + 1, N
+               K = LSCALE( I )
+               IF( K.EQ.I )
+     $            GO TO 100
+               CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
+  100       CONTINUE
+         END IF
+      END IF
+*
+  110 CONTINUE
+*
+      RETURN
+*
+*     End of ZGGBAK
+*
+      END