Logo Search packages:      
Sourcecode: r-base version File versions

blas.f

      double precision function dasum(n,dx,incx)
c
c     takes the sum of the absolute values.
c     jack dongarra, linpack, 3/11/78.
c     modified 3/93 to return if incx .le. 0.
c     modified 12/3/93, array(1) declarations changed to array(*)
c
      double precision dx(*),dtemp
      integer i,incx,m,mp1,n,nincx
c
      dasum = 0.0d0
      dtemp = 0.0d0
      if( n.le.0 .or. incx.le.0 )return
      if(incx.eq.1)go to 20
c
c        code for increment not equal to 1
c
      nincx = n*incx
      do 10 i = 1,nincx,incx
        dtemp = dtemp + dabs(dx(i))
   10 continue
      dasum = dtemp
      return
c
c        code for increment equal to 1
c
c
c        clean-up loop
c
   20 m = mod(n,6)
      if( m .eq. 0 ) go to 40
      do 30 i = 1,m
        dtemp = dtemp + dabs(dx(i))
   30 continue
      if( n .lt. 6 ) go to 60
   40 mp1 = m + 1
      do 50 i = mp1,n,6
        dtemp = dtemp + dabs(dx(i)) + dabs(dx(i + 1)) + dabs(dx(i + 2))
     *  + dabs(dx(i + 3)) + dabs(dx(i + 4)) + dabs(dx(i + 5))
   50 continue
   60 dasum = dtemp
      return
      end
      subroutine daxpy(n,da,dx,incx,dy,incy)
c
c     constant times a vector plus a vector.
c     uses unrolled loops for increments equal to one.
c     jack dongarra, linpack, 3/11/78.
c     modified 12/3/93, array(1) declarations changed to array(*)
c
      double precision dx(*),dy(*),da
      integer i,incx,incy,ix,iy,m,mp1,n
c
      if(n.le.0)return
      if (da .eq. 0.0d0) return
      if(incx.eq.1.and.incy.eq.1)go to 20
c
c        code for unequal increments or equal increments
c          not equal to 1
c
      ix = 1
      iy = 1
      if(incx.lt.0)ix = (-n+1)*incx + 1
      if(incy.lt.0)iy = (-n+1)*incy + 1
      do 10 i = 1,n
        dy(iy) = dy(iy) + da*dx(ix)
        ix = ix + incx
        iy = iy + incy
   10 continue
      return
c
c        code for both increments equal to 1
c
c
c        clean-up loop
c
   20 m = mod(n,4)
      if( m .eq. 0 ) go to 40
      do 30 i = 1,m
        dy(i) = dy(i) + da*dx(i)
   30 continue
      if( n .lt. 4 ) return
   40 mp1 = m + 1
      do 50 i = mp1,n,4
        dy(i) = dy(i) + da*dx(i)
        dy(i + 1) = dy(i + 1) + da*dx(i + 1)
        dy(i + 2) = dy(i + 2) + da*dx(i + 2)
        dy(i + 3) = dy(i + 3) + da*dx(i + 3)
   50 continue
      return
      end
      subroutine  dcopy(n,dx,incx,dy,incy)
c
c     copies a vector, x, to a vector, y.
c     uses unrolled loops for increments equal to one.
c     jack dongarra, linpack, 3/11/78.
c     modified 12/3/93, array(1) declarations changed to array(*)
c
      double precision dx(*),dy(*)
      integer i,incx,incy,ix,iy,m,mp1,n
c
      if(n.le.0)return
      if(incx.eq.1.and.incy.eq.1)go to 20
c
c        code for unequal increments or equal increments
c          not equal to 1
c
      ix = 1
      iy = 1
      if(incx.lt.0)ix = (-n+1)*incx + 1
      if(incy.lt.0)iy = (-n+1)*incy + 1
      do 10 i = 1,n
        dy(iy) = dx(ix)
        ix = ix + incx
        iy = iy + incy
   10 continue
      return
c
c        code for both increments equal to 1
c
c
c        clean-up loop
c
   20 m = mod(n,7)
      if( m .eq. 0 ) go to 40
      do 30 i = 1,m
        dy(i) = dx(i)
   30 continue
      if( n .lt. 7 ) return
   40 mp1 = m + 1
      do 50 i = mp1,n,7
        dy(i) = dx(i)
        dy(i + 1) = dx(i + 1)
        dy(i + 2) = dx(i + 2)
        dy(i + 3) = dx(i + 3)
        dy(i + 4) = dx(i + 4)
        dy(i + 5) = dx(i + 5)
        dy(i + 6) = dx(i + 6)
   50 continue
      return
      end
      double precision function ddot(n,dx,incx,dy,incy)
c
c     forms the dot product of two vectors.
c     uses unrolled loops for increments equal to one.
c     jack dongarra, linpack, 3/11/78.
c     modified 12/3/93, array(1) declarations changed to array(*)
c
      double precision dx(*),dy(*),dtemp
      integer i,incx,incy,ix,iy,m,mp1,n
c
      ddot = 0.0d0
      dtemp = 0.0d0
      if(n.le.0)return
      if(incx.eq.1.and.incy.eq.1)go to 20
c
c        code for unequal increments or equal increments
c          not equal to 1
c
      ix = 1
      iy = 1
      if(incx.lt.0)ix = (-n+1)*incx + 1
      if(incy.lt.0)iy = (-n+1)*incy + 1
      do 10 i = 1,n
        dtemp = dtemp + dx(ix)*dy(iy)
        ix = ix + incx
        iy = iy + incy
   10 continue
      ddot = dtemp
      return
c
c        code for both increments equal to 1
c
c
c        clean-up loop
c
   20 m = mod(n,5)
      if( m .eq. 0 ) go to 40
      do 30 i = 1,m
        dtemp = dtemp + dx(i)*dy(i)
   30 continue
      if( n .lt. 5 ) go to 60
   40 mp1 = m + 1
      do 50 i = mp1,n,5
        dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) +
     *   dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4)
   50 continue
   60 ddot = dtemp
      return
      end
      SUBROUTINE DGBMV ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX,
     $                   BETA, Y, INCY )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   ALPHA, BETA
      INTEGER            INCX, INCY, KL, KU, LDA, M, N
      CHARACTER*1        TRANS
*     .. Array Arguments ..
      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
*     ..
*
*  Purpose
*  =======
*
*  DGBMV  performs one of the matrix-vector operations
*
*     y := alpha*A*x + beta*y,   or   y := alpha*A











'*x + beta*y,**  where alpha and beta are scalars, x and y are vectors and A is an*  m by n band matrix, with kl sub-diagonals and ku super-diagonals.**  Parameters*  ==========**  TRANS  - CHARACTER*1.*           On entry, TRANS specifies the operation to be performed as*           follows:**              TRANS = 'N' or 'n

'   y := alpha*A*x + beta*y.**              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
*
*              TRANS = 'C' or 'c'   y := alpha*A
























































'*x + beta*y.**           Unchanged on exit.**  M      - INTEGER.*           On entry, M specifies the number of rows of the matrix A.*           M must be at least zero.*           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the number of columns of the matrix A.*           N must be at least zero.*           Unchanged on exit.**  KL     - INTEGER.*           On entry, KL specifies the number of sub-diagonals of the*           matrix A. KL must satisfy  0 .le. KL.*           Unchanged on exit.**  KU     - INTEGER.*           On entry, KU specifies the number of super-diagonals of the*           matrix A. KU must satisfy  0 .le. KU.*           Unchanged on exit.**  ALPHA  - DOUBLE PRECISION.*           On entry, ALPHA specifies the scalar alpha.*           Unchanged on exit.**  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).*           Before entry, the leading ( kl + ku + 1 ) by n part of the*           array A must contain the matrix of coefficients, supplied*           column by column, with the leading diagonal of the matrix in*           row ( ku + 1 ) of the array, the first super-diagonal*           starting at position 2 in row ku, the first sub-diagonal*           starting at position 1 in row ( ku + 2 ), and so on.*           Elements in the array A that do not correspond to elements*           in the band matrix (such as the top left ku by ku triangle)*           are not referenced.*           The following program segment will transfer a band matrix*           from conventional full matrix storage to band storage:**                 DO 20, J = 1, N*                    K = KU + 1 - J*                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )*                       A( K + I, J ) = matrix( I, J )*              10    CONTINUE*              20 CONTINUE**           Unchanged on exit.**  LDA    - INTEGER.*           On entry, LDA specifies the first dimension of A as declared*           in the calling (sub) program. LDA must be at least*           ( kl + ku + 1 ).*           Unchanged on exit.**  X      - DOUBLE PRECISION array of DIMENSION at least*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n

















'*           and at least*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.*           Before entry, the incremented array X must contain the*           vector x.*           Unchanged on exit.**  INCX   - INTEGER.*           On entry, INCX specifies the increment for the elements of*           X. INCX must not be zero.*           Unchanged on exit.**  BETA   - DOUBLE PRECISION.*           On entry, BETA specifies the scalar beta. When BETA is*           supplied as zero then Y need not be set on input.*           Unchanged on exit.**  Y      - DOUBLE PRECISION array of DIMENSION at least*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n







































'*           and at least*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.*           Before entry, the incremented array Y must contain the*           vector y. On exit, Y is overwritten by the updated vector y.**  INCY   - INTEGER.*           On entry, INCY specifies the increment for the elements of*           Y. INCY must not be zero.*           Unchanged on exit.***  Level 2 Blas routine.**  -- Written on 22-October-1986.*     Jack Dongarra, Argonne National Lab.*     Jeremy Du Croz, Nag Central Office.*     Sven Hammarling, Nag Central Office.*     Richard Hanson, Sandia National Labs.**     .. Parameters ..      DOUBLE PRECISION   ONE         , ZERO      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )*     .. Local Scalars ..      DOUBLE PRECISION   TEMP      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KUP1, KX, KY,     $                   LENX, LENY*     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     .. Intrinsic Functions ..      INTRINSIC          MAX, MIN*     ..*     .. Executable Statements ..**     Test the input parameters.*      INFO = 0      IF     ( .NOT.LSAME( TRANS, 'N
' ).AND.     $         .NOT.LSAME( TRANS, 'T
' ).AND.     $         .NOT.LSAME( TRANS, 'C

















' )      )THEN         INFO = 1      ELSE IF( M.LT.0 )THEN         INFO = 2      ELSE IF( N.LT.0 )THEN         INFO = 3      ELSE IF( KL.LT.0 )THEN         INFO = 4      ELSE IF( KU.LT.0 )THEN         INFO = 5      ELSE IF( LDA.LT.( KL + KU + 1 ) )THEN         INFO = 8      ELSE IF( INCX.EQ.0 )THEN         INFO = 10      ELSE IF( INCY.EQ.0 )THEN         INFO = 13      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DGBMV 












', INFO )         RETURN      END IF**     Quick return if possible.*      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )     $   RETURN**     Set  LENX  and  LENY, the lengths of the vectors x and y, and set*     up the start points in  X  and  Y.*      IF( LSAME( TRANS, 'N



















































' ) )THEN         LENX = N         LENY = M      ELSE         LENX = M         LENY = N      END IF      IF( INCX.GT.0 )THEN         KX = 1      ELSE         KX = 1 - ( LENX - 1 )*INCX      END IF      IF( INCY.GT.0 )THEN         KY = 1      ELSE         KY = 1 - ( LENY - 1 )*INCY      END IF**     Start the operations. In this version the elements of A are*     accessed sequentially with one pass through the band part of A.**     First form  y := beta*y.*      IF( BETA.NE.ONE )THEN         IF( INCY.EQ.1 )THEN            IF( BETA.EQ.ZERO )THEN               DO 10, I = 1, LENY                  Y( I ) = ZERO   10          CONTINUE            ELSE               DO 20, I = 1, LENY                  Y( I ) = BETA*Y( I )   20          CONTINUE            END IF         ELSE            IY = KY            IF( BETA.EQ.ZERO )THEN               DO 30, I = 1, LENY                  Y( IY ) = ZERO                  IY      = IY   + INCY   30          CONTINUE            ELSE               DO 40, I = 1, LENY                  Y( IY ) = BETA*Y( IY )                  IY      = IY           + INCY   40          CONTINUE            END IF         END IF      END IF      IF( ALPHA.EQ.ZERO )     $   RETURN      KUP1 = KU + 1      IF( LSAME( TRANS, 'N

































' ) )THEN**        Form  y := alpha*A*x + y.*         JX = KX         IF( INCY.EQ.1 )THEN            DO 60, J = 1, N               IF( X( JX ).NE.ZERO )THEN                  TEMP = ALPHA*X( JX )                  K    = KUP1 - J                  DO 50, I = MAX( 1, J - KU ), MIN( M, J + KL )                     Y( I ) = Y( I ) + TEMP*A( K + I, J )   50             CONTINUE               END IF               JX = JX + INCX   60       CONTINUE         ELSE            DO 80, J = 1, N               IF( X( JX ).NE.ZERO )THEN                  TEMP = ALPHA*X( JX )                  IY   = KY                  K    = KUP1 - J                  DO 70, I = MAX( 1, J - KU ), MIN( M, J + KL )                     Y( IY ) = Y( IY ) + TEMP*A( K + I, J )                     IY      = IY      + INCY   70             CONTINUE               END IF               JX = JX + INCX               IF( J.GT.KU )     $            KY = KY + INCY   80       CONTINUE         END IF      ELSE**        Form  y := alpha*A'*x + y.
*
         JY = KY
         IF( INCX.EQ.1 )THEN
            DO 100, J = 1, N
               TEMP = ZERO
               K    = KUP1 - J
               DO 90, I = MAX( 1, J - KU ), MIN( M, J + KL )
                  TEMP = TEMP + A( K + I, J )*X( I )
   90          CONTINUE
               Y( JY ) = Y( JY ) + ALPHA*TEMP
               JY      = JY      + INCY
  100       CONTINUE
         ELSE
            DO 120, J = 1, N
               TEMP = ZERO
               IX   = KX
               K    = KUP1 - J
               DO 110, I = MAX( 1, J - KU ), MIN( M, J + KL )
                  TEMP = TEMP + A( K + I, J )*X( IX )
                  IX   = IX   + INCX
  110          CONTINUE
               Y( JY ) = Y( JY ) + ALPHA*TEMP
               JY      = JY      + INCY
               IF( J.GT.KU )
     $            KX = KX + INCX
  120       CONTINUE
         END IF
      END IF
*
      RETURN
*
*     End of DGBMV .
*
      END
      SUBROUTINE DGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
     $                   BETA, C, LDC )
*     .. Scalar Arguments ..
      CHARACTER*1        TRANSA, TRANSB
      INTEGER            M, N, K, LDA, LDB, LDC
      DOUBLE PRECISION   ALPHA, BETA
*     .. Array Arguments ..
      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * )
*     ..
*
*  Purpose
*  =======
*
*  DGEMM  performs one of the matrix-matrix operations
*
*     C := alpha*op( A )*op( B ) + beta*C,
*
*  where  op( X ) is one of
*
*     op( X ) = X   or   op( X ) = X











',**  alpha and beta are scalars, and A, B and C are matrices, with op( A )*  an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.**  Parameters*  ==========**  TRANSA - CHARACTER*1.*           On entry, TRANSA specifies the form of op( A ) to be used in*           the matrix multiplication as follows:**              TRANSA = 'N' or 'n

',  op( A ) = A.**              TRANSA = 'T' or 't',  op( A ) = A'.
*
*              TRANSA = 'C' or 'c',  op( A ) = A







'.**           Unchanged on exit.**  TRANSB - CHARACTER*1.*           On entry, TRANSB specifies the form of op( B ) to be used in*           the matrix multiplication as follows:**              TRANSB = 'N' or 'n

',  op( B ) = B.**              TRANSB = 'T' or 't',  op( B ) = B'.
*
*              TRANSB = 'C' or 'c',  op( B ) = B

























'.**           Unchanged on exit.**  M      - INTEGER.*           On entry,  M  specifies  the number  of rows  of the  matrix*           op( A )  and of the  matrix  C.  M  must  be at least  zero.*           Unchanged on exit.**  N      - INTEGER.*           On entry,  N  specifies the number  of columns of the matrix*           op( B ) and the number of columns of the matrix C. N must be*           at least zero.*           Unchanged on exit.**  K      - INTEGER.*           On entry,  K  specifies  the number of columns of the matrix*           op( A ) and the number of rows of the matrix op( B ). K must*           be at least  zero.*           Unchanged on exit.**  ALPHA  - DOUBLE PRECISION.*           On entry, ALPHA specifies the scalar alpha.*           Unchanged on exit.**  A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is*           k  when  TRANSA = 'N' or 'n
',  and is  m  otherwise.*           Before entry with  TRANSA = 'N' or 'n







',  the leading  m by k*           part of the array  A  must contain the matrix  A,  otherwise*           the leading  k by m  part of the array  A  must contain  the*           matrix A.*           Unchanged on exit.**  LDA    - INTEGER.*           On entry, LDA specifies the first dimension of A as declared*           in the calling (sub) program. When  TRANSA = 'N' or 'n





' then*           LDA must be at least  max( 1, m ), otherwise  LDA must be at*           least  max( 1, k ).*           Unchanged on exit.**  B      - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is*           n  when  TRANSB = 'N' or 'n
',  and is  k  otherwise.*           Before entry with  TRANSB = 'N' or 'n







',  the leading  k by n*           part of the array  B  must contain the matrix  B,  otherwise*           the leading  n by k  part of the array  B  must contain  the*           matrix B.*           Unchanged on exit.**  LDB    - INTEGER.*           On entry, LDB specifies the first dimension of B as declared*           in the calling (sub) program. When  TRANSB = 'N' or 'n





















































' then*           LDB must be at least  max( 1, k ), otherwise  LDB must be at*           least  max( 1, n ).*           Unchanged on exit.**  BETA   - DOUBLE PRECISION.*           On entry,  BETA  specifies the scalar  beta.  When  BETA  is*           supplied as zero then C need not be set on input.*           Unchanged on exit.**  C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).*           Before entry, the leading  m by n  part of the array  C must*           contain the matrix  C,  except when  beta  is zero, in which*           case C need not be set on entry.*           On exit, the array  C  is overwritten by the  m by n  matrix*           ( alpha*op( A )*op( B ) + beta*C ).**  LDC    - INTEGER.*           On entry, LDC specifies the first dimension of C as declared*           in  the  calling  (sub)  program.   LDC  must  be  at  least*           max( 1, m ).*           Unchanged on exit.***  Level 3 Blas routine.**  -- Written on 8-February-1989.*     Jack Dongarra, Argonne National Laboratory.*     Iain Duff, AERE Harwell.*     Jeremy Du Croz, Numerical Algorithms Group Ltd.*     Sven Hammarling, Numerical Algorithms Group Ltd.***     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     .. Intrinsic Functions ..      INTRINSIC          MAX*     .. Local Scalars ..      LOGICAL            NOTA, NOTB      INTEGER            I, INFO, J, L, NCOLA, NROWA, NROWB      DOUBLE PRECISION   TEMP*     .. Parameters ..      DOUBLE PRECISION   ONE         , ZERO      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )*     ..*     .. Executable Statements ..**     Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not*     transposed and set  NROWA, NCOLA and  NROWB  as the number of rows*     and  columns of  A  and the  number of  rows  of  B  respectively.*      NOTA  = LSAME( TRANSA, 'N
' )      NOTB  = LSAME( TRANSB, 'N

















' )      IF( NOTA )THEN         NROWA = M         NCOLA = K      ELSE         NROWA = K         NCOLA = M      END IF      IF( NOTB )THEN         NROWB = K      ELSE         NROWB = N      END IF**     Test the input parameters.*      INFO = 0      IF(      ( .NOT.NOTA                 ).AND.     $         ( .NOT.LSAME( TRANSA, 'C
' ) ).AND.     $         ( .NOT.LSAME( TRANSA, 'T


' ) )      )THEN         INFO = 1      ELSE IF( ( .NOT.NOTB                 ).AND.     $         ( .NOT.LSAME( TRANSB, 'C
' ) ).AND.     $         ( .NOT.LSAME( TRANSB, 'T















' ) )      )THEN         INFO = 2      ELSE IF( M  .LT.0               )THEN         INFO = 3      ELSE IF( N  .LT.0               )THEN         INFO = 4      ELSE IF( K  .LT.0               )THEN         INFO = 5      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN         INFO = 8      ELSE IF( LDB.LT.MAX( 1, NROWB ) )THEN         INFO = 10      ELSE IF( LDC.LT.MAX( 1, M     ) )THEN         INFO = 13      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DGEMM 
























































', INFO )         RETURN      END IF**     Quick return if possible.*      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )     $   RETURN**     And if  alpha.eq.zero.*      IF( ALPHA.EQ.ZERO )THEN         IF( BETA.EQ.ZERO )THEN            DO 20, J = 1, N               DO 10, I = 1, M                  C( I, J ) = ZERO   10          CONTINUE   20       CONTINUE         ELSE            DO 40, J = 1, N               DO 30, I = 1, M                  C( I, J ) = BETA*C( I, J )   30          CONTINUE   40       CONTINUE         END IF         RETURN      END IF**     Start the operations.*      IF( NOTB )THEN         IF( NOTA )THEN**           Form  C := alpha*A*B + beta*C.*            DO 90, J = 1, N               IF( BETA.EQ.ZERO )THEN                  DO 50, I = 1, M                     C( I, J ) = ZERO   50             CONTINUE               ELSE IF( BETA.NE.ONE )THEN                  DO 60, I = 1, M                     C( I, J ) = BETA*C( I, J )   60             CONTINUE               END IF               DO 80, L = 1, K                  IF( B( L, J ).NE.ZERO )THEN                     TEMP = ALPHA*B( L, J )                     DO 70, I = 1, M                        C( I, J ) = C( I, J ) + TEMP*A( I, L )   70                CONTINUE                  END IF   80          CONTINUE   90       CONTINUE         ELSE**           Form  C := alpha*A'*B + beta*C
*
            DO 120, J = 1, N
               DO 110, I = 1, M
                  TEMP = ZERO
                  DO 100, L = 1, K
                     TEMP = TEMP + A( L, I )*B( L, J )
  100             CONTINUE
                  IF( BETA.EQ.ZERO )THEN
                     C( I, J ) = ALPHA*TEMP
                  ELSE
                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
                  END IF
  110          CONTINUE
  120       CONTINUE
         END IF
      ELSE
         IF( NOTA )THEN
*
*           Form  C := alpha*A*B






















' + beta*C*            DO 170, J = 1, N               IF( BETA.EQ.ZERO )THEN                  DO 130, I = 1, M                     C( I, J ) = ZERO  130             CONTINUE               ELSE IF( BETA.NE.ONE )THEN                  DO 140, I = 1, M                     C( I, J ) = BETA*C( I, J )  140             CONTINUE               END IF               DO 160, L = 1, K                  IF( B( J, L ).NE.ZERO )THEN                     TEMP = ALPHA*B( J, L )                     DO 150, I = 1, M                        C( I, J ) = C( I, J ) + TEMP*A( I, L )  150                CONTINUE                  END IF  160          CONTINUE  170       CONTINUE         ELSE**           Form  C := alpha*A'*B





































' + beta*C*            DO 200, J = 1, N               DO 190, I = 1, M                  TEMP = ZERO                  DO 180, L = 1, K                     TEMP = TEMP + A( L, I )*B( J, L )  180             CONTINUE                  IF( BETA.EQ.ZERO )THEN                     C( I, J ) = ALPHA*TEMP                  ELSE                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )                  END IF  190          CONTINUE  200       CONTINUE         END IF      END IF*      RETURN**     End of DGEMM .*      END      SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,     $                   BETA, Y, INCY )*     .. Scalar Arguments ..      DOUBLE PRECISION   ALPHA, BETA      INTEGER            INCX, INCY, LDA, M, N      CHARACTER*1        TRANS*     .. Array Arguments ..      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )*     ..**  Purpose*  =======**  DGEMV  performs one of the matrix-vector operations**     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,
*
*  where alpha and beta are scalars, x and y are vectors and A is an
*  m by n matrix.
*
*  Parameters
*  ==========
*
*  TRANS  - CHARACTER*1.
*           On entry, TRANS specifies the operation to be performed as
*           follows:
*
*              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
*
*              TRANS = 'T' or 't'   y := alpha*A

'*x + beta*y.**              TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y.
*
*           Unchanged on exit.
*
*  M      - INTEGER.
*           On entry, M specifies the number of rows of the matrix A.
*           M must be at least zero.
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry, N specifies the number of columns of the matrix A.
*           N must be at least zero.
*           Unchanged on exit.
*
*  ALPHA  - DOUBLE PRECISION.
*           On entry, ALPHA specifies the scalar alpha.
*           Unchanged on exit.
*
*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
*           Before entry, the leading m by n part of the array A must
*           contain the matrix of coefficients.
*           Unchanged on exit.
*
*  LDA    - INTEGER.
*           On entry, LDA specifies the first dimension of A as declared
*           in the calling (sub) program. LDA must be at least
*           max( 1, m ).
*           Unchanged on exit.
*
*  X      - DOUBLE PRECISION array of DIMENSION at least
*           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*           and at least
*           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*           Before entry, the incremented array X must contain the
*           vector x.
*           Unchanged on exit.
*
*  INCX   - INTEGER.
*           On entry, INCX specifies the increment for the elements of
*           X. INCX must not be zero.
*           Unchanged on exit.
*
*  BETA   - DOUBLE PRECISION.
*           On entry, BETA specifies the scalar beta. When BETA is
*           supplied as zero then Y need not be set on input.
*           Unchanged on exit.
*
*  Y      - DOUBLE PRECISION array of DIMENSION at least
*           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*           and at least
*           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*           Before entry with BETA non-zero, the incremented array Y
*           must contain the vector y. On exit, Y is overwritten by the
*           updated vector y.
*
*  INCY   - INTEGER.
*           On entry, INCY specifies the increment for the elements of
*           Y. INCY must not be zero.
*           Unchanged on exit.
*
*
*  Level 2 Blas routine.
*
*  -- Written on 22-October-1986.
*     Jack Dongarra, Argonne National Lab.
*     Jeremy Du Croz, Nag Central Office.
*     Sven Hammarling, Nag Central Office.
*     Richard Hanson, Sandia National Labs.
*
*
*     .. Parameters ..
      DOUBLE PRECISION   ONE         , ZERO
      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
*     .. Local Scalars ..
      DOUBLE PRECISION   TEMP
      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     .. Intrinsic Functions ..
      INTRINSIC          MAX
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      INFO = 0
      IF     ( .NOT.LSAME( TRANS, 'N' ).AND.
     $         .NOT.LSAME( TRANS, 'T' ).AND.
     $         .NOT.LSAME( TRANS, 'C' )      )THEN
         INFO = 1
      ELSE IF( M.LT.0 )THEN
         INFO = 2
      ELSE IF( N.LT.0 )THEN
         INFO = 3
      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
         INFO = 6
      ELSE IF( INCX.EQ.0 )THEN
         INFO = 8
      ELSE IF( INCY.EQ.0 )THEN
         INFO = 11
      END IF
      IF( INFO.NE.0 )THEN
         CALL XERBLA( 'DGEMV ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
     $   RETURN
*
*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
*     up the start points in  X  and  Y.
*
      IF( LSAME( TRANS, 'N' ) )THEN
         LENX = N
         LENY = M
      ELSE
         LENX = M
         LENY = N
      END IF
      IF( INCX.GT.0 )THEN
         KX = 1
      ELSE
         KX = 1 - ( LENX - 1 )*INCX
      END IF
      IF( INCY.GT.0 )THEN
         KY = 1
      ELSE
         KY = 1 - ( LENY - 1 )*INCY
      END IF
*
*     Start the operations. In this version the elements of A are
*     accessed sequentially with one pass through A.
*
*     First form  y := beta*y.
*
      IF( BETA.NE.ONE )THEN
         IF( INCY.EQ.1 )THEN
            IF( BETA.EQ.ZERO )THEN
               DO 10, I = 1, LENY
                  Y( I ) = ZERO
   10          CONTINUE
            ELSE
               DO 20, I = 1, LENY
                  Y( I ) = BETA*Y( I )
   20          CONTINUE
            END IF
         ELSE
            IY = KY
            IF( BETA.EQ.ZERO )THEN
               DO 30, I = 1, LENY
                  Y( IY ) = ZERO
                  IY      = IY   + INCY
   30          CONTINUE
            ELSE
               DO 40, I = 1, LENY
                  Y( IY ) = BETA*Y( IY )
                  IY      = IY           + INCY
   40          CONTINUE
            END IF
         END IF
      END IF
      IF( ALPHA.EQ.ZERO )
     $   RETURN
      IF( LSAME( TRANS, 'N' ) )THEN
*
*        Form  y := alpha*A*x + y.
*
         JX = KX
         IF( INCY.EQ.1 )THEN
            DO 60, J = 1, N
               IF( X( JX ).NE.ZERO )THEN
                  TEMP = ALPHA*X( JX )
                  DO 50, I = 1, M
                     Y( I ) = Y( I ) + TEMP*A( I, J )
   50             CONTINUE
               END IF
               JX = JX + INCX
   60       CONTINUE
         ELSE
            DO 80, J = 1, N
               IF( X( JX ).NE.ZERO )THEN
                  TEMP = ALPHA*X( JX )
                  IY   = KY
                  DO 70, I = 1, M
                     Y( IY ) = Y( IY ) + TEMP*A( I, J )
                     IY      = IY      + INCY
   70             CONTINUE
               END IF
               JX = JX + INCX
   80       CONTINUE
         END IF
      ELSE
*
*        Form  y := alpha*A











































'*x + y.*         JY = KY         IF( INCX.EQ.1 )THEN            DO 100, J = 1, N               TEMP = ZERO               DO 90, I = 1, M                  TEMP = TEMP + A( I, J )*X( I )   90          CONTINUE               Y( JY ) = Y( JY ) + ALPHA*TEMP               JY      = JY      + INCY  100       CONTINUE         ELSE            DO 120, J = 1, N               TEMP = ZERO               IX   = KX               DO 110, I = 1, M                  TEMP = TEMP + A( I, J )*X( IX )                  IX   = IX   + INCX  110          CONTINUE               Y( JY ) = Y( JY ) + ALPHA*TEMP               JY      = JY      + INCY  120       CONTINUE         END IF      END IF*      RETURN**     End of DGEMV .*      END      SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )*     .. Scalar Arguments ..      DOUBLE PRECISION   ALPHA      INTEGER            INCX, INCY, LDA, M, N*     .. Array Arguments ..      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )*     ..**  Purpose*  =======**  DGER   performs the rank 1 operation**     A := alpha*x*y' + A,
*
*  where alpha is a scalar, x is an m element vector, y is an n element
*  vector and A is an m by n matrix.
*
*  Parameters
*  ==========
*
*  M      - INTEGER.
*           On entry, M specifies the number of rows of the matrix A.
*           M must be at least zero.
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry, N specifies the number of columns of the matrix A.
*           N must be at least zero.
*           Unchanged on exit.
*
*  ALPHA  - DOUBLE PRECISION.
*           On entry, ALPHA specifies the scalar alpha.
*           Unchanged on exit.
*
*  X      - DOUBLE PRECISION array of dimension at least
*           ( 1 + ( m - 1 )*abs( INCX ) ).
*           Before entry, the incremented array X must contain the m
*           element vector x.
*           Unchanged on exit.
*
*  INCX   - INTEGER.
*           On entry, INCX specifies the increment for the elements of
*           X. INCX must not be zero.
*           Unchanged on exit.
*
*  Y      - DOUBLE PRECISION array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCY ) ).
*           Before entry, the incremented array Y must contain the n
*           element vector y.
*           Unchanged on exit.
*
*  INCY   - INTEGER.
*           On entry, INCY specifies the increment for the elements of
*           Y. INCY must not be zero.
*           Unchanged on exit.
*
*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
*           Before entry, the leading m by n part of the array A must
*           contain the matrix of coefficients. On exit, A is
*           overwritten by the updated matrix.
*
*  LDA    - INTEGER.
*           On entry, LDA specifies the first dimension of A as declared
*           in the calling (sub) program. LDA must be at least
*           max( 1, m ).
*           Unchanged on exit.
*
*
*  Level 2 Blas routine.
*
*  -- Written on 22-October-1986.
*     Jack Dongarra, Argonne National Lab.
*     Jeremy Du Croz, Nag Central Office.
*     Sven Hammarling, Nag Central Office.
*     Richard Hanson, Sandia National Labs.
*
*
*     .. Parameters ..
      DOUBLE PRECISION   ZERO
      PARAMETER        ( ZERO = 0.0D+0 )
*     .. Local Scalars ..
      DOUBLE PRECISION   TEMP
      INTEGER            I, INFO, IX, J, JY, KX
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     .. Intrinsic Functions ..
      INTRINSIC          MAX
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      INFO = 0
      IF     ( M.LT.0 )THEN
         INFO = 1
      ELSE IF( N.LT.0 )THEN
         INFO = 2
      ELSE IF( INCX.EQ.0 )THEN
         INFO = 5
      ELSE IF( INCY.EQ.0 )THEN
         INFO = 7
      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
         INFO = 9
      END IF
      IF( INFO.NE.0 )THEN
         CALL XERBLA( 'DGER  ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
     $   RETURN
*
*     Start the operations. In this version the elements of A are
*     accessed sequentially with one pass through A.
*
      IF( INCY.GT.0 )THEN
         JY = 1
      ELSE
         JY = 1 - ( N - 1 )*INCY
      END IF
      IF( INCX.EQ.1 )THEN
         DO 20, J = 1, N
            IF( Y( JY ).NE.ZERO )THEN
               TEMP = ALPHA*Y( JY )
               DO 10, I = 1, M
                  A( I, J ) = A( I, J ) + X( I )*TEMP
   10          CONTINUE
            END IF
            JY = JY + INCY
   20    CONTINUE
      ELSE
         IF( INCX.GT.0 )THEN
            KX = 1
         ELSE
            KX = 1 - ( M - 1 )*INCX
         END IF
         DO 40, J = 1, N
            IF( Y( JY ).NE.ZERO )THEN
               TEMP = ALPHA*Y( JY )
               IX   = KX
               DO 30, I = 1, M
                  A( I, J ) = A( I, J ) + X( IX )*TEMP
                  IX        = IX        + INCX
   30          CONTINUE
            END IF
            JY = JY + INCY
   40    CONTINUE
      END IF
*
      RETURN
*
*     End of DGER  .
*
      END
      DOUBLE PRECISION FUNCTION DNRM2 ( N, X, INCX )
*     .. Scalar Arguments ..
      INTEGER                           INCX, N
*     .. Array Arguments ..
      DOUBLE PRECISION                  X( * )
*     ..
*
*  DNRM2 returns the euclidean norm of a vector via the function
*  name, so that
*
*     DNRM2 := sqrt( x









































































































































































































































































































































































































































'*x )****  -- This version written on 25-October-1982.*     Modified on 14-October-1993 to inline the call to DLASSQ.*     Sven Hammarling, Nag Ltd.***     .. Parameters ..      DOUBLE PRECISION      ONE         , ZERO      PARAMETER           ( ONE = 1.0D+0, ZERO = 0.0D+0 )*     .. Local Scalars ..      INTEGER               IX      DOUBLE PRECISION      ABSXI, NORM, SCALE, SSQ*     .. Intrinsic Functions ..      INTRINSIC             ABS, SQRT*     ..*     .. Executable Statements ..      IF( N.LT.1 .OR. INCX.LT.1 )THEN         NORM  = ZERO      ELSE IF( N.EQ.1 )THEN         NORM  = ABS( X( 1 ) )      ELSE         SCALE = ZERO         SSQ   = ONE*        The following loop is equivalent to this call to the LAPACK*        auxiliary routine:*        CALL DLASSQ( N, X, INCX, SCALE, SSQ )*         DO 10, IX = 1, 1 + ( N - 1 )*INCX, INCX            IF( X( IX ).NE.ZERO )THEN               ABSXI = ABS( X( IX ) )               IF( SCALE.LT.ABSXI )THEN                  SSQ   = ONE   + SSQ*( SCALE/ABSXI )**2                  SCALE = ABSXI               ELSE                  SSQ   = SSQ   +     ( ABSXI/SCALE )**2               END IF            END IF   10    CONTINUE         NORM  = SCALE * SQRT( SSQ )      END IF*      DNRM2 = NORM      RETURN**     End of DNRM2.*      END      subroutine  drot (n,dx,incx,dy,incy,c,s)cc     applies a plane rotation.c     jack dongarra, linpack, 3/11/78.c     modified 12/3/93, array(1) declarations changed to array(*)c      double precision dx(*),dy(*),dtemp,c,s      integer i,incx,incy,ix,iy,nc      if(n.le.0)return      if(incx.eq.1.and.incy.eq.1)go to 20cc       code for unequal increments or equal increments not equalc         to 1c      ix = 1      iy = 1      if(incx.lt.0)ix = (-n+1)*incx + 1      if(incy.lt.0)iy = (-n+1)*incy + 1      do 10 i = 1,n        dtemp = c*dx(ix) + s*dy(iy)        dy(iy) = c*dy(iy) - s*dx(ix)        dx(ix) = dtemp        ix = ix + incx        iy = iy + incy   10 continue      returncc       code for both increments equal to 1c   20 do 30 i = 1,n        dtemp = c*dx(i) + s*dy(i)        dy(i) = c*dy(i) - s*dx(i)        dx(i) = dtemp   30 continue      return      end      subroutine drotg(da,db,c,s)cc     construct givens plane rotation.c     jack dongarra, linpack, 3/11/78.c      double precision da,db,c,s,roe,scale,r,zc      roe = db      if( dabs(da) .gt. dabs(db) ) roe = da      scale = dabs(da) + dabs(db)      if( scale .ne. 0.0d0 ) go to 10         c = 1.0d0         s = 0.0d0         r = 0.0d0         z = 0.0d0         go to 20   10 r = scale*dsqrt((da/scale)**2 + (db/scale)**2)      r = dsign(1.0d0,roe)*r      c = da/r      s = db/r      z = 1.0d0      if( dabs(da) .gt. dabs(db) ) z = s      if( dabs(db) .ge. dabs(da) .and. c .ne. 0.0d0 ) z = 1.0d0/c   20 da = r      db = z      return      end      SUBROUTINE DROTM (N,DX,INCX,DY,INCY,DPARAM)CC     APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIXCC     (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE INC     (DY**T)CC     DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSEC     LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.C     WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..CC     DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0CC       (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0)C     H=(          )    (          )    (          )    (          )C       (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).C     SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.C      INTEGER N, INCX, INCY      INTEGER NSTEPS, I, KX,KY      DOUBLE PRECISION DFLAG,DH12,DH22,DX,TWO,Z,DH11,DH21,     1 DPARAM,DY,W,ZERO      DIMENSION DX(1),DY(1),DPARAM(5)      DATA ZERO,TWO/0.D0,2.D0/C      DFLAG=DPARAM(1)      IF(N .LE. 0 .OR.(DFLAG+TWO.EQ.ZERO)) GO TO 140          IF(.NOT.(INCX.EQ.INCY.AND. INCX .GT.0)) GO TO 70C               NSTEPS=N*INCX               IF(DFLAG) 50,10,30   10          CONTINUE               DH12=DPARAM(4)               DH21=DPARAM(3)                    DO 20 I=1,NSTEPS,INCX                    W=DX(I)                    Z=DY(I)                    DX(I)=W+Z*DH12                    DY(I)=W*DH21+Z   20               CONTINUE               GO TO 140   30          CONTINUE               DH11=DPARAM(2)               DH22=DPARAM(5)                    DO 40 I=1,NSTEPS,INCX                    W=DX(I)                    Z=DY(I)                    DX(I)=W*DH11+Z                    DY(I)=-W+DH22*Z   40               CONTINUE               GO TO 140   50          CONTINUE               DH11=DPARAM(2)               DH12=DPARAM(4)               DH21=DPARAM(3)               DH22=DPARAM(5)                    DO 60 I=1,NSTEPS,INCX                    W=DX(I)                    Z=DY(I)                    DX(I)=W*DH11+Z*DH12                    DY(I)=W*DH21+Z*DH22   60               CONTINUE               GO TO 140   70     CONTINUE          KX=1          KY=1          IF(INCX .LT. 0) KX=1+(1-N)*INCX          IF(INCY .LT. 0) KY=1+(1-N)*INCYC          IF(DFLAG)120,80,100   80     CONTINUE          DH12=DPARAM(4)          DH21=DPARAM(3)               DO 90 I=1,N               W=DX(KX)               Z=DY(KY)               DX(KX)=W+Z*DH12               DY(KY)=W*DH21+Z               KX=KX+INCX               KY=KY+INCY   90          CONTINUE          GO TO 140  100     CONTINUE          DH11=DPARAM(2)          DH22=DPARAM(5)               DO 110 I=1,N               W=DX(KX)               Z=DY(KY)               DX(KX)=W*DH11+Z               DY(KY)=-W+DH22*Z               KX=KX+INCX               KY=KY+INCY  110          CONTINUE          GO TO 140  120     CONTINUE          DH11=DPARAM(2)          DH12=DPARAM(4)          DH21=DPARAM(3)          DH22=DPARAM(5)               DO 130 I=1,N               W=DX(KX)               Z=DY(KY)               DX(KX)=W*DH11+Z*DH12               DY(KY)=W*DH21+Z*DH22               KX=KX+INCX               KY=KY+INCY  130          CONTINUE  140     CONTINUE          RETURN          END      SUBROUTINE DROTMG (DD1,DD2,DX1,DY1,DPARAM)CC     CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROSC     THE SECOND COMPONENT OF THE 2-VECTOR  (DSQRT(DD1)*DX1,DSQRT(DD2)*C     DY2)**T.C     WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..CC     DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0CC       (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0)C     H=(          )    (          )    (          )    (          )C       (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).C     LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22C     RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THEC     VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)CC     THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BEC     INEXACT.  THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZEC     OF DD1 AND DD2.  ALL ACTUAL SCALING OF DATA IS DONE USING GAM.C      DOUBLE PRECISION GAM,ONE,RGAMSQ,DD2,DH11,DH21,DPARAM,DP2,     1 DQ2,DU,DY1,ZERO,GAMSQ,DD1,DFLAG,DH12,DH22,DP1,DQ1,     2 DTEMP,DX1,TWO      DIMENSION DPARAM(5)C      INTEGER IGOC      DATA ZERO,ONE,TWO /0.D0,1.D0,2.D0/      DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/C      IF(.NOT. DD1 .LT. ZERO) GO TO 10C       GO ZERO-H-D-AND-DX1..          GO TO 60   10 CONTINUEC     CASE-DD1-NONNEGATIVE      DP2=DD2*DY1      IF(.NOT. DP2 .EQ. ZERO) GO TO 20          DFLAG=-TWO          GO TO 260C     REGULAR-CASE..   20 CONTINUE      DP1=DD1*DX1      DQ2=DP2*DY1      DQ1=DP1*DX1C      IF(.NOT. DABS(DQ1) .GT. DABS(DQ2)) GO TO 40          DH21=-DY1/DX1          DH12=DP2/DP1C          DU=ONE-DH12*DH21C          IF(.NOT. DU .LE. ZERO) GO TO 30C         GO ZERO-H-D-AND-DX1..               GO TO 60   30     CONTINUE               DFLAG=ZERO               DD1=DD1/DU               DD2=DD2/DU               DX1=DX1*DUC         GO SCALE-CHECK..               GO TO 100   40 CONTINUE          IF(.NOT. DQ2 .LT. ZERO) GO TO 50C         GO ZERO-H-D-AND-DX1..               GO TO 60   50     CONTINUE               DFLAG=ONE               DH11=DP1/DP2               DH22=DX1/DY1               DU=ONE+DH11*DH22               DTEMP=DD2/DU               DD2=DD1/DU               DD1=DTEMP               DX1=DY1*DUC         GO SCALE-CHECK               GO TO 100C     PROCEDURE..ZERO-H-D-AND-DX1..   60 CONTINUE          DFLAG=-ONE          DH11=ZERO          DH12=ZERO          DH21=ZERO          DH22=ZEROC          DD1=ZERO          DD2=ZERO          DX1=ZEROC         RETURN..          GO TO 220C     PROCEDURE..FIX-H..   70 CONTINUE      IF(.NOT. DFLAG .GE. ZERO) GO TO 90C          IF(.NOT. DFLAG .EQ. ZERO) GO TO 80          DH11=ONE          DH22=ONE          DFLAG=-ONE          GO TO 90   80     CONTINUE          DH21=-ONE          DH12=ONE          DFLAG=-ONE   90 CONTINUE      GO TO IGO,(120,150,180,210)C     PROCEDURE..SCALE-CHECK  100 CONTINUE  110     CONTINUE          IF(.NOT. DD1 .LE. RGAMSQ) GO TO 130               IF(DD1 .EQ. ZERO) GO TO 160               ASSIGN 120 TO IGOC              FIX-H..               GO TO 70  120          CONTINUE               DD1=DD1*GAM**2               DX1=DX1/GAM               DH11=DH11/GAM               DH12=DH12/GAM          GO TO 110  130 CONTINUE  140     CONTINUE          IF(.NOT. DD1 .GE. GAMSQ) GO TO 160               ASSIGN 150 TO IGOC              FIX-H..               GO TO 70  150          CONTINUE               DD1=DD1/GAM**2               DX1=DX1*GAM               DH11=DH11*GAM               DH12=DH12*GAM          GO TO 140  160 CONTINUE  170     CONTINUE          IF(.NOT. DABS(DD2) .LE. RGAMSQ) GO TO 190               IF(DD2 .EQ. ZERO) GO TO 220               ASSIGN 180 TO IGOC              FIX-H..               GO TO 70  180          CONTINUE               DD2=DD2*GAM**2               DH21=DH21/GAM               DH22=DH22/GAM          GO TO 170  190 CONTINUE  200     CONTINUE          IF(.NOT. DABS(DD2) .GE. GAMSQ) GO TO 220               ASSIGN 210 TO IGOC              FIX-H..               GO TO 70  210          CONTINUE               DD2=DD2/GAM**2               DH21=DH21*GAM               DH22=DH22*GAM          GO TO 200  220 CONTINUE          IF(DFLAG)250,230,240  230     CONTINUE               DPARAM(3)=DH21               DPARAM(4)=DH12               GO TO 260  240     CONTINUE               DPARAM(2)=DH11               DPARAM(5)=DH22               GO TO 260  250     CONTINUE               DPARAM(2)=DH11               DPARAM(3)=DH21               DPARAM(4)=DH12               DPARAM(5)=DH22  260 CONTINUE          DPARAM(1)=DFLAG          RETURN      END      SUBROUTINE DSBMV ( UPLO, N, K, ALPHA, A, LDA, X, INCX,     $                   BETA, Y, INCY )*     .. Scalar Arguments ..      DOUBLE PRECISION   ALPHA, BETA      INTEGER            INCX, INCY, K, LDA, N      CHARACTER*1        UPLO*     .. Array Arguments ..      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )*     ..**  Purpose*  =======**  DSBMV  performs the matrix-vector  operation**     y := alpha*A*x + beta*y,**  where alpha and beta are scalars, x and y are n element vectors and*  A is an n by n symmetric band matrix, with k super-diagonals.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On entry, UPLO specifies whether the upper or lower*           triangular part of the band matrix A is being supplied as*           follows:**              UPLO = 'U' or 'u


'   The upper triangular part of A is*                                  being supplied.**              UPLO = 'L' or 'l



















'   The lower triangular part of A is*                                  being supplied.**           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the order of the matrix A.*           N must be at least zero.*           Unchanged on exit.**  K      - INTEGER.*           On entry, K specifies the number of super-diagonals of the*           matrix A. K must satisfy  0 .le. K.*           Unchanged on exit.**  ALPHA  - DOUBLE PRECISION.*           On entry, ALPHA specifies the scalar alpha.*           Unchanged on exit.**  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).*           Before entry with UPLO = 'U' or 'u

















', the leading ( k + 1 )*           by n part of the array A must contain the upper triangular*           band part of the symmetric matrix, supplied column by*           column, with the leading diagonal of the matrix in row*           ( k + 1 ) of the array, the first super-diagonal starting at*           position 2 in row k, and so on. The top left k by k triangle*           of the array A is not referenced.*           The following program segment will transfer the upper*           triangular part of a symmetric band matrix from conventional*           full matrix storage to band storage:**                 DO 20, J = 1, N*                    M = K + 1 - J*                    DO 10, I = MAX( 1, J - K ), J*                       A( M + I, J ) = matrix( I, J )*              10    CONTINUE*              20 CONTINUE**           Before entry with UPLO = 'L' or 'l















































































', the leading ( k + 1 )*           by n part of the array A must contain the lower triangular*           band part of the symmetric matrix, supplied column by*           column, with the leading diagonal of the matrix in row 1 of*           the array, the first sub-diagonal starting at position 1 in*           row 2, and so on. The bottom right k by k triangle of the*           array A is not referenced.*           The following program segment will transfer the lower*           triangular part of a symmetric band matrix from conventional*           full matrix storage to band storage:**                 DO 20, J = 1, N*                    M = 1 - J*                    DO 10, I = J, MIN( N, J + K )*                       A( M + I, J ) = matrix( I, J )*              10    CONTINUE*              20 CONTINUE**           Unchanged on exit.**  LDA    - INTEGER.*           On entry, LDA specifies the first dimension of A as declared*           in the calling (sub) program. LDA must be at least*           ( k + 1 ).*           Unchanged on exit.**  X      - DOUBLE PRECISION array of DIMENSION at least*           ( 1 + ( n - 1 )*abs( INCX ) ).*           Before entry, the incremented array X must contain the*           vector x.*           Unchanged on exit.**  INCX   - INTEGER.*           On entry, INCX specifies the increment for the elements of*           X. INCX must not be zero.*           Unchanged on exit.**  BETA   - DOUBLE PRECISION.*           On entry, BETA specifies the scalar beta.*           Unchanged on exit.**  Y      - DOUBLE PRECISION array of DIMENSION at least*           ( 1 + ( n - 1 )*abs( INCY ) ).*           Before entry, the incremented array Y must contain the*           vector y. On exit, Y is overwritten by the updated vector y.**  INCY   - INTEGER.*           On entry, INCY specifies the increment for the elements of*           Y. INCY must not be zero.*           Unchanged on exit.***  Level 2 Blas routine.**  -- Written on 22-October-1986.*     Jack Dongarra, Argonne National Lab.*     Jeremy Du Croz, Nag Central Office.*     Sven Hammarling, Nag Central Office.*     Richard Hanson, Sandia National Labs.***     .. Parameters ..      DOUBLE PRECISION   ONE         , ZERO      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )*     .. Local Scalars ..      DOUBLE PRECISION   TEMP1, TEMP2      INTEGER            I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L*     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     .. Intrinsic Functions ..      INTRINSIC          MAX, MIN*     ..*     .. Executable Statements ..**     Test the input parameters.*      INFO = 0      IF     ( .NOT.LSAME( UPLO, 'U
' ).AND.     $         .NOT.LSAME( UPLO, 'L













' )      )THEN         INFO = 1      ELSE IF( N.LT.0 )THEN         INFO = 2      ELSE IF( K.LT.0 )THEN         INFO = 3      ELSE IF( LDA.LT.( K + 1 ) )THEN         INFO = 6      ELSE IF( INCX.EQ.0 )THEN         INFO = 8      ELSE IF( INCY.EQ.0 )THEN         INFO = 11      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DSBMV 






















































', INFO )         RETURN      END IF**     Quick return if possible.*      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )     $   RETURN**     Set up the start points in  X  and  Y.*      IF( INCX.GT.0 )THEN         KX = 1      ELSE         KX = 1 - ( N - 1 )*INCX      END IF      IF( INCY.GT.0 )THEN         KY = 1      ELSE         KY = 1 - ( N - 1 )*INCY      END IF**     Start the operations. In this version the elements of the array A*     are accessed sequentially with one pass through A.**     First form  y := beta*y.*      IF( BETA.NE.ONE )THEN         IF( INCY.EQ.1 )THEN            IF( BETA.EQ.ZERO )THEN               DO 10, I = 1, N                  Y( I ) = ZERO   10          CONTINUE            ELSE               DO 20, I = 1, N                  Y( I ) = BETA*Y( I )   20          CONTINUE            END IF         ELSE            IY = KY            IF( BETA.EQ.ZERO )THEN               DO 30, I = 1, N                  Y( IY ) = ZERO                  IY      = IY   + INCY   30          CONTINUE            ELSE               DO 40, I = 1, N                  Y( IY ) = BETA*Y( IY )                  IY      = IY           + INCY   40          CONTINUE            END IF         END IF      END IF      IF( ALPHA.EQ.ZERO )     $   RETURN      IF( LSAME( UPLO, 'U







































































































































































































































' ) )THEN**        Form  y  when upper triangle of A is stored.*         KPLUS1 = K + 1         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN            DO 60, J = 1, N               TEMP1 = ALPHA*X( J )               TEMP2 = ZERO               L     = KPLUS1 - J               DO 50, I = MAX( 1, J - K ), J - 1                  Y( I ) = Y( I ) + TEMP1*A( L + I, J )                  TEMP2  = TEMP2  + A( L + I, J )*X( I )   50          CONTINUE               Y( J ) = Y( J ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2   60       CONTINUE         ELSE            JX = KX            JY = KY            DO 80, J = 1, N               TEMP1 = ALPHA*X( JX )               TEMP2 = ZERO               IX    = KX               IY    = KY               L     = KPLUS1 - J               DO 70, I = MAX( 1, J - K ), J - 1                  Y( IY ) = Y( IY ) + TEMP1*A( L + I, J )                  TEMP2   = TEMP2   + A( L + I, J )*X( IX )                  IX      = IX      + INCX                  IY      = IY      + INCY   70          CONTINUE               Y( JY ) = Y( JY ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2               JX      = JX      + INCX               JY      = JY      + INCY               IF( J.GT.K )THEN                  KX = KX + INCX                  KY = KY + INCY               END IF   80       CONTINUE         END IF      ELSE**        Form  y  when lower triangle of A is stored.*         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN            DO 100, J = 1, N               TEMP1  = ALPHA*X( J )               TEMP2  = ZERO               Y( J ) = Y( J )       + TEMP1*A( 1, J )               L      = 1            - J               DO 90, I = J + 1, MIN( N, J + K )                  Y( I ) = Y( I ) + TEMP1*A( L + I, J )                  TEMP2  = TEMP2  + A( L + I, J )*X( I )   90          CONTINUE               Y( J ) = Y( J ) + ALPHA*TEMP2  100       CONTINUE         ELSE            JX = KX            JY = KY            DO 120, J = 1, N               TEMP1   = ALPHA*X( JX )               TEMP2   = ZERO               Y( JY ) = Y( JY )       + TEMP1*A( 1, J )               L       = 1             - J               IX      = JX               IY      = JY               DO 110, I = J + 1, MIN( N, J + K )                  IX      = IX      + INCX                  IY      = IY      + INCY                  Y( IY ) = Y( IY ) + TEMP1*A( L + I, J )                  TEMP2   = TEMP2   + A( L + I, J )*X( IX )  110          CONTINUE               Y( JY ) = Y( JY ) + ALPHA*TEMP2               JX      = JX      + INCX               JY      = JY      + INCY  120       CONTINUE         END IF      END IF*      RETURN**     End of DSBMV .*      END      subroutine  dscal(n,da,dx,incx)cc     scales a vector by a constant.c     uses unrolled loops for increment equal to one.c     jack dongarra, linpack, 3/11/78.c     modified 3/93 to return if incx .le. 0.c     modified 12/3/93, array(1) declarations changed to array(*)c      double precision da,dx(*)      integer i,incx,m,mp1,n,nincxc      if( n.le.0 .or. incx.le.0 )return      if(incx.eq.1)go to 20cc        code for increment not equal to 1c      nincx = n*incx      do 10 i = 1,nincx,incx        dx(i) = da*dx(i)   10 continue      returncc        code for increment equal to 1ccc        clean-up loopc   20 m = mod(n,5)      if( m .eq. 0 ) go to 40      do 30 i = 1,m        dx(i) = da*dx(i)   30 continue      if( n .lt. 5 ) return   40 mp1 = m + 1      do 50 i = mp1,n,5        dx(i) = da*dx(i)        dx(i + 1) = da*dx(i + 1)        dx(i + 2) = da*dx(i + 2)        dx(i + 3) = da*dx(i + 3)        dx(i + 4) = da*dx(i + 4)   50 continue      return      end*DECK DSDOT      DOUBLE PRECISION FUNCTION DSDOT (N, SX, INCX, SY, INCY)C***BEGIN PROLOGUE  DSDOTC***PURPOSE  Compute the inner product of two vectors with extendedC            precision accumulation and result.C***LIBRARY   SLATEC (BLAS)C***CATEGORY  D1A4C***TYPE      DOUBLE PRECISION (DSDOT-D, DCDOT-C)C***KEYWORDS  BLAS, COMPLEX VECTORS, DOT PRODUCT, INNER PRODUCT,C             LINEAR ALGEBRA, VECTORC***AUTHOR  Lawson, C. L., (JPL)C           Hanson, R. J., (SNLA)C           Kincaid, D. R., (U. of Texas)C           Krogh, F. T., (JPL)C***DESCRIPTIONCC                B L A S  SubprogramC    Description of ParametersCC     --Input--C        N  number of elements in input vector(s)C       SX  single precision vector with N elementsC     INCX  storage spacing between elements of SXC       SY  single precision vector with N elementsC     INCY  storage spacing between elements of SYCC     --Output--C    DSDOT  double precision dot product (zero if N.LE.0)CC     Returns D.P. dot product accumulated in D.P., for S.P. SX and SYC     DSDOT = sum for I = 0 to N-1 of  SX(LX+I*INCX) * SY(LY+I*INCY),C     where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY isC     defined in a similar way using INCY.CC***REFERENCES  C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.C                 Krogh, Basic linear algebra subprograms for FortranC                 usage, Algorithm No. 539, Transactions on MathematicalC                 Software 5, 3 (September 1979), pp. 308-323.C***ROUTINES CALLED  (NONE)C***REVISION HISTORY  (YYMMDD)C   791001  DATE WRITTENC   890831  Modified array declarations.  (WRB)C   890831  REVISION DATE from Version 3.2C   891214  Prologue converted to Version 4.0 format.  (BAB)C   920310  Corrected definition of LX in DESCRIPTION.  (WRB)C   920501  Reformatted the REFERENCES section.  (WRB)C***END PROLOGUE  DSDOT      REAL SX(*),SY(*)      INTEGER N, INCX, INCYC      INTEGER KX,KY,I,NSCC***FIRST EXECUTABLE STATEMENT  DSDOT      DSDOT = 0.0D0      IF (N .LE. 0) RETURN      IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 20CC     Code for unequal or nonpositive increments.C      KX = 1      KY = 1      IF (INCX .LT. 0) KX = 1+(1-N)*INCX      IF (INCY .LT. 0) KY = 1+(1-N)*INCY      DO 10 I = 1,N        DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))        KX = KX + INCX        KY = KY + INCY   10 CONTINUE      RETURNCC     Code for equal, positive, non-unit increments.C   20 NS = N*INCX      DO 30 I = 1,NS,INCX        DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))   30 CONTINUE      RETURN      END      SUBROUTINE DSPMV ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )*     .. Scalar Arguments ..      DOUBLE PRECISION   ALPHA, BETA      INTEGER            INCX, INCY, N      CHARACTER*1        UPLO*     .. Array Arguments ..      DOUBLE PRECISION   AP( * ), X( * ), Y( * )*     ..**  Purpose*  =======**  DSPMV  performs the matrix-vector operation**     y := alpha*A*x + beta*y,**  where alpha and beta are scalars, x and y are n element vectors and*  A is an n by n symmetric matrix, supplied in packed form.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On entry, UPLO specifies whether the upper or lower*           triangular part of the matrix A is supplied in the packed*           array AP as follows:**              UPLO = 'U' or 'u


'   The upper triangular part of A is*                                  supplied in AP.**              UPLO = 'L' or 'l















'   The lower triangular part of A is*                                  supplied in AP.**           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the order of the matrix A.*           N must be at least zero.*           Unchanged on exit.**  ALPHA  - DOUBLE PRECISION.*           On entry, ALPHA specifies the scalar alpha.*           Unchanged on exit.**  AP     - DOUBLE PRECISION array of DIMENSION at least*           ( ( n*( n + 1 ) )/2 ).*           Before entry with UPLO = 'U' or 'u




', the array AP must*           contain the upper triangular part of the symmetric matrix*           packed sequentially, column by column, so that AP( 1 )*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )*           and a( 2, 2 ) respectively, and so on.*           Before entry with UPLO = 'L' or 'l




























































', the array AP must*           contain the lower triangular part of the symmetric matrix*           packed sequentially, column by column, so that AP( 1 )*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )*           and a( 3, 1 ) respectively, and so on.*           Unchanged on exit.**  X      - DOUBLE PRECISION array of dimension at least*           ( 1 + ( n - 1 )*abs( INCX ) ).*           Before entry, the incremented array X must contain the n*           element vector x.*           Unchanged on exit.**  INCX   - INTEGER.*           On entry, INCX specifies the increment for the elements of*           X. INCX must not be zero.*           Unchanged on exit.**  BETA   - DOUBLE PRECISION.*           On entry, BETA specifies the scalar beta. When BETA is*           supplied as zero then Y need not be set on input.*           Unchanged on exit.**  Y      - DOUBLE PRECISION array of dimension at least*           ( 1 + ( n - 1 )*abs( INCY ) ).*           Before entry, the incremented array Y must contain the n*           element vector y. On exit, Y is overwritten by the updated*           vector y.**  INCY   - INTEGER.*           On entry, INCY specifies the increment for the elements of*           Y. INCY must not be zero.*           Unchanged on exit.***  Level 2 Blas routine.**  -- Written on 22-October-1986.*     Jack Dongarra, Argonne National Lab.*     Jeremy Du Croz, Nag Central Office.*     Sven Hammarling, Nag Central Office.*     Richard Hanson, Sandia National Labs.***     .. Parameters ..      DOUBLE PRECISION   ONE         , ZERO      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )*     .. Local Scalars ..      DOUBLE PRECISION   TEMP1, TEMP2      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY*     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     ..*     .. Executable Statements ..**     Test the input parameters.*      INFO = 0      IF     ( .NOT.LSAME( UPLO, 'U
' ).AND.     $         .NOT.LSAME( UPLO, 'L









' )      )THEN         INFO = 1      ELSE IF( N.LT.0 )THEN         INFO = 2      ELSE IF( INCX.EQ.0 )THEN         INFO = 6      ELSE IF( INCY.EQ.0 )THEN         INFO = 9      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DSPMV 























































', INFO )         RETURN      END IF**     Quick return if possible.*      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )     $   RETURN**     Set up the start points in  X  and  Y.*      IF( INCX.GT.0 )THEN         KX = 1      ELSE         KX = 1 - ( N - 1 )*INCX      END IF      IF( INCY.GT.0 )THEN         KY = 1      ELSE         KY = 1 - ( N - 1 )*INCY      END IF**     Start the operations. In this version the elements of the array AP*     are accessed sequentially with one pass through AP.**     First form  y := beta*y.*      IF( BETA.NE.ONE )THEN         IF( INCY.EQ.1 )THEN            IF( BETA.EQ.ZERO )THEN               DO 10, I = 1, N                  Y( I ) = ZERO   10          CONTINUE            ELSE               DO 20, I = 1, N                  Y( I ) = BETA*Y( I )   20          CONTINUE            END IF         ELSE            IY = KY            IF( BETA.EQ.ZERO )THEN               DO 30, I = 1, N                  Y( IY ) = ZERO                  IY      = IY   + INCY   30          CONTINUE            ELSE               DO 40, I = 1, N                  Y( IY ) = BETA*Y( IY )                  IY      = IY           + INCY   40          CONTINUE            END IF         END IF      END IF      IF( ALPHA.EQ.ZERO )     $   RETURN      KK = 1      IF( LSAME( UPLO, 'U
































































































' ) )THEN**        Form  y  when AP contains the upper triangle.*         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN            DO 60, J = 1, N               TEMP1 = ALPHA*X( J )               TEMP2 = ZERO               K     = KK               DO 50, I = 1, J - 1                  Y( I ) = Y( I ) + TEMP1*AP( K )                  TEMP2  = TEMP2  + AP( K )*X( I )                  K      = K      + 1   50          CONTINUE               Y( J ) = Y( J ) + TEMP1*AP( KK + J - 1 ) + ALPHA*TEMP2               KK     = KK     + J   60       CONTINUE         ELSE            JX = KX            JY = KY            DO 80, J = 1, N               TEMP1 = ALPHA*X( JX )               TEMP2 = ZERO               IX    = KX               IY    = KY               DO 70, K = KK, KK + J - 2                  Y( IY ) = Y( IY ) + TEMP1*AP( K )                  TEMP2   = TEMP2   + AP( K )*X( IX )                  IX      = IX      + INCX                  IY      = IY      + INCY   70          CONTINUE               Y( JY ) = Y( JY ) + TEMP1*AP( KK + J - 1 ) + ALPHA*TEMP2               JX      = JX      + INCX               JY      = JY      + INCY               KK      = KK      + J   80       CONTINUE         END IF      ELSE**        Form  y  when AP contains the lower triangle.*         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN            DO 100, J = 1, N               TEMP1  = ALPHA*X( J )               TEMP2  = ZERO               Y( J ) = Y( J )       + TEMP1*AP( KK )               K      = KK           + 1               DO 90, I = J + 1, N                  Y( I ) = Y( I ) + TEMP1*AP( K )                  TEMP2  = TEMP2  + AP( K )*X( I )                  K      = K      + 1   90          CONTINUE               Y( J ) = Y( J ) + ALPHA*TEMP2               KK     = KK     + ( N - J + 1 )  100       CONTINUE         ELSE            JX = KX            JY = KY            DO 120, J = 1, N               TEMP1   = ALPHA*X( JX )               TEMP2   = ZERO               Y( JY ) = Y( JY )       + TEMP1*AP( KK )               IX      = JX               IY      = JY               DO 110, K = KK + 1, KK + N - J                  IX      = IX      + INCX                  IY      = IY      + INCY                  Y( IY ) = Y( IY ) + TEMP1*AP( K )                  TEMP2   = TEMP2   + AP( K )*X( IX )  110          CONTINUE               Y( JY ) = Y( JY ) + ALPHA*TEMP2               JX      = JX      + INCX               JY      = JY      + INCY               KK      = KK      + ( N - J + 1 )  120       CONTINUE         END IF      END IF*      RETURN**     End of DSPMV .*      END      SUBROUTINE DSPR  ( UPLO, N, ALPHA, X, INCX, AP )*     .. Scalar Arguments ..      DOUBLE PRECISION   ALPHA      INTEGER            INCX, N      CHARACTER*1        UPLO*     .. Array Arguments ..      DOUBLE PRECISION   AP( * ), X( * )*     ..**  Purpose*  =======**  DSPR    performs the symmetric rank 1 operation**     A := alpha*x*x' + A,
*
*  where alpha is a real scalar, x is an n element vector and A is an
*  n by n symmetric matrix, supplied in packed form.
*
*  Parameters
*  ==========
*
*  UPLO   - CHARACTER*1.
*           On entry, UPLO specifies whether the upper or lower
*           triangular part of the matrix A is supplied in the packed
*           array AP as follows:
*
*              UPLO = 'U' or 'u'   The upper triangular part of A is
*                                  supplied in AP.
*
*              UPLO = 'L' or 'l'   The lower triangular part of A is
*                                  supplied in AP.
*
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry, N specifies the order of the matrix A.
*           N must be at least zero.
*           Unchanged on exit.
*
*  ALPHA  - DOUBLE PRECISION.
*           On entry, ALPHA specifies the scalar alpha.
*           Unchanged on exit.
*
*  X      - DOUBLE PRECISION array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCX ) ).
*           Before entry, the incremented array X must contain the n
*           element vector x.
*           Unchanged on exit.
*
*  INCX   - INTEGER.
*           On entry, INCX specifies the increment for the elements of
*           X. INCX must not be zero.
*           Unchanged on exit.
*
*  AP     - DOUBLE PRECISION array of DIMENSION at least
*           ( ( n*( n + 1 ) )/2 ).
*           Before entry with  UPLO = 'U' or 'u', the array AP must
*           contain the upper triangular part of the symmetric matrix
*           packed sequentially, column by column, so that AP( 1 )
*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
*           and a( 2, 2 ) respectively, and so on. On exit, the array
*           AP is overwritten by the upper triangular part of the
*           updated matrix.
*           Before entry with UPLO = 'L' or 'l', the array AP must
*           contain the lower triangular part of the symmetric matrix
*           packed sequentially, column by column, so that AP( 1 )
*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
*           and a( 3, 1 ) respectively, and so on. On exit, the array
*           AP is overwritten by the lower triangular part of the
*           updated matrix.
*
*
*  Level 2 Blas routine.
*
*  -- Written on 22-October-1986.
*     Jack Dongarra, Argonne National Lab.
*     Jeremy Du Croz, Nag Central Office.
*     Sven Hammarling, Nag Central Office.
*     Richard Hanson, Sandia National Labs.
*
*
*     .. Parameters ..
      DOUBLE PRECISION   ZERO
      PARAMETER        ( ZERO = 0.0D+0 )
*     .. Local Scalars ..
      DOUBLE PRECISION   TEMP
      INTEGER            I, INFO, IX, J, JX, K, KK, KX
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      INFO = 0
      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
     $         .NOT.LSAME( UPLO, 'L' )      )THEN
         INFO = 1
      ELSE IF( N.LT.0 )THEN
         INFO = 2
      ELSE IF( INCX.EQ.0 )THEN
         INFO = 5
      END IF
      IF( INFO.NE.0 )THEN
         CALL XERBLA( 'DSPR  ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
     $   RETURN
*
*     Set the start point in X if the increment is not unity.
*
      IF( INCX.LE.0 )THEN
         KX = 1 - ( N - 1 )*INCX
      ELSE IF( INCX.NE.1 )THEN
         KX = 1
      END IF
*
*     Start the operations. In this version the elements of the array AP
*     are accessed sequentially with one pass through AP.
*
      KK = 1
      IF( LSAME( UPLO, 'U' ) )THEN
*
*        Form  A  when upper triangle is stored in AP.
*
         IF( INCX.EQ.1 )THEN
            DO 20, J = 1, N
               IF( X( J ).NE.ZERO )THEN
                  TEMP = ALPHA*X( J )
                  K    = KK
                  DO 10, I = 1, J
                     AP( K ) = AP( K ) + X( I )*TEMP
                     K       = K       + 1
   10             CONTINUE
               END IF
               KK = KK + J
   20       CONTINUE
         ELSE
            JX = KX
            DO 40, J = 1, N
               IF( X( JX ).NE.ZERO )THEN
                  TEMP = ALPHA*X( JX )
                  IX   = KX
                  DO 30, K = KK, KK + J - 1
                     AP( K ) = AP( K ) + X( IX )*TEMP
                     IX      = IX      + INCX
   30             CONTINUE
               END IF
               JX = JX + INCX
               KK = KK + J
   40       CONTINUE
         END IF
      ELSE
*
*        Form  A  when lower triangle is stored in AP.
*
         IF( INCX.EQ.1 )THEN
            DO 60, J = 1, N
               IF( X( J ).NE.ZERO )THEN
                  TEMP = ALPHA*X( J )
                  K    = KK
                  DO 50, I = J, N
                     AP( K ) = AP( K ) + X( I )*TEMP
                     K       = K       + 1
   50             CONTINUE
               END IF
               KK = KK + N - J + 1
   60       CONTINUE
         ELSE
            JX = KX
            DO 80, J = 1, N
               IF( X( JX ).NE.ZERO )THEN
                  TEMP = ALPHA*X( JX )
                  IX   = JX
                  DO 70, K = KK, KK + N - J
                     AP( K ) = AP( K ) + X( IX )*TEMP
                     IX      = IX      + INCX
   70             CONTINUE
               END IF
               JX = JX + INCX
               KK = KK + N - J + 1
   80       CONTINUE
         END IF
      END IF
*
      RETURN
*
*     End of DSPR  .
*
      END
      SUBROUTINE DSPR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   ALPHA
      INTEGER            INCX, INCY, N
      CHARACTER*1        UPLO
*     .. Array Arguments ..
      DOUBLE PRECISION   AP( * ), X( * ), Y( * )
*     ..
*
*  Purpose
*  =======
*
*  DSPR2  performs the symmetric rank 2 operation
*
*     A := alpha*x*y' + alpha*y*x' + A,
*
*  where alpha is a scalar, x and y are n element vectors and A is an
*  n by n symmetric matrix, supplied in packed form.
*
*  Parameters
*  ==========
*
*  UPLO   - CHARACTER*1.
*           On entry, UPLO specifies whether the upper or lower
*           triangular part of the matrix A is supplied in the packed
*           array AP as follows:
*
*              UPLO = 'U' or 'u'   The upper triangular part of A is
*                                  supplied in AP.
*
*              UPLO = 'L' or 'l'   The lower triangular part of A is
*                                  supplied in AP.
*
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry, N specifies the order of the matrix A.
*           N must be at least zero.
*           Unchanged on exit.
*
*  ALPHA  - DOUBLE PRECISION.
*           On entry, ALPHA specifies the scalar alpha.
*           Unchanged on exit.
*
*  X      - DOUBLE PRECISION array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCX ) ).
*           Before entry, the incremented array X must contain the n
*           element vector x.
*           Unchanged on exit.
*
*  INCX   - INTEGER.
*           On entry, INCX specifies the increment for the elements of
*           X. INCX must not be zero.
*           Unchanged on exit.
*
*  Y      - DOUBLE PRECISION array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCY ) ).
*           Before entry, the incremented array Y must contain the n
*           element vector y.
*           Unchanged on exit.
*
*  INCY   - INTEGER.
*           On entry, INCY specifies the increment for the elements of
*           Y. INCY must not be zero.
*           Unchanged on exit.
*
*  AP     - DOUBLE PRECISION array of DIMENSION at least
*           ( ( n*( n + 1 ) )/2 ).
*           Before entry with  UPLO = 'U' or 'u', the array AP must
*           contain the upper triangular part of the symmetric matrix
*           packed sequentially, column by column, so that AP( 1 )
*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
*           and a( 2, 2 ) respectively, and so on. On exit, the array
*           AP is overwritten by the upper triangular part of the
*           updated matrix.
*           Before entry with UPLO = 'L' or 'l', the array AP must
*           contain the lower triangular part of the symmetric matrix
*           packed sequentially, column by column, so that AP( 1 )
*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
*           and a( 3, 1 ) respectively, and so on. On exit, the array
*           AP is overwritten by the lower triangular part of the
*           updated matrix.
*
*
*  Level 2 Blas routine.
*
*  -- Written on 22-October-1986.
*     Jack Dongarra, Argonne National Lab.
*     Jeremy Du Croz, Nag Central Office.
*     Sven Hammarling, Nag Central Office.
*     Richard Hanson, Sandia National Labs.
*
*
*     .. Parameters ..
      DOUBLE PRECISION   ZERO
      PARAMETER        ( ZERO = 0.0D+0 )
*     .. Local Scalars ..
      DOUBLE PRECISION   TEMP1, TEMP2
      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      INFO = 0
      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
     $         .NOT.LSAME( UPLO, 'L' )      )THEN
         INFO = 1
      ELSE IF( N.LT.0 )THEN
         INFO = 2
      ELSE IF( INCX.EQ.0 )THEN
         INFO = 5
      ELSE IF( INCY.EQ.0 )THEN
         INFO = 7
      END IF
      IF( INFO.NE.0 )THEN
         CALL XERBLA( 'DSPR2 ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
     $   RETURN
*
*     Set up the start points in X and Y if the increments are not both
*     unity.
*
      IF( ( INCX.NE.1 ).OR.( INCY.NE.1 ) )THEN
         IF( INCX.GT.0 )THEN
            KX = 1
         ELSE
            KX = 1 - ( N - 1 )*INCX
         END IF
         IF( INCY.GT.0 )THEN
            KY = 1
         ELSE
            KY = 1 - ( N - 1 )*INCY
         END IF
         JX = KX
         JY = KY
      END IF
*
*     Start the operations. In this version the elements of the array AP
*     are accessed sequentially with one pass through AP.
*
      KK = 1
      IF( LSAME( UPLO, 'U' ) )THEN
*
*        Form  A  when upper triangle is stored in AP.
*
         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
            DO 20, J = 1, N
               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
                  TEMP1 = ALPHA*Y( J )
                  TEMP2 = ALPHA*X( J )
                  K     = KK
                  DO 10, I = 1, J
                     AP( K ) = AP( K ) + X( I )*TEMP1 + Y( I )*TEMP2
                     K       = K       + 1
   10             CONTINUE
               END IF
               KK = KK + J
   20       CONTINUE
         ELSE
            DO 40, J = 1, N
               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
                  TEMP1 = ALPHA*Y( JY )
                  TEMP2 = ALPHA*X( JX )
                  IX    = KX
                  IY    = KY
                  DO 30, K = KK, KK + J - 1
                     AP( K ) = AP( K ) + X( IX )*TEMP1 + Y( IY )*TEMP2
                     IX      = IX      + INCX
                     IY      = IY      + INCY
   30             CONTINUE
               END IF
               JX = JX + INCX
               JY = JY + INCY
               KK = KK + J
   40       CONTINUE
         END IF
      ELSE
*
*        Form  A  when lower triangle is stored in AP.
*
         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
            DO 60, J = 1, N
               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN
                  TEMP1 = ALPHA*Y( J )
                  TEMP2 = ALPHA*X( J )
                  K     = KK
                  DO 50, I = J, N
                     AP( K ) = AP( K ) + X( I )*TEMP1 + Y( I )*TEMP2
                     K       = K       + 1
   50             CONTINUE
               END IF
               KK = KK + N - J + 1
   60       CONTINUE
         ELSE
            DO 80, J = 1, N
               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN
                  TEMP1 = ALPHA*Y( JY )
                  TEMP2 = ALPHA*X( JX )
                  IX    = JX
                  IY    = JY
                  DO 70, K = KK, KK + N - J
                     AP( K ) = AP( K ) + X( IX )*TEMP1 + Y( IY )*TEMP2
                     IX      = IX      + INCX
                     IY      = IY      + INCY
   70             CONTINUE
               END IF
               JX = JX + INCX
               JY = JY + INCY
               KK = KK + N - J + 1
   80       CONTINUE
         END IF
      END IF
*
      RETURN
*
*     End of DSPR2 .
*
      END
      subroutine  dswap (n,dx,incx,dy,incy)
c
c     interchanges two vectors.
c     uses unrolled loops for increments equal one.
c     jack dongarra, linpack, 3/11/78.
c     modified 12/3/93, array(1) declarations changed to array(*)
c
      double precision dx(*),dy(*),dtemp
      integer i,incx,incy,ix,iy,m,mp1,n
c
      if(n.le.0)return
      if(incx.eq.1.and.incy.eq.1)go to 20
c
c       code for unequal increments or equal increments not equal
c         to 1
c
      ix = 1
      iy = 1
      if(incx.lt.0)ix = (-n+1)*incx + 1
      if(incy.lt.0)iy = (-n+1)*incy + 1
      do 10 i = 1,n
        dtemp = dx(ix)
        dx(ix) = dy(iy)
        dy(iy) = dtemp
        ix = ix + incx
        iy = iy + incy
   10 continue
      return
c
c       code for both increments equal to 1
c
c
c       clean-up loop
c
   20 m = mod(n,3)
      if( m .eq. 0 ) go to 40
      do 30 i = 1,m
        dtemp = dx(i)
        dx(i) = dy(i)
        dy(i) = dtemp
   30 continue
      if( n .lt. 3 ) return
   40 mp1 = m + 1
      do 50 i = mp1,n,3
        dtemp = dx(i)
        dx(i) = dy(i)
        dy(i) = dtemp
        dtemp = dx(i + 1)
        dx(i + 1) = dy(i + 1)
        dy(i + 1) = dtemp
        dtemp = dx(i + 2)
        dx(i + 2) = dy(i + 2)
        dy(i + 2) = dtemp
   50 continue
      return
      end
      SUBROUTINE DSYMM ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB,
     $                   BETA, C, LDC )
*     .. Scalar Arguments ..
      CHARACTER*1        SIDE, UPLO
      INTEGER            M, N, LDA, LDB, LDC
      DOUBLE PRECISION   ALPHA, BETA
*     .. Array Arguments ..
      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * )
*     ..
*
*  Purpose
*  =======
*
*  DSYMM  performs one of the matrix-matrix operations
*
*     C := alpha*A*B + beta*C,
*
*  or
*
*     C := alpha*B*A + beta*C,
*
*  where alpha and beta are scalars,  A is a symmetric matrix and  B and
*  C are  m by n matrices.
*
*  Parameters
*  ==========
*
*  SIDE   - CHARACTER*1.
*           On entry,  SIDE  specifies whether  the  symmetric matrix  A
*           appears on the  left or right  in the  operation as follows:
*
*              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
*
*              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
*
*           Unchanged on exit.
*
*  UPLO   - CHARACTER*1.
*           On  entry,   UPLO  specifies  whether  the  upper  or  lower
*           triangular  part  of  the  symmetric  matrix   A  is  to  be
*           referenced as follows:
*
*              UPLO = 'U' or 'u'   Only the upper triangular part of the
*                                  symmetric matrix is to be referenced.
*
*              UPLO = 'L' or 'l'   Only the lower triangular part of the
*                                  symmetric matrix is to be referenced.
*
*           Unchanged on exit.
*
*  M      - INTEGER.
*           On entry,  M  specifies the number of rows of the matrix  C.
*           M  must be at least zero.
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry, N specifies the number of columns of the matrix C.
*           N  must be at least zero.
*           Unchanged on exit.
*
*  ALPHA  - DOUBLE PRECISION.
*           On entry, ALPHA specifies the scalar alpha.
*           Unchanged on exit.
*
*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
*           m  when  SIDE = 'L' or 'l'  and is  n otherwise.
*           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
*           the array  A  must contain the  symmetric matrix,  such that
*           when  UPLO = 'U' or 'u', the leading m by m upper triangular
*           part of the array  A  must contain the upper triangular part
*           of the  symmetric matrix and the  strictly  lower triangular
*           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
*           the leading  m by m  lower triangular part  of the  array  A
*           must  contain  the  lower triangular part  of the  symmetric
*           matrix and the  strictly upper triangular part of  A  is not
*           referenced.
*           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
*           the array  A  must contain the  symmetric matrix,  such that
*           when  UPLO = 'U' or 'u', the leading n by n upper triangular
*           part of the array  A  must contain the upper triangular part
*           of the  symmetric matrix and the  strictly  lower triangular
*           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
*           the leading  n by n  lower triangular part  of the  array  A
*           must  contain  the  lower triangular part  of the  symmetric
*           matrix and the  strictly upper triangular part of  A  is not
*           referenced.
*           Unchanged on exit.
*
*  LDA    - INTEGER.
*           On entry, LDA specifies the first dimension of A as declared
*           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
*           LDA must be at least  max( 1, m ), otherwise  LDA must be at
*           least  max( 1, n ).
*           Unchanged on exit.
*
*  B      - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
*           Before entry, the leading  m by n part of the array  B  must
*           contain the matrix B.
*           Unchanged on exit.
*
*  LDB    - INTEGER.
*           On entry, LDB specifies the first dimension of B as declared
*           in  the  calling  (sub)  program.   LDB  must  be  at  least
*           max( 1, m ).
*           Unchanged on exit.
*
*  BETA   - DOUBLE PRECISION.
*           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
*           supplied as zero then C need not be set on input.
*           Unchanged on exit.
*
*  C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
*           Before entry, the leading  m by n  part of the array  C must
*           contain the matrix  C,  except when  beta  is zero, in which
*           case C need not be set on entry.
*           On exit, the array  C  is overwritten by the  m by n updated
*           matrix.
*
*  LDC    - INTEGER.
*           On entry, LDC specifies the first dimension of C as declared
*           in  the  calling  (sub)  program.   LDC  must  be  at  least
*           max( 1, m ).
*           Unchanged on exit.
*
*
*  Level 3 Blas routine.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     .. Intrinsic Functions ..
      INTRINSIC          MAX
*     .. Local Scalars ..
      LOGICAL            UPPER
      INTEGER            I, INFO, J, K, NROWA
      DOUBLE PRECISION   TEMP1, TEMP2
*     .. Parameters ..
      DOUBLE PRECISION   ONE         , ZERO
      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
*     ..
*     .. Executable Statements ..
*
*     Set NROWA as the number of rows of A.
*
      IF( LSAME( SIDE, 'L' ) )THEN
         NROWA = M
      ELSE
         NROWA = N
      END IF
      UPPER = LSAME( UPLO, 'U' )
*
*     Test the input parameters.
*
      INFO = 0
      IF(      ( .NOT.LSAME( SIDE, 'L' ) ).AND.
     $         ( .NOT.LSAME( SIDE, 'R' ) )      )THEN
         INFO = 1
      ELSE IF( ( .NOT.UPPER              ).AND.
     $         ( .NOT.LSAME( UPLO, 'L' ) )      )THEN
         INFO = 2
      ELSE IF( M  .LT.0               )THEN
         INFO = 3
      ELSE IF( N  .LT.0               )THEN
         INFO = 4
      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
         INFO = 7
      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN
         INFO = 9
      ELSE IF( LDC.LT.MAX( 1, M     ) )THEN
         INFO = 12
      END IF
      IF( INFO.NE.0 )THEN
         CALL XERBLA( 'DSYMM ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
     $    ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
     $   RETURN
*
*     And when  alpha.eq.zero.
*
      IF( ALPHA.EQ.ZERO )THEN
         IF( BETA.EQ.ZERO )THEN
            DO 20, J = 1, N
               DO 10, I = 1, M
                  C( I, J ) = ZERO
   10          CONTINUE
   20       CONTINUE
         ELSE
            DO 40, J = 1, N
               DO 30, I = 1, M
                  C( I, J ) = BETA*C( I, J )
   30          CONTINUE
   40       CONTINUE
         END IF
         RETURN
      END IF
*
*     Start the operations.
*
      IF( LSAME( SIDE, 'L' ) )THEN
*
*        Form  C := alpha*A*B + beta*C.
*
         IF( UPPER )THEN
            DO 70, J = 1, N
               DO 60, I = 1, M
                  TEMP1 = ALPHA*B( I, J )
                  TEMP2 = ZERO
                  DO 50, K = 1, I - 1
                     C( K, J ) = C( K, J ) + TEMP1    *A( K, I )
                     TEMP2     = TEMP2     + B( K, J )*A( K, I )
   50             CONTINUE
                  IF( BETA.EQ.ZERO )THEN
                     C( I, J ) = TEMP1*A( I, I ) + ALPHA*TEMP2
                  ELSE
                     C( I, J ) = BETA *C( I, J ) +
     $                           TEMP1*A( I, I ) + ALPHA*TEMP2
                  END IF
   60          CONTINUE
   70       CONTINUE
         ELSE
            DO 100, J = 1, N
               DO 90, I = M, 1, -1
                  TEMP1 = ALPHA*B( I, J )
                  TEMP2 = ZERO
                  DO 80, K = I + 1, M
                     C( K, J ) = C( K, J ) + TEMP1    *A( K, I )
                     TEMP2     = TEMP2     + B( K, J )*A( K, I )
   80             CONTINUE
                  IF( BETA.EQ.ZERO )THEN
                     C( I, J ) = TEMP1*A( I, I ) + ALPHA*TEMP2
                  ELSE
                     C( I, J ) = BETA *C( I, J ) +
     $                           TEMP1*A( I, I ) + ALPHA*TEMP2
                  END IF
   90          CONTINUE
  100       CONTINUE
         END IF
      ELSE
*
*        Form  C := alpha*B*A + beta*C.
*
         DO 170, J = 1, N
            TEMP1 = ALPHA*A( J, J )
            IF( BETA.EQ.ZERO )THEN
               DO 110, I = 1, M
                  C( I, J ) = TEMP1*B( I, J )
  110          CONTINUE
            ELSE
               DO 120, I = 1, M
                  C( I, J ) = BETA*C( I, J ) + TEMP1*B( I, J )
  120          CONTINUE
            END IF
            DO 140, K = 1, J - 1
               IF( UPPER )THEN
                  TEMP1 = ALPHA*A( K, J )
               ELSE
                  TEMP1 = ALPHA*A( J, K )
               END IF
               DO 130, I = 1, M
                  C( I, J ) = C( I, J ) + TEMP1*B( I, K )
  130          CONTINUE
  140       CONTINUE
            DO 160, K = J + 1, N
               IF( UPPER )THEN
                  TEMP1 = ALPHA*A( J, K )
               ELSE
                  TEMP1 = ALPHA*A( K, J )
               END IF
               DO 150, I = 1, M
                  C( I, J ) = C( I, J ) + TEMP1*B( I, K )
  150          CONTINUE
  160       CONTINUE
  170    CONTINUE
      END IF
*
      RETURN
*
*     End of DSYMM .
*
      END
      SUBROUTINE DSYMV ( UPLO, N, ALPHA, A, LDA, X, INCX,
     $                   BETA, Y, INCY )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   ALPHA, BETA
      INTEGER            INCX, INCY, LDA, N
      CHARACTER*1        UPLO
*     .. Array Arguments ..
      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
*     ..
*
*  Purpose
*  =======
*
*  DSYMV  performs the matrix-vector  operation
*
*     y := alpha*A*x + beta*y,
*
*  where alpha and beta are scalars, x and y are n element vectors and
*  A is an n by n symmetric matrix.
*
*  Parameters
*  ==========
*
*  UPLO   - CHARACTER*1.
*           On entry, UPLO specifies whether the upper or lower
*           triangular part of the array A is to be referenced as
*           follows:
*
*              UPLO = 'U' or 'u'   Only the upper triangular part of A
*                                  is to be referenced.
*
*              UPLO = 'L' or 'l'   Only the lower triangular part of A
*                                  is to be referenced.
*
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry, N specifies the order of the matrix A.
*           N must be at least zero.
*           Unchanged on exit.
*
*  ALPHA  - DOUBLE PRECISION.
*           On entry, ALPHA specifies the scalar alpha.
*           Unchanged on exit.
*
*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
*           Before entry with  UPLO = 'U' or 'u', the leading n by n
*           upper triangular part of the array A must contain the upper
*           triangular part of the symmetric matrix and the strictly
*           lower triangular part of A is not referenced.
*           Before entry with UPLO = 'L' or 'l', the leading n by n
*           lower triangular part of the array A must contain the lower
*           triangular part of the symmetric matrix and the strictly
*           upper triangular part of A is not referenced.
*           Unchanged on exit.
*
*  LDA    - INTEGER.
*           On entry, LDA specifies the first dimension of A as declared
*           in the calling (sub) program. LDA must be at least
*           max( 1, n ).
*           Unchanged on exit.
*
*  X      - DOUBLE PRECISION array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCX ) ).
*           Before entry, the incremented array X must contain the n
*           element vector x.
*           Unchanged on exit.
*
*  INCX   - INTEGER.
*           On entry, INCX specifies the increment for the elements of
*           X. INCX must not be zero.
*           Unchanged on exit.
*
*  BETA   - DOUBLE PRECISION.
*           On entry, BETA specifies the scalar beta. When BETA is
*           supplied as zero then Y need not be set on input.
*           Unchanged on exit.
*
*  Y      - DOUBLE PRECISION array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCY ) ).
*           Before entry, the incremented array Y must contain the n
*           element vector y. On exit, Y is overwritten by the updated
*           vector y.
*
*  INCY   - INTEGER.
*           On entry, INCY specifies the increment for the elements of
*           Y. INCY must not be zero.
*           Unchanged on exit.
*
*
*  Level 2 Blas routine.
*
*  -- Written on 22-October-1986.
*     Jack Dongarra, Argonne National Lab.
*     Jeremy Du Croz, Nag Central Office.
*     Sven Hammarling, Nag Central Office.
*     Richard Hanson, Sandia National Labs.
*
*
*     .. Parameters ..
      DOUBLE PRECISION   ONE         , ZERO
      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
*     .. Local Scalars ..
      DOUBLE PRECISION   TEMP1, TEMP2
      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     .. Intrinsic Functions ..
      INTRINSIC          MAX
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      INFO = 0
      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
     $         .NOT.LSAME( UPLO, 'L' )      )THEN
         INFO = 1
      ELSE IF( N.LT.0 )THEN
         INFO = 2
      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
         INFO = 5
      ELSE IF( INCX.EQ.0 )THEN
         INFO = 7
      ELSE IF( INCY.EQ.0 )THEN
         INFO = 10
      END IF
      IF( INFO.NE.0 )THEN
         CALL XERBLA( 'DSYMV ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
     $   RETURN
*
*     Set up the start points in  X  and  Y.
*
      IF( INCX.GT.0 )THEN
         KX = 1
      ELSE
         KX = 1 - ( N - 1 )*INCX
      END IF
      IF( INCY.GT.0 )THEN
         KY = 1
      ELSE
         KY = 1 - ( N - 1 )*INCY
      END IF
*
*     Start the operations. In this version the elements of A are
*     accessed sequentially with one pass through the triangular part
*     of A.
*
*     First form  y := beta*y.
*
      IF( BETA.NE.ONE )THEN
         IF( INCY.EQ.1 )THEN
            IF( BETA.EQ.ZERO )THEN
               DO 10, I = 1, N
                  Y( I ) = ZERO
   10          CONTINUE
            ELSE
               DO 20, I = 1, N
                  Y( I ) = BETA*Y( I )
   20          CONTINUE
            END IF
         ELSE
            IY = KY
            IF( BETA.EQ.ZERO )THEN
               DO 30, I = 1, N
                  Y( IY ) = ZERO
                  IY      = IY   + INCY
   30          CONTINUE
            ELSE
               DO 40, I = 1, N
                  Y( IY ) = BETA*Y( IY )
                  IY      = IY           + INCY
   40          CONTINUE
            END IF
         END IF
      END IF
      IF( ALPHA.EQ.ZERO )
     $   RETURN
      IF( LSAME( UPLO, 'U' ) )THEN
*
*        Form  y  when A is stored in upper triangle.
*
         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
            DO 60, J = 1, N
               TEMP1 = ALPHA*X( J )
               TEMP2 = ZERO
               DO 50, I = 1, J - 1
                  Y( I ) = Y( I ) + TEMP1*A( I, J )
                  TEMP2  = TEMP2  + A( I, J )*X( I )
   50          CONTINUE
               Y( J ) = Y( J ) + TEMP1*A( J, J ) + ALPHA*TEMP2
   60       CONTINUE
         ELSE
            JX = KX
            JY = KY
            DO 80, J = 1, N
               TEMP1 = ALPHA*X( JX )
               TEMP2 = ZERO
               IX    = KX
               IY    = KY
               DO 70, I = 1, J - 1
                  Y( IY ) = Y( IY ) + TEMP1*A( I, J )
                  TEMP2   = TEMP2   + A( I, J )*X( IX )
                  IX      = IX      + INCX
                  IY      = IY      + INCY
   70          CONTINUE
               Y( JY ) = Y( JY ) + TEMP1*A( J, J ) + ALPHA*TEMP2
               JX      = JX      + INCX
               JY      = JY      + INCY
   80       CONTINUE
         END IF
      ELSE
*
*        Form  y  when A is stored in lower triangle.
*
         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
            DO 100, J = 1, N
               TEMP1  = ALPHA*X( J )
               TEMP2  = ZERO
               Y( J ) = Y( J )       + TEMP1*A( J, J )
               DO 90, I = J + 1, N
                  Y( I ) = Y( I ) + TEMP1*A( I, J )
                  TEMP2  = TEMP2  + A( I, J )*X( I )
   90          CONTINUE
               Y( J ) = Y( J ) + ALPHA*TEMP2
  100       CONTINUE
         ELSE
            JX = KX
            JY = KY
            DO 120, J = 1, N
               TEMP1   = ALPHA*X( JX )
               TEMP2   = ZERO
               Y( JY ) = Y( JY )       + TEMP1*A( J, J )
               IX      = JX
               IY      = JY
               DO 110, I = J + 1, N
                  IX      = IX      + INCX
                  IY      = IY      + INCY
                  Y( IY ) = Y( IY ) + TEMP1*A( I, J )
                  TEMP2   = TEMP2   + A( I, J )*X( IX )
  110          CONTINUE
               Y( JY ) = Y( JY ) + ALPHA*TEMP2
               JX      = JX      + INCX
               JY      = JY      + INCY
  120       CONTINUE
         END IF
      END IF
*
      RETURN
*
*     End of DSYMV .
*
      END
      SUBROUTINE DSYR  ( UPLO, N, ALPHA, X, INCX, A, LDA )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   ALPHA
      INTEGER            INCX, LDA, N
      CHARACTER*1        UPLO
*     .. Array Arguments ..
      DOUBLE PRECISION   A( LDA, * ), X( * )
*     ..
*
*  Purpose
*  =======
*
*  DSYR   performs the symmetric rank 1 operation
*
*     A := alpha*x*x












' + A,**  where alpha is a real scalar, x is an n element vector and A is an*  n by n symmetric matrix.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On entry, UPLO specifies whether the upper or lower*           triangular part of the array A is to be referenced as*           follows:**              UPLO = 'U' or 'u


'   Only the upper triangular part of A*                                  is to be referenced.**              UPLO = 'L' or 'l

























'   Only the lower triangular part of A*                                  is to be referenced.**           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the order of the matrix A.*           N must be at least zero.*           Unchanged on exit.**  ALPHA  - DOUBLE PRECISION.*           On entry, ALPHA specifies the scalar alpha.*           Unchanged on exit.**  X      - DOUBLE PRECISION array of dimension at least*           ( 1 + ( n - 1 )*abs( INCX ) ).*           Before entry, the incremented array X must contain the n*           element vector x.*           Unchanged on exit.**  INCX   - INTEGER.*           On entry, INCX specifies the increment for the elements of*           X. INCX must not be zero.*           Unchanged on exit.**  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).*           Before entry with  UPLO = 'U' or 'u





', the leading n by n*           upper triangular part of the array A must contain the upper*           triangular part of the symmetric matrix and the strictly*           lower triangular part of A is not referenced. On exit, the*           upper triangular part of the array A is overwritten by the*           upper triangular part of the updated matrix.*           Before entry with UPLO = 'L' or 'l









































', the leading n by n*           lower triangular part of the array A must contain the lower*           triangular part of the symmetric matrix and the strictly*           upper triangular part of A is not referenced. On exit, the*           lower triangular part of the array A is overwritten by the*           lower triangular part of the updated matrix.**  LDA    - INTEGER.*           On entry, LDA specifies the first dimension of A as declared*           in the calling (sub) program. LDA must be at least*           max( 1, n ).*           Unchanged on exit.***  Level 2 Blas routine.**  -- Written on 22-October-1986.*     Jack Dongarra, Argonne National Lab.*     Jeremy Du Croz, Nag Central Office.*     Sven Hammarling, Nag Central Office.*     Richard Hanson, Sandia National Labs.***     .. Parameters ..      DOUBLE PRECISION   ZERO      PARAMETER        ( ZERO = 0.0D+0 )*     .. Local Scalars ..      DOUBLE PRECISION   TEMP      INTEGER            I, INFO, IX, J, JX, KX*     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     .. Intrinsic Functions ..      INTRINSIC          MAX*     ..*     .. Executable Statements ..**     Test the input parameters.*      INFO = 0      IF     ( .NOT.LSAME( UPLO, 'U
' ).AND.     $         .NOT.LSAME( UPLO, 'L









' )      )THEN         INFO = 1      ELSE IF( N.LT.0 )THEN         INFO = 2      ELSE IF( INCX.EQ.0 )THEN         INFO = 5      ELSE IF( LDA.LT.MAX( 1, N ) )THEN         INFO = 7      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DSYR  




















', INFO )         RETURN      END IF**     Quick return if possible.*      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )     $   RETURN**     Set the start point in X if the increment is not unity.*      IF( INCX.LE.0 )THEN         KX = 1 - ( N - 1 )*INCX      ELSE IF( INCX.NE.1 )THEN         KX = 1      END IF**     Start the operations. In this version the elements of A are*     accessed sequentially with one pass through the triangular part*     of A.*      IF( LSAME( UPLO, 'U










































































' ) )THEN**        Form  A  when A is stored in upper triangle.*         IF( INCX.EQ.1 )THEN            DO 20, J = 1, N               IF( X( J ).NE.ZERO )THEN                  TEMP = ALPHA*X( J )                  DO 10, I = 1, J                     A( I, J ) = A( I, J ) + X( I )*TEMP   10             CONTINUE               END IF   20       CONTINUE         ELSE            JX = KX            DO 40, J = 1, N               IF( X( JX ).NE.ZERO )THEN                  TEMP = ALPHA*X( JX )                  IX   = KX                  DO 30, I = 1, J                     A( I, J ) = A( I, J ) + X( IX )*TEMP                     IX        = IX        + INCX   30             CONTINUE               END IF               JX = JX + INCX   40       CONTINUE         END IF      ELSE**        Form  A  when A is stored in lower triangle.*         IF( INCX.EQ.1 )THEN            DO 60, J = 1, N               IF( X( J ).NE.ZERO )THEN                  TEMP = ALPHA*X( J )                  DO 50, I = J, N                     A( I, J ) = A( I, J ) + X( I )*TEMP   50             CONTINUE               END IF   60       CONTINUE         ELSE            JX = KX            DO 80, J = 1, N               IF( X( JX ).NE.ZERO )THEN                  TEMP = ALPHA*X( JX )                  IX   = JX                  DO 70, I = J, N                     A( I, J ) = A( I, J ) + X( IX )*TEMP                     IX        = IX        + INCX   70             CONTINUE               END IF               JX = JX + INCX   80       CONTINUE         END IF      END IF*      RETURN**     End of DSYR  .*      END      SUBROUTINE DSYR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA )*     .. Scalar Arguments ..      DOUBLE PRECISION   ALPHA      INTEGER            INCX, INCY, LDA, N      CHARACTER*1        UPLO*     .. Array Arguments ..      DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )*     ..**  Purpose*  =======**  DSYR2  performs the symmetric rank 2 operation**     A := alpha*x*y' + alpha*y*x












' + A,**  where alpha is a scalar, x and y are n element vectors and A is an n*  by n symmetric matrix.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On entry, UPLO specifies whether the upper or lower*           triangular part of the array A is to be referenced as*           follows:**              UPLO = 'U' or 'u


'   Only the upper triangular part of A*                                  is to be referenced.**              UPLO = 'L' or 'l




































'   Only the lower triangular part of A*                                  is to be referenced.**           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the order of the matrix A.*           N must be at least zero.*           Unchanged on exit.**  ALPHA  - DOUBLE PRECISION.*           On entry, ALPHA specifies the scalar alpha.*           Unchanged on exit.**  X      - DOUBLE PRECISION array of dimension at least*           ( 1 + ( n - 1 )*abs( INCX ) ).*           Before entry, the incremented array X must contain the n*           element vector x.*           Unchanged on exit.**  INCX   - INTEGER.*           On entry, INCX specifies the increment for the elements of*           X. INCX must not be zero.*           Unchanged on exit.**  Y      - DOUBLE PRECISION array of dimension at least*           ( 1 + ( n - 1 )*abs( INCY ) ).*           Before entry, the incremented array Y must contain the n*           element vector y.*           Unchanged on exit.**  INCY   - INTEGER.*           On entry, INCY specifies the increment for the elements of*           Y. INCY must not be zero.*           Unchanged on exit.**  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).*           Before entry with  UPLO = 'U' or 'u





', the leading n by n*           upper triangular part of the array A must contain the upper*           triangular part of the symmetric matrix and the strictly*           lower triangular part of A is not referenced. On exit, the*           upper triangular part of the array A is overwritten by the*           upper triangular part of the updated matrix.*           Before entry with UPLO = 'L' or 'l









































', the leading n by n*           lower triangular part of the array A must contain the lower*           triangular part of the symmetric matrix and the strictly*           upper triangular part of A is not referenced. On exit, the*           lower triangular part of the array A is overwritten by the*           lower triangular part of the updated matrix.**  LDA    - INTEGER.*           On entry, LDA specifies the first dimension of A as declared*           in the calling (sub) program. LDA must be at least*           max( 1, n ).*           Unchanged on exit.***  Level 2 Blas routine.**  -- Written on 22-October-1986.*     Jack Dongarra, Argonne National Lab.*     Jeremy Du Croz, Nag Central Office.*     Sven Hammarling, Nag Central Office.*     Richard Hanson, Sandia National Labs.***     .. Parameters ..      DOUBLE PRECISION   ZERO      PARAMETER        ( ZERO = 0.0D+0 )*     .. Local Scalars ..      DOUBLE PRECISION   TEMP1, TEMP2      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY*     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     .. Intrinsic Functions ..      INTRINSIC          MAX*     ..*     .. Executable Statements ..**     Test the input parameters.*      INFO = 0      IF     ( .NOT.LSAME( UPLO, 'U
' ).AND.     $         .NOT.LSAME( UPLO, 'L











' )      )THEN         INFO = 1      ELSE IF( N.LT.0 )THEN         INFO = 2      ELSE IF( INCX.EQ.0 )THEN         INFO = 5      ELSE IF( INCY.EQ.0 )THEN         INFO = 7      ELSE IF( LDA.LT.MAX( 1, N ) )THEN         INFO = 9      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DSYR2 






























', INFO )         RETURN      END IF**     Quick return if possible.*      IF( ( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )     $   RETURN**     Set up the start points in X and Y if the increments are not both*     unity.*      IF( ( INCX.NE.1 ).OR.( INCY.NE.1 ) )THEN         IF( INCX.GT.0 )THEN            KX = 1         ELSE            KX = 1 - ( N - 1 )*INCX         END IF         IF( INCY.GT.0 )THEN            KY = 1         ELSE            KY = 1 - ( N - 1 )*INCY         END IF         JX = KX         JY = KY      END IF**     Start the operations. In this version the elements of A are*     accessed sequentially with one pass through the triangular part*     of A.*      IF( LSAME( UPLO, 'U





















































































' ) )THEN**        Form  A  when A is stored in the upper triangle.*         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN            DO 20, J = 1, N               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN                  TEMP1 = ALPHA*Y( J )                  TEMP2 = ALPHA*X( J )                  DO 10, I = 1, J                     A( I, J ) = A( I, J ) + X( I )*TEMP1 + Y( I )*TEMP2   10             CONTINUE               END IF   20       CONTINUE         ELSE            DO 40, J = 1, N               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN                  TEMP1 = ALPHA*Y( JY )                  TEMP2 = ALPHA*X( JX )                  IX    = KX                  IY    = KY                  DO 30, I = 1, J                     A( I, J ) = A( I, J ) + X( IX )*TEMP1     $                                     + Y( IY )*TEMP2                     IX        = IX        + INCX                     IY        = IY        + INCY   30             CONTINUE               END IF               JX = JX + INCX               JY = JY + INCY   40       CONTINUE         END IF      ELSE**        Form  A  when A is stored in the lower triangle.*         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN            DO 60, J = 1, N               IF( ( X( J ).NE.ZERO ).OR.( Y( J ).NE.ZERO ) )THEN                  TEMP1 = ALPHA*Y( J )                  TEMP2 = ALPHA*X( J )                  DO 50, I = J, N                     A( I, J ) = A( I, J ) + X( I )*TEMP1 + Y( I )*TEMP2   50             CONTINUE               END IF   60       CONTINUE         ELSE            DO 80, J = 1, N               IF( ( X( JX ).NE.ZERO ).OR.( Y( JY ).NE.ZERO ) )THEN                  TEMP1 = ALPHA*Y( JY )                  TEMP2 = ALPHA*X( JX )                  IX    = JX                  IY    = JY                  DO 70, I = J, N                     A( I, J ) = A( I, J ) + X( IX )*TEMP1     $                                     + Y( IY )*TEMP2                     IX        = IX        + INCX                     IY        = IY        + INCY   70             CONTINUE               END IF               JX = JX + INCX               JY = JY + INCY   80       CONTINUE         END IF      END IF*      RETURN**     End of DSYR2 .*      END      SUBROUTINE DSYR2K( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB,     $                   BETA, C, LDC )*     .. Scalar Arguments ..      CHARACTER*1        UPLO, TRANS      INTEGER            N, K, LDA, LDB, LDC      DOUBLE PRECISION   ALPHA, BETA*     .. Array Arguments ..      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * )*     ..**  Purpose*  =======**  DSYR2K  performs one of the symmetric rank 2k operations**     C := alpha*A*B' + alpha*B*A



' + beta*C,**  or**     C := alpha*A'*B + alpha*B













'*A + beta*C,**  where  alpha and beta  are scalars, C is an  n by n  symmetric matrix*  and  A and B  are  n by k  matrices  in the  first  case  and  k by n*  matrices in the second case.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On  entry,   UPLO  specifies  whether  the  upper  or  lower*           triangular  part  of the  array  C  is to be  referenced  as*           follows:**              UPLO = 'U' or 'u


'   Only the  upper triangular part of  C*                                  is to be referenced.**              UPLO = 'L' or 'l








'   Only the  lower triangular part of  C*                                  is to be referenced.**           Unchanged on exit.**  TRANS  - CHARACTER*1.*           On entry,  TRANS  specifies the operation to be performed as*           follows:**              TRANS = 'N' or 'n'   C := alpha*A*B' + alpha*B*A


' +*                                        beta*C.**              TRANS = 'T' or 't'   C := alpha*A'*B + alpha*B


'*A +*                                        beta*C.**              TRANS = 'C' or 'c'   C := alpha*A'*B + alpha*B










'*A +*                                        beta*C.**           Unchanged on exit.**  N      - INTEGER.*           On entry,  N specifies the order of the matrix C.  N must be*           at least zero.*           Unchanged on exit.**  K      - INTEGER.*           On entry with  TRANS = 'N' or 'n

',  K  specifies  the number*           of  columns  of the  matrices  A and B,  and on  entry  with*           TRANS = 'T' or 't' or 'C' or 'c








',  K  specifies  the  number*           of rows of the matrices  A and B.  K must be at least  zero.*           Unchanged on exit.**  ALPHA  - DOUBLE PRECISION.*           On entry, ALPHA specifies the scalar alpha.*           Unchanged on exit.**  A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is*           k  when  TRANS = 'N' or 'n
',  and is  n  otherwise.*           Before entry with  TRANS = 'N' or 'n







',  the  leading  n by k*           part of the array  A  must contain the matrix  A,  otherwise*           the leading  k by n  part of the array  A  must contain  the*           matrix A.*           Unchanged on exit.**  LDA    - INTEGER.*           On entry, LDA specifies the first dimension of A as declared*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n





'*           then  LDA must be at least  max( 1, n ), otherwise  LDA must*           be at least  max( 1, k ).*           Unchanged on exit.**  B      - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is*           k  when  TRANS = 'N' or 'n
',  and is  n  otherwise.*           Before entry with  TRANS = 'N' or 'n







',  the  leading  n by k*           part of the array  B  must contain the matrix  B,  otherwise*           the leading  k by n  part of the array  B  must contain  the*           matrix B.*           Unchanged on exit.**  LDB    - INTEGER.*           On entry, LDB specifies the first dimension of B as declared*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n









'*           then  LDB must be at least  max( 1, n ), otherwise  LDB must*           be at least  max( 1, k ).*           Unchanged on exit.**  BETA   - DOUBLE PRECISION.*           On entry, BETA specifies the scalar beta.*           Unchanged on exit.**  C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).*           Before entry  with  UPLO = 'U' or 'u





',  the leading  n by n*           upper triangular part of the array C must contain the upper*           triangular part  of the  symmetric matrix  and the strictly*           lower triangular part of C is not referenced.  On exit, the*           upper triangular part of the array  C is overwritten by the*           upper triangular part of the updated matrix.*           Before entry  with  UPLO = 'L' or 'l










































',  the leading  n by n*           lower triangular part of the array C must contain the lower*           triangular part  of the  symmetric matrix  and the strictly*           upper triangular part of C is not referenced.  On exit, the*           lower triangular part of the array  C is overwritten by the*           lower triangular part of the updated matrix.**  LDC    - INTEGER.*           On entry, LDC specifies the first dimension of C as declared*           in  the  calling  (sub)  program.   LDC  must  be  at  least*           max( 1, n ).*           Unchanged on exit.***  Level 3 Blas routine.***  -- Written on 8-February-1989.*     Jack Dongarra, Argonne National Laboratory.*     Iain Duff, AERE Harwell.*     Jeremy Du Croz, Numerical Algorithms Group Ltd.*     Sven Hammarling, Numerical Algorithms Group Ltd.***     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     .. Intrinsic Functions ..      INTRINSIC          MAX*     .. Local Scalars ..      LOGICAL            UPPER      INTEGER            I, INFO, J, L, NROWA      DOUBLE PRECISION   TEMP1, TEMP2*     .. Parameters ..      DOUBLE PRECISION   ONE         , ZERO      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )*     ..*     .. Executable Statements ..**     Test the input parameters.*      IF( LSAME( TRANS, 'N




' ) )THEN         NROWA = N      ELSE         NROWA = K      END IF      UPPER = LSAME( UPLO, 'U



' )*      INFO = 0      IF(      ( .NOT.UPPER               ).AND.     $         ( .NOT.LSAME( UPLO , 'L

' ) )      )THEN         INFO = 1      ELSE IF( ( .NOT.LSAME( TRANS, 'N
' ) ).AND.     $         ( .NOT.LSAME( TRANS, 'T
' ) ).AND.     $         ( .NOT.LSAME( TRANS, 'C













' ) )      )THEN         INFO = 2      ELSE IF( N  .LT.0               )THEN         INFO = 3      ELSE IF( K  .LT.0               )THEN         INFO = 4      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN         INFO = 7      ELSE IF( LDB.LT.MAX( 1, NROWA ) )THEN         INFO = 9      ELSE IF( LDC.LT.MAX( 1, N     ) )THEN         INFO = 12      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DSYR2K














































', INFO )         RETURN      END IF**     Quick return if possible.*      IF( ( N.EQ.0 ).OR.     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )     $   RETURN**     And when  alpha.eq.zero.*      IF( ALPHA.EQ.ZERO )THEN         IF( UPPER )THEN            IF( BETA.EQ.ZERO )THEN               DO 20, J = 1, N                  DO 10, I = 1, J                     C( I, J ) = ZERO   10             CONTINUE   20          CONTINUE            ELSE               DO 40, J = 1, N                  DO 30, I = 1, J                     C( I, J ) = BETA*C( I, J )   30             CONTINUE   40          CONTINUE            END IF         ELSE            IF( BETA.EQ.ZERO )THEN               DO 60, J = 1, N                  DO 50, I = J, N                     C( I, J ) = ZERO   50             CONTINUE   60          CONTINUE            ELSE               DO 80, J = 1, N                  DO 70, I = J, N                     C( I, J ) = BETA*C( I, J )   70             CONTINUE   80          CONTINUE            END IF         END IF         RETURN      END IF**     Start the operations.*      IF( LSAME( TRANS, 'N

' ) )THEN**        Form  C := alpha*A*B' + alpha*B*A


















































' + C.*         IF( UPPER )THEN            DO 130, J = 1, N               IF( BETA.EQ.ZERO )THEN                  DO 90, I = 1, J                     C( I, J ) = ZERO   90             CONTINUE               ELSE IF( BETA.NE.ONE )THEN                  DO 100, I = 1, J                     C( I, J ) = BETA*C( I, J )  100             CONTINUE               END IF               DO 120, L = 1, K                  IF( ( A( J, L ).NE.ZERO ).OR.     $                ( B( J, L ).NE.ZERO )     )THEN                     TEMP1 = ALPHA*B( J, L )                     TEMP2 = ALPHA*A( J, L )                     DO 110, I = 1, J                        C( I, J ) = C( I, J ) +     $                              A( I, L )*TEMP1 + B( I, L )*TEMP2  110                CONTINUE                  END IF  120          CONTINUE  130       CONTINUE         ELSE            DO 180, J = 1, N               IF( BETA.EQ.ZERO )THEN                  DO 140, I = J, N                     C( I, J ) = ZERO  140             CONTINUE               ELSE IF( BETA.NE.ONE )THEN                  DO 150, I = J, N                     C( I, J ) = BETA*C( I, J )  150             CONTINUE               END IF               DO 170, L = 1, K                  IF( ( A( J, L ).NE.ZERO ).OR.     $                ( B( J, L ).NE.ZERO )     )THEN                     TEMP1 = ALPHA*B( J, L )                     TEMP2 = ALPHA*A( J, L )                     DO 160, I = J, N                        C( I, J ) = C( I, J ) +     $                              A( I, L )*TEMP1 + B( I, L )*TEMP2  160                CONTINUE                  END IF  170          CONTINUE  180       CONTINUE         END IF      ELSE**        Form  C := alpha*A'*B + alpha*B


























































'*A + C.*         IF( UPPER )THEN            DO 210, J = 1, N               DO 200, I = 1, J                  TEMP1 = ZERO                  TEMP2 = ZERO                  DO 190, L = 1, K                     TEMP1 = TEMP1 + A( L, I )*B( L, J )                     TEMP2 = TEMP2 + B( L, I )*A( L, J )  190             CONTINUE                  IF( BETA.EQ.ZERO )THEN                     C( I, J ) = ALPHA*TEMP1 + ALPHA*TEMP2                  ELSE                     C( I, J ) = BETA *C( I, J ) +     $                           ALPHA*TEMP1 + ALPHA*TEMP2                  END IF  200          CONTINUE  210       CONTINUE         ELSE            DO 240, J = 1, N               DO 230, I = J, N                  TEMP1 = ZERO                  TEMP2 = ZERO                  DO 220, L = 1, K                     TEMP1 = TEMP1 + A( L, I )*B( L, J )                     TEMP2 = TEMP2 + B( L, I )*A( L, J )  220             CONTINUE                  IF( BETA.EQ.ZERO )THEN                     C( I, J ) = ALPHA*TEMP1 + ALPHA*TEMP2                  ELSE                     C( I, J ) = BETA *C( I, J ) +     $                           ALPHA*TEMP1 + ALPHA*TEMP2                  END IF  230          CONTINUE  240       CONTINUE         END IF      END IF*      RETURN**     End of DSYR2K.*      END      SUBROUTINE DSYRK ( UPLO, TRANS, N, K, ALPHA, A, LDA,     $                   BETA, C, LDC )*     .. Scalar Arguments ..      CHARACTER*1        UPLO, TRANS      INTEGER            N, K, LDA, LDC      DOUBLE PRECISION   ALPHA, BETA*     .. Array Arguments ..      DOUBLE PRECISION   A( LDA, * ), C( LDC, * )*     ..**  Purpose*  =======**  DSYRK  performs one of the symmetric rank k operations**     C := alpha*A*A' + beta*C,
*
*  or
*
*     C := alpha*A













'*A + beta*C,**  where  alpha and beta  are scalars, C is an  n by n  symmetric matrix*  and  A  is an  n by k  matrix in the first case and a  k by n  matrix*  in the second case.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On  entry,   UPLO  specifies  whether  the  upper  or  lower*           triangular  part  of the  array  C  is to be  referenced  as*           follows:**              UPLO = 'U' or 'u


'   Only the  upper triangular part of  C*                                  is to be referenced.**              UPLO = 'L' or 'l








'   Only the  lower triangular part of  C*                                  is to be referenced.**           Unchanged on exit.**  TRANS  - CHARACTER*1.*           On entry,  TRANS  specifies the operation to be performed as*           follows:**              TRANS = 'N' or 'n'   C := alpha*A*A' + beta*C.
*
*              TRANS = 'T' or 't'   C := alpha*A

'*A + beta*C.**              TRANS = 'C' or 'c'   C := alpha*A'*A + beta*C.
*
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry,  N specifies the order of the matrix C.  N must be
*           at least zero.
*           Unchanged on exit.
*
*  K      - INTEGER.
*           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
*           of  columns   of  the   matrix   A,   and  on   entry   with
*           TRANS = 'T' or 't' or 'C' or 'c',  K  specifies  the  number
*           of rows of the matrix  A.  K must be at least zero.
*           Unchanged on exit.
*
*  ALPHA  - DOUBLE PRECISION.
*           On entry, ALPHA specifies the scalar alpha.
*           Unchanged on exit.
*
*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
*           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
*           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
*           part of the array  A  must contain the matrix  A,  otherwise
*           the leading  k by n  part of the array  A  must contain  the
*           matrix A.
*           Unchanged on exit.
*
*  LDA    - INTEGER.
*           On entry, LDA specifies the first dimension of A as declared
*           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
*           then  LDA must be at least  max( 1, n ), otherwise  LDA must
*           be at least  max( 1, k ).
*           Unchanged on exit.
*
*  BETA   - DOUBLE PRECISION.
*           On entry, BETA specifies the scalar beta.
*           Unchanged on exit.
*
*  C      - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
*           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
*           upper triangular part of the array C must contain the upper
*           triangular part  of the  symmetric matrix  and the strictly
*           lower triangular part of C is not referenced.  On exit, the
*           upper triangular part of the array  C is overwritten by the
*           upper triangular part of the updated matrix.
*           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
*           lower triangular part of the array C must contain the lower
*           triangular part  of the  symmetric matrix  and the strictly
*           upper triangular part of C is not referenced.  On exit, the
*           lower triangular part of the array  C is overwritten by the
*           lower triangular part of the updated matrix.
*
*  LDC    - INTEGER.
*           On entry, LDC specifies the first dimension of C as declared
*           in  the  calling  (sub)  program.   LDC  must  be  at  least
*           max( 1, n ).
*           Unchanged on exit.
*
*
*  Level 3 Blas routine.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     .. Intrinsic Functions ..
      INTRINSIC          MAX
*     .. Local Scalars ..
      LOGICAL            UPPER
      INTEGER            I, INFO, J, L, NROWA
      DOUBLE PRECISION   TEMP
*     .. Parameters ..
      DOUBLE PRECISION   ONE ,         ZERO
      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      IF( LSAME( TRANS, 'N' ) )THEN
         NROWA = N
      ELSE
         NROWA = K
      END IF
      UPPER = LSAME( UPLO, 'U' )
*
      INFO = 0
      IF(      ( .NOT.UPPER               ).AND.
     $         ( .NOT.LSAME( UPLO , 'L' ) )      )THEN
         INFO = 1
      ELSE IF( ( .NOT.LSAME( TRANS, 'N' ) ).AND.
     $         ( .NOT.LSAME( TRANS, 'T' ) ).AND.
     $         ( .NOT.LSAME( TRANS, 'C' ) )      )THEN
         INFO = 2
      ELSE IF( N  .LT.0               )THEN
         INFO = 3
      ELSE IF( K  .LT.0               )THEN
         INFO = 4
      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
         INFO = 7
      ELSE IF( LDC.LT.MAX( 1, N     ) )THEN
         INFO = 10
      END IF
      IF( INFO.NE.0 )THEN
         CALL XERBLA( 'DSYRK ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( ( N.EQ.0 ).OR.
     $    ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
     $   RETURN
*
*     And when  alpha.eq.zero.
*
      IF( ALPHA.EQ.ZERO )THEN
         IF( UPPER )THEN
            IF( BETA.EQ.ZERO )THEN
               DO 20, J = 1, N
                  DO 10, I = 1, J
                     C( I, J ) = ZERO
   10             CONTINUE
   20          CONTINUE
            ELSE
               DO 40, J = 1, N
                  DO 30, I = 1, J
                     C( I, J ) = BETA*C( I, J )
   30             CONTINUE
   40          CONTINUE
            END IF
         ELSE
            IF( BETA.EQ.ZERO )THEN
               DO 60, J = 1, N
                  DO 50, I = J, N
                     C( I, J ) = ZERO
   50             CONTINUE
   60          CONTINUE
            ELSE
               DO 80, J = 1, N
                  DO 70, I = J, N
                     C( I, J ) = BETA*C( I, J )
   70             CONTINUE
   80          CONTINUE
            END IF
         END IF
         RETURN
      END IF
*
*     Start the operations.
*
      IF( LSAME( TRANS, 'N' ) )THEN
*
*        Form  C := alpha*A*A












































' + beta*C.*         IF( UPPER )THEN            DO 130, J = 1, N               IF( BETA.EQ.ZERO )THEN                  DO 90, I = 1, J                     C( I, J ) = ZERO   90             CONTINUE               ELSE IF( BETA.NE.ONE )THEN                  DO 100, I = 1, J                     C( I, J ) = BETA*C( I, J )  100             CONTINUE               END IF               DO 120, L = 1, K                  IF( A( J, L ).NE.ZERO )THEN                     TEMP = ALPHA*A( J, L )                     DO 110, I = 1, J                        C( I, J ) = C( I, J ) + TEMP*A( I, L )  110                CONTINUE                  END IF  120          CONTINUE  130       CONTINUE         ELSE            DO 180, J = 1, N               IF( BETA.EQ.ZERO )THEN                  DO 140, I = J, N                     C( I, J ) = ZERO  140             CONTINUE               ELSE IF( BETA.NE.ONE )THEN                  DO 150, I = J, N                     C( I, J ) = BETA*C( I, J )  150             CONTINUE               END IF               DO 170, L = 1, K                  IF( A( J, L ).NE.ZERO )THEN                     TEMP      = ALPHA*A( J, L )                     DO 160, I = J, N                        C( I, J ) = C( I, J ) + TEMP*A( I, L )  160                CONTINUE                  END IF  170          CONTINUE  180       CONTINUE         END IF      ELSE**        Form  C := alpha*A'*A + beta*C.
*
         IF( UPPER )THEN
            DO 210, J = 1, N
               DO 200, I = 1, J
                  TEMP = ZERO
                  DO 190, L = 1, K
                     TEMP = TEMP + A( L, I )*A( L, J )
  190             CONTINUE
                  IF( BETA.EQ.ZERO )THEN
                     C( I, J ) = ALPHA*TEMP
                  ELSE
                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
                  END IF
  200          CONTINUE
  210       CONTINUE
         ELSE
            DO 240, J = 1, N
               DO 230, I = J, N
                  TEMP = ZERO
                  DO 220, L = 1, K
                     TEMP = TEMP + A( L, I )*A( L, J )
  220             CONTINUE
                  IF( BETA.EQ.ZERO )THEN
                     C( I, J ) = ALPHA*TEMP
                  ELSE
                     C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
                  END IF
  230          CONTINUE
  240       CONTINUE
         END IF
      END IF
*
      RETURN
*
*     End of DSYRK .
*
      END
      SUBROUTINE DTBMV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
*     .. Scalar Arguments ..
      INTEGER            INCX, K, LDA, N
      CHARACTER*1        DIAG, TRANS, UPLO
*     .. Array Arguments ..
      DOUBLE PRECISION   A( LDA, * ), X( * )
*     ..
*
*  Purpose
*  =======
*
*  DTBMV  performs one of the matrix-vector operations
*
*     x := A*x,   or   x := A











'*x,**  where x is an n element vector and  A is an n by n unit, or non-unit,*  upper or lower triangular band matrix, with ( k + 1 ) diagonals.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On entry, UPLO specifies whether the matrix is an upper or*           lower triangular matrix as follows:**              UPLO = 'U' or 'u

'   A is an upper triangular matrix.**              UPLO = 'L' or 'l







'   A is a lower triangular matrix.**           Unchanged on exit.**  TRANS  - CHARACTER*1.*           On entry, TRANS specifies the operation to be performed as*           follows:**              TRANS = 'N' or 'n

'   x := A*x.**              TRANS = 'T' or 't'   x := A'*x.
*
*              TRANS = 'C' or 'c'   x := A







'*x.**           Unchanged on exit.**  DIAG   - CHARACTER*1.*           On entry, DIAG specifies whether or not A is unit*           triangular as follows:**              DIAG = 'U' or 'u

'   A is assumed to be unit triangular.**              DIAG = 'N' or 'n










'   A is not assumed to be unit*                                  triangular.**           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the order of the matrix A.*           N must be at least zero.*           Unchanged on exit.**  K      - INTEGER.*           On entry with UPLO = 'U' or 'u

', K specifies the number of*           super-diagonals of the matrix A.*           On entry with UPLO = 'L' or 'l





', K specifies the number of*           sub-diagonals of the matrix A.*           K must satisfy  0 .le. K.*           Unchanged on exit.**  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).*           Before entry with UPLO = 'U' or 'u

















', the leading ( k + 1 )*           by n part of the array A must contain the upper triangular*           band part of the matrix of coefficients, supplied column by*           column, with the leading diagonal of the matrix in row*           ( k + 1 ) of the array, the first super-diagonal starting at*           position 2 in row k, and so on. The top left k by k triangle*           of the array A is not referenced.*           The following program segment will transfer an upper*           triangular band matrix from conventional full matrix storage*           to band storage:**                 DO 20, J = 1, N*                    M = K + 1 - J*                    DO 10, I = MAX( 1, J - K ), J*                       A( M + I, J ) = matrix( I, J )*              10    CONTINUE*              20 CONTINUE**           Before entry with UPLO = 'L' or 'l

















', the leading ( k + 1 )*           by n part of the array A must contain the lower triangular*           band part of the matrix of coefficients, supplied column by*           column, with the leading diagonal of the matrix in row 1 of*           the array, the first sub-diagonal starting at position 1 in*           row 2, and so on. The bottom right k by k triangle of the*           array A is not referenced.*           The following program segment will transfer a lower*           triangular band matrix from conventional full matrix storage*           to band storage:**                 DO 20, J = 1, N*                    M = 1 - J*                    DO 10, I = J, MIN( N, J + K )*                       A( M + I, J ) = matrix( I, J )*              10    CONTINUE*              20 CONTINUE**           Note that when DIAG = 'U' or 'u



















































' the elements of the array A*           corresponding to the diagonal elements of the matrix are not*           referenced, but are assumed to be unity.*           Unchanged on exit.**  LDA    - INTEGER.*           On entry, LDA specifies the first dimension of A as declared*           in the calling (sub) program. LDA must be at least*           ( k + 1 ).*           Unchanged on exit.**  X      - DOUBLE PRECISION array of dimension at least*           ( 1 + ( n - 1 )*abs( INCX ) ).*           Before entry, the incremented array X must contain the n*           element vector x. On exit, X is overwritten with the*           tranformed vector x.**  INCX   - INTEGER.*           On entry, INCX specifies the increment for the elements of*           X. INCX must not be zero.*           Unchanged on exit.***  Level 2 Blas routine.**  -- Written on 22-October-1986.*     Jack Dongarra, Argonne National Lab.*     Jeremy Du Croz, Nag Central Office.*     Sven Hammarling, Nag Central Office.*     Richard Hanson, Sandia National Labs.***     .. Parameters ..      DOUBLE PRECISION   ZERO      PARAMETER        ( ZERO = 0.0D+0 )*     .. Local Scalars ..      DOUBLE PRECISION   TEMP      INTEGER            I, INFO, IX, J, JX, KPLUS1, KX, L      LOGICAL            NOUNIT*     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     .. Intrinsic Functions ..      INTRINSIC          MAX, MIN*     ..*     .. Executable Statements ..**     Test the input parameters.*      INFO = 0      IF     ( .NOT.LSAME( UPLO , 'U
' ).AND.     $         .NOT.LSAME( UPLO , 'L

' )      )THEN         INFO = 1      ELSE IF( .NOT.LSAME( TRANS, 'N
' ).AND.     $         .NOT.LSAME( TRANS, 'T
' ).AND.     $         .NOT.LSAME( TRANS, 'C

' )      )THEN         INFO = 2      ELSE IF( .NOT.LSAME( DIAG , 'U
' ).AND.     $         .NOT.LSAME( DIAG , 'N











' )      )THEN         INFO = 3      ELSE IF( N.LT.0 )THEN         INFO = 4      ELSE IF( K.LT.0 )THEN         INFO = 5      ELSE IF( LDA.LT.( K + 1 ) )THEN         INFO = 7      ELSE IF( INCX.EQ.0 )THEN         INFO = 9      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DTBMV 








', INFO )         RETURN      END IF**     Quick return if possible.*      IF( N.EQ.0 )     $   RETURN*      NOUNIT = LSAME( DIAG, 'N













' )**     Set up the start point in X if the increment is not unity. This*     will be  ( N - 1 )*INCX   too small for descending loops.*      IF( INCX.LE.0 )THEN         KX = 1 - ( N - 1 )*INCX      ELSE IF( INCX.NE.1 )THEN         KX = 1      END IF**     Start the operations. In this version the elements of A are*     accessed sequentially with one pass through A.*      IF( LSAME( TRANS, 'N



' ) )THEN**         Form  x := A*x.*         IF( LSAME( UPLO, 'U




































































' ) )THEN            KPLUS1 = K + 1            IF( INCX.EQ.1 )THEN               DO 20, J = 1, N                  IF( X( J ).NE.ZERO )THEN                     TEMP = X( J )                     L    = KPLUS1 - J                     DO 10, I = MAX( 1, J - K ), J - 1                        X( I ) = X( I ) + TEMP*A( L + I, J )   10                CONTINUE                     IF( NOUNIT )     $                  X( J ) = X( J )*A( KPLUS1, J )                  END IF   20          CONTINUE            ELSE               JX = KX               DO 40, J = 1, N                  IF( X( JX ).NE.ZERO )THEN                     TEMP = X( JX )                     IX   = KX                     L    = KPLUS1  - J                     DO 30, I = MAX( 1, J - K ), J - 1                        X( IX ) = X( IX ) + TEMP*A( L + I, J )                        IX      = IX      + INCX   30                CONTINUE                     IF( NOUNIT )     $                  X( JX ) = X( JX )*A( KPLUS1, J )                  END IF                  JX = JX + INCX                  IF( J.GT.K )     $               KX = KX + INCX   40          CONTINUE            END IF         ELSE            IF( INCX.EQ.1 )THEN               DO 60, J = N, 1, -1                  IF( X( J ).NE.ZERO )THEN                     TEMP = X( J )                     L    = 1      - J                     DO 50, I = MIN( N, J + K ), J + 1, -1                        X( I ) = X( I ) + TEMP*A( L + I, J )   50                CONTINUE                     IF( NOUNIT )     $                  X( J ) = X( J )*A( 1, J )                  END IF   60          CONTINUE            ELSE               KX = KX + ( N - 1 )*INCX               JX = KX               DO 80, J = N, 1, -1                  IF( X( JX ).NE.ZERO )THEN                     TEMP = X( JX )                     IX   = KX                     L    = 1       - J                     DO 70, I = MIN( N, J + K ), J + 1, -1                        X( IX ) = X( IX ) + TEMP*A( L + I, J )                        IX      = IX      - INCX   70                CONTINUE                     IF( NOUNIT )     $                  X( JX ) = X( JX )*A( 1, J )                  END IF                  JX = JX - INCX                  IF( ( N - J ).GE.K )     $               KX = KX - INCX   80          CONTINUE            END IF         END IF      ELSE**        Form  x := A'*x.
*
         IF( LSAME( UPLO, 'U' ) )THEN
            KPLUS1 = K + 1
            IF( INCX.EQ.1 )THEN
               DO 100, J = N, 1, -1
                  TEMP = X( J )
                  L    = KPLUS1 - J
                  IF( NOUNIT )
     $               TEMP = TEMP*A( KPLUS1, J )
                  DO 90, I = J - 1, MAX( 1, J - K ), -1
                     TEMP = TEMP + A( L + I, J )*X( I )
   90             CONTINUE
                  X( J ) = TEMP
  100          CONTINUE
            ELSE
               KX = KX + ( N - 1 )*INCX
               JX = KX
               DO 120, J = N, 1, -1
                  TEMP = X( JX )
                  KX   = KX      - INCX
                  IX   = KX
                  L    = KPLUS1  - J
                  IF( NOUNIT )
     $               TEMP = TEMP*A( KPLUS1, J )
                  DO 110, I = J - 1, MAX( 1, J - K ), -1
                     TEMP = TEMP + A( L + I, J )*X( IX )
                     IX   = IX   - INCX
  110             CONTINUE
                  X( JX ) = TEMP
                  JX      = JX   - INCX
  120          CONTINUE
            END IF
         ELSE
            IF( INCX.EQ.1 )THEN
               DO 140, J = 1, N
                  TEMP = X( J )
                  L    = 1      - J
                  IF( NOUNIT )
     $               TEMP = TEMP*A( 1, J )
                  DO 130, I = J + 1, MIN( N, J + K )
                     TEMP = TEMP + A( L + I, J )*X( I )
  130             CONTINUE
                  X( J ) = TEMP
  140          CONTINUE
            ELSE
               JX = KX
               DO 160, J = 1, N
                  TEMP = X( JX )
                  KX   = KX      + INCX
                  IX   = KX
                  L    = 1       - J
                  IF( NOUNIT )
     $               TEMP = TEMP*A( 1, J )
                  DO 150, I = J + 1, MIN( N, J + K )
                     TEMP = TEMP + A( L + I, J )*X( IX )
                     IX   = IX   + INCX
  150             CONTINUE
                  X( JX ) = TEMP
                  JX      = JX   + INCX
  160          CONTINUE
            END IF
         END IF
      END IF
*
      RETURN
*
*     End of DTBMV .
*
      END
      SUBROUTINE DTBSV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX )
*     .. Scalar Arguments ..
      INTEGER            INCX, K, LDA, N
      CHARACTER*1        DIAG, TRANS, UPLO
*     .. Array Arguments ..
      DOUBLE PRECISION   A( LDA, * ), X( * )
*     ..
*
*  Purpose
*  =======
*
*  DTBSV  solves one of the systems of equations
*
*     A*x = b,   or   A















'*x = b,**  where b and x are n element vectors and A is an n by n unit, or*  non-unit, upper or lower triangular band matrix, with ( k + 1 )*  diagonals.**  No test for singularity or near-singularity is included in this*  routine. Such tests must be performed before calling this routine.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On entry, UPLO specifies whether the matrix is an upper or*           lower triangular matrix as follows:**              UPLO = 'U' or 'u

'   A is an upper triangular matrix.**              UPLO = 'L' or 'l







'   A is a lower triangular matrix.**           Unchanged on exit.**  TRANS  - CHARACTER*1.*           On entry, TRANS specifies the equations to be solved as*           follows:**              TRANS = 'N' or 'n

'   A*x = b.**              TRANS = 'T' or 't'   A'*x = b.
*
*              TRANS = 'C' or 'c'   A







'*x = b.**           Unchanged on exit.**  DIAG   - CHARACTER*1.*           On entry, DIAG specifies whether or not A is unit*           triangular as follows:**              DIAG = 'U' or 'u

'   A is assumed to be unit triangular.**              DIAG = 'N' or 'n










'   A is not assumed to be unit*                                  triangular.**           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the order of the matrix A.*           N must be at least zero.*           Unchanged on exit.**  K      - INTEGER.*           On entry with UPLO = 'U' or 'u

', K specifies the number of*           super-diagonals of the matrix A.*           On entry with UPLO = 'L' or 'l





', K specifies the number of*           sub-diagonals of the matrix A.*           K must satisfy  0 .le. K.*           Unchanged on exit.**  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).*           Before entry with UPLO = 'U' or 'u

















', the leading ( k + 1 )*           by n part of the array A must contain the upper triangular*           band part of the matrix of coefficients, supplied column by*           column, with the leading diagonal of the matrix in row*           ( k + 1 ) of the array, the first super-diagonal starting at*           position 2 in row k, and so on. The top left k by k triangle*           of the array A is not referenced.*           The following program segment will transfer an upper*           triangular band matrix from conventional full matrix storage*           to band storage:**                 DO 20, J = 1, N*                    M = K + 1 - J*                    DO 10, I = MAX( 1, J - K ), J*                       A( M + I, J ) = matrix( I, J )*              10    CONTINUE*              20 CONTINUE**           Before entry with UPLO = 'L' or 'l

















', the leading ( k + 1 )*           by n part of the array A must contain the lower triangular*           band part of the matrix of coefficients, supplied column by*           column, with the leading diagonal of the matrix in row 1 of*           the array, the first sub-diagonal starting at position 1 in*           row 2, and so on. The bottom right k by k triangle of the*           array A is not referenced.*           The following program segment will transfer a lower*           triangular band matrix from conventional full matrix storage*           to band storage:**                 DO 20, J = 1, N*                    M = 1 - J*                    DO 10, I = J, MIN( N, J + K )*                       A( M + I, J ) = matrix( I, J )*              10    CONTINUE*              20 CONTINUE**           Note that when DIAG = 'U' or 'u



















































' the elements of the array A*           corresponding to the diagonal elements of the matrix are not*           referenced, but are assumed to be unity.*           Unchanged on exit.**  LDA    - INTEGER.*           On entry, LDA specifies the first dimension of A as declared*           in the calling (sub) program. LDA must be at least*           ( k + 1 ).*           Unchanged on exit.**  X      - DOUBLE PRECISION array of dimension at least*           ( 1 + ( n - 1 )*abs( INCX ) ).*           Before entry, the incremented array X must contain the n*           element right-hand side vector b. On exit, X is overwritten*           with the solution vector x.**  INCX   - INTEGER.*           On entry, INCX specifies the increment for the elements of*           X. INCX must not be zero.*           Unchanged on exit.***  Level 2 Blas routine.**  -- Written on 22-October-1986.*     Jack Dongarra, Argonne National Lab.*     Jeremy Du Croz, Nag Central Office.*     Sven Hammarling, Nag Central Office.*     Richard Hanson, Sandia National Labs.***     .. Parameters ..      DOUBLE PRECISION   ZERO      PARAMETER        ( ZERO = 0.0D+0 )*     .. Local Scalars ..      DOUBLE PRECISION   TEMP      INTEGER            I, INFO, IX, J, JX, KPLUS1, KX, L      LOGICAL            NOUNIT*     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     .. Intrinsic Functions ..      INTRINSIC          MAX, MIN*     ..*     .. Executable Statements ..**     Test the input parameters.*      INFO = 0      IF     ( .NOT.LSAME( UPLO , 'U
' ).AND.     $         .NOT.LSAME( UPLO , 'L

' )      )THEN         INFO = 1      ELSE IF( .NOT.LSAME( TRANS, 'N
' ).AND.     $         .NOT.LSAME( TRANS, 'T
' ).AND.     $         .NOT.LSAME( TRANS, 'C

' )      )THEN         INFO = 2      ELSE IF( .NOT.LSAME( DIAG , 'U
' ).AND.     $         .NOT.LSAME( DIAG , 'N











' )      )THEN         INFO = 3      ELSE IF( N.LT.0 )THEN         INFO = 4      ELSE IF( K.LT.0 )THEN         INFO = 5      ELSE IF( LDA.LT.( K + 1 ) )THEN         INFO = 7      ELSE IF( INCX.EQ.0 )THEN         INFO = 9      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DTBSV 








', INFO )         RETURN      END IF**     Quick return if possible.*      IF( N.EQ.0 )     $   RETURN*      NOUNIT = LSAME( DIAG, 'N













' )**     Set up the start point in X if the increment is not unity. This*     will be  ( N - 1 )*INCX  too small for descending loops.*      IF( INCX.LE.0 )THEN         KX = 1 - ( N - 1 )*INCX      ELSE IF( INCX.NE.1 )THEN         KX = 1      END IF**     Start the operations. In this version the elements of A are*     accessed by sequentially with one pass through A.*      IF( LSAME( TRANS, 'N



' ) )THEN**        Form  x := inv( A )*x.*         IF( LSAME( UPLO, 'U


































































' ) )THEN            KPLUS1 = K + 1            IF( INCX.EQ.1 )THEN               DO 20, J = N, 1, -1                  IF( X( J ).NE.ZERO )THEN                     L = KPLUS1 - J                     IF( NOUNIT )     $                  X( J ) = X( J )/A( KPLUS1, J )                     TEMP = X( J )                     DO 10, I = J - 1, MAX( 1, J - K ), -1                        X( I ) = X( I ) - TEMP*A( L + I, J )   10                CONTINUE                  END IF   20          CONTINUE            ELSE               KX = KX + ( N - 1 )*INCX               JX = KX               DO 40, J = N, 1, -1                  KX = KX - INCX                  IF( X( JX ).NE.ZERO )THEN                     IX = KX                     L  = KPLUS1 - J                     IF( NOUNIT )     $                  X( JX ) = X( JX )/A( KPLUS1, J )                     TEMP = X( JX )                     DO 30, I = J - 1, MAX( 1, J - K ), -1                        X( IX ) = X( IX ) - TEMP*A( L + I, J )                        IX      = IX      - INCX   30                CONTINUE                  END IF                  JX = JX - INCX   40          CONTINUE            END IF         ELSE            IF( INCX.EQ.1 )THEN               DO 60, J = 1, N                  IF( X( J ).NE.ZERO )THEN                     L = 1 - J                     IF( NOUNIT )     $                  X( J ) = X( J )/A( 1, J )                     TEMP = X( J )                     DO 50, I = J + 1, MIN( N, J + K )                        X( I ) = X( I ) - TEMP*A( L + I, J )   50                CONTINUE                  END IF   60          CONTINUE            ELSE               JX = KX               DO 80, J = 1, N                  KX = KX + INCX                  IF( X( JX ).NE.ZERO )THEN                     IX = KX                     L  = 1  - J                     IF( NOUNIT )     $                  X( JX ) = X( JX )/A( 1, J )                     TEMP = X( JX )                     DO 70, I = J + 1, MIN( N, J + K )                        X( IX ) = X( IX ) - TEMP*A( L + I, J )                        IX      = IX      + INCX   70                CONTINUE                  END IF                  JX = JX + INCX   80          CONTINUE            END IF         END IF      ELSE**        Form  x := inv( A')*x.
*
         IF( LSAME( UPLO, 'U' ) )THEN
            KPLUS1 = K + 1
            IF( INCX.EQ.1 )THEN
               DO 100, J = 1, N
                  TEMP = X( J )
                  L    = KPLUS1 - J
                  DO 90, I = MAX( 1, J - K ), J - 1
                     TEMP = TEMP - A( L + I, J )*X( I )
   90             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/A( KPLUS1, J )
                  X( J ) = TEMP
  100          CONTINUE
            ELSE
               JX = KX
               DO 120, J = 1, N
                  TEMP = X( JX )
                  IX   = KX
                  L    = KPLUS1  - J
                  DO 110, I = MAX( 1, J - K ), J - 1
                     TEMP = TEMP - A( L + I, J )*X( IX )
                     IX   = IX   + INCX
  110             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/A( KPLUS1, J )
                  X( JX ) = TEMP
                  JX      = JX   + INCX
                  IF( J.GT.K )
     $               KX = KX + INCX
  120          CONTINUE
            END IF
         ELSE
            IF( INCX.EQ.1 )THEN
               DO 140, J = N, 1, -1
                  TEMP = X( J )
                  L    = 1      - J
                  DO 130, I = MIN( N, J + K ), J + 1, -1
                     TEMP = TEMP - A( L + I, J )*X( I )
  130             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/A( 1, J )
                  X( J ) = TEMP
  140          CONTINUE
            ELSE
               KX = KX + ( N - 1 )*INCX
               JX = KX
               DO 160, J = N, 1, -1
                  TEMP = X( JX )
                  IX   = KX
                  L    = 1       - J
                  DO 150, I = MIN( N, J + K ), J + 1, -1
                     TEMP = TEMP - A( L + I, J )*X( IX )
                     IX   = IX   - INCX
  150             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/A( 1, J )
                  X( JX ) = TEMP
                  JX      = JX   - INCX
                  IF( ( N - J ).GE.K )
     $               KX = KX - INCX
  160          CONTINUE
            END IF
         END IF
      END IF
*
      RETURN
*
*     End of DTBSV .
*
      END
      SUBROUTINE DTPMV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
*     .. Scalar Arguments ..
      INTEGER            INCX, N
      CHARACTER*1        DIAG, TRANS, UPLO
*     .. Array Arguments ..
      DOUBLE PRECISION   AP( * ), X( * )
*     ..
*
*  Purpose
*  =======
*
*  DTPMV  performs one of the matrix-vector operations
*
*     x := A*x,   or   x := A











'*x,**  where x is an n element vector and  A is an n by n unit, or non-unit,*  upper or lower triangular matrix, supplied in packed form.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On entry, UPLO specifies whether the matrix is an upper or*           lower triangular matrix as follows:**              UPLO = 'U' or 'u

'   A is an upper triangular matrix.**              UPLO = 'L' or 'l







'   A is a lower triangular matrix.**           Unchanged on exit.**  TRANS  - CHARACTER*1.*           On entry, TRANS specifies the operation to be performed as*           follows:**              TRANS = 'N' or 'n

'   x := A*x.**              TRANS = 'T' or 't'   x := A'*x.
*
*              TRANS = 'C' or 'c'   x := A







'*x.**           Unchanged on exit.**  DIAG   - CHARACTER*1.*           On entry, DIAG specifies whether or not A is unit*           triangular as follows:**              DIAG = 'U' or 'u

'   A is assumed to be unit triangular.**              DIAG = 'N' or 'n











'   A is not assumed to be unit*                                  triangular.**           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the order of the matrix A.*           N must be at least zero.*           Unchanged on exit.**  AP     - DOUBLE PRECISION array of DIMENSION at least*           ( ( n*( n + 1 ) )/2 ).*           Before entry with  UPLO = 'U' or 'u




', the array AP must*           contain the upper triangular matrix packed sequentially,*           column by column, so that AP( 1 ) contains a( 1, 1 ),*           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )*           respectively, and so on.*           Before entry with UPLO = 'L' or 'l




', the array AP must*           contain the lower triangular matrix packed sequentially,*           column by column, so that AP( 1 ) contains a( 1, 1 ),*           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )*           respectively, and so on.*           Note that when  DIAG = 'U' or 'u










































', the diagonal elements of*           A are not referenced, but are assumed to be unity.*           Unchanged on exit.**  X      - DOUBLE PRECISION array of dimension at least*           ( 1 + ( n - 1 )*abs( INCX ) ).*           Before entry, the incremented array X must contain the n*           element vector x. On exit, X is overwritten with the*           tranformed vector x.**  INCX   - INTEGER.*           On entry, INCX specifies the increment for the elements of*           X. INCX must not be zero.*           Unchanged on exit.***  Level 2 Blas routine.**  -- Written on 22-October-1986.*     Jack Dongarra, Argonne National Lab.*     Jeremy Du Croz, Nag Central Office.*     Sven Hammarling, Nag Central Office.*     Richard Hanson, Sandia National Labs.***     .. Parameters ..      DOUBLE PRECISION   ZERO      PARAMETER        ( ZERO = 0.0D+0 )*     .. Local Scalars ..      DOUBLE PRECISION   TEMP      INTEGER            I, INFO, IX, J, JX, K, KK, KX      LOGICAL            NOUNIT*     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     ..*     .. Executable Statements ..**     Test the input parameters.*      INFO = 0      IF     ( .NOT.LSAME( UPLO , 'U
' ).AND.     $         .NOT.LSAME( UPLO , 'L

' )      )THEN         INFO = 1      ELSE IF( .NOT.LSAME( TRANS, 'N
' ).AND.     $         .NOT.LSAME( TRANS, 'T
' ).AND.     $         .NOT.LSAME( TRANS, 'C

' )      )THEN         INFO = 2      ELSE IF( .NOT.LSAME( DIAG , 'U
' ).AND.     $         .NOT.LSAME( DIAG , 'N







' )      )THEN         INFO = 3      ELSE IF( N.LT.0 )THEN         INFO = 4      ELSE IF( INCX.EQ.0 )THEN         INFO = 7      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DTPMV 








', INFO )         RETURN      END IF**     Quick return if possible.*      IF( N.EQ.0 )     $   RETURN*      NOUNIT = LSAME( DIAG, 'N













' )**     Set up the start point in X if the increment is not unity. This*     will be  ( N - 1 )*INCX  too small for descending loops.*      IF( INCX.LE.0 )THEN         KX = 1 - ( N - 1 )*INCX      ELSE IF( INCX.NE.1 )THEN         KX = 1      END IF**     Start the operations. In this version the elements of AP are*     accessed sequentially with one pass through AP.*      IF( LSAME( TRANS, 'N



' ) )THEN**        Form  x:= A*x.*         IF( LSAME( UPLO, 'U





































































' ) )THEN            KK =1            IF( INCX.EQ.1 )THEN               DO 20, J = 1, N                  IF( X( J ).NE.ZERO )THEN                     TEMP = X( J )                     K    = KK                     DO 10, I = 1, J - 1                        X( I ) = X( I ) + TEMP*AP( K )                        K      = K      + 1   10                CONTINUE                     IF( NOUNIT )     $                  X( J ) = X( J )*AP( KK + J - 1 )                  END IF                  KK = KK + J   20          CONTINUE            ELSE               JX = KX               DO 40, J = 1, N                  IF( X( JX ).NE.ZERO )THEN                     TEMP = X( JX )                     IX   = KX                     DO 30, K = KK, KK + J - 2                        X( IX ) = X( IX ) + TEMP*AP( K )                        IX      = IX      + INCX   30                CONTINUE                     IF( NOUNIT )     $                  X( JX ) = X( JX )*AP( KK + J - 1 )                  END IF                  JX = JX + INCX                  KK = KK + J   40          CONTINUE            END IF         ELSE            KK = ( N*( N + 1 ) )/2            IF( INCX.EQ.1 )THEN               DO 60, J = N, 1, -1                  IF( X( J ).NE.ZERO )THEN                     TEMP = X( J )                     K    = KK                     DO 50, I = N, J + 1, -1                        X( I ) = X( I ) + TEMP*AP( K )                        K      = K      - 1   50                CONTINUE                     IF( NOUNIT )     $                  X( J ) = X( J )*AP( KK - N + J )                  END IF                  KK = KK - ( N - J + 1 )   60          CONTINUE            ELSE               KX = KX + ( N - 1 )*INCX               JX = KX               DO 80, J = N, 1, -1                  IF( X( JX ).NE.ZERO )THEN                     TEMP = X( JX )                     IX   = KX                     DO 70, K = KK, KK - ( N - ( J + 1 ) ), -1                        X( IX ) = X( IX ) + TEMP*AP( K )                        IX      = IX      - INCX   70                CONTINUE                     IF( NOUNIT )     $                  X( JX ) = X( JX )*AP( KK - N + J )                  END IF                  JX = JX - INCX                  KK = KK - ( N - J + 1 )   80          CONTINUE            END IF         END IF      ELSE**        Form  x := A'*x.
*
         IF( LSAME( UPLO, 'U' ) )THEN
            KK = ( N*( N + 1 ) )/2
            IF( INCX.EQ.1 )THEN
               DO 100, J = N, 1, -1
                  TEMP = X( J )
                  IF( NOUNIT )
     $               TEMP = TEMP*AP( KK )
                  K = KK - 1
                  DO 90, I = J - 1, 1, -1
                     TEMP = TEMP + AP( K )*X( I )
                     K    = K    - 1
   90             CONTINUE
                  X( J ) = TEMP
                  KK     = KK   - J
  100          CONTINUE
            ELSE
               JX = KX + ( N - 1 )*INCX
               DO 120, J = N, 1, -1
                  TEMP = X( JX )
                  IX   = JX
                  IF( NOUNIT )
     $               TEMP = TEMP*AP( KK )
                  DO 110, K = KK - 1, KK - J + 1, -1
                     IX   = IX   - INCX
                     TEMP = TEMP + AP( K )*X( IX )
  110             CONTINUE
                  X( JX ) = TEMP
                  JX      = JX   - INCX
                  KK      = KK   - J
  120          CONTINUE
            END IF
         ELSE
            KK = 1
            IF( INCX.EQ.1 )THEN
               DO 140, J = 1, N
                  TEMP = X( J )
                  IF( NOUNIT )
     $               TEMP = TEMP*AP( KK )
                  K = KK + 1
                  DO 130, I = J + 1, N
                     TEMP = TEMP + AP( K )*X( I )
                     K    = K    + 1
  130             CONTINUE
                  X( J ) = TEMP
                  KK     = KK   + ( N - J + 1 )
  140          CONTINUE
            ELSE
               JX = KX
               DO 160, J = 1, N
                  TEMP = X( JX )
                  IX   = JX
                  IF( NOUNIT )
     $               TEMP = TEMP*AP( KK )
                  DO 150, K = KK + 1, KK + N - J
                     IX   = IX   + INCX
                     TEMP = TEMP + AP( K )*X( IX )
  150             CONTINUE
                  X( JX ) = TEMP
                  JX      = JX   + INCX
                  KK      = KK   + ( N - J + 1 )
  160          CONTINUE
            END IF
         END IF
      END IF
*
      RETURN
*
*     End of DTPMV .
*
      END
      SUBROUTINE DTPSV ( UPLO, TRANS, DIAG, N, AP, X, INCX )
*     .. Scalar Arguments ..
      INTEGER            INCX, N
      CHARACTER*1        DIAG, TRANS, UPLO
*     .. Array Arguments ..
      DOUBLE PRECISION   AP( * ), X( * )
*     ..
*
*  Purpose
*  =======
*
*  DTPSV  solves one of the systems of equations
*
*     A*x = b,   or   A














'*x = b,**  where b and x are n element vectors and A is an n by n unit, or*  non-unit, upper or lower triangular matrix, supplied in packed form.**  No test for singularity or near-singularity is included in this*  routine. Such tests must be performed before calling this routine.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On entry, UPLO specifies whether the matrix is an upper or*           lower triangular matrix as follows:**              UPLO = 'U' or 'u

'   A is an upper triangular matrix.**              UPLO = 'L' or 'l







'   A is a lower triangular matrix.**           Unchanged on exit.**  TRANS  - CHARACTER*1.*           On entry, TRANS specifies the equations to be solved as*           follows:**              TRANS = 'N' or 'n

'   A*x = b.**              TRANS = 'T' or 't'   A'*x = b.
*
*              TRANS = 'C' or 'c'   A







'*x = b.**           Unchanged on exit.**  DIAG   - CHARACTER*1.*           On entry, DIAG specifies whether or not A is unit*           triangular as follows:**              DIAG = 'U' or 'u

'   A is assumed to be unit triangular.**              DIAG = 'N' or 'n











'   A is not assumed to be unit*                                  triangular.**           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the order of the matrix A.*           N must be at least zero.*           Unchanged on exit.**  AP     - DOUBLE PRECISION array of DIMENSION at least*           ( ( n*( n + 1 ) )/2 ).*           Before entry with  UPLO = 'U' or 'u




', the array AP must*           contain the upper triangular matrix packed sequentially,*           column by column, so that AP( 1 ) contains a( 1, 1 ),*           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )*           respectively, and so on.*           Before entry with UPLO = 'L' or 'l




', the array AP must*           contain the lower triangular matrix packed sequentially,*           column by column, so that AP( 1 ) contains a( 1, 1 ),*           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )*           respectively, and so on.*           Note that when  DIAG = 'U' or 'u










































', the diagonal elements of*           A are not referenced, but are assumed to be unity.*           Unchanged on exit.**  X      - DOUBLE PRECISION array of dimension at least*           ( 1 + ( n - 1 )*abs( INCX ) ).*           Before entry, the incremented array X must contain the n*           element right-hand side vector b. On exit, X is overwritten*           with the solution vector x.**  INCX   - INTEGER.*           On entry, INCX specifies the increment for the elements of*           X. INCX must not be zero.*           Unchanged on exit.***  Level 2 Blas routine.**  -- Written on 22-October-1986.*     Jack Dongarra, Argonne National Lab.*     Jeremy Du Croz, Nag Central Office.*     Sven Hammarling, Nag Central Office.*     Richard Hanson, Sandia National Labs.***     .. Parameters ..      DOUBLE PRECISION   ZERO      PARAMETER        ( ZERO = 0.0D+0 )*     .. Local Scalars ..      DOUBLE PRECISION   TEMP      INTEGER            I, INFO, IX, J, JX, K, KK, KX      LOGICAL            NOUNIT*     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     ..*     .. Executable Statements ..**     Test the input parameters.*      INFO = 0      IF     ( .NOT.LSAME( UPLO , 'U
' ).AND.     $         .NOT.LSAME( UPLO , 'L

' )      )THEN         INFO = 1      ELSE IF( .NOT.LSAME( TRANS, 'N
' ).AND.     $         .NOT.LSAME( TRANS, 'T
' ).AND.     $         .NOT.LSAME( TRANS, 'C

' )      )THEN         INFO = 2      ELSE IF( .NOT.LSAME( DIAG , 'U
' ).AND.     $         .NOT.LSAME( DIAG , 'N







' )      )THEN         INFO = 3      ELSE IF( N.LT.0 )THEN         INFO = 4      ELSE IF( INCX.EQ.0 )THEN         INFO = 7      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DTPSV 








', INFO )         RETURN      END IF**     Quick return if possible.*      IF( N.EQ.0 )     $   RETURN*      NOUNIT = LSAME( DIAG, 'N













' )**     Set up the start point in X if the increment is not unity. This*     will be  ( N - 1 )*INCX  too small for descending loops.*      IF( INCX.LE.0 )THEN         KX = 1 - ( N - 1 )*INCX      ELSE IF( INCX.NE.1 )THEN         KX = 1      END IF**     Start the operations. In this version the elements of AP are*     accessed sequentially with one pass through AP.*      IF( LSAME( TRANS, 'N



' ) )THEN**        Form  x := inv( A )*x.*         IF( LSAME( UPLO, 'U




































































' ) )THEN            KK = ( N*( N + 1 ) )/2            IF( INCX.EQ.1 )THEN               DO 20, J = N, 1, -1                  IF( X( J ).NE.ZERO )THEN                     IF( NOUNIT )     $                  X( J ) = X( J )/AP( KK )                     TEMP = X( J )                     K    = KK     - 1                     DO 10, I = J - 1, 1, -1                        X( I ) = X( I ) - TEMP*AP( K )                        K      = K      - 1   10                CONTINUE                  END IF                  KK = KK - J   20          CONTINUE            ELSE               JX = KX + ( N - 1 )*INCX               DO 40, J = N, 1, -1                  IF( X( JX ).NE.ZERO )THEN                     IF( NOUNIT )     $                  X( JX ) = X( JX )/AP( KK )                     TEMP = X( JX )                     IX   = JX                     DO 30, K = KK - 1, KK - J + 1, -1                        IX      = IX      - INCX                        X( IX ) = X( IX ) - TEMP*AP( K )   30                CONTINUE                  END IF                  JX = JX - INCX                  KK = KK - J   40          CONTINUE            END IF         ELSE            KK = 1            IF( INCX.EQ.1 )THEN               DO 60, J = 1, N                  IF( X( J ).NE.ZERO )THEN                     IF( NOUNIT )     $                  X( J ) = X( J )/AP( KK )                     TEMP = X( J )                     K    = KK     + 1                     DO 50, I = J + 1, N                        X( I ) = X( I ) - TEMP*AP( K )                        K      = K      + 1   50                CONTINUE                  END IF                  KK = KK + ( N - J + 1 )   60          CONTINUE            ELSE               JX = KX               DO 80, J = 1, N                  IF( X( JX ).NE.ZERO )THEN                     IF( NOUNIT )     $                  X( JX ) = X( JX )/AP( KK )                     TEMP = X( JX )                     IX   = JX                     DO 70, K = KK + 1, KK + N - J                        IX      = IX      + INCX                        X( IX ) = X( IX ) - TEMP*AP( K )   70                CONTINUE                  END IF                  JX = JX + INCX                  KK = KK + ( N - J + 1 )   80          CONTINUE            END IF         END IF      ELSE**        Form  x := inv( A' )*x.
*
         IF( LSAME( UPLO, 'U' ) )THEN
            KK = 1
            IF( INCX.EQ.1 )THEN
               DO 100, J = 1, N
                  TEMP = X( J )
                  K    = KK
                  DO 90, I = 1, J - 1
                     TEMP = TEMP - AP( K )*X( I )
                     K    = K    + 1
   90             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/AP( KK + J - 1 )
                  X( J ) = TEMP
                  KK     = KK   + J
  100          CONTINUE
            ELSE
               JX = KX
               DO 120, J = 1, N
                  TEMP = X( JX )
                  IX   = KX
                  DO 110, K = KK, KK + J - 2
                     TEMP = TEMP - AP( K )*X( IX )
                     IX   = IX   + INCX
  110             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/AP( KK + J - 1 )
                  X( JX ) = TEMP
                  JX      = JX   + INCX
                  KK      = KK   + J
  120          CONTINUE
            END IF
         ELSE
            KK = ( N*( N + 1 ) )/2
            IF( INCX.EQ.1 )THEN
               DO 140, J = N, 1, -1
                  TEMP = X( J )
                  K = KK
                  DO 130, I = N, J + 1, -1
                     TEMP = TEMP - AP( K )*X( I )
                     K    = K    - 1
  130             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/AP( KK - N + J )
                  X( J ) = TEMP
                  KK     = KK   - ( N - J + 1 )
  140          CONTINUE
            ELSE
               KX = KX + ( N - 1 )*INCX
               JX = KX
               DO 160, J = N, 1, -1
                  TEMP = X( JX )
                  IX   = KX
                  DO 150, K = KK, KK - ( N - ( J + 1 ) ), -1
                     TEMP = TEMP - AP( K )*X( IX )
                     IX   = IX   - INCX
  150             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/AP( KK - N + J )
                  X( JX ) = TEMP
                  JX      = JX   - INCX
                  KK      = KK   - (N - J + 1 )
  160          CONTINUE
            END IF
         END IF
      END IF
*
      RETURN
*
*     End of DTPSV .
*
      END
      SUBROUTINE DTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
     $                   B, LDB )
*     .. Scalar Arguments ..
      CHARACTER*1        SIDE, UPLO, TRANSA, DIAG
      INTEGER            M, N, LDA, LDB
      DOUBLE PRECISION   ALPHA
*     .. Array Arguments ..
      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
*     ..
*
*  Purpose
*  =======
*
*  DTRMM  performs one of the matrix-matrix operations
*
*     B := alpha*op( A )*B,   or   B := alpha*B*op( A ),
*
*  where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
*  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
*
*     op( A ) = A   or   op( A ) = A








'.**  Parameters*  ==========**  SIDE   - CHARACTER*1.*           On entry,  SIDE specifies whether  op( A ) multiplies B from*           the left or right as follows:**              SIDE = 'L' or 'l

'   B := alpha*op( A )*B.**              SIDE = 'R' or 'r







'   B := alpha*B*op( A ).**           Unchanged on exit.**  UPLO   - CHARACTER*1.*           On entry, UPLO specifies whether the matrix A is an upper or*           lower triangular matrix as follows:**              UPLO = 'U' or 'u

'   A is an upper triangular matrix.**              UPLO = 'L' or 'l







'   A is a lower triangular matrix.**           Unchanged on exit.**  TRANSA - CHARACTER*1.*           On entry, TRANSA specifies the form of op( A ) to be used in*           the matrix multiplication as follows:**              TRANSA = 'N' or 'n

'   op( A ) = A.**              TRANSA = 'T' or 't'   op( A ) = A'.
*
*              TRANSA = 'C' or 'c'   op( A ) = A







'.**           Unchanged on exit.**  DIAG   - CHARACTER*1.*           On entry, DIAG specifies whether or not A is unit triangular*           as follows:**              DIAG = 'U' or 'u

'   A is assumed to be unit triangular.**              DIAG = 'N' or 'n





















'   A is not assumed to be unit*                                  triangular.**           Unchanged on exit.**  M      - INTEGER.*           On entry, M specifies the number of rows of B. M must be at*           least zero.*           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the number of columns of B.  N must be*           at least zero.*           Unchanged on exit.**  ALPHA  - DOUBLE PRECISION.*           On entry,  ALPHA specifies the scalar  alpha. When  alpha is*           zero then  A is not referenced and  B need not be set before*           entry.*           Unchanged on exit.**  A      - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m*           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r
'.*           Before entry  with  UPLO = 'U' or 'u



',  the  leading  k by k*           upper triangular part of the array  A must contain the upper*           triangular matrix  and the strictly lower triangular part of*           A is not referenced.*           Before entry  with  UPLO = 'L' or 'l



',  the  leading  k by k*           lower triangular part of the array  A must contain the lower*           triangular matrix  and the strictly upper triangular part of*           A is not referenced.*           Note that when  DIAG = 'U' or 'u





',  the diagonal elements of*           A  are not referenced either,  but are assumed to be  unity.*           Unchanged on exit.**  LDA    - INTEGER.*           On entry, LDA specifies the first dimension of A as declared*           in the calling (sub) program.  When  SIDE = 'L' or 'l
'  then*           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r











































'*           then LDA must be at least max( 1, n ).*           Unchanged on exit.**  B      - DOUBLE PRECISION array of DIMENSION ( LDB, n ).*           Before entry,  the leading  m by n part of the array  B must*           contain the matrix  B,  and  on exit  is overwritten  by the*           transformed matrix.**  LDB    - INTEGER.*           On entry, LDB specifies the first dimension of B as declared*           in  the  calling  (sub)  program.   LDB  must  be  at  least*           max( 1, m ).*           Unchanged on exit.***  Level 3 Blas routine.**  -- Written on 8-February-1989.*     Jack Dongarra, Argonne National Laboratory.*     Iain Duff, AERE Harwell.*     Jeremy Du Croz, Numerical Algorithms Group Ltd.*     Sven Hammarling, Numerical Algorithms Group Ltd.***     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     .. Intrinsic Functions ..      INTRINSIC          MAX*     .. Local Scalars ..      LOGICAL            LSIDE, NOUNIT, UPPER      INTEGER            I, INFO, J, K, NROWA      DOUBLE PRECISION   TEMP*     .. Parameters ..      DOUBLE PRECISION   ONE         , ZERO      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )*     ..*     .. Executable Statements ..**     Test the input parameters.*      LSIDE  = LSAME( SIDE  , 'L





' )      IF( LSIDE )THEN         NROWA = M      ELSE         NROWA = N      END IF      NOUNIT = LSAME( DIAG  , 'N
' )      UPPER  = LSAME( UPLO  , 'U



' )*      INFO   = 0      IF(      ( .NOT.LSIDE                ).AND.     $         ( .NOT.LSAME( SIDE  , 'R


' ) )      )THEN         INFO = 1      ELSE IF( ( .NOT.UPPER                ).AND.     $         ( .NOT.LSAME( UPLO  , 'L

' ) )      )THEN         INFO = 2      ELSE IF( ( .NOT.LSAME( TRANSA, 'N
' ) ).AND.     $         ( .NOT.LSAME( TRANSA, 'T
' ) ).AND.     $         ( .NOT.LSAME( TRANSA, 'C

' ) )      )THEN         INFO = 3      ELSE IF( ( .NOT.LSAME( DIAG  , 'U
' ) ).AND.     $         ( .NOT.LSAME( DIAG  , 'N











' ) )      )THEN         INFO = 4      ELSE IF( M  .LT.0               )THEN         INFO = 5      ELSE IF( N  .LT.0               )THEN         INFO = 6      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN         INFO = 9      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN         INFO = 11      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DTRMM 






















', INFO )         RETURN      END IF**     Quick return if possible.*      IF( N.EQ.0 )     $   RETURN**     And when  alpha.eq.zero.*      IF( ALPHA.EQ.ZERO )THEN         DO 20, J = 1, N            DO 10, I = 1, M               B( I, J ) = ZERO   10       CONTINUE   20    CONTINUE         RETURN      END IF**     Start the operations.*      IF( LSIDE )THEN         IF( LSAME( TRANSA, 'N


































' ) )THEN**           Form  B := alpha*A*B.*            IF( UPPER )THEN               DO 50, J = 1, N                  DO 40, K = 1, M                     IF( B( K, J ).NE.ZERO )THEN                        TEMP = ALPHA*B( K, J )                        DO 30, I = 1, K - 1                           B( I, J ) = B( I, J ) + TEMP*A( I, K )   30                   CONTINUE                        IF( NOUNIT )     $                     TEMP = TEMP*A( K, K )                        B( K, J ) = TEMP                     END IF   40             CONTINUE   50          CONTINUE            ELSE               DO 80, J = 1, N                  DO 70 K = M, 1, -1                     IF( B( K, J ).NE.ZERO )THEN                        TEMP      = ALPHA*B( K, J )                        B( K, J ) = TEMP                        IF( NOUNIT )     $                     B( K, J ) = B( K, J )*A( K, K )                        DO 60, I = K + 1, M                           B( I, J ) = B( I, J ) + TEMP*A( I, K )   60                   CONTINUE                     END IF   70             CONTINUE   80          CONTINUE            END IF         ELSE**           Form  B := alpha*A'*B.
*
            IF( UPPER )THEN
               DO 110, J = 1, N
                  DO 100, I = M, 1, -1
                     TEMP = B( I, J )
                     IF( NOUNIT )
     $                  TEMP = TEMP*A( I, I )
                     DO 90, K = 1, I - 1
                        TEMP = TEMP + A( K, I )*B( K, J )
   90                CONTINUE
                     B( I, J ) = ALPHA*TEMP
  100             CONTINUE
  110          CONTINUE
            ELSE
               DO 140, J = 1, N
                  DO 130, I = 1, M
                     TEMP = B( I, J )
                     IF( NOUNIT )
     $                  TEMP = TEMP*A( I, I )
                     DO 120, K = I + 1, M
                        TEMP = TEMP + A( K, I )*B( K, J )
  120                CONTINUE
                     B( I, J ) = ALPHA*TEMP
  130             CONTINUE
  140          CONTINUE
            END IF
         END IF
      ELSE
         IF( LSAME( TRANSA, 'N' ) )THEN
*
*           Form  B := alpha*B*A.
*
            IF( UPPER )THEN
               DO 180, J = N, 1, -1
                  TEMP = ALPHA
                  IF( NOUNIT )
     $               TEMP = TEMP*A( J, J )
                  DO 150, I = 1, M
                     B( I, J ) = TEMP*B( I, J )
  150             CONTINUE
                  DO 170, K = 1, J - 1
                     IF( A( K, J ).NE.ZERO )THEN
                        TEMP = ALPHA*A( K, J )
                        DO 160, I = 1, M
                           B( I, J ) = B( I, J ) + TEMP*B( I, K )
  160                   CONTINUE
                     END IF
  170             CONTINUE
  180          CONTINUE
            ELSE
               DO 220, J = 1, N
                  TEMP = ALPHA
                  IF( NOUNIT )
     $               TEMP = TEMP*A( J, J )
                  DO 190, I = 1, M
                     B( I, J ) = TEMP*B( I, J )
  190             CONTINUE
                  DO 210, K = J + 1, N
                     IF( A( K, J ).NE.ZERO )THEN
                        TEMP = ALPHA*A( K, J )
                        DO 200, I = 1, M
                           B( I, J ) = B( I, J ) + TEMP*B( I, K )
  200                   CONTINUE
                     END IF
  210             CONTINUE
  220          CONTINUE
            END IF
         ELSE
*
*           Form  B := alpha*B*A





























































'.*            IF( UPPER )THEN               DO 260, K = 1, N                  DO 240, J = 1, K - 1                     IF( A( J, K ).NE.ZERO )THEN                        TEMP = ALPHA*A( J, K )                        DO 230, I = 1, M                           B( I, J ) = B( I, J ) + TEMP*B( I, K )  230                   CONTINUE                     END IF  240             CONTINUE                  TEMP = ALPHA                  IF( NOUNIT )     $               TEMP = TEMP*A( K, K )                  IF( TEMP.NE.ONE )THEN                     DO 250, I = 1, M                        B( I, K ) = TEMP*B( I, K )  250                CONTINUE                  END IF  260          CONTINUE            ELSE               DO 300, K = N, 1, -1                  DO 280, J = K + 1, N                     IF( A( J, K ).NE.ZERO )THEN                        TEMP = ALPHA*A( J, K )                        DO 270, I = 1, M                           B( I, J ) = B( I, J ) + TEMP*B( I, K )  270                   CONTINUE                     END IF  280             CONTINUE                  TEMP = ALPHA                  IF( NOUNIT )     $               TEMP = TEMP*A( K, K )                  IF( TEMP.NE.ONE )THEN                     DO 290, I = 1, M                        B( I, K ) = TEMP*B( I, K )  290                CONTINUE                  END IF  300          CONTINUE            END IF         END IF      END IF*      RETURN**     End of DTRMM .*      END      SUBROUTINE DTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )*     .. Scalar Arguments ..      INTEGER            INCX, LDA, N      CHARACTER*1        DIAG, TRANS, UPLO*     .. Array Arguments ..      DOUBLE PRECISION   A( LDA, * ), X( * )*     ..**  Purpose*  =======**  DTRMV  performs one of the matrix-vector operations**     x := A*x,   or   x := A'*x,
*
*  where x is an n element vector and  A is an n by n unit, or non-unit,
*  upper or lower triangular matrix.
*
*  Parameters
*  ==========
*
*  UPLO   - CHARACTER*1.
*           On entry, UPLO specifies whether the matrix is an upper or
*           lower triangular matrix as follows:
*
*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
*
*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
*
*           Unchanged on exit.
*
*  TRANS  - CHARACTER*1.
*           On entry, TRANS specifies the operation to be performed as
*           follows:
*
*              TRANS = 'N' or 'n'   x := A*x.
*
*              TRANS = 'T' or 't'   x := A

'*x.**              TRANS = 'C' or 'c'   x := A'*x.
*
*           Unchanged on exit.
*
*  DIAG   - CHARACTER*1.
*           On entry, DIAG specifies whether or not A is unit
*           triangular as follows:
*
*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
*
*              DIAG = 'N' or 'n'   A is not assumed to be unit
*                                  triangular.
*
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry, N specifies the order of the matrix A.
*           N must be at least zero.
*           Unchanged on exit.
*
*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
*           Before entry with  UPLO = 'U' or 'u', the leading n by n
*           upper triangular part of the array A must contain the upper
*           triangular matrix and the strictly lower triangular part of
*           A is not referenced.
*           Before entry with UPLO = 'L' or 'l', the leading n by n
*           lower triangular part of the array A must contain the lower
*           triangular matrix and the strictly upper triangular part of
*           A is not referenced.
*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
*           A are not referenced either, but are assumed to be unity.
*           Unchanged on exit.
*
*  LDA    - INTEGER.
*           On entry, LDA specifies the first dimension of A as declared
*           in the calling (sub) program. LDA must be at least
*           max( 1, n ).
*           Unchanged on exit.
*
*  X      - DOUBLE PRECISION array of dimension at least
*           ( 1 + ( n - 1 )*abs( INCX ) ).
*           Before entry, the incremented array X must contain the n
*           element vector x. On exit, X is overwritten with the
*           tranformed vector x.
*
*  INCX   - INTEGER.
*           On entry, INCX specifies the increment for the elements of
*           X. INCX must not be zero.
*           Unchanged on exit.
*
*
*  Level 2 Blas routine.
*
*  -- Written on 22-October-1986.
*     Jack Dongarra, Argonne National Lab.
*     Jeremy Du Croz, Nag Central Office.
*     Sven Hammarling, Nag Central Office.
*     Richard Hanson, Sandia National Labs.
*
*
*     .. Parameters ..
      DOUBLE PRECISION   ZERO
      PARAMETER        ( ZERO = 0.0D+0 )
*     .. Local Scalars ..
      DOUBLE PRECISION   TEMP
      INTEGER            I, INFO, IX, J, JX, KX
      LOGICAL            NOUNIT
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     .. Intrinsic Functions ..
      INTRINSIC          MAX
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      INFO = 0
      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.
     $         .NOT.LSAME( UPLO , 'L' )      )THEN
         INFO = 1
      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
     $         .NOT.LSAME( TRANS, 'T' ).AND.
     $         .NOT.LSAME( TRANS, 'C' )      )THEN
         INFO = 2
      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
     $         .NOT.LSAME( DIAG , 'N' )      )THEN
         INFO = 3
      ELSE IF( N.LT.0 )THEN
         INFO = 4
      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
         INFO = 6
      ELSE IF( INCX.EQ.0 )THEN
         INFO = 8
      END IF
      IF( INFO.NE.0 )THEN
         CALL XERBLA( 'DTRMV ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( N.EQ.0 )
     $   RETURN
*
      NOUNIT = LSAME( DIAG, 'N' )
*
*     Set up the start point in X if the increment is not unity. This
*     will be  ( N - 1 )*INCX  too small for descending loops.
*
      IF( INCX.LE.0 )THEN
         KX = 1 - ( N - 1 )*INCX
      ELSE IF( INCX.NE.1 )THEN
         KX = 1
      END IF
*
*     Start the operations. In this version the elements of A are
*     accessed sequentially with one pass through A.
*
      IF( LSAME( TRANS, 'N' ) )THEN
*
*        Form  x := A*x.
*
         IF( LSAME( UPLO, 'U' ) )THEN
            IF( INCX.EQ.1 )THEN
               DO 20, J = 1, N
                  IF( X( J ).NE.ZERO )THEN
                     TEMP = X( J )
                     DO 10, I = 1, J - 1
                        X( I ) = X( I ) + TEMP*A( I, J )
   10                CONTINUE
                     IF( NOUNIT )
     $                  X( J ) = X( J )*A( J, J )
                  END IF
   20          CONTINUE
            ELSE
               JX = KX
               DO 40, J = 1, N
                  IF( X( JX ).NE.ZERO )THEN
                     TEMP = X( JX )
                     IX   = KX
                     DO 30, I = 1, J - 1
                        X( IX ) = X( IX ) + TEMP*A( I, J )
                        IX      = IX      + INCX
   30                CONTINUE
                     IF( NOUNIT )
     $                  X( JX ) = X( JX )*A( J, J )
                  END IF
                  JX = JX + INCX
   40          CONTINUE
            END IF
         ELSE
            IF( INCX.EQ.1 )THEN
               DO 60, J = N, 1, -1
                  IF( X( J ).NE.ZERO )THEN
                     TEMP = X( J )
                     DO 50, I = N, J + 1, -1
                        X( I ) = X( I ) + TEMP*A( I, J )
   50                CONTINUE
                     IF( NOUNIT )
     $                  X( J ) = X( J )*A( J, J )
                  END IF
   60          CONTINUE
            ELSE
               KX = KX + ( N - 1 )*INCX
               JX = KX
               DO 80, J = N, 1, -1
                  IF( X( JX ).NE.ZERO )THEN
                     TEMP = X( JX )
                     IX   = KX
                     DO 70, I = N, J + 1, -1
                        X( IX ) = X( IX ) + TEMP*A( I, J )
                        IX      = IX      - INCX
   70                CONTINUE
                     IF( NOUNIT )
     $                  X( JX ) = X( JX )*A( J, J )
                  END IF
                  JX = JX - INCX
   80          CONTINUE
            END IF
         END IF
      ELSE
*
*        Form  x := A

'*x.*         IF( LSAME( UPLO, 'U















































































' ) )THEN            IF( INCX.EQ.1 )THEN               DO 100, J = N, 1, -1                  TEMP = X( J )                  IF( NOUNIT )     $               TEMP = TEMP*A( J, J )                  DO 90, I = J - 1, 1, -1                     TEMP = TEMP + A( I, J )*X( I )   90             CONTINUE                  X( J ) = TEMP  100          CONTINUE            ELSE               JX = KX + ( N - 1 )*INCX               DO 120, J = N, 1, -1                  TEMP = X( JX )                  IX   = JX                  IF( NOUNIT )     $               TEMP = TEMP*A( J, J )                  DO 110, I = J - 1, 1, -1                     IX   = IX   - INCX                     TEMP = TEMP + A( I, J )*X( IX )  110             CONTINUE                  X( JX ) = TEMP                  JX      = JX   - INCX  120          CONTINUE            END IF         ELSE            IF( INCX.EQ.1 )THEN               DO 140, J = 1, N                  TEMP = X( J )                  IF( NOUNIT )     $               TEMP = TEMP*A( J, J )                  DO 130, I = J + 1, N                     TEMP = TEMP + A( I, J )*X( I )  130             CONTINUE                  X( J ) = TEMP  140          CONTINUE            ELSE               JX = KX               DO 160, J = 1, N                  TEMP = X( JX )                  IX   = JX                  IF( NOUNIT )     $               TEMP = TEMP*A( J, J )                  DO 150, I = J + 1, N                     IX   = IX   + INCX                     TEMP = TEMP + A( I, J )*X( IX )  150             CONTINUE                  X( JX ) = TEMP                  JX      = JX   + INCX  160          CONTINUE            END IF         END IF      END IF*      RETURN**     End of DTRMV .*      END      SUBROUTINE DTRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,     $                   B, LDB )*     .. Scalar Arguments ..      CHARACTER*1        SIDE, UPLO, TRANSA, DIAG      INTEGER            M, N, LDA, LDB      DOUBLE PRECISION   ALPHA*     .. Array Arguments ..      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )*     ..**  Purpose*  =======**  DTRSM  solves one of the matrix equations**     op( A )*X = alpha*B,   or   X*op( A ) = alpha*B,**  where alpha is a scalar, X and B are m by n matrices, A is a unit, or*  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of**     op( A ) = A   or   op( A ) = A'.
*
*  The matrix X is overwritten on B.
*
*  Parameters
*  ==========
*
*  SIDE   - CHARACTER*1.
*           On entry, SIDE specifies whether op( A ) appears on the left
*           or right of X as follows:
*
*              SIDE = 'L' or 'l'   op( A )*X = alpha*B.
*
*              SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
*
*           Unchanged on exit.
*
*  UPLO   - CHARACTER*1.
*           On entry, UPLO specifies whether the matrix A is an upper or
*           lower triangular matrix as follows:
*
*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
*
*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
*
*           Unchanged on exit.
*
*  TRANSA - CHARACTER*1.
*           On entry, TRANSA specifies the form of op( A ) to be used in
*           the matrix multiplication as follows:
*
*              TRANSA = 'N' or 'n'   op( A ) = A.
*
*              TRANSA = 'T' or 't'   op( A ) = A

'.**              TRANSA = 'C' or 'c'   op( A ) = A'.
*
*           Unchanged on exit.
*
*  DIAG   - CHARACTER*1.
*           On entry, DIAG specifies whether or not A is unit triangular
*           as follows:
*
*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
*
*              DIAG = 'N' or 'n'   A is not assumed to be unit
*                                  triangular.
*
*           Unchanged on exit.
*
*  M      - INTEGER.
*           On entry, M specifies the number of rows of B. M must be at
*           least zero.
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry, N specifies the number of columns of B.  N must be
*           at least zero.
*           Unchanged on exit.
*
*  ALPHA  - DOUBLE PRECISION.
*           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
*           zero then  A is not referenced and  B need not be set before
*           entry.
*           Unchanged on exit.
*
*  A      - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
*           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
*           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
*           upper triangular part of the array  A must contain the upper
*           triangular matrix  and the strictly lower triangular part of
*           A is not referenced.
*           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
*           lower triangular part of the array  A must contain the lower
*           triangular matrix  and the strictly upper triangular part of
*           A is not referenced.
*           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
*           A  are not referenced either,  but are assumed to be  unity.
*           Unchanged on exit.
*
*  LDA    - INTEGER.
*           On entry, LDA specifies the first dimension of A as declared
*           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
*           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
*           then LDA must be at least max( 1, n ).
*           Unchanged on exit.
*
*  B      - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
*           Before entry,  the leading  m by n part of the array  B must
*           contain  the  right-hand  side  matrix  B,  and  on exit  is
*           overwritten by the solution matrix  X.
*
*  LDB    - INTEGER.
*           On entry, LDB specifies the first dimension of B as declared
*           in  the  calling  (sub)  program.   LDB  must  be  at  least
*           max( 1, m ).
*           Unchanged on exit.
*
*
*  Level 3 Blas routine.
*
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     .. Intrinsic Functions ..
      INTRINSIC          MAX
*     .. Local Scalars ..
      LOGICAL            LSIDE, NOUNIT, UPPER
      INTEGER            I, INFO, J, K, NROWA
      DOUBLE PRECISION   TEMP
*     .. Parameters ..
      DOUBLE PRECISION   ONE         , ZERO
      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      LSIDE  = LSAME( SIDE  , 'L' )
      IF( LSIDE )THEN
         NROWA = M
      ELSE
         NROWA = N
      END IF
      NOUNIT = LSAME( DIAG  , 'N' )
      UPPER  = LSAME( UPLO  , 'U' )
*
      INFO   = 0
      IF(      ( .NOT.LSIDE                ).AND.
     $         ( .NOT.LSAME( SIDE  , 'R' ) )      )THEN
         INFO = 1
      ELSE IF( ( .NOT.UPPER                ).AND.
     $         ( .NOT.LSAME( UPLO  , 'L' ) )      )THEN
         INFO = 2
      ELSE IF( ( .NOT.LSAME( TRANSA, 'N' ) ).AND.
     $         ( .NOT.LSAME( TRANSA, 'T' ) ).AND.
     $         ( .NOT.LSAME( TRANSA, 'C' ) )      )THEN
         INFO = 3
      ELSE IF( ( .NOT.LSAME( DIAG  , 'U' ) ).AND.
     $         ( .NOT.LSAME( DIAG  , 'N' ) )      )THEN
         INFO = 4
      ELSE IF( M  .LT.0               )THEN
         INFO = 5
      ELSE IF( N  .LT.0               )THEN
         INFO = 6
      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
         INFO = 9
      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN
         INFO = 11
      END IF
      IF( INFO.NE.0 )THEN
         CALL XERBLA( 'DTRSM ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( N.EQ.0 )
     $   RETURN
*
*     And when  alpha.eq.zero.
*
      IF( ALPHA.EQ.ZERO )THEN
         DO 20, J = 1, N
            DO 10, I = 1, M
               B( I, J ) = ZERO
   10       CONTINUE
   20    CONTINUE
         RETURN
      END IF
*
*     Start the operations.
*
      IF( LSIDE )THEN
         IF( LSAME( TRANSA, 'N' ) )THEN
*
*           Form  B := alpha*inv( A )*B.
*
            IF( UPPER )THEN
               DO 60, J = 1, N
                  IF( ALPHA.NE.ONE )THEN
                     DO 30, I = 1, M
                        B( I, J ) = ALPHA*B( I, J )
   30                CONTINUE
                  END IF
                  DO 50, K = M, 1, -1
                     IF( B( K, J ).NE.ZERO )THEN
                        IF( NOUNIT )
     $                     B( K, J ) = B( K, J )/A( K, K )
                        DO 40, I = 1, K - 1
                           B( I, J ) = B( I, J ) - B( K, J )*A( I, K )
   40                   CONTINUE
                     END IF
   50             CONTINUE
   60          CONTINUE
            ELSE
               DO 100, J = 1, N
                  IF( ALPHA.NE.ONE )THEN
                     DO 70, I = 1, M
                        B( I, J ) = ALPHA*B( I, J )
   70                CONTINUE
                  END IF
                  DO 90 K = 1, M
                     IF( B( K, J ).NE.ZERO )THEN
                        IF( NOUNIT )
     $                     B( K, J ) = B( K, J )/A( K, K )
                        DO 80, I = K + 1, M
                           B( I, J ) = B( I, J ) - B( K, J )*A( I, K )
   80                   CONTINUE
                     END IF
   90             CONTINUE
  100          CONTINUE
            END IF
         ELSE
*
*           Form  B := alpha*inv( A




























' )*B.*            IF( UPPER )THEN               DO 130, J = 1, N                  DO 120, I = 1, M                     TEMP = ALPHA*B( I, J )                     DO 110, K = 1, I - 1                        TEMP = TEMP - A( K, I )*B( K, J )  110                CONTINUE                     IF( NOUNIT )     $                  TEMP = TEMP/A( I, I )                     B( I, J ) = TEMP  120             CONTINUE  130          CONTINUE            ELSE               DO 160, J = 1, N                  DO 150, I = M, 1, -1                     TEMP = ALPHA*B( I, J )                     DO 140, K = I + 1, M                        TEMP = TEMP - A( K, I )*B( K, J )  140                CONTINUE                     IF( NOUNIT )     $                  TEMP = TEMP/A( I, I )                     B( I, J ) = TEMP  150             CONTINUE  160          CONTINUE            END IF         END IF      ELSE         IF( LSAME( TRANSA, 'N
















































' ) )THEN**           Form  B := alpha*B*inv( A ).*            IF( UPPER )THEN               DO 210, J = 1, N                  IF( ALPHA.NE.ONE )THEN                     DO 170, I = 1, M                        B( I, J ) = ALPHA*B( I, J )  170                CONTINUE                  END IF                  DO 190, K = 1, J - 1                     IF( A( K, J ).NE.ZERO )THEN                        DO 180, I = 1, M                           B( I, J ) = B( I, J ) - A( K, J )*B( I, K )  180                   CONTINUE                     END IF  190             CONTINUE                  IF( NOUNIT )THEN                     TEMP = ONE/A( J, J )                     DO 200, I = 1, M                        B( I, J ) = TEMP*B( I, J )  200                CONTINUE                  END IF  210          CONTINUE            ELSE               DO 260, J = N, 1, -1                  IF( ALPHA.NE.ONE )THEN                     DO 220, I = 1, M                        B( I, J ) = ALPHA*B( I, J )  220                CONTINUE                  END IF                  DO 240, K = J + 1, N                     IF( A( K, J ).NE.ZERO )THEN                        DO 230, I = 1, M                           B( I, J ) = B( I, J ) - A( K, J )*B( I, K )  230                   CONTINUE                     END IF  240             CONTINUE                  IF( NOUNIT )THEN                     TEMP = ONE/A( J, J )                     DO 250, I = 1, M                       B( I, J ) = TEMP*B( I, J )  250                CONTINUE                  END IF  260          CONTINUE            END IF         ELSE**           Form  B := alpha*B*inv( A' ).
*
            IF( UPPER )THEN
               DO 310, K = N, 1, -1
                  IF( NOUNIT )THEN
                     TEMP = ONE/A( K, K )
                     DO 270, I = 1, M
                        B( I, K ) = TEMP*B( I, K )
  270                CONTINUE
                  END IF
                  DO 290, J = 1, K - 1
                     IF( A( J, K ).NE.ZERO )THEN
                        TEMP = A( J, K )
                        DO 280, I = 1, M
                           B( I, J ) = B( I, J ) - TEMP*B( I, K )
  280                   CONTINUE
                     END IF
  290             CONTINUE
                  IF( ALPHA.NE.ONE )THEN
                     DO 300, I = 1, M
                        B( I, K ) = ALPHA*B( I, K )
  300                CONTINUE
                  END IF
  310          CONTINUE
            ELSE
               DO 360, K = 1, N
                  IF( NOUNIT )THEN
                     TEMP = ONE/A( K, K )
                     DO 320, I = 1, M
                        B( I, K ) = TEMP*B( I, K )
  320                CONTINUE
                  END IF
                  DO 340, J = K + 1, N
                     IF( A( J, K ).NE.ZERO )THEN
                        TEMP = A( J, K )
                        DO 330, I = 1, M
                           B( I, J ) = B( I, J ) - TEMP*B( I, K )
  330                   CONTINUE
                     END IF
  340             CONTINUE
                  IF( ALPHA.NE.ONE )THEN
                     DO 350, I = 1, M
                        B( I, K ) = ALPHA*B( I, K )
  350                CONTINUE
                  END IF
  360          CONTINUE
            END IF
         END IF
      END IF
*
      RETURN
*
*     End of DTRSM .
*
      END
      SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
*     .. Scalar Arguments ..
      INTEGER            INCX, LDA, N
      CHARACTER*1        DIAG, TRANS, UPLO
*     .. Array Arguments ..
      DOUBLE PRECISION   A( LDA, * ), X( * )
*     ..
*
*  Purpose
*  =======
*
*  DTRSV  solves one of the systems of equations
*
*     A*x = b,   or   A














'*x = b,**  where b and x are n element vectors and A is an n by n unit, or*  non-unit, upper or lower triangular matrix.**  No test for singularity or near-singularity is included in this*  routine. Such tests must be performed before calling this routine.**  Parameters*  ==========**  UPLO   - CHARACTER*1.*           On entry, UPLO specifies whether the matrix is an upper or*           lower triangular matrix as follows:**              UPLO = 'U' or 'u

'   A is an upper triangular matrix.**              UPLO = 'L' or 'l







'   A is a lower triangular matrix.**           Unchanged on exit.**  TRANS  - CHARACTER*1.*           On entry, TRANS specifies the equations to be solved as*           follows:**              TRANS = 'N' or 'n

'   A*x = b.**              TRANS = 'T' or 't'   A'*x = b.
*
*              TRANS = 'C' or 'c'   A







'*x = b.**           Unchanged on exit.**  DIAG   - CHARACTER*1.*           On entry, DIAG specifies whether or not A is unit*           triangular as follows:**              DIAG = 'U' or 'u

'   A is assumed to be unit triangular.**              DIAG = 'N' or 'n










'   A is not assumed to be unit*                                  triangular.**           Unchanged on exit.**  N      - INTEGER.*           On entry, N specifies the order of the matrix A.*           N must be at least zero.*           Unchanged on exit.**  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).*           Before entry with  UPLO = 'U' or 'u



', the leading n by n*           upper triangular part of the array A must contain the upper*           triangular matrix and the strictly lower triangular part of*           A is not referenced.*           Before entry with UPLO = 'L' or 'l



', the leading n by n*           lower triangular part of the array A must contain the lower*           triangular matrix and the strictly upper triangular part of*           A is not referenced.*           Note that when  DIAG = 'U' or 'u


















































', the diagonal elements of*           A are not referenced either, but are assumed to be unity.*           Unchanged on exit.**  LDA    - INTEGER.*           On entry, LDA specifies the first dimension of A as declared*           in the calling (sub) program. LDA must be at least*           max( 1, n ).*           Unchanged on exit.**  X      - DOUBLE PRECISION array of dimension at least*           ( 1 + ( n - 1 )*abs( INCX ) ).*           Before entry, the incremented array X must contain the n*           element right-hand side vector b. On exit, X is overwritten*           with the solution vector x.**  INCX   - INTEGER.*           On entry, INCX specifies the increment for the elements of*           X. INCX must not be zero.*           Unchanged on exit.***  Level 2 Blas routine.**  -- Written on 22-October-1986.*     Jack Dongarra, Argonne National Lab.*     Jeremy Du Croz, Nag Central Office.*     Sven Hammarling, Nag Central Office.*     Richard Hanson, Sandia National Labs.***     .. Parameters ..      DOUBLE PRECISION   ZERO      PARAMETER        ( ZERO = 0.0D+0 )*     .. Local Scalars ..      DOUBLE PRECISION   TEMP      INTEGER            I, INFO, IX, J, JX, KX      LOGICAL            NOUNIT*     .. External Functions ..      LOGICAL            LSAME      EXTERNAL           LSAME*     .. External Subroutines ..      EXTERNAL           XERBLA*     .. Intrinsic Functions ..      INTRINSIC          MAX*     ..*     .. Executable Statements ..**     Test the input parameters.*      INFO = 0      IF     ( .NOT.LSAME( UPLO , 'U
' ).AND.     $         .NOT.LSAME( UPLO , 'L

' )      )THEN         INFO = 1      ELSE IF( .NOT.LSAME( TRANS, 'N
' ).AND.     $         .NOT.LSAME( TRANS, 'T
' ).AND.     $         .NOT.LSAME( TRANS, 'C

' )      )THEN         INFO = 2      ELSE IF( .NOT.LSAME( DIAG , 'U
' ).AND.     $         .NOT.LSAME( DIAG , 'N









' )      )THEN         INFO = 3      ELSE IF( N.LT.0 )THEN         INFO = 4      ELSE IF( LDA.LT.MAX( 1, N ) )THEN         INFO = 6      ELSE IF( INCX.EQ.0 )THEN         INFO = 8      END IF      IF( INFO.NE.0 )THEN         CALL XERBLA( 'DTRSV 








', INFO )         RETURN      END IF**     Quick return if possible.*      IF( N.EQ.0 )     $   RETURN*      NOUNIT = LSAME( DIAG, 'N













' )**     Set up the start point in X if the increment is not unity. This*     will be  ( N - 1 )*INCX  too small for descending loops.*      IF( INCX.LE.0 )THEN         KX = 1 - ( N - 1 )*INCX      ELSE IF( INCX.NE.1 )THEN         KX = 1      END IF**     Start the operations. In this version the elements of A are*     accessed sequentially with one pass through A.*      IF( LSAME( TRANS, 'N



' ) )THEN**        Form  x := inv( A )*x.*         IF( LSAME( UPLO, 'U


























































' ) )THEN            IF( INCX.EQ.1 )THEN               DO 20, J = N, 1, -1                  IF( X( J ).NE.ZERO )THEN                     IF( NOUNIT )     $                  X( J ) = X( J )/A( J, J )                     TEMP = X( J )                     DO 10, I = J - 1, 1, -1                        X( I ) = X( I ) - TEMP*A( I, J )   10                CONTINUE                  END IF   20          CONTINUE            ELSE               JX = KX + ( N - 1 )*INCX               DO 40, J = N, 1, -1                  IF( X( JX ).NE.ZERO )THEN                     IF( NOUNIT )     $                  X( JX ) = X( JX )/A( J, J )                     TEMP = X( JX )                     IX   = JX                     DO 30, I = J - 1, 1, -1                        IX      = IX      - INCX                        X( IX ) = X( IX ) - TEMP*A( I, J )   30                CONTINUE                  END IF                  JX = JX - INCX   40          CONTINUE            END IF         ELSE            IF( INCX.EQ.1 )THEN               DO 60, J = 1, N                  IF( X( J ).NE.ZERO )THEN                     IF( NOUNIT )     $                  X( J ) = X( J )/A( J, J )                     TEMP = X( J )                     DO 50, I = J + 1, N                        X( I ) = X( I ) - TEMP*A( I, J )   50                CONTINUE                  END IF   60          CONTINUE            ELSE               JX = KX               DO 80, J = 1, N                  IF( X( JX ).NE.ZERO )THEN                     IF( NOUNIT )     $                  X( JX ) = X( JX )/A( J, J )                     TEMP = X( JX )                     IX   = JX                     DO 70, I = J + 1, N                        IX      = IX      + INCX                        X( IX ) = X( IX ) - TEMP*A( I, J )   70                CONTINUE                  END IF                  JX = JX + INCX   80          CONTINUE            END IF         END IF      ELSE**        Form  x := inv( A' )*x.
*
         IF( LSAME( UPLO, 'U' ) )THEN
            IF( INCX.EQ.1 )THEN
               DO 100, J = 1, N
                  TEMP = X( J )
                  DO 90, I = 1, J - 1
                     TEMP = TEMP - A( I, J )*X( I )
   90             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/A( J, J )
                  X( J ) = TEMP
  100          CONTINUE
            ELSE
               JX = KX
               DO 120, J = 1, N
                  TEMP = X( JX )
                  IX   = KX
                  DO 110, I = 1, J - 1
                     TEMP = TEMP - A( I, J )*X( IX )
                     IX   = IX   + INCX
  110             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/A( J, J )
                  X( JX ) = TEMP
                  JX      = JX   + INCX
  120          CONTINUE
            END IF
         ELSE
            IF( INCX.EQ.1 )THEN
               DO 140, J = N, 1, -1
                  TEMP = X( J )
                  DO 130, I = N, J + 1, -1
                     TEMP = TEMP - A( I, J )*X( I )
  130             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/A( J, J )
                  X( J ) = TEMP
  140          CONTINUE
            ELSE
               KX = KX + ( N - 1 )*INCX
               JX = KX
               DO 160, J = N, 1, -1
                  TEMP = X( JX )
                  IX   = KX
                  DO 150, I = N, J + 1, -1
                     TEMP = TEMP - A( I, J )*X( IX )
                     IX   = IX   - INCX
  150             CONTINUE
                  IF( NOUNIT )
     $               TEMP = TEMP/A( J, J )
                  X( JX ) = TEMP
                  JX      = JX   - INCX
  160          CONTINUE
            END IF
         END IF
      END IF
*
      RETURN
*
*     End of DTRSV .
*
      END
      integer function idamax(n,dx,incx)
c
c     finds the index of element having max. absolute value.
c     jack dongarra, linpack, 3/11/78.
c     modified 3/93 to return if incx .le. 0.
c     modified 12/3/93, array(1) declarations changed to array(*)
c
      double precision dx(*),dmax
      integer i,incx,ix,n
c
      idamax = 0
      if( n.lt.1 .or. incx.le.0 ) return
      idamax = 1
      if(n.eq.1)return
      if(incx.eq.1)go to 20
c
c        code for increment not equal to 1
c
      ix = 1
      dmax = dabs(dx(1))
      ix = ix + incx
      do 10 i = 2,n
         if(dabs(dx(ix)).le.dmax) go to 5
         idamax = i
         dmax = dabs(dx(ix))
    5    ix = ix + incx
   10 continue
      return
c
c        code for increment equal to 1
c
   20 dmax = dabs(dx(1))
      do 30 i = 2,n
         if(dabs(dx(i)).le.dmax) go to 30
         idamax = i
         dmax = dabs(dx(i))
   30 continue
      return
      end
      LOGICAL          FUNCTION LSAME( CA, CB )
*
*  -- LAPACK auxiliary routine (version 2.0) --
*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
*     Courant Institute, Argonne National Lab, and Rice University
*     January 31, 1994
*
*     .. Scalar Arguments ..
      CHARACTER          CA, CB
*     ..
*
*  Purpose
*  =======
*
*  LSAME returns .TRUE. if CA is the same letter as CB regardless of
*  case.
*
*  Arguments
*  =========
*
*  CA      (input) CHARACTER*1
*  CB      (input) CHARACTER*1
*          CA and CB specify the single characters to be compared.
*
* =====================================================================
*
*     .. Intrinsic Functions ..
      INTRINSIC          ICHAR
*     ..
*     .. Local Scalars ..
      INTEGER            INTA, INTB, ZCODE
*     ..
*     .. Executable Statements ..
*
*     Test if the characters are equal
*
      LSAME = CA.EQ.CB
      IF( LSAME )
     $   RETURN
*
*     Now test for equivalence if both characters are alphabetic.
*
      ZCODE = ICHAR( 'Z' )
*
*     Use 'Z' rather than 'A' so that ASCII can be detected on Prime
*     machines, on which ICHAR returns a value with bit 8 set.
*     ICHAR('A') on Prime machines returns 193 which is the same as
*     ICHAR('A') on an EBCDIC machine.
*
      INTA = ICHAR( CA )
      INTB = ICHAR( CB )
*
      IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN
*
*        ASCII is assumed - ZCODE is the ASCII code of either lower or
*        upper case 'Z'.
*
         IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32
         IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32
*
      ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN
*
*        EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
*        upper case 'Z'.
*
         IF( INTA.GE.129 .AND. INTA.LE.137 .OR.
     $       INTA.GE.145 .AND. INTA.LE.153 .OR.
     $       INTA.GE.162 .AND. INTA.LE.169 ) INTA = INTA + 64
         IF( INTB.GE.129 .AND. INTB.LE.137 .OR.
     $       INTB.GE.145 .AND. INTB.LE.153 .OR.
     $       INTB.GE.162 .AND. INTB.LE.169 ) INTB = INTB + 64
*
      ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN
*
*        ASCII is assumed, on Prime machines - ZCODE is the ASCII code
*        plus 128 of either lower or upper case 'Z'.
*
         IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32
         IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32
      END IF
      LSAME = INTA.EQ.INTB
*
*     RETURN
*
*     End of LSAME
*
      END

Generated by  Doxygen 1.6.0   Back to index