update

61 files changed, 36659 insertions, 0 deletions

diff --git a/eigen/blas/BandTriangularSolver.h b/eigen/blas/BandTriangularSolver.h
new file mode 100644
index 0000000..ce2d74d
--- /dev/null
+++ b/eigen/blas/BandTriangularSolver.h
@@ -0,0 +1,97 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2011 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#ifndef EIGEN_BAND_TRIANGULARSOLVER_H
+#define EIGEN_BAND_TRIANGULARSOLVER_H
+
+namespace internal {
+
+ /* \internal
+  * Solve Ax=b with A a band triangular matrix
+  * TODO: extend it to matrices for x abd b */
+template<typename Index, int Mode, typename LhsScalar, bool ConjLhs, typename RhsScalar, int StorageOrder>
+struct band_solve_triangular_selector;
+
+
+template<typename Index, int Mode, typename LhsScalar, bool ConjLhs, typename RhsScalar>
+struct band_solve_triangular_selector<Index,Mode,LhsScalar,ConjLhs,RhsScalar,RowMajor>
+{
+  typedef Map<const Matrix<LhsScalar,Dynamic,Dynamic,RowMajor>, 0, OuterStride<> > LhsMap;
+  typedef Map<Matrix<RhsScalar,Dynamic,1> > RhsMap;
+  enum { IsLower = (Mode&Lower) ? 1 : 0 };
+  static void run(Index size, Index k, const LhsScalar* _lhs, Index lhsStride, RhsScalar* _other)
+  {
+    const LhsMap lhs(_lhs,size,k+1,OuterStride<>(lhsStride));
+    RhsMap other(_other,size,1);
+    typename internal::conditional<
+                          ConjLhs,
+                          const CwiseUnaryOp<typename internal::scalar_conjugate_op<LhsScalar>,LhsMap>,
+                          const LhsMap&>
+                        ::type cjLhs(lhs);
+                        
+    for(int col=0 ; col<other.cols() ; ++col)
+    {
+      for(int ii=0; ii<size; ++ii)
+      {
+        int i = IsLower ? ii : size-ii-1;
+        int actual_k = (std::min)(k,ii);
+        int actual_start = IsLower ? k-actual_k : 1;
+        
+        if(actual_k>0)
+          other.coeffRef(i,col) -= cjLhs.row(i).segment(actual_start,actual_k).transpose()
+                                  .cwiseProduct(other.col(col).segment(IsLower ? i-actual_k : i+1,actual_k)).sum();
+
+        if((Mode&UnitDiag)==0)
+          other.coeffRef(i,col) /= cjLhs(i,IsLower ? k : 0);
+      }
+    }
+  }
+  
+};
+
+template<typename Index, int Mode, typename LhsScalar, bool ConjLhs, typename RhsScalar>
+struct band_solve_triangular_selector<Index,Mode,LhsScalar,ConjLhs,RhsScalar,ColMajor>
+{
+  typedef Map<const Matrix<LhsScalar,Dynamic,Dynamic,ColMajor>, 0, OuterStride<> > LhsMap;
+  typedef Map<Matrix<RhsScalar,Dynamic,1> > RhsMap;
+  enum { IsLower = (Mode&Lower) ? 1 : 0 };
+  static void run(Index size, Index k, const LhsScalar* _lhs, Index lhsStride, RhsScalar* _other)
+  {
+    const LhsMap lhs(_lhs,k+1,size,OuterStride<>(lhsStride));
+    RhsMap other(_other,size,1);
+    typename internal::conditional<
+                          ConjLhs,
+                          const CwiseUnaryOp<typename internal::scalar_conjugate_op<LhsScalar>,LhsMap>,
+                          const LhsMap&>
+                        ::type cjLhs(lhs);
+                        
+    for(int col=0 ; col<other.cols() ; ++col)
+    {
+      for(int ii=0; ii<size; ++ii)
+      {
+        int i = IsLower ? ii : size-ii-1;
+        int actual_k = (std::min)(k,size-ii-1);
+        int actual_start = IsLower ? 1 : k-actual_k;
+        
+        if((Mode&UnitDiag)==0)
+          other.coeffRef(i,col) /= cjLhs(IsLower ? 0 : k, i);
+
+        if(actual_k>0)
+          other.col(col).segment(IsLower ? i+1 : i-actual_k, actual_k)
+              -= other.coeff(i,col) * cjLhs.col(i).segment(actual_start,actual_k);
+        
+      }
+    }
+  }
+};
+
+
+} // end namespace internal
+
+#endif // EIGEN_BAND_TRIANGULARSOLVER_H
diff --git a/eigen/blas/CMakeLists.txt b/eigen/blas/CMakeLists.txt
new file mode 100644
index 0000000..a9bc051
--- /dev/null
+++ b/eigen/blas/CMakeLists.txt
@@ -0,0 +1,60 @@
+
+project(EigenBlas CXX)
+
+include("../cmake/language_support.cmake")
+
+workaround_9220(Fortran EIGEN_Fortran_COMPILER_WORKS)
+
+if(EIGEN_Fortran_COMPILER_WORKS)
+  enable_language(Fortran OPTIONAL)
+  if(NOT CMAKE_Fortran_COMPILER)
+    set(EIGEN_Fortran_COMPILER_WORKS OFF)
+  endif()
+endif()
+
+add_custom_target(blas)
+
+set(EigenBlas_SRCS single.cpp double.cpp complex_single.cpp complex_double.cpp xerbla.cpp)
+
+if(EIGEN_Fortran_COMPILER_WORKS)
+
+set(EigenBlas_SRCS ${EigenBlas_SRCS}
+    complexdots.f
+    srotm.f srotmg.f drotm.f drotmg.f
+    lsame.f  dspmv.f ssbmv.f
+    chbmv.f  sspmv.f
+    zhbmv.f  chpmv.f dsbmv.f
+    zhpmv.f
+    dtbmv.f stbmv.f ctbmv.f ztbmv.f
+)
+else()
+
+message(WARNING " No fortran compiler has been detected, the blas build will be incomplete.")
+
+endif()
+
+add_library(eigen_blas_static ${EigenBlas_SRCS})
+add_library(eigen_blas SHARED ${EigenBlas_SRCS})
+
+if(EIGEN_STANDARD_LIBRARIES_TO_LINK_TO)
+  target_link_libraries(eigen_blas_static ${EIGEN_STANDARD_LIBRARIES_TO_LINK_TO})
+  target_link_libraries(eigen_blas        ${EIGEN_STANDARD_LIBRARIES_TO_LINK_TO})
+endif()
+
+add_dependencies(blas eigen_blas eigen_blas_static)
+
+install(TARGETS eigen_blas eigen_blas_static
+        RUNTIME DESTINATION bin
+        LIBRARY DESTINATION lib
+        ARCHIVE DESTINATION lib)
+
+if(EIGEN_Fortran_COMPILER_WORKS)
+
+if(EIGEN_LEAVE_TEST_IN_ALL_TARGET)
+  add_subdirectory(testing) # can't do EXCLUDE_FROM_ALL here, breaks CTest
+else()
+  add_subdirectory(testing EXCLUDE_FROM_ALL)
+endif()
+
+endif()
+
diff --git a/eigen/blas/GeneralRank1Update.h b/eigen/blas/GeneralRank1Update.h
new file mode 100644
index 0000000..07d388c
--- /dev/null
+++ b/eigen/blas/GeneralRank1Update.h
@@ -0,0 +1,44 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2012 Chen-Pang He <jdh8@ms63.hinet.net>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#ifndef EIGEN_GENERAL_RANK1UPDATE_H
+#define EIGEN_GENERAL_RANK1UPDATE_H
+
+namespace internal {
+
+/* Optimized matrix += alpha * uv' */
+template<typename Scalar, typename Index, int StorageOrder, bool ConjLhs, bool ConjRhs>
+struct general_rank1_update;
+
+template<typename Scalar, typename Index, bool ConjLhs, bool ConjRhs>
+struct general_rank1_update<Scalar,Index,ColMajor,ConjLhs,ConjRhs>
+{
+  static void run(Index rows, Index cols, Scalar* mat, Index stride, const Scalar* u, const Scalar* v, Scalar alpha)
+  {
+    typedef Map<const Matrix<Scalar,Dynamic,1> > OtherMap;
+    typedef typename conj_expr_if<ConjLhs,OtherMap>::type ConjRhsType;
+    conj_if<ConjRhs> cj;
+
+    for (Index i=0; i<cols; ++i)
+      Map<Matrix<Scalar,Dynamic,1> >(mat+stride*i,rows) += alpha * cj(v[i]) * ConjRhsType(OtherMap(u,rows));
+  }
+};
+
+template<typename Scalar, typename Index, bool ConjLhs, bool ConjRhs>
+struct general_rank1_update<Scalar,Index,RowMajor,ConjLhs,ConjRhs>
+{
+  static void run(Index rows, Index cols, Scalar* mat, Index stride, const Scalar* u, const Scalar* v, Scalar alpha)
+  {
+    general_rank1_update<Scalar,Index,ColMajor,ConjRhs,ConjRhs>::run(rows,cols,mat,stride,u,v,alpha);
+  }
+};
+
+} // end namespace internal
+
+#endif // EIGEN_GENERAL_RANK1UPDATE_H
diff --git a/eigen/blas/PackedSelfadjointProduct.h b/eigen/blas/PackedSelfadjointProduct.h
new file mode 100644
index 0000000..07327a2
--- /dev/null
+++ b/eigen/blas/PackedSelfadjointProduct.h
@@ -0,0 +1,53 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2012 Chen-Pang He <jdh8@ms63.hinet.net>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#ifndef EIGEN_SELFADJOINT_PACKED_PRODUCT_H
+#define EIGEN_SELFADJOINT_PACKED_PRODUCT_H
+
+namespace internal {
+
+/* Optimized matrix += alpha * uv'
+ * The matrix is in packed form.
+ */
+template<typename Scalar, typename Index, int StorageOrder, int UpLo, bool ConjLhs, bool ConjRhs>
+struct selfadjoint_packed_rank1_update;
+
+template<typename Scalar, typename Index, int UpLo, bool ConjLhs, bool ConjRhs>
+struct selfadjoint_packed_rank1_update<Scalar,Index,ColMajor,UpLo,ConjLhs,ConjRhs>
+{
+  typedef typename NumTraits<Scalar>::Real RealScalar;
+  static void run(Index size, Scalar* mat, const Scalar* vec, RealScalar alpha)
+  {
+    typedef Map<const Matrix<Scalar,Dynamic,1> > OtherMap;
+    typedef typename conj_expr_if<ConjLhs,OtherMap>::type ConjRhsType;
+    conj_if<ConjRhs> cj;
+
+    for (Index i=0; i<size; ++i)
+    {
+      Map<Matrix<Scalar,Dynamic,1> >(mat, UpLo==Lower ? size-i : (i+1)) += alpha * cj(vec[i]) * ConjRhsType(OtherMap(vec+(UpLo==Lower ? i : 0), UpLo==Lower ? size-i : (i+1)));
+      //FIXME This should be handled outside.
+      mat[UpLo==Lower ? 0 : i] = numext::real(mat[UpLo==Lower ? 0 : i]);
+      mat += UpLo==Lower ? size-i : (i+1);
+    }
+  }
+};
+
+template<typename Scalar, typename Index, int UpLo, bool ConjLhs, bool ConjRhs>
+struct selfadjoint_packed_rank1_update<Scalar,Index,RowMajor,UpLo,ConjLhs,ConjRhs>
+{
+  typedef typename NumTraits<Scalar>::Real RealScalar;
+  static void run(Index size, Scalar* mat, const Scalar* vec, RealScalar alpha)
+  {
+    selfadjoint_packed_rank1_update<Scalar,Index,ColMajor,UpLo==Lower?Upper:Lower,ConjRhs,ConjLhs>::run(size,mat,vec,alpha);
+  }
+};
+
+} // end namespace internal
+
+#endif // EIGEN_SELFADJOINT_PACKED_PRODUCT_H
diff --git a/eigen/blas/PackedTriangularMatrixVector.h b/eigen/blas/PackedTriangularMatrixVector.h
new file mode 100644
index 0000000..e9886d5
--- /dev/null
+++ b/eigen/blas/PackedTriangularMatrixVector.h
@@ -0,0 +1,79 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2012 Chen-Pang He <jdh8@ms63.hinet.net>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#ifndef EIGEN_PACKED_TRIANGULAR_MATRIX_VECTOR_H
+#define EIGEN_PACKED_TRIANGULAR_MATRIX_VECTOR_H
+
+namespace internal {
+
+template<typename Index, int Mode, typename LhsScalar, bool ConjLhs, typename RhsScalar, bool ConjRhs, int StorageOrder>
+struct packed_triangular_matrix_vector_product;
+
+template<typename Index, int Mode, typename LhsScalar, bool ConjLhs, typename RhsScalar, bool ConjRhs>
+struct packed_triangular_matrix_vector_product<Index,Mode,LhsScalar,ConjLhs,RhsScalar,ConjRhs,ColMajor>
+{
+  typedef typename scalar_product_traits<LhsScalar, RhsScalar>::ReturnType ResScalar;
+  enum {
+    IsLower     = (Mode & Lower)   ==Lower,
+    HasUnitDiag = (Mode & UnitDiag)==UnitDiag,
+    HasZeroDiag = (Mode & ZeroDiag)==ZeroDiag
+  };
+  static void run(Index size, const LhsScalar* lhs, const RhsScalar* rhs, ResScalar* res, ResScalar alpha)
+  {
+    internal::conj_if<ConjRhs> cj;
+    typedef Map<const Matrix<LhsScalar,Dynamic,1> > LhsMap;
+    typedef typename conj_expr_if<ConjLhs,LhsMap>::type ConjLhsType;
+    typedef Map<Matrix<ResScalar,Dynamic,1> > ResMap;
+
+    for (Index i=0; i<size; ++i)
+    {
+      Index s = IsLower&&(HasUnitDiag||HasZeroDiag) ? 1 : 0;
+      Index r = IsLower ? size-i: i+1;
+      if (EIGEN_IMPLIES(HasUnitDiag||HasZeroDiag, (--r)>0))
+	ResMap(res+(IsLower ? s+i : 0),r) += alpha * cj(rhs[i]) * ConjLhsType(LhsMap(lhs+s,r));
+      if (HasUnitDiag)
+	res[i] += alpha * cj(rhs[i]);
+      lhs += IsLower ? size-i: i+1;
+    }
+  };
+};
+
+template<typename Index, int Mode, typename LhsScalar, bool ConjLhs, typename RhsScalar, bool ConjRhs>
+struct packed_triangular_matrix_vector_product<Index,Mode,LhsScalar,ConjLhs,RhsScalar,ConjRhs,RowMajor>
+{
+  typedef typename scalar_product_traits<LhsScalar, RhsScalar>::ReturnType ResScalar;
+  enum {
+    IsLower     = (Mode & Lower)   ==Lower,
+    HasUnitDiag = (Mode & UnitDiag)==UnitDiag,
+    HasZeroDiag = (Mode & ZeroDiag)==ZeroDiag
+  };
+  static void run(Index size, const LhsScalar* lhs, const RhsScalar* rhs, ResScalar* res, ResScalar alpha)
+  {
+    internal::conj_if<ConjRhs> cj;
+    typedef Map<const Matrix<LhsScalar,Dynamic,1> > LhsMap;
+    typedef typename conj_expr_if<ConjLhs,LhsMap>::type ConjLhsType;
+    typedef Map<const Matrix<RhsScalar,Dynamic,1> > RhsMap;
+    typedef typename conj_expr_if<ConjRhs,RhsMap>::type ConjRhsType;
+
+    for (Index i=0; i<size; ++i)
+    {
+      Index s = !IsLower&&(HasUnitDiag||HasZeroDiag) ? 1 : 0;
+      Index r = IsLower ? i+1 : size-i;
+      if (EIGEN_IMPLIES(HasUnitDiag||HasZeroDiag, (--r)>0))
+	res[i] += alpha * (ConjLhsType(LhsMap(lhs+s,r)).cwiseProduct(ConjRhsType(RhsMap(rhs+(IsLower ? 0 : s+i),r)))).sum();
+      if (HasUnitDiag)
+	res[i] += alpha * cj(rhs[i]);
+      lhs += IsLower ? i+1 : size-i;
+    }
+  };
+};
+
+} // end namespace internal
+
+#endif // EIGEN_PACKED_TRIANGULAR_MATRIX_VECTOR_H
diff --git a/eigen/blas/PackedTriangularSolverVector.h b/eigen/blas/PackedTriangularSolverVector.h
new file mode 100644
index 0000000..5c0bb4b
--- /dev/null
+++ b/eigen/blas/PackedTriangularSolverVector.h
@@ -0,0 +1,88 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2012 Chen-Pang He <jdh8@ms63.hinet.net>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#ifndef EIGEN_PACKED_TRIANGULAR_SOLVER_VECTOR_H
+#define EIGEN_PACKED_TRIANGULAR_SOLVER_VECTOR_H
+
+namespace internal {
+
+template<typename LhsScalar, typename RhsScalar, typename Index, int Side, int Mode, bool Conjugate, int StorageOrder>
+struct packed_triangular_solve_vector;
+
+// forward and backward substitution, row-major, rhs is a vector
+template<typename LhsScalar, typename RhsScalar, typename Index, int Mode, bool Conjugate>
+struct packed_triangular_solve_vector<LhsScalar, RhsScalar, Index, OnTheLeft, Mode, Conjugate, RowMajor>
+{
+  enum {
+    IsLower = (Mode&Lower)==Lower
+  };
+  static void run(Index size, const LhsScalar* lhs, RhsScalar* rhs)
+  {
+    internal::conj_if<Conjugate> cj;
+    typedef Map<const Matrix<LhsScalar,Dynamic,1> > LhsMap;
+    typedef typename conj_expr_if<Conjugate,LhsMap>::type ConjLhsType;
+
+    lhs += IsLower ? 0 : (size*(size+1)>>1)-1;
+    for(Index pi=0; pi<size; ++pi)
+    {
+      Index i = IsLower ? pi : size-pi-1;
+      Index s = IsLower ? 0 : 1;
+      if (pi>0)
+	rhs[i] -= (ConjLhsType(LhsMap(lhs+s,pi))
+	    .cwiseProduct(Map<const Matrix<RhsScalar,Dynamic,1> >(rhs+(IsLower ? 0 : i+1),pi))).sum();
+      if (!(Mode & UnitDiag))
+	rhs[i] /= cj(lhs[IsLower ? i : 0]);
+      IsLower ? lhs += pi+1 : lhs -= pi+2;
+    }
+  }
+};
+
+// forward and backward substitution, column-major, rhs is a vector
+template<typename LhsScalar, typename RhsScalar, typename Index, int Mode, bool Conjugate>
+struct packed_triangular_solve_vector<LhsScalar, RhsScalar, Index, OnTheLeft, Mode, Conjugate, ColMajor>
+{
+  enum {
+    IsLower = (Mode&Lower)==Lower
+  };
+  static void run(Index size, const LhsScalar* lhs, RhsScalar* rhs)
+  {
+    internal::conj_if<Conjugate> cj;
+    typedef Map<const Matrix<LhsScalar,Dynamic,1> > LhsMap;
+    typedef typename conj_expr_if<Conjugate,LhsMap>::type ConjLhsType;
+
+    lhs += IsLower ? 0 : size*(size-1)>>1;
+    for(Index pi=0; pi<size; ++pi)
+    {
+      Index i = IsLower ? pi : size-pi-1;
+      Index r = size - pi - 1;
+      if (!(Mode & UnitDiag))
+	rhs[i] /= cj(lhs[IsLower ? 0 : i]);
+      if (r>0)
+	Map<Matrix<RhsScalar,Dynamic,1> >(rhs+(IsLower? i+1 : 0),r) -=
+	    rhs[i] * ConjLhsType(LhsMap(lhs+(IsLower? 1 : 0),r));
+      IsLower ? lhs += size-pi : lhs -= r;
+    }
+  }
+};
+
+template<typename LhsScalar, typename RhsScalar, typename Index, int Mode, bool Conjugate, int StorageOrder>
+struct packed_triangular_solve_vector<LhsScalar, RhsScalar, Index, OnTheRight, Mode, Conjugate, StorageOrder>
+{
+  static void run(Index size, const LhsScalar* lhs, RhsScalar* rhs)
+  {
+    packed_triangular_solve_vector<LhsScalar,RhsScalar,Index,OnTheLeft,
+	((Mode&Upper)==Upper ? Lower : Upper) | (Mode&UnitDiag),
+	Conjugate,StorageOrder==RowMajor?ColMajor:RowMajor
+      >::run(size, lhs, rhs);
+  }
+};
+
+} // end namespace internal
+
+#endif // EIGEN_PACKED_TRIANGULAR_SOLVER_VECTOR_H
diff --git a/eigen/blas/README.txt b/eigen/blas/README.txt
new file mode 100644
index 0000000..63a5203
--- /dev/null
+++ b/eigen/blas/README.txt
@@ -0,0 +1,6 @@
+
+This directory contains a BLAS library built on top of Eigen.
+
+This module is not built by default. In order to compile it, you need to
+type 'make blas' from within your build dir.
+
diff --git a/eigen/blas/Rank2Update.h b/eigen/blas/Rank2Update.h
new file mode 100644
index 0000000..138d70f
--- /dev/null
+++ b/eigen/blas/Rank2Update.h
@@ -0,0 +1,57 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2012 Chen-Pang He <jdh8@ms63.hinet.net>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#ifndef EIGEN_RANK2UPDATE_H
+#define EIGEN_RANK2UPDATE_H
+
+namespace internal {
+
+/* Optimized selfadjoint matrix += alpha * uv' + conj(alpha)*vu'
+ * This is the low-level version of SelfadjointRank2Update.h
+ */
+template<typename Scalar, typename Index, int UpLo>
+struct rank2_update_selector
+{
+  static void run(Index size, Scalar* mat, Index stride, const Scalar* u, const Scalar* v, Scalar alpha)
+  {
+    typedef Map<const Matrix<Scalar,Dynamic,1> > OtherMap;
+    for (Index i=0; i<size; ++i)
+    {
+      Map<Matrix<Scalar,Dynamic,1> >(mat+stride*i+(UpLo==Lower ? i : 0), UpLo==Lower ? size-i : (i+1)) +=
+      numext::conj(alpha) * numext::conj(u[i]) * OtherMap(v+(UpLo==Lower ? i : 0), UpLo==Lower ? size-i : (i+1))
+                + alpha * numext::conj(v[i]) * OtherMap(u+(UpLo==Lower ? i : 0), UpLo==Lower ? size-i : (i+1));
+    }
+  }
+};
+
+/* Optimized selfadjoint matrix += alpha * uv' + conj(alpha)*vu'
+ * The matrix is in packed form.
+ */
+template<typename Scalar, typename Index, int UpLo>
+struct packed_rank2_update_selector
+{
+  static void run(Index size, Scalar* mat, const Scalar* u, const Scalar* v, Scalar alpha)
+  {
+    typedef Map<const Matrix<Scalar,Dynamic,1> > OtherMap;
+    Index offset = 0;
+    for (Index i=0; i<size; ++i)
+    {
+      Map<Matrix<Scalar,Dynamic,1> >(mat+offset, UpLo==Lower ? size-i : (i+1)) +=
+      numext::conj(alpha) * numext::conj(u[i]) * OtherMap(v+(UpLo==Lower ? i : 0), UpLo==Lower ? size-i : (i+1))
+                + alpha * numext::conj(v[i]) * OtherMap(u+(UpLo==Lower ? i : 0), UpLo==Lower ? size-i : (i+1));
+      //FIXME This should be handled outside.
+      mat[offset+(UpLo==Lower ? 0 : i)] = numext::real(mat[offset+(UpLo==Lower ? 0 : i)]);
+      offset += UpLo==Lower ? size-i : (i+1);
+    }
+  }
+};
+
+} // end namespace internal
+
+#endif // EIGEN_RANK2UPDATE_H
diff --git a/eigen/blas/chbmv.f b/eigen/blas/chbmv.f
new file mode 100644
index 0000000..1b1c330
--- /dev/null
+++ b/eigen/blas/chbmv.f
@@ -0,0 +1,310 @@
+      SUBROUTINE CHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*     .. Scalar Arguments ..
+      COMPLEX ALPHA,BETA
+      INTEGER INCX,INCY,K,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  CHBMV  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 hermitian band matrix, with k super-diagonals.
+*
+*  Arguments
+*  ==========
+*
+*  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  - COMPLEX         .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX          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 hermitian 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 hermitian 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 hermitian 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 hermitian 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 the imaginary parts of the diagonal elements need
+*           not be set and are assumed to be zero.
+*           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      - COMPLEX          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   - COMPLEX         .
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX          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.
+*
+*  Further Details
+*  ===============
+*
+*  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 ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX 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 CONJG,MAX,MIN,REAL
+*     ..
+*
+*     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('CHBMV ',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 + CONJG(A(L+I,J))*X(I)
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*REAL(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 + CONJG(A(L+I,J))*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*REAL(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*REAL(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 + CONJG(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*REAL(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 + CONJG(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 CHBMV .
+*
+      END
diff --git a/eigen/blas/chpmv.f b/eigen/blas/chpmv.f
new file mode 100644
index 0000000..158be5a
--- /dev/null
+++ b/eigen/blas/chpmv.f
@@ -0,0 +1,272 @@
+      SUBROUTINE CHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
+*     .. Scalar Arguments ..
+      COMPLEX ALPHA,BETA
+      INTEGER INCX,INCY,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX AP(*),X(*),Y(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  CHPMV  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 hermitian matrix, supplied in packed form.
+*
+*  Arguments
+*  ==========
+*
+*  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  - COMPLEX         .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  AP     - COMPLEX          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 hermitian 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 hermitian 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 the imaginary parts of the diagonal elements need
+*           not be set and are assumed to be zero.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX          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   - COMPLEX         .
+*           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      - COMPLEX          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.
+*
+*  Further Details
+*  ===============
+*
+*  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 ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,REAL
+*     ..
+*
+*     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('CHPMV ',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 + CONJG(AP(K))*X(I)
+                      K = K + 1
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*REAL(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 + CONJG(AP(K))*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*REAL(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*REAL(AP(KK))
+                  K = KK + 1
+                  DO 90 I = J + 1,N
+                      Y(I) = Y(I) + TEMP1*AP(K)
+                      TEMP2 = TEMP2 + CONJG(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*REAL(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 + CONJG(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 CHPMV .
+*
+      END
diff --git a/eigen/blas/common.h b/eigen/blas/common.h
new file mode 100644
index 0000000..2bf642c
--- /dev/null
+++ b/eigen/blas/common.h
@@ -0,0 +1,145 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009-2010 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#ifndef EIGEN_BLAS_COMMON_H
+#define EIGEN_BLAS_COMMON_H
+
+#include <Eigen/Core>
+#include <Eigen/Jacobi>
+
+#include <iostream>
+#include <complex>
+
+#ifndef SCALAR
+#error the token SCALAR must be defined to compile this file
+#endif
+
+#include <Eigen/src/misc/blas.h>
+
+
+#define NOTR    0
+#define TR      1
+#define ADJ     2
+
+#define LEFT    0
+#define RIGHT   1
+
+#define UP      0
+#define LO      1
+
+#define NUNIT   0
+#define UNIT    1
+
+#define INVALID 0xff
+
+#define OP(X)   (   ((X)=='N' || (X)=='n') ? NOTR   \
+                  : ((X)=='T' || (X)=='t') ? TR     \
+                  : ((X)=='C' || (X)=='c') ? ADJ    \
+                  : INVALID)
+
+#define SIDE(X) (   ((X)=='L' || (X)=='l') ? LEFT   \
+                  : ((X)=='R' || (X)=='r') ? RIGHT  \
+                  : INVALID)
+
+#define UPLO(X) (   ((X)=='U' || (X)=='u') ? UP     \
+                  : ((X)=='L' || (X)=='l') ? LO     \
+                  : INVALID)
+
+#define DIAG(X) (   ((X)=='N' || (X)=='n') ? NUNIT  \
+                  : ((X)=='U' || (X)=='u') ? UNIT   \
+                  : INVALID)
+
+
+inline bool check_op(const char* op)
+{
+  return OP(*op)!=0xff;
+}
+
+inline bool check_side(const char* side)
+{
+  return SIDE(*side)!=0xff;
+}
+
+inline bool check_uplo(const char* uplo)
+{
+  return UPLO(*uplo)!=0xff;
+}
+
+
+namespace Eigen {
+#include "BandTriangularSolver.h"
+#include "GeneralRank1Update.h"
+#include "PackedSelfadjointProduct.h"
+#include "PackedTriangularMatrixVector.h"
+#include "PackedTriangularSolverVector.h"
+#include "Rank2Update.h"
+}
+
+using namespace Eigen;
+
+typedef SCALAR Scalar;
+typedef NumTraits<Scalar>::Real RealScalar;
+typedef std::complex<RealScalar> Complex;
+
+enum
+{
+  IsComplex = Eigen::NumTraits<SCALAR>::IsComplex,
+  Conj = IsComplex
+};
+
+typedef Matrix<Scalar,Dynamic,Dynamic,ColMajor> PlainMatrixType;
+typedef Map<Matrix<Scalar,Dynamic,Dynamic,ColMajor>, 0, OuterStride<> > MatrixType;
+typedef Map<Matrix<Scalar,Dynamic,1>, 0, InnerStride<Dynamic> > StridedVectorType;
+typedef Map<Matrix<Scalar,Dynamic,1> > CompactVectorType;
+
+template<typename T>
+Map<Matrix<T,Dynamic,Dynamic,ColMajor>, 0, OuterStride<> >
+matrix(T* data, int rows, int cols, int stride)
+{
+  return Map<Matrix<T,Dynamic,Dynamic,ColMajor>, 0, OuterStride<> >(data, rows, cols, OuterStride<>(stride));
+}
+
+template<typename T>
+Map<Matrix<T,Dynamic,1>, 0, InnerStride<Dynamic> > vector(T* data, int size, int incr)
+{
+  return Map<Matrix<T,Dynamic,1>, 0, InnerStride<Dynamic> >(data, size, InnerStride<Dynamic>(incr));
+}
+
+template<typename T>
+Map<Matrix<T,Dynamic,1> > vector(T* data, int size)
+{
+  return Map<Matrix<T,Dynamic,1> >(data, size);
+}
+
+template<typename T>
+T* get_compact_vector(T* x, int n, int incx)
+{
+  if(incx==1)
+    return x;
+
+  T* ret = new Scalar[n];
+  if(incx<0) vector(ret,n) = vector(x,n,-incx).reverse();
+  else       vector(ret,n) = vector(x,n, incx);
+  return ret;
+}
+
+template<typename T>
+T* copy_back(T* x_cpy, T* x, int n, int incx)
+{
+  if(x_cpy==x)
+    return 0;
+
+  if(incx<0) vector(x,n,-incx).reverse() = vector(x_cpy,n);
+  else       vector(x,n, incx)           = vector(x_cpy,n);
+  return x_cpy;
+}
+
+#define EIGEN_BLAS_FUNC(X) EIGEN_CAT(SCALAR_SUFFIX,X##_)
+
+#endif // EIGEN_BLAS_COMMON_H
diff --git a/eigen/blas/complex_double.cpp b/eigen/blas/complex_double.cpp
new file mode 100644
index 0000000..648c6d4
--- /dev/null
+++ b/eigen/blas/complex_double.cpp
@@ -0,0 +1,20 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#define SCALAR        std::complex<double>
+#define SCALAR_SUFFIX z
+#define SCALAR_SUFFIX_UP "Z"
+#define REAL_SCALAR_SUFFIX d
+#define ISCOMPLEX     1
+
+#include "level1_impl.h"
+#include "level1_cplx_impl.h"
+#include "level2_impl.h"
+#include "level2_cplx_impl.h"
+#include "level3_impl.h"
diff --git a/eigen/blas/complex_single.cpp b/eigen/blas/complex_single.cpp
new file mode 100644
index 0000000..7786519
--- /dev/null
+++ b/eigen/blas/complex_single.cpp
@@ -0,0 +1,20 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#define SCALAR        std::complex<float>
+#define SCALAR_SUFFIX c
+#define SCALAR_SUFFIX_UP "C"
+#define REAL_SCALAR_SUFFIX s
+#define ISCOMPLEX     1
+
+#include "level1_impl.h"
+#include "level1_cplx_impl.h"
+#include "level2_impl.h"
+#include "level2_cplx_impl.h"
+#include "level3_impl.h"
diff --git a/eigen/blas/complexdots.f b/eigen/blas/complexdots.f
new file mode 100644
index 0000000..a7da51d
--- /dev/null
+++ b/eigen/blas/complexdots.f
@@ -0,0 +1,43 @@
+      COMPLEX FUNCTION CDOTC(N,CX,INCX,CY,INCY)
+      INTEGER INCX,INCY,N
+      COMPLEX CX(*),CY(*)
+      COMPLEX RES
+      EXTERNAL CDOTCW
+      
+      CALL CDOTCW(N,CX,INCX,CY,INCY,RES)
+      CDOTC = RES
+      RETURN
+      END
+      
+      COMPLEX FUNCTION CDOTU(N,CX,INCX,CY,INCY)
+      INTEGER INCX,INCY,N
+      COMPLEX CX(*),CY(*)
+      COMPLEX RES
+      EXTERNAL CDOTUW
+      
+      CALL CDOTUW(N,CX,INCX,CY,INCY,RES)
+      CDOTU = RES
+      RETURN
+      END
+      
+      DOUBLE COMPLEX FUNCTION ZDOTC(N,CX,INCX,CY,INCY)
+      INTEGER INCX,INCY,N
+      DOUBLE COMPLEX CX(*),CY(*)
+      DOUBLE COMPLEX RES
+      EXTERNAL ZDOTCW
+      
+      CALL ZDOTCW(N,CX,INCX,CY,INCY,RES)
+      ZDOTC = RES
+      RETURN
+      END
+      
+      DOUBLE COMPLEX FUNCTION ZDOTU(N,CX,INCX,CY,INCY)
+      INTEGER INCX,INCY,N
+      DOUBLE COMPLEX CX(*),CY(*)
+      DOUBLE COMPLEX RES
+      EXTERNAL ZDOTUW
+      
+      CALL ZDOTUW(N,CX,INCX,CY,INCY,RES)
+      ZDOTU = RES
+      RETURN
+      END
diff --git a/eigen/blas/ctbmv.f b/eigen/blas/ctbmv.f
new file mode 100644
index 0000000..5a879fa
--- /dev/null
+++ b/eigen/blas/ctbmv.f
@@ -0,0 +1,366 @@
+      SUBROUTINE CTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+*     .. Scalar Arguments ..
+      INTEGER INCX,K,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  CTBMV  performs one of the matrix-vector operations
+*
+*     x := A*x,   or   x := A'*x,   or   x := conjg( 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.
+*
+*  Arguments
+*  ==========
+*
+*  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 := conjg( 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      - COMPLEX          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      - COMPLEX          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.
+*
+*  Further Details
+*  ===============
+*
+*  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 ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
+      LOGICAL NOCONJ,NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX,MIN
+*     ..
+*
+*     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('CTBMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOCONJ = LSAME(TRANS,'T')
+      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  or  x := conjg( A' )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KPLUS1 = K + 1
+              IF (INCX.EQ.1) THEN
+                  DO 110 J = N,1,-1
+                      TEMP = X(J)
+                      L = KPLUS1 - J
+                      IF (NOCONJ) THEN
+                          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
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(KPLUS1,J))
+                          DO 100 I = J - 1,MAX(1,J-K),-1
+                              TEMP = TEMP + CONJG(A(L+I,J))*X(I)
+  100                     CONTINUE
+                      END IF
+                      X(J) = TEMP
+  110             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 140 J = N,1,-1
+                      TEMP = X(JX)
+                      KX = KX - INCX
+                      IX = KX
+                      L = KPLUS1 - J
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
+                          DO 120 I = J - 1,MAX(1,J-K),-1
+                              TEMP = TEMP + A(L+I,J)*X(IX)
+                              IX = IX - INCX
+  120                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(KPLUS1,J))
+                          DO 130 I = J - 1,MAX(1,J-K),-1
+                              TEMP = TEMP + CONJG(A(L+I,J))*X(IX)
+                              IX = IX - INCX
+  130                     CONTINUE
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX - INCX
+  140             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 170 J = 1,N
+                      TEMP = X(J)
+                      L = 1 - J
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(1,J)
+                          DO 150 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + A(L+I,J)*X(I)
+  150                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(1,J))
+                          DO 160 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + CONJG(A(L+I,J))*X(I)
+  160                     CONTINUE
+                      END IF
+                      X(J) = TEMP
+  170             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 200 J = 1,N
+                      TEMP = X(JX)
+                      KX = KX + INCX
+                      IX = KX
+                      L = 1 - J
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(1,J)
+                          DO 180 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + A(L+I,J)*X(IX)
+                              IX = IX + INCX
+  180                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(1,J))
+                          DO 190 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + CONJG(A(L+I,J))*X(IX)
+                              IX = IX + INCX
+  190                     CONTINUE
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX + INCX
+  200             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CTBMV .
+*
+      END
diff --git a/eigen/blas/double.cpp b/eigen/blas/double.cpp
new file mode 100644
index 0000000..8fd0709
--- /dev/null
+++ b/eigen/blas/double.cpp
@@ -0,0 +1,33 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009 Gael Guennebaud <gael.guennebaud@inria.fr>
+// Copyright (C) 2012 Chen-Pang He <jdh8@ms63.hinet.net>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#define SCALAR        double
+#define SCALAR_SUFFIX d
+#define SCALAR_SUFFIX_UP "D"
+#define ISCOMPLEX     0
+
+#include "level1_impl.h"
+#include "level1_real_impl.h"
+#include "level2_impl.h"
+#include "level2_real_impl.h"
+#include "level3_impl.h"
+
+double BLASFUNC(dsdot)(int* n, float* x, int* incx, float* y, int* incy)
+{
+  if(*n<=0) return 0;
+
+  if(*incx==1 && *incy==1)    return (vector(x,*n).cast<double>().cwiseProduct(vector(y,*n).cast<double>())).sum();
+  else if(*incx>0 && *incy>0) return (vector(x,*n,*incx).cast<double>().cwiseProduct(vector(y,*n,*incy).cast<double>())).sum();
+  else if(*incx<0 && *incy>0) return (vector(x,*n,-*incx).reverse().cast<double>().cwiseProduct(vector(y,*n,*incy).cast<double>())).sum();
+  else if(*incx>0 && *incy<0) return (vector(x,*n,*incx).cast<double>().cwiseProduct(vector(y,*n,-*incy).reverse().cast<double>())).sum();
+  else if(*incx<0 && *incy<0) return (vector(x,*n,-*incx).reverse().cast<double>().cwiseProduct(vector(y,*n,-*incy).reverse().cast<double>())).sum();
+  else return 0;
+}
+
diff --git a/eigen/blas/drotm.f b/eigen/blas/drotm.f
new file mode 100644
index 0000000..63a3b11
--- /dev/null
+++ b/eigen/blas/drotm.f
@@ -0,0 +1,147 @@
+      SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
+*     .. Scalar Arguments ..
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*     APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
+*
+*     (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
+*     (DY**T)
+*
+*     DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
+*     LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
+*     WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+*
+*     DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0
+*
+*       (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0)
+*     H=(          )    (          )    (          )    (          )
+*       (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).
+*     SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
+*
+*  Arguments
+*  =========
+*
+*  N      (input) INTEGER
+*         number of elements in input vector(s)
+*
+*  DX     (input/output) DOUBLE PRECISION array, dimension N
+*         double precision vector with N elements
+*
+*  INCX   (input) INTEGER
+*         storage spacing between elements of DX
+*
+*  DY     (input/output) DOUBLE PRECISION array, dimension N
+*         double precision vector with N elements
+*
+*  INCY   (input) INTEGER
+*         storage spacing between elements of DY
+*
+*  DPARAM (input/output)  DOUBLE PRECISION array, dimension 5 
+*     DPARAM(1)=DFLAG
+*     DPARAM(2)=DH11
+*     DPARAM(3)=DH21
+*     DPARAM(4)=DH12
+*     DPARAM(5)=DH22
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
+      INTEGER I,KX,KY,NSTEPS
+*     ..
+*     .. Data statements ..
+      DATA ZERO,TWO/0.D0,2.D0/
+*     ..
+*
+      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 70
+*
+      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)*INCY
+*
+      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
diff --git a/eigen/blas/drotmg.f b/eigen/blas/drotmg.f
new file mode 100644
index 0000000..3ae647b
--- /dev/null
+++ b/eigen/blas/drotmg.f
@@ -0,0 +1,206 @@
+      SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM)
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION DD1,DD2,DX1,DY1
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DPARAM(5)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*     CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
+*     THE SECOND COMPONENT OF THE 2-VECTOR  (DSQRT(DD1)*DX1,DSQRT(DD2)*
+*     DY2)**T.
+*     WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+*
+*     DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0
+*
+*       (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0)
+*     H=(          )    (          )    (          )    (          )
+*       (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).
+*     LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22
+*     RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE
+*     VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)
+*
+*     THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
+*     INEXACT.  THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
+*     OF DD1 AND DD2.  ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
+*
+*
+*  Arguments
+*  =========
+*
+*  DD1    (input/output) DOUBLE PRECISION
+*
+*  DD2    (input/output) DOUBLE PRECISION 
+*
+*  DX1    (input/output) DOUBLE PRECISION 
+*
+*  DY1    (input) DOUBLE PRECISION
+*
+*  DPARAM (input/output)  DOUBLE PRECISION array, dimension 5
+*     DPARAM(1)=DFLAG
+*     DPARAM(2)=DH11
+*     DPARAM(3)=DH21
+*     DPARAM(4)=DH12
+*     DPARAM(5)=DH22
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,DP1,DP2,DQ1,DQ2,DTEMP,
+     +                 DU,GAM,GAMSQ,ONE,RGAMSQ,TWO,ZERO
+      INTEGER IGO
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC DABS
+*     ..
+*     .. Data statements ..
+*
+      DATA ZERO,ONE,TWO/0.D0,1.D0,2.D0/
+      DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/
+*     ..
+
+      IF (.NOT.DD1.LT.ZERO) GO TO 10
+*       GO ZERO-H-D-AND-DX1..
+      GO TO 60
+   10 CONTINUE
+*     CASE-DD1-NONNEGATIVE
+      DP2 = DD2*DY1
+      IF (.NOT.DP2.EQ.ZERO) GO TO 20
+      DFLAG = -TWO
+      GO TO 260
+*     REGULAR-CASE..
+   20 CONTINUE
+      DP1 = DD1*DX1
+      DQ2 = DP2*DY1
+      DQ1 = DP1*DX1
+*
+      IF (.NOT.DABS(DQ1).GT.DABS(DQ2)) GO TO 40
+      DH21 = -DY1/DX1
+      DH12 = DP2/DP1
+*
+      DU = ONE - DH12*DH21
+*
+      IF (.NOT.DU.LE.ZERO) GO TO 30
+*         GO ZERO-H-D-AND-DX1..
+      GO TO 60
+   30 CONTINUE
+      DFLAG = ZERO
+      DD1 = DD1/DU
+      DD2 = DD2/DU
+      DX1 = DX1*DU
+*         GO SCALE-CHECK..
+      GO TO 100
+   40 CONTINUE
+      IF (.NOT.DQ2.LT.ZERO) GO TO 50
+*         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*DU
+*         GO SCALE-CHECK
+      GO TO 100
+*     PROCEDURE..ZERO-H-D-AND-DX1..
+   60 CONTINUE
+      DFLAG = -ONE
+      DH11 = ZERO
+      DH12 = ZERO
+      DH21 = ZERO
+      DH22 = ZERO
+*
+      DD1 = ZERO
+      DD2 = ZERO
+      DX1 = ZERO
+*         RETURN..
+      GO TO 220
+*     PROCEDURE..FIX-H..
+   70 CONTINUE
+      IF (.NOT.DFLAG.GE.ZERO) GO TO 90
+*
+      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)
+*     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 IGO
+*              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 IGO
+*              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 IGO
+*              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 IGO
+*              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
diff --git a/eigen/blas/dsbmv.f b/eigen/blas/dsbmv.f
new file mode 100644
index 0000000..8c82d1f
--- /dev/null
+++ b/eigen/blas/dsbmv.f
@@ -0,0 +1,304 @@
+      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 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.
+*
+*  Arguments
+*  ==========
+*
+*  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
+*     ..
+*
+*     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
diff --git a/eigen/blas/dspmv.f b/eigen/blas/dspmv.f
new file mode 100644
index 0000000..f6e121e
--- /dev/null
+++ b/eigen/blas/dspmv.f
@@ -0,0 +1,265 @@
+      SUBROUTINE DSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION ALPHA,BETA
+      INTEGER INCX,INCY,N
+      CHARACTER 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.
+*
+*  Arguments
+*  ==========
+*
+*  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.
+*
+*  Further Details
+*  ===============
+*
+*  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
+*     ..
+*
+*     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
diff --git a/eigen/blas/dtbmv.f b/eigen/blas/dtbmv.f
new file mode 100644
index 0000000..a87ffde
--- /dev/null
+++ b/eigen/blas/dtbmv.f
@@ -0,0 +1,335 @@
+      SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+*     .. Scalar Arguments ..
+      INTEGER INCX,K,LDA,N
+      CHARACTER 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.
+*
+*  Arguments
+*  ==========
+*
+*  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.
+*
+*  Further Details
+*  ===============
+*
+*  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
+*     ..
+*
+*     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
diff --git a/eigen/blas/level1_cplx_impl.h b/eigen/blas/level1_cplx_impl.h
new file mode 100644
index 0000000..283b9f8
--- /dev/null
+++ b/eigen/blas/level1_cplx_impl.h
@@ -0,0 +1,127 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009-2010 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#include "common.h"
+
+struct scalar_norm1_op {
+  typedef RealScalar result_type;
+  EIGEN_EMPTY_STRUCT_CTOR(scalar_norm1_op)
+  inline RealScalar operator() (const Scalar& a) const { return numext::norm1(a); }
+};
+namespace Eigen {
+  namespace internal {
+    template<> struct functor_traits<scalar_norm1_op >
+    {
+      enum { Cost = 3 * NumTraits<Scalar>::AddCost, PacketAccess = 0 };
+    };
+  }
+}
+
+// computes the sum of magnitudes of all vector elements or, for a complex vector x, the sum
+// res = |Rex1| + |Imx1| + |Rex2| + |Imx2| + ... + |Rexn| + |Imxn|, where x is a vector of order n
+RealScalar EIGEN_CAT(EIGEN_CAT(REAL_SCALAR_SUFFIX,SCALAR_SUFFIX),asum_)(int *n, RealScalar *px, int *incx)
+{
+//   std::cerr << "__asum " << *n << " " << *incx << "\n";
+  Complex* x = reinterpret_cast<Complex*>(px);
+
+  if(*n<=0) return 0;
+
+  if(*incx==1)  return vector(x,*n).unaryExpr<scalar_norm1_op>().sum();
+  else          return vector(x,*n,std::abs(*incx)).unaryExpr<scalar_norm1_op>().sum();
+}
+
+// computes a dot product of a conjugated vector with another vector.
+int EIGEN_BLAS_FUNC(dotcw)(int *n, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar* pres)
+{
+//   std::cerr << "_dotc " << *n << " " << *incx << " " << *incy << "\n";
+
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar* res = reinterpret_cast<Scalar*>(pres);
+
+  if(*incx==1 && *incy==1)    *res = (vector(x,*n).dot(vector(y,*n)));
+  else if(*incx>0 && *incy>0) *res = (vector(x,*n,*incx).dot(vector(y,*n,*incy)));
+  else if(*incx<0 && *incy>0) *res = (vector(x,*n,-*incx).reverse().dot(vector(y,*n,*incy)));
+  else if(*incx>0 && *incy<0) *res = (vector(x,*n,*incx).dot(vector(y,*n,-*incy).reverse()));
+  else if(*incx<0 && *incy<0) *res = (vector(x,*n,-*incx).reverse().dot(vector(y,*n,-*incy).reverse()));
+  return 0;
+}
+
+// computes a vector-vector dot product without complex conjugation.
+int EIGEN_BLAS_FUNC(dotuw)(int *n, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar* pres)
+{
+//   std::cerr << "_dotu " << *n << " " << *incx << " " << *incy << "\n";
+
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar* res = reinterpret_cast<Scalar*>(pres);
+
+  if(*incx==1 && *incy==1)    *res = (vector(x,*n).cwiseProduct(vector(y,*n))).sum();
+  else if(*incx>0 && *incy>0) *res = (vector(x,*n,*incx).cwiseProduct(vector(y,*n,*incy))).sum();
+  else if(*incx<0 && *incy>0) *res = (vector(x,*n,-*incx).reverse().cwiseProduct(vector(y,*n,*incy))).sum();
+  else if(*incx>0 && *incy<0) *res = (vector(x,*n,*incx).cwiseProduct(vector(y,*n,-*incy).reverse())).sum();
+  else if(*incx<0 && *incy<0) *res = (vector(x,*n,-*incx).reverse().cwiseProduct(vector(y,*n,-*incy).reverse())).sum();
+  return 0;
+}
+
+RealScalar EIGEN_CAT(EIGEN_CAT(REAL_SCALAR_SUFFIX,SCALAR_SUFFIX),nrm2_)(int *n, RealScalar *px, int *incx)
+{
+//   std::cerr << "__nrm2 " << *n << " " << *incx << "\n";
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+
+  if(*incx==1)
+    return vector(x,*n).stableNorm();
+
+  return vector(x,*n,*incx).stableNorm();
+}
+
+int EIGEN_CAT(EIGEN_CAT(SCALAR_SUFFIX,REAL_SCALAR_SUFFIX),rot_)(int *n, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar *pc, RealScalar *ps)
+{
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  RealScalar c = *pc;
+  RealScalar s = *ps;
+
+  StridedVectorType vx(vector(x,*n,std::abs(*incx)));
+  StridedVectorType vy(vector(y,*n,std::abs(*incy)));
+
+  Reverse<StridedVectorType> rvx(vx);
+  Reverse<StridedVectorType> rvy(vy);
+
+  // TODO implement mixed real-scalar rotations
+       if(*incx<0 && *incy>0) internal::apply_rotation_in_the_plane(rvx, vy, JacobiRotation<Scalar>(c,s));
+  else if(*incx>0 && *incy<0) internal::apply_rotation_in_the_plane(vx, rvy, JacobiRotation<Scalar>(c,s));
+  else                        internal::apply_rotation_in_the_plane(vx, vy,  JacobiRotation<Scalar>(c,s));
+
+  return 0;
+}
+
+int EIGEN_CAT(EIGEN_CAT(SCALAR_SUFFIX,REAL_SCALAR_SUFFIX),scal_)(int *n, RealScalar *palpha, RealScalar *px, int *incx)
+{
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  RealScalar alpha = *palpha;
+
+//   std::cerr << "__scal " << *n << " " << alpha << " " << *incx << "\n";
+
+  if(*incx==1)  vector(x,*n) *= alpha;
+  else          vector(x,*n,std::abs(*incx)) *= alpha;
+
+  return 0;
+}
+
diff --git a/eigen/blas/level1_impl.h b/eigen/blas/level1_impl.h
new file mode 100644
index 0000000..b08c2f6
--- /dev/null
+++ b/eigen/blas/level1_impl.h
@@ -0,0 +1,167 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009-2010 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#include "common.h"
+
+int EIGEN_BLAS_FUNC(axpy)(int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *py, int *incy)
+{
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar alpha  = *reinterpret_cast<Scalar*>(palpha);
+
+  if(*n<=0) return 0;
+
+  if(*incx==1 && *incy==1)    vector(y,*n) += alpha * vector(x,*n);
+  else if(*incx>0 && *incy>0) vector(y,*n,*incy) += alpha * vector(x,*n,*incx);
+  else if(*incx>0 && *incy<0) vector(y,*n,-*incy).reverse() += alpha * vector(x,*n,*incx);
+  else if(*incx<0 && *incy>0) vector(y,*n,*incy) += alpha * vector(x,*n,-*incx).reverse();
+  else if(*incx<0 && *incy<0) vector(y,*n,-*incy).reverse() += alpha * vector(x,*n,-*incx).reverse();
+
+  return 0;
+}
+
+int EIGEN_BLAS_FUNC(copy)(int *n, RealScalar *px, int *incx, RealScalar *py, int *incy)
+{
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+
+  // be carefull, *incx==0 is allowed !!
+  if(*incx==1 && *incy==1)
+    vector(y,*n) = vector(x,*n);
+  else
+  {
+    if(*incx<0) x = x - (*n-1)*(*incx);
+    if(*incy<0) y = y - (*n-1)*(*incy);
+    for(int i=0;i<*n;++i)
+    {
+      *y = *x;
+      x += *incx;
+      y += *incy;
+    }
+  }
+
+  return 0;
+}
+
+int EIGEN_CAT(EIGEN_CAT(i,SCALAR_SUFFIX),amax_)(int *n, RealScalar *px, int *incx)
+{
+  if(*n<=0) return 0;
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+
+  DenseIndex ret;
+  if(*incx==1)  vector(x,*n).cwiseAbs().maxCoeff(&ret);
+  else          vector(x,*n,std::abs(*incx)).cwiseAbs().maxCoeff(&ret);
+  return ret+1;
+}
+
+int EIGEN_CAT(EIGEN_CAT(i,SCALAR_SUFFIX),amin_)(int *n, RealScalar *px, int *incx)
+{
+  if(*n<=0) return 0;
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  
+  DenseIndex ret;
+  if(*incx==1)  vector(x,*n).cwiseAbs().minCoeff(&ret);
+  else          vector(x,*n,std::abs(*incx)).cwiseAbs().minCoeff(&ret);
+  return ret+1;
+}
+
+int EIGEN_BLAS_FUNC(rotg)(RealScalar *pa, RealScalar *pb, RealScalar *pc, RealScalar *ps)
+{
+  using std::sqrt;
+  using std::abs;
+  
+  Scalar& a = *reinterpret_cast<Scalar*>(pa);
+  Scalar& b = *reinterpret_cast<Scalar*>(pb);
+  RealScalar* c = pc;
+  Scalar* s = reinterpret_cast<Scalar*>(ps);
+
+  #if !ISCOMPLEX
+  Scalar r,z;
+  Scalar aa = abs(a);
+  Scalar ab = abs(b);
+  if((aa+ab)==Scalar(0))
+  {
+    *c = 1;
+    *s = 0;
+    r = 0;
+    z = 0;
+  }
+  else
+  {
+    r = sqrt(a*a + b*b);
+    Scalar amax = aa>ab ? a : b;
+    r = amax>0 ? r : -r;
+    *c = a/r;
+    *s = b/r;
+    z = 1;
+    if (aa > ab) z = *s;
+    if (ab > aa && *c!=RealScalar(0))
+      z = Scalar(1)/ *c;
+  }
+  *pa = r;
+  *pb = z;
+  #else
+  Scalar alpha;
+  RealScalar norm,scale;
+  if(abs(a)==RealScalar(0))
+  {
+    *c = RealScalar(0);
+    *s = Scalar(1);
+    a = b;
+  }
+  else
+  {
+    scale = abs(a) + abs(b);
+    norm = scale*sqrt((numext::abs2(a/scale)) + (numext::abs2(b/scale)));
+    alpha = a/abs(a);
+    *c = abs(a)/norm;
+    *s = alpha*numext::conj(b)/norm;
+    a = alpha*norm;
+  }
+  #endif
+
+//   JacobiRotation<Scalar> r;
+//   r.makeGivens(a,b);
+//   *c = r.c();
+//   *s = r.s();
+
+  return 0;
+}
+
+int EIGEN_BLAS_FUNC(scal)(int *n, RealScalar *palpha, RealScalar *px, int *incx)
+{
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  if(*incx==1)  vector(x,*n) *= alpha;
+  else          vector(x,*n,std::abs(*incx)) *= alpha;
+
+  return 0;
+}
+
+int EIGEN_BLAS_FUNC(swap)(int *n, RealScalar *px, int *incx, RealScalar *py, int *incy)
+{
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+
+  if(*incx==1 && *incy==1)    vector(y,*n).swap(vector(x,*n));
+  else if(*incx>0 && *incy>0) vector(y,*n,*incy).swap(vector(x,*n,*incx));
+  else if(*incx>0 && *incy<0) vector(y,*n,-*incy).reverse().swap(vector(x,*n,*incx));
+  else if(*incx<0 && *incy>0) vector(y,*n,*incy).swap(vector(x,*n,-*incx).reverse());
+  else if(*incx<0 && *incy<0) vector(y,*n,-*incy).reverse().swap(vector(x,*n,-*incx).reverse());
+
+  return 1;
+}
+
diff --git a/eigen/blas/level1_real_impl.h b/eigen/blas/level1_real_impl.h
new file mode 100644
index 0000000..8acecdf
--- /dev/null
+++ b/eigen/blas/level1_real_impl.h
@@ -0,0 +1,100 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009-2010 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#include "common.h"
+
+// computes the sum of magnitudes of all vector elements or, for a complex vector x, the sum
+// res = |Rex1| + |Imx1| + |Rex2| + |Imx2| + ... + |Rexn| + |Imxn|, where x is a vector of order n
+RealScalar EIGEN_BLAS_FUNC(asum)(int *n, RealScalar *px, int *incx)
+{
+//   std::cerr << "_asum " << *n << " " << *incx << "\n";
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+
+  if(*n<=0) return 0;
+
+  if(*incx==1)  return vector(x,*n).cwiseAbs().sum();
+  else          return vector(x,*n,std::abs(*incx)).cwiseAbs().sum();
+}
+
+// computes a vector-vector dot product.
+Scalar EIGEN_BLAS_FUNC(dot)(int *n, RealScalar *px, int *incx, RealScalar *py, int *incy)
+{
+//   std::cerr << "_dot " << *n << " " << *incx << " " << *incy << "\n";
+
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+
+  if(*incx==1 && *incy==1)    return (vector(x,*n).cwiseProduct(vector(y,*n))).sum();
+  else if(*incx>0 && *incy>0) return (vector(x,*n,*incx).cwiseProduct(vector(y,*n,*incy))).sum();
+  else if(*incx<0 && *incy>0) return (vector(x,*n,-*incx).reverse().cwiseProduct(vector(y,*n,*incy))).sum();
+  else if(*incx>0 && *incy<0) return (vector(x,*n,*incx).cwiseProduct(vector(y,*n,-*incy).reverse())).sum();
+  else if(*incx<0 && *incy<0) return (vector(x,*n,-*incx).reverse().cwiseProduct(vector(y,*n,-*incy).reverse())).sum();
+  else return 0;
+}
+
+// computes the Euclidean norm of a vector.
+// FIXME
+Scalar EIGEN_BLAS_FUNC(nrm2)(int *n, RealScalar *px, int *incx)
+{
+//   std::cerr << "_nrm2 " << *n << " " << *incx << "\n";
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+
+  if(*incx==1)  return vector(x,*n).stableNorm();
+  else          return vector(x,*n,std::abs(*incx)).stableNorm();
+}
+
+int EIGEN_BLAS_FUNC(rot)(int *n, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar *pc, RealScalar *ps)
+{
+//   std::cerr << "_rot " << *n << " " << *incx << " " << *incy << "\n";
+  if(*n<=0) return 0;
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar c = *reinterpret_cast<Scalar*>(pc);
+  Scalar s = *reinterpret_cast<Scalar*>(ps);
+
+  StridedVectorType vx(vector(x,*n,std::abs(*incx)));
+  StridedVectorType vy(vector(y,*n,std::abs(*incy)));
+
+  Reverse<StridedVectorType> rvx(vx);
+  Reverse<StridedVectorType> rvy(vy);
+
+       if(*incx<0 && *incy>0) internal::apply_rotation_in_the_plane(rvx, vy, JacobiRotation<Scalar>(c,s));
+  else if(*incx>0 && *incy<0) internal::apply_rotation_in_the_plane(vx, rvy, JacobiRotation<Scalar>(c,s));
+  else                        internal::apply_rotation_in_the_plane(vx, vy,  JacobiRotation<Scalar>(c,s));
+
+
+  return 0;
+}
+
+/*
+// performs rotation of points in the modified plane.
+int EIGEN_BLAS_FUNC(rotm)(int *n, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar *param)
+{
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+
+  // TODO
+
+  return 0;
+}
+
+// computes the modified parameters for a Givens rotation.
+int EIGEN_BLAS_FUNC(rotmg)(RealScalar *d1, RealScalar *d2, RealScalar *x1, RealScalar *x2, RealScalar *param)
+{
+  // TODO
+
+  return 0;
+}
+*/
diff --git a/eigen/blas/level2_cplx_impl.h b/eigen/blas/level2_cplx_impl.h
new file mode 100644
index 0000000..b850b6c
--- /dev/null
+++ b/eigen/blas/level2_cplx_impl.h
@@ -0,0 +1,394 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009-2010 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#include "common.h"
+
+/**  ZHEMV  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 hermitian matrix.
+  */
+int EIGEN_BLAS_FUNC(hemv)(char *uplo, int *n, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *px, int *incx, RealScalar *pbeta, RealScalar *py, int *incy)
+{
+  typedef void (*functype)(int, const Scalar*, int, const Scalar*, int, Scalar*, Scalar);
+  static functype func[2];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<2; ++k)
+      func[k] = 0;
+
+    func[UP] = (internal::selfadjoint_matrix_vector_product<Scalar,int,ColMajor,Upper,false,false>::run);
+    func[LO] = (internal::selfadjoint_matrix_vector_product<Scalar,int,ColMajor,Lower,false,false>::run);
+
+    init = true;
+  }
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar alpha  = *reinterpret_cast<Scalar*>(palpha);
+  Scalar beta   = *reinterpret_cast<Scalar*>(pbeta);
+
+  // check arguments
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)        info = 1;
+  else if(*n<0)                   info = 2;
+  else if(*lda<std::max(1,*n))    info = 5;
+  else if(*incx==0)               info = 7;
+  else if(*incy==0)               info = 10;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"HEMV ",&info,6);
+
+  if(*n==0)
+    return 1;
+
+  Scalar* actual_x = get_compact_vector(x,*n,*incx);
+  Scalar* actual_y = get_compact_vector(y,*n,*incy);
+
+  if(beta!=Scalar(1))
+  {
+    if(beta==Scalar(0)) vector(actual_y, *n).setZero();
+    else                vector(actual_y, *n) *= beta;
+  }
+
+  if(alpha!=Scalar(0))
+  {
+    int code = UPLO(*uplo);
+    if(code>=2 || func[code]==0)
+      return 0;
+
+    func[code](*n, a, *lda, actual_x, 1, actual_y, alpha);
+  }
+
+  if(actual_x!=x) delete[] actual_x;
+  if(actual_y!=y) delete[] copy_back(actual_y,y,*n,*incy);
+
+  return 1;
+}
+
+/**  ZHBMV  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 hermitian band matrix, with k super-diagonals.
+  */
+// int EIGEN_BLAS_FUNC(hbmv)(char *uplo, int *n, int *k, RealScalar *alpha, RealScalar *a, int *lda,
+//                           RealScalar *x, int *incx, RealScalar *beta, RealScalar *y, int *incy)
+// {
+//   return 1;
+// }
+
+/**  ZHPMV  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 hermitian matrix, supplied in packed form.
+  */
+// int EIGEN_BLAS_FUNC(hpmv)(char *uplo, int *n, RealScalar *alpha, RealScalar *ap, RealScalar *x, int *incx, RealScalar *beta, RealScalar *y, int *incy)
+// {
+//   return 1;
+// }
+
+/**  ZHPR    performs the hermitian rank 1 operation
+  *
+  *     A := alpha*x*conjg( x' ) + A,
+  *
+  *  where alpha is a real scalar, x is an n element vector and A is an
+  *  n by n hermitian matrix, supplied in packed form.
+  */
+int EIGEN_BLAS_FUNC(hpr)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *pap)
+{
+  typedef void (*functype)(int, Scalar*, const Scalar*, RealScalar);
+  static functype func[2];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<2; ++k)
+      func[k] = 0;
+
+    func[UP] = (internal::selfadjoint_packed_rank1_update<Scalar,int,ColMajor,Upper,false,Conj>::run);
+    func[LO] = (internal::selfadjoint_packed_rank1_update<Scalar,int,ColMajor,Lower,false,Conj>::run);
+
+    init = true;
+  }
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* ap = reinterpret_cast<Scalar*>(pap);
+  RealScalar alpha = *palpha;
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"HPR  ",&info,6);
+
+  if(alpha==Scalar(0))
+    return 1;
+
+  Scalar* x_cpy = get_compact_vector(x, *n, *incx);
+
+  int code = UPLO(*uplo);
+  if(code>=2 || func[code]==0)
+    return 0;
+
+  func[code](*n, ap, x_cpy, alpha);
+
+  if(x_cpy!=x)  delete[] x_cpy;
+
+  return 1;
+}
+
+/**  ZHPR2  performs the hermitian rank 2 operation
+  *
+  *     A := alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A,
+  *
+  *  where alpha is a scalar, x and y are n element vectors and A is an
+  *  n by n hermitian matrix, supplied in packed form.
+  */
+int EIGEN_BLAS_FUNC(hpr2)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar *pap)
+{
+  typedef void (*functype)(int, Scalar*, const Scalar*, const Scalar*, Scalar);
+  static functype func[2];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<2; ++k)
+      func[k] = 0;
+
+    func[UP] = (internal::packed_rank2_update_selector<Scalar,int,Upper>::run);
+    func[LO] = (internal::packed_rank2_update_selector<Scalar,int,Lower>::run);
+
+    init = true;
+  }
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar* ap = reinterpret_cast<Scalar*>(pap);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  else if(*incy==0)                                                   info = 7;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"HPR2 ",&info,6);
+
+  if(alpha==Scalar(0))
+    return 1;
+
+  Scalar* x_cpy = get_compact_vector(x, *n, *incx);
+  Scalar* y_cpy = get_compact_vector(y, *n, *incy);
+
+  int code = UPLO(*uplo);
+  if(code>=2 || func[code]==0)
+    return 0;
+
+  func[code](*n, ap, x_cpy, y_cpy, alpha);
+
+  if(x_cpy!=x)  delete[] x_cpy;
+  if(y_cpy!=y)  delete[] y_cpy;
+
+  return 1;
+}
+
+/**  ZHER   performs the hermitian rank 1 operation
+  *
+  *     A := alpha*x*conjg( x' ) + A,
+  *
+  *  where alpha is a real scalar, x is an n element vector and A is an
+  *  n by n hermitian matrix.
+  */
+int EIGEN_BLAS_FUNC(her)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *pa, int *lda)
+{
+  typedef void (*functype)(int, Scalar*, int, const Scalar*, const Scalar*, const Scalar&);
+  static functype func[2];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<2; ++k)
+      func[k] = 0;
+
+    func[UP] = (selfadjoint_rank1_update<Scalar,int,ColMajor,Upper,false,Conj>::run);
+    func[LO] = (selfadjoint_rank1_update<Scalar,int,ColMajor,Lower,false,Conj>::run);
+
+    init = true;
+  }
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  RealScalar alpha = *reinterpret_cast<RealScalar*>(palpha);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  else if(*lda<std::max(1,*n))                                        info = 7;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"HER  ",&info,6);
+
+  if(alpha==RealScalar(0))
+    return 1;
+
+  Scalar* x_cpy = get_compact_vector(x, *n, *incx);
+
+  int code = UPLO(*uplo);
+  if(code>=2 || func[code]==0)
+    return 0;
+
+  func[code](*n, a, *lda, x_cpy, x_cpy, alpha);
+
+  matrix(a,*n,*n,*lda).diagonal().imag().setZero();
+
+  if(x_cpy!=x)  delete[] x_cpy;
+
+  return 1;
+}
+
+/**  ZHER2  performs the hermitian rank 2 operation
+  *
+  *     A := alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A,
+  *
+  *  where alpha is a scalar, x and y are n element vectors and A is an n
+  *  by n hermitian matrix.
+  */
+int EIGEN_BLAS_FUNC(her2)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar *pa, int *lda)
+{
+  typedef void (*functype)(int, Scalar*, int, const Scalar*, const Scalar*, Scalar);
+  static functype func[2];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<2; ++k)
+      func[k] = 0;
+
+    func[UP] = (internal::rank2_update_selector<Scalar,int,Upper>::run);
+    func[LO] = (internal::rank2_update_selector<Scalar,int,Lower>::run);
+
+    init = true;
+  }
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  else if(*incy==0)                                                   info = 7;
+  else if(*lda<std::max(1,*n))                                        info = 9;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"HER2 ",&info,6);
+
+  if(alpha==Scalar(0))
+    return 1;
+
+  Scalar* x_cpy = get_compact_vector(x, *n, *incx);
+  Scalar* y_cpy = get_compact_vector(y, *n, *incy);
+
+  int code = UPLO(*uplo);
+  if(code>=2 || func[code]==0)
+    return 0;
+
+  func[code](*n, a, *lda, x_cpy, y_cpy, alpha);
+
+  matrix(a,*n,*n,*lda).diagonal().imag().setZero();
+
+  if(x_cpy!=x)  delete[] x_cpy;
+  if(y_cpy!=y)  delete[] y_cpy;
+
+  return 1;
+}
+
+/**  ZGERU  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.
+  */
+int EIGEN_BLAS_FUNC(geru)(int *m, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar *pa, int *lda)
+{
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+       if(*m<0)                                                       info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  else if(*incy==0)                                                   info = 7;
+  else if(*lda<std::max(1,*m))                                        info = 9;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"GERU ",&info,6);
+
+  if(alpha==Scalar(0))
+    return 1;
+
+  Scalar* x_cpy = get_compact_vector(x,*m,*incx);
+  Scalar* y_cpy = get_compact_vector(y,*n,*incy);
+
+  internal::general_rank1_update<Scalar,int,ColMajor,false,false>::run(*m, *n, a, *lda, x_cpy, y_cpy, alpha);
+
+  if(x_cpy!=x)  delete[] x_cpy;
+  if(y_cpy!=y)  delete[] y_cpy;
+
+  return 1;
+}
+
+/**  ZGERC  performs the rank 1 operation
+  *
+  *     A := alpha*x*conjg( 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.
+  */
+int EIGEN_BLAS_FUNC(gerc)(int *m, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar *pa, int *lda)
+{
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+       if(*m<0)                                                       info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  else if(*incy==0)                                                   info = 7;
+  else if(*lda<std::max(1,*m))                                        info = 9;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"GERC ",&info,6);
+
+  if(alpha==Scalar(0))
+    return 1;
+
+  Scalar* x_cpy = get_compact_vector(x,*m,*incx);
+  Scalar* y_cpy = get_compact_vector(y,*n,*incy);
+
+  internal::general_rank1_update<Scalar,int,ColMajor,false,Conj>::run(*m, *n, a, *lda, x_cpy, y_cpy, alpha);
+
+  if(x_cpy!=x)  delete[] x_cpy;
+  if(y_cpy!=y)  delete[] y_cpy;
+
+  return 1;
+}
diff --git a/eigen/blas/level2_impl.h b/eigen/blas/level2_impl.h
new file mode 100644
index 0000000..5f39419
--- /dev/null
+++ b/eigen/blas/level2_impl.h
@@ -0,0 +1,524 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009-2010 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#include "common.h"
+
+int EIGEN_BLAS_FUNC(gemv)(char *opa, int *m, int *n, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *pb, int *incb, RealScalar *pbeta, RealScalar *pc, int *incc)
+{
+  typedef void (*functype)(int, int, const Scalar *, int, const Scalar *, int , Scalar *, int, Scalar);
+  static functype func[4];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<4; ++k)
+      func[k] = 0;
+
+    func[NOTR] = (internal::general_matrix_vector_product<int,Scalar,ColMajor,false,Scalar,false>::run);
+    func[TR  ] = (internal::general_matrix_vector_product<int,Scalar,RowMajor,false,Scalar,false>::run);
+    func[ADJ ] = (internal::general_matrix_vector_product<int,Scalar,RowMajor,Conj, Scalar,false>::run);
+
+    init = true;
+  }
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* b = reinterpret_cast<Scalar*>(pb);
+  Scalar* c = reinterpret_cast<Scalar*>(pc);
+  Scalar alpha  = *reinterpret_cast<Scalar*>(palpha);
+  Scalar beta   = *reinterpret_cast<Scalar*>(pbeta);
+
+  // check arguments
+  int info = 0;
+  if(OP(*opa)==INVALID)           info = 1;
+  else if(*m<0)                   info = 2;
+  else if(*n<0)                   info = 3;
+  else if(*lda<std::max(1,*m))    info = 6;
+  else if(*incb==0)               info = 8;
+  else if(*incc==0)               info = 11;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"GEMV ",&info,6);
+
+  if(*m==0 || *n==0 || (alpha==Scalar(0) && beta==Scalar(1)))
+    return 0;
+
+  int actual_m = *m;
+  int actual_n = *n;
+  int code = OP(*opa);
+  if(code!=NOTR)
+    std::swap(actual_m,actual_n);
+
+  Scalar* actual_b = get_compact_vector(b,actual_n,*incb);
+  Scalar* actual_c = get_compact_vector(c,actual_m,*incc);
+
+  if(beta!=Scalar(1))
+  {
+    if(beta==Scalar(0)) vector(actual_c, actual_m).setZero();
+    else                vector(actual_c, actual_m) *= beta;
+  }
+
+  if(code>=4 || func[code]==0)
+    return 0;
+
+  func[code](actual_m, actual_n, a, *lda, actual_b, 1, actual_c, 1, alpha);
+
+  if(actual_b!=b) delete[] actual_b;
+  if(actual_c!=c) delete[] copy_back(actual_c,c,actual_m,*incc);
+
+  return 1;
+}
+
+int EIGEN_BLAS_FUNC(trsv)(char *uplo, char *opa, char *diag, int *n, RealScalar *pa, int *lda, RealScalar *pb, int *incb)
+{
+  typedef void (*functype)(int, const Scalar *, int, Scalar *);
+  static functype func[16];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<16; ++k)
+      func[k] = 0;
+
+    func[NOTR  | (UP << 2) | (NUNIT << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|0,       false,ColMajor>::run);
+    func[TR    | (UP << 2) | (NUNIT << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|0,       false,RowMajor>::run);
+    func[ADJ   | (UP << 2) | (NUNIT << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|0,       Conj, RowMajor>::run);
+
+    func[NOTR  | (LO << 2) | (NUNIT << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|0,       false,ColMajor>::run);
+    func[TR    | (LO << 2) | (NUNIT << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|0,       false,RowMajor>::run);
+    func[ADJ   | (LO << 2) | (NUNIT << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|0,       Conj, RowMajor>::run);
+
+    func[NOTR  | (UP << 2) | (UNIT  << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|UnitDiag,false,ColMajor>::run);
+    func[TR    | (UP << 2) | (UNIT  << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|UnitDiag,false,RowMajor>::run);
+    func[ADJ   | (UP << 2) | (UNIT  << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|UnitDiag,Conj, RowMajor>::run);
+
+    func[NOTR  | (LO << 2) | (UNIT  << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|UnitDiag,false,ColMajor>::run);
+    func[TR    | (LO << 2) | (UNIT  << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|UnitDiag,false,RowMajor>::run);
+    func[ADJ   | (LO << 2) | (UNIT  << 3)] = (internal::triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|UnitDiag,Conj, RowMajor>::run);
+
+    init = true;
+  }
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* b = reinterpret_cast<Scalar*>(pb);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(OP(*opa)==INVALID)                                          info = 2;
+  else if(DIAG(*diag)==INVALID)                                       info = 3;
+  else if(*n<0)                                                       info = 4;
+  else if(*lda<std::max(1,*n))                                        info = 6;
+  else if(*incb==0)                                                   info = 8;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"TRSV ",&info,6);
+
+  Scalar* actual_b = get_compact_vector(b,*n,*incb);
+
+  int code = OP(*opa) | (UPLO(*uplo) << 2) | (DIAG(*diag) << 3);
+  func[code](*n, a, *lda, actual_b);
+
+  if(actual_b!=b) delete[] copy_back(actual_b,b,*n,*incb);
+
+  return 0;
+}
+
+
+
+int EIGEN_BLAS_FUNC(trmv)(char *uplo, char *opa, char *diag, int *n, RealScalar *pa, int *lda, RealScalar *pb, int *incb)
+{
+  typedef void (*functype)(int, int, const Scalar *, int, const Scalar *, int, Scalar *, int, const Scalar&);
+  static functype func[16];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<16; ++k)
+      func[k] = 0;
+
+    func[NOTR  | (UP << 2) | (NUNIT << 3)] = (internal::triangular_matrix_vector_product<int,Upper|0,       Scalar,false,Scalar,false,ColMajor>::run);
+    func[TR    | (UP << 2) | (NUNIT << 3)] = (internal::triangular_matrix_vector_product<int,Lower|0,       Scalar,false,Scalar,false,RowMajor>::run);
+    func[ADJ   | (UP << 2) | (NUNIT << 3)] = (internal::triangular_matrix_vector_product<int,Lower|0,       Scalar,Conj, Scalar,false,RowMajor>::run);
+
+    func[NOTR  | (LO << 2) | (NUNIT << 3)] = (internal::triangular_matrix_vector_product<int,Lower|0,       Scalar,false,Scalar,false,ColMajor>::run);
+    func[TR    | (LO << 2) | (NUNIT << 3)] = (internal::triangular_matrix_vector_product<int,Upper|0,       Scalar,false,Scalar,false,RowMajor>::run);
+    func[ADJ   | (LO << 2) | (NUNIT << 3)] = (internal::triangular_matrix_vector_product<int,Upper|0,       Scalar,Conj, Scalar,false,RowMajor>::run);
+
+    func[NOTR  | (UP << 2) | (UNIT  << 3)] = (internal::triangular_matrix_vector_product<int,Upper|UnitDiag,Scalar,false,Scalar,false,ColMajor>::run);
+    func[TR    | (UP << 2) | (UNIT  << 3)] = (internal::triangular_matrix_vector_product<int,Lower|UnitDiag,Scalar,false,Scalar,false,RowMajor>::run);
+    func[ADJ   | (UP << 2) | (UNIT  << 3)] = (internal::triangular_matrix_vector_product<int,Lower|UnitDiag,Scalar,Conj, Scalar,false,RowMajor>::run);
+
+    func[NOTR  | (LO << 2) | (UNIT  << 3)] = (internal::triangular_matrix_vector_product<int,Lower|UnitDiag,Scalar,false,Scalar,false,ColMajor>::run);
+    func[TR    | (LO << 2) | (UNIT  << 3)] = (internal::triangular_matrix_vector_product<int,Upper|UnitDiag,Scalar,false,Scalar,false,RowMajor>::run);
+    func[ADJ   | (LO << 2) | (UNIT  << 3)] = (internal::triangular_matrix_vector_product<int,Upper|UnitDiag,Scalar,Conj, Scalar,false,RowMajor>::run);
+
+    init = true;
+  }
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* b = reinterpret_cast<Scalar*>(pb);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(OP(*opa)==INVALID)                                          info = 2;
+  else if(DIAG(*diag)==INVALID)                                       info = 3;
+  else if(*n<0)                                                       info = 4;
+  else if(*lda<std::max(1,*n))                                        info = 6;
+  else if(*incb==0)                                                   info = 8;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"TRMV ",&info,6);
+
+  if(*n==0)
+    return 1;
+
+  Scalar* actual_b = get_compact_vector(b,*n,*incb);
+  Matrix<Scalar,Dynamic,1> res(*n);
+  res.setZero();
+
+  int code = OP(*opa) | (UPLO(*uplo) << 2) | (DIAG(*diag) << 3);
+  if(code>=16 || func[code]==0)
+    return 0;
+
+  func[code](*n, *n, a, *lda, actual_b, 1, res.data(), 1, Scalar(1));
+
+  copy_back(res.data(),b,*n,*incb);
+  if(actual_b!=b) delete[] actual_b;
+
+  return 1;
+}
+
+/**  GBMV  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.
+  */
+int EIGEN_BLAS_FUNC(gbmv)(char *trans, int *m, int *n, int *kl, int *ku, RealScalar *palpha, RealScalar *pa, int *lda,
+                          RealScalar *px, int *incx, RealScalar *pbeta, RealScalar *py, int *incy)
+{
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+  Scalar beta = *reinterpret_cast<Scalar*>(pbeta);
+  int coeff_rows = *kl+*ku+1;
+  
+  int info = 0;
+       if(OP(*trans)==INVALID)                                        info = 1;
+  else if(*m<0)                                                       info = 2;
+  else if(*n<0)                                                       info = 3;
+  else if(*kl<0)                                                      info = 4;
+  else if(*ku<0)                                                      info = 5;
+  else if(*lda<coeff_rows)                                            info = 8;
+  else if(*incx==0)                                                   info = 10;
+  else if(*incy==0)                                                   info = 13;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"GBMV ",&info,6);
+  
+  if(*m==0 || *n==0 || (alpha==Scalar(0) && beta==Scalar(1)))
+    return 0;
+  
+  int actual_m = *m;
+  int actual_n = *n;
+  if(OP(*trans)!=NOTR)
+    std::swap(actual_m,actual_n);
+  
+  Scalar* actual_x = get_compact_vector(x,actual_n,*incx);
+  Scalar* actual_y = get_compact_vector(y,actual_m,*incy);
+  
+  if(beta!=Scalar(1))
+  {
+    if(beta==Scalar(0)) vector(actual_y, actual_m).setZero();
+    else                vector(actual_y, actual_m) *= beta;
+  }
+  
+  MatrixType mat_coeffs(a,coeff_rows,*n,*lda);
+  
+  int nb = std::min(*n,(*m)+(*ku));
+  for(int j=0; j<nb; ++j)
+  {
+    int start = std::max(0,j - *ku);
+    int end = std::min((*m)-1,j + *kl);
+    int len = end - start + 1;
+    int offset = (*ku) - j + start;
+    if(OP(*trans)==NOTR)
+      vector(actual_y+start,len) += (alpha*actual_x[j]) * mat_coeffs.col(j).segment(offset,len);
+    else if(OP(*trans)==TR)
+      actual_y[j] += alpha * ( mat_coeffs.col(j).segment(offset,len).transpose() * vector(actual_x+start,len) ).value();
+    else
+      actual_y[j] += alpha * ( mat_coeffs.col(j).segment(offset,len).adjoint()   * vector(actual_x+start,len) ).value();
+  }    
+  
+  if(actual_x!=x) delete[] actual_x;
+  if(actual_y!=y) delete[] copy_back(actual_y,y,actual_m,*incy);
+  
+  return 0;
+}
+
+#if 0
+/**  TBMV  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.
+  */
+int EIGEN_BLAS_FUNC(tbmv)(char *uplo, char *opa, char *diag, int *n, int *k, RealScalar *pa, int *lda, RealScalar *px, int *incx)
+{
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  int coeff_rows = *k + 1;
+  
+  int info = 0;
+       if(UPLO(*uplo)==INVALID)                                       info = 1;
+  else if(OP(*opa)==INVALID)                                          info = 2;
+  else if(DIAG(*diag)==INVALID)                                       info = 3;
+  else if(*n<0)                                                       info = 4;
+  else if(*k<0)                                                       info = 5;
+  else if(*lda<coeff_rows)                                            info = 7;
+  else if(*incx==0)                                                   info = 9;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"TBMV ",&info,6);
+  
+  if(*n==0)
+    return 0;
+  
+  int actual_n = *n;
+  
+  Scalar* actual_x = get_compact_vector(x,actual_n,*incx);
+  
+  MatrixType mat_coeffs(a,coeff_rows,*n,*lda);
+  
+  int ku = UPLO(*uplo)==UPPER ? *k : 0;
+  int kl = UPLO(*uplo)==LOWER ? *k : 0;
+  
+  for(int j=0; j<*n; ++j)
+  {
+    int start = std::max(0,j - ku);
+    int end = std::min((*m)-1,j + kl);
+    int len = end - start + 1;
+    int offset = (ku) - j + start;
+    
+    if(OP(*trans)==NOTR)
+      vector(actual_y+start,len) += (alpha*actual_x[j]) * mat_coeffs.col(j).segment(offset,len);
+    else if(OP(*trans)==TR)
+      actual_y[j] += alpha * ( mat_coeffs.col(j).segment(offset,len).transpose() * vector(actual_x+start,len) ).value();
+    else
+      actual_y[j] += alpha * ( mat_coeffs.col(j).segment(offset,len).adjoint()   * vector(actual_x+start,len) ).value();
+  }    
+  
+  if(actual_x!=x) delete[] actual_x;
+  if(actual_y!=y) delete[] copy_back(actual_y,y,actual_m,*incy);
+  
+  return 0;
+}
+#endif
+
+/**  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.
+  */
+int EIGEN_BLAS_FUNC(tbsv)(char *uplo, char *op, char *diag, int *n, int *k, RealScalar *pa, int *lda, RealScalar *px, int *incx)
+{
+  typedef void (*functype)(int, int, const Scalar *, int, Scalar *);
+  static functype func[16];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<16; ++k)
+      func[k] = 0;
+
+    func[NOTR  | (UP << 2) | (NUNIT << 3)] = (internal::band_solve_triangular_selector<int,Upper|0,       Scalar,false,Scalar,ColMajor>::run);
+    func[TR    | (UP << 2) | (NUNIT << 3)] = (internal::band_solve_triangular_selector<int,Lower|0,       Scalar,false,Scalar,RowMajor>::run);
+    func[ADJ   | (UP << 2) | (NUNIT << 3)] = (internal::band_solve_triangular_selector<int,Lower|0,       Scalar,Conj, Scalar,RowMajor>::run);
+
+    func[NOTR  | (LO << 2) | (NUNIT << 3)] = (internal::band_solve_triangular_selector<int,Lower|0,       Scalar,false,Scalar,ColMajor>::run);
+    func[TR    | (LO << 2) | (NUNIT << 3)] = (internal::band_solve_triangular_selector<int,Upper|0,       Scalar,false,Scalar,RowMajor>::run);
+    func[ADJ   | (LO << 2) | (NUNIT << 3)] = (internal::band_solve_triangular_selector<int,Upper|0,       Scalar,Conj, Scalar,RowMajor>::run);
+
+    func[NOTR  | (UP << 2) | (UNIT  << 3)] = (internal::band_solve_triangular_selector<int,Upper|UnitDiag,Scalar,false,Scalar,ColMajor>::run);
+    func[TR    | (UP << 2) | (UNIT  << 3)] = (internal::band_solve_triangular_selector<int,Lower|UnitDiag,Scalar,false,Scalar,RowMajor>::run);
+    func[ADJ   | (UP << 2) | (UNIT  << 3)] = (internal::band_solve_triangular_selector<int,Lower|UnitDiag,Scalar,Conj, Scalar,RowMajor>::run);
+
+    func[NOTR  | (LO << 2) | (UNIT  << 3)] = (internal::band_solve_triangular_selector<int,Lower|UnitDiag,Scalar,false,Scalar,ColMajor>::run);
+    func[TR    | (LO << 2) | (UNIT  << 3)] = (internal::band_solve_triangular_selector<int,Upper|UnitDiag,Scalar,false,Scalar,RowMajor>::run);
+    func[ADJ   | (LO << 2) | (UNIT  << 3)] = (internal::band_solve_triangular_selector<int,Upper|UnitDiag,Scalar,Conj, Scalar,RowMajor>::run);
+
+    init = true;
+  }
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  int coeff_rows = *k+1;
+  
+  int info = 0;
+       if(UPLO(*uplo)==INVALID)                                       info = 1;
+  else if(OP(*op)==INVALID)                                           info = 2;
+  else if(DIAG(*diag)==INVALID)                                       info = 3;
+  else if(*n<0)                                                       info = 4;
+  else if(*k<0)                                                       info = 5;
+  else if(*lda<coeff_rows)                                            info = 7;
+  else if(*incx==0)                                                   info = 9;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"TBSV ",&info,6);
+  
+  if(*n==0 || (*k==0 && DIAG(*diag)==UNIT))
+    return 0;
+  
+  int actual_n = *n;
+ 
+  Scalar* actual_x = get_compact_vector(x,actual_n,*incx);
+  
+  int code = OP(*op) | (UPLO(*uplo) << 2) | (DIAG(*diag) << 3);
+  if(code>=16 || func[code]==0)
+    return 0;
+
+  func[code](*n, *k, a, *lda, actual_x);
+  
+  if(actual_x!=x) delete[] copy_back(actual_x,x,actual_n,*incx);
+  
+  return 0;
+}
+
+/**  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.
+  */
+int EIGEN_BLAS_FUNC(tpmv)(char *uplo, char *opa, char *diag, int *n, RealScalar *pap, RealScalar *px, int *incx)
+{
+  typedef void (*functype)(int, const Scalar*, const Scalar*, Scalar*, Scalar);
+  static functype func[16];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<16; ++k)
+      func[k] = 0;
+
+    func[NOTR  | (UP << 2) | (NUNIT << 3)] = (internal::packed_triangular_matrix_vector_product<int,Upper|0,       Scalar,false,Scalar,false,ColMajor>::run);
+    func[TR    | (UP << 2) | (NUNIT << 3)] = (internal::packed_triangular_matrix_vector_product<int,Lower|0,       Scalar,false,Scalar,false,RowMajor>::run);
+    func[ADJ   | (UP << 2) | (NUNIT << 3)] = (internal::packed_triangular_matrix_vector_product<int,Lower|0,       Scalar,Conj, Scalar,false,RowMajor>::run);
+
+    func[NOTR  | (LO << 2) | (NUNIT << 3)] = (internal::packed_triangular_matrix_vector_product<int,Lower|0,       Scalar,false,Scalar,false,ColMajor>::run);
+    func[TR    | (LO << 2) | (NUNIT << 3)] = (internal::packed_triangular_matrix_vector_product<int,Upper|0,       Scalar,false,Scalar,false,RowMajor>::run);
+    func[ADJ   | (LO << 2) | (NUNIT << 3)] = (internal::packed_triangular_matrix_vector_product<int,Upper|0,       Scalar,Conj, Scalar,false,RowMajor>::run);
+
+    func[NOTR  | (UP << 2) | (UNIT  << 3)] = (internal::packed_triangular_matrix_vector_product<int,Upper|UnitDiag,Scalar,false,Scalar,false,ColMajor>::run);
+    func[TR    | (UP << 2) | (UNIT  << 3)] = (internal::packed_triangular_matrix_vector_product<int,Lower|UnitDiag,Scalar,false,Scalar,false,RowMajor>::run);
+    func[ADJ   | (UP << 2) | (UNIT  << 3)] = (internal::packed_triangular_matrix_vector_product<int,Lower|UnitDiag,Scalar,Conj, Scalar,false,RowMajor>::run);
+
+    func[NOTR  | (LO << 2) | (UNIT  << 3)] = (internal::packed_triangular_matrix_vector_product<int,Lower|UnitDiag,Scalar,false,Scalar,false,ColMajor>::run);
+    func[TR    | (LO << 2) | (UNIT  << 3)] = (internal::packed_triangular_matrix_vector_product<int,Upper|UnitDiag,Scalar,false,Scalar,false,RowMajor>::run);
+    func[ADJ   | (LO << 2) | (UNIT  << 3)] = (internal::packed_triangular_matrix_vector_product<int,Upper|UnitDiag,Scalar,Conj, Scalar,false,RowMajor>::run);
+
+    init = true;
+  }
+
+  Scalar* ap = reinterpret_cast<Scalar*>(pap);
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(OP(*opa)==INVALID)                                          info = 2;
+  else if(DIAG(*diag)==INVALID)                                       info = 3;
+  else if(*n<0)                                                       info = 4;
+  else if(*incx==0)                                                   info = 7;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"TPMV ",&info,6);
+
+  if(*n==0)
+    return 1;
+
+  Scalar* actual_x = get_compact_vector(x,*n,*incx);
+  Matrix<Scalar,Dynamic,1> res(*n);
+  res.setZero();
+
+  int code = OP(*opa) | (UPLO(*uplo) << 2) | (DIAG(*diag) << 3);
+  if(code>=16 || func[code]==0)
+    return 0;
+
+  func[code](*n, ap, actual_x, res.data(), Scalar(1));
+
+  copy_back(res.data(),x,*n,*incx);
+  if(actual_x!=x) delete[] actual_x;
+
+  return 1;
+}
+
+/**  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.
+  */
+int EIGEN_BLAS_FUNC(tpsv)(char *uplo, char *opa, char *diag, int *n, RealScalar *pap, RealScalar *px, int *incx)
+{
+  typedef void (*functype)(int, const Scalar*, Scalar*);
+  static functype func[16];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<16; ++k)
+      func[k] = 0;
+
+    func[NOTR  | (UP << 2) | (NUNIT << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|0,       false,ColMajor>::run);
+    func[TR    | (UP << 2) | (NUNIT << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|0,       false,RowMajor>::run);
+    func[ADJ   | (UP << 2) | (NUNIT << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|0,       Conj, RowMajor>::run);
+
+    func[NOTR  | (LO << 2) | (NUNIT << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|0,       false,ColMajor>::run);
+    func[TR    | (LO << 2) | (NUNIT << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|0,       false,RowMajor>::run);
+    func[ADJ   | (LO << 2) | (NUNIT << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|0,       Conj, RowMajor>::run);
+
+    func[NOTR  | (UP << 2) | (UNIT  << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|UnitDiag,false,ColMajor>::run);
+    func[TR    | (UP << 2) | (UNIT  << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|UnitDiag,false,RowMajor>::run);
+    func[ADJ   | (UP << 2) | (UNIT  << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|UnitDiag,Conj, RowMajor>::run);
+
+    func[NOTR  | (LO << 2) | (UNIT  << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Lower|UnitDiag,false,ColMajor>::run);
+    func[TR    | (LO << 2) | (UNIT  << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|UnitDiag,false,RowMajor>::run);
+    func[ADJ   | (LO << 2) | (UNIT  << 3)] = (internal::packed_triangular_solve_vector<Scalar,Scalar,int,OnTheLeft, Upper|UnitDiag,Conj, RowMajor>::run);
+
+    init = true;
+  }
+
+  Scalar* ap = reinterpret_cast<Scalar*>(pap);
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(OP(*opa)==INVALID)                                          info = 2;
+  else if(DIAG(*diag)==INVALID)                                       info = 3;
+  else if(*n<0)                                                       info = 4;
+  else if(*incx==0)                                                   info = 7;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"TPSV ",&info,6);
+
+  Scalar* actual_x = get_compact_vector(x,*n,*incx);
+
+  int code = OP(*opa) | (UPLO(*uplo) << 2) | (DIAG(*diag) << 3);
+  func[code](*n, ap, actual_x);
+
+  if(actual_x!=x) delete[] copy_back(actual_x,x,*n,*incx);
+
+  return 1;
+}
+
diff --git a/eigen/blas/level2_real_impl.h b/eigen/blas/level2_real_impl.h
new file mode 100644
index 0000000..8d56eaa
--- /dev/null
+++ b/eigen/blas/level2_real_impl.h
@@ -0,0 +1,370 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009-2010 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#include "common.h"
+
+// y = alpha*A*x + beta*y
+int EIGEN_BLAS_FUNC(symv) (char *uplo, int *n, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *px, int *incx, RealScalar *pbeta, RealScalar *py, int *incy)
+{
+  typedef void (*functype)(int, const Scalar*, int, const Scalar*, int, Scalar*, Scalar);
+  static functype func[2];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<2; ++k)
+      func[k] = 0;
+
+    func[UP] = (internal::selfadjoint_matrix_vector_product<Scalar,int,ColMajor,Upper,false,false>::run);
+    func[LO] = (internal::selfadjoint_matrix_vector_product<Scalar,int,ColMajor,Lower,false,false>::run);
+
+    init = true;
+  }
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar alpha  = *reinterpret_cast<Scalar*>(palpha);
+  Scalar beta   = *reinterpret_cast<Scalar*>(pbeta);
+
+  // check arguments
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)        info = 1;
+  else if(*n<0)                   info = 2;
+  else if(*lda<std::max(1,*n))    info = 5;
+  else if(*incx==0)               info = 7;
+  else if(*incy==0)               info = 10;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"SYMV ",&info,6);
+
+  if(*n==0)
+    return 0;
+
+  Scalar* actual_x = get_compact_vector(x,*n,*incx);
+  Scalar* actual_y = get_compact_vector(y,*n,*incy);
+
+  if(beta!=Scalar(1))
+  {
+    if(beta==Scalar(0)) vector(actual_y, *n).setZero();
+    else                vector(actual_y, *n) *= beta;
+  }
+
+  int code = UPLO(*uplo);
+  if(code>=2 || func[code]==0)
+    return 0;
+
+  func[code](*n, a, *lda, actual_x, 1, actual_y, alpha);
+
+  if(actual_x!=x) delete[] actual_x;
+  if(actual_y!=y) delete[] copy_back(actual_y,y,*n,*incy);
+
+  return 1;
+}
+
+// C := alpha*x*x' + C
+int EIGEN_BLAS_FUNC(syr)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *pc, int *ldc)
+{
+
+//   typedef void (*functype)(int, const Scalar *, int, Scalar *, int, Scalar);
+//   static functype func[2];
+
+//   static bool init = false;
+//   if(!init)
+//   {
+//     for(int k=0; k<2; ++k)
+//       func[k] = 0;
+//
+//     func[UP] = (internal::selfadjoint_product<Scalar,ColMajor,ColMajor,false,UpperTriangular>::run);
+//     func[LO] = (internal::selfadjoint_product<Scalar,ColMajor,ColMajor,false,LowerTriangular>::run);
+
+//     init = true;
+//   }
+  typedef void (*functype)(int, Scalar*, int, const Scalar*, const Scalar*, const Scalar&);
+  static functype func[2];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<2; ++k)
+      func[k] = 0;
+
+    func[UP] = (selfadjoint_rank1_update<Scalar,int,ColMajor,Upper,false,Conj>::run);
+    func[LO] = (selfadjoint_rank1_update<Scalar,int,ColMajor,Lower,false,Conj>::run);
+
+    init = true;
+  }
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* c = reinterpret_cast<Scalar*>(pc);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  else if(*ldc<std::max(1,*n))                                        info = 7;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"SYR  ",&info,6);
+
+  if(*n==0 || alpha==Scalar(0)) return 1;
+
+  // if the increment is not 1, let's copy it to a temporary vector to enable vectorization
+  Scalar* x_cpy = get_compact_vector(x,*n,*incx);
+
+  int code = UPLO(*uplo);
+  if(code>=2 || func[code]==0)
+    return 0;
+
+  func[code](*n, c, *ldc, x_cpy, x_cpy, alpha);
+
+  if(x_cpy!=x)  delete[] x_cpy;
+
+  return 1;
+}
+
+// C := alpha*x*y' + alpha*y*x' + C
+int EIGEN_BLAS_FUNC(syr2)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar *pc, int *ldc)
+{
+//   typedef void (*functype)(int, const Scalar *, int, const Scalar *, int, Scalar *, int, Scalar);
+//   static functype func[2];
+//
+//   static bool init = false;
+//   if(!init)
+//   {
+//     for(int k=0; k<2; ++k)
+//       func[k] = 0;
+//
+//     func[UP] = (internal::selfadjoint_product<Scalar,ColMajor,ColMajor,false,UpperTriangular>::run);
+//     func[LO] = (internal::selfadjoint_product<Scalar,ColMajor,ColMajor,false,LowerTriangular>::run);
+//
+//     init = true;
+//   }
+  typedef void (*functype)(int, Scalar*, int, const Scalar*, const Scalar*, Scalar);
+  static functype func[2];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<2; ++k)
+      func[k] = 0;
+
+    func[UP] = (internal::rank2_update_selector<Scalar,int,Upper>::run);
+    func[LO] = (internal::rank2_update_selector<Scalar,int,Lower>::run);
+
+    init = true;
+  }
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar* c = reinterpret_cast<Scalar*>(pc);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  else if(*incy==0)                                                   info = 7;
+  else if(*ldc<std::max(1,*n))                                        info = 9;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"SYR2 ",&info,6);
+
+  if(alpha==Scalar(0))
+    return 1;
+
+  Scalar* x_cpy = get_compact_vector(x,*n,*incx);
+  Scalar* y_cpy = get_compact_vector(y,*n,*incy);
+  
+  int code = UPLO(*uplo);
+  if(code>=2 || func[code]==0)
+    return 0;
+
+  func[code](*n, c, *ldc, x_cpy, y_cpy, alpha);
+
+  if(x_cpy!=x)  delete[] x_cpy;
+  if(y_cpy!=y)  delete[] y_cpy;
+
+//   int code = UPLO(*uplo);
+//   if(code>=2 || func[code]==0)
+//     return 0;
+
+//   func[code](*n, a, *inca, b, *incb, c, *ldc, alpha);
+  return 1;
+}
+
+/**  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.
+  */
+// int EIGEN_BLAS_FUNC(sbmv)( char *uplo, int *n, int *k, RealScalar *alpha, RealScalar *a, int *lda,
+//                            RealScalar *x, int *incx, RealScalar *beta, RealScalar *y, int *incy)
+// {
+//   return 1;
+// }
+
+
+/**  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.
+  *
+  */
+// int EIGEN_BLAS_FUNC(spmv)(char *uplo, int *n, RealScalar *alpha, RealScalar *ap, RealScalar *x, int *incx, RealScalar *beta, RealScalar *y, int *incy)
+// {
+//   return 1;
+// }
+
+/**  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.
+  */
+int EIGEN_BLAS_FUNC(spr)(char *uplo, int *n, Scalar *palpha, Scalar *px, int *incx, Scalar *pap)
+{
+  typedef void (*functype)(int, Scalar*, const Scalar*, Scalar);
+  static functype func[2];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<2; ++k)
+      func[k] = 0;
+
+    func[UP] = (internal::selfadjoint_packed_rank1_update<Scalar,int,ColMajor,Upper,false,false>::run);
+    func[LO] = (internal::selfadjoint_packed_rank1_update<Scalar,int,ColMajor,Lower,false,false>::run);
+
+    init = true;
+  }
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* ap = reinterpret_cast<Scalar*>(pap);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"SPR  ",&info,6);
+
+  if(alpha==Scalar(0))
+    return 1;
+
+  Scalar* x_cpy = get_compact_vector(x, *n, *incx);
+
+  int code = UPLO(*uplo);
+  if(code>=2 || func[code]==0)
+    return 0;
+
+  func[code](*n, ap, x_cpy, alpha);
+
+  if(x_cpy!=x)  delete[] x_cpy;
+
+  return 1;
+}
+
+/**  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.
+  */
+int EIGEN_BLAS_FUNC(spr2)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar *pap)
+{
+  typedef void (*functype)(int, Scalar*, const Scalar*, const Scalar*, Scalar);
+  static functype func[2];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<2; ++k)
+      func[k] = 0;
+
+    func[UP] = (internal::packed_rank2_update_selector<Scalar,int,Upper>::run);
+    func[LO] = (internal::packed_rank2_update_selector<Scalar,int,Lower>::run);
+
+    init = true;
+  }
+
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar* ap = reinterpret_cast<Scalar*>(pap);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  else if(*incy==0)                                                   info = 7;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"SPR2 ",&info,6);
+
+  if(alpha==Scalar(0))
+    return 1;
+
+  Scalar* x_cpy = get_compact_vector(x, *n, *incx);
+  Scalar* y_cpy = get_compact_vector(y, *n, *incy);
+
+  int code = UPLO(*uplo);
+  if(code>=2 || func[code]==0)
+    return 0;
+
+  func[code](*n, ap, x_cpy, y_cpy, alpha);
+
+  if(x_cpy!=x)  delete[] x_cpy;
+  if(y_cpy!=y)  delete[] y_cpy;
+
+  return 1;
+}
+
+/**  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.
+  */
+int EIGEN_BLAS_FUNC(ger)(int *m, int *n, Scalar *palpha, Scalar *px, int *incx, Scalar *py, int *incy, Scalar *pa, int *lda)
+{
+  Scalar* x = reinterpret_cast<Scalar*>(px);
+  Scalar* y = reinterpret_cast<Scalar*>(py);
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+       if(*m<0)                                                       info = 1;
+  else if(*n<0)                                                       info = 2;
+  else if(*incx==0)                                                   info = 5;
+  else if(*incy==0)                                                   info = 7;
+  else if(*lda<std::max(1,*m))                                        info = 9;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"GER  ",&info,6);
+
+  if(alpha==Scalar(0))
+    return 1;
+
+  Scalar* x_cpy = get_compact_vector(x,*m,*incx);
+  Scalar* y_cpy = get_compact_vector(y,*n,*incy);
+
+  internal::general_rank1_update<Scalar,int,ColMajor,false,false>::run(*m, *n, a, *lda, x_cpy, y_cpy, alpha);
+
+  if(x_cpy!=x)  delete[] x_cpy;
+  if(y_cpy!=y)  delete[] y_cpy;
+
+  return 1;
+}
+
+
diff --git a/eigen/blas/level3_impl.h b/eigen/blas/level3_impl.h
new file mode 100644
index 0000000..07dbc22
--- /dev/null
+++ b/eigen/blas/level3_impl.h
@@ -0,0 +1,634 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009-2010 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#include "common.h"
+
+int EIGEN_BLAS_FUNC(gemm)(char *opa, char *opb, int *m, int *n, int *k, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *pb, int *ldb, RealScalar *pbeta, RealScalar *pc, int *ldc)
+{
+//   std::cerr << "in gemm " << *opa << " " << *opb << " " << *m << " " << *n << " " << *k << " " << *lda << " " << *ldb << " " << *ldc << " " << *palpha << " " << *pbeta << "\n";
+  typedef void (*functype)(DenseIndex, DenseIndex, DenseIndex, const Scalar *, DenseIndex, const Scalar *, DenseIndex, Scalar *, DenseIndex, Scalar, internal::level3_blocking<Scalar,Scalar>&, Eigen::internal::GemmParallelInfo<DenseIndex>*);
+  static functype func[12];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<12; ++k)
+      func[k] = 0;
+    func[NOTR  | (NOTR << 2)] = (internal::general_matrix_matrix_product<DenseIndex,Scalar,ColMajor,false,Scalar,ColMajor,false,ColMajor>::run);
+    func[TR    | (NOTR << 2)] = (internal::general_matrix_matrix_product<DenseIndex,Scalar,RowMajor,false,Scalar,ColMajor,false,ColMajor>::run);
+    func[ADJ   | (NOTR << 2)] = (internal::general_matrix_matrix_product<DenseIndex,Scalar,RowMajor,Conj, Scalar,ColMajor,false,ColMajor>::run);
+    func[NOTR  | (TR   << 2)] = (internal::general_matrix_matrix_product<DenseIndex,Scalar,ColMajor,false,Scalar,RowMajor,false,ColMajor>::run);
+    func[TR    | (TR   << 2)] = (internal::general_matrix_matrix_product<DenseIndex,Scalar,RowMajor,false,Scalar,RowMajor,false,ColMajor>::run);
+    func[ADJ   | (TR   << 2)] = (internal::general_matrix_matrix_product<DenseIndex,Scalar,RowMajor,Conj, Scalar,RowMajor,false,ColMajor>::run);
+    func[NOTR  | (ADJ  << 2)] = (internal::general_matrix_matrix_product<DenseIndex,Scalar,ColMajor,false,Scalar,RowMajor,Conj, ColMajor>::run);
+    func[TR    | (ADJ  << 2)] = (internal::general_matrix_matrix_product<DenseIndex,Scalar,RowMajor,false,Scalar,RowMajor,Conj, ColMajor>::run);
+    func[ADJ   | (ADJ  << 2)] = (internal::general_matrix_matrix_product<DenseIndex,Scalar,RowMajor,Conj, Scalar,RowMajor,Conj, ColMajor>::run);
+    init = true;
+  }
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* b = reinterpret_cast<Scalar*>(pb);
+  Scalar* c = reinterpret_cast<Scalar*>(pc);
+  Scalar alpha  = *reinterpret_cast<Scalar*>(palpha);
+  Scalar beta   = *reinterpret_cast<Scalar*>(pbeta);
+
+  int info = 0;
+  if(OP(*opa)==INVALID)                                               info = 1;
+  else if(OP(*opb)==INVALID)                                          info = 2;
+  else if(*m<0)                                                       info = 3;
+  else if(*n<0)                                                       info = 4;
+  else if(*k<0)                                                       info = 5;
+  else if(*lda<std::max(1,(OP(*opa)==NOTR)?*m:*k))                    info = 8;
+  else if(*ldb<std::max(1,(OP(*opb)==NOTR)?*k:*n))                    info = 10;
+  else if(*ldc<std::max(1,*m))                                        info = 13;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"GEMM ",&info,6);
+
+  if(beta!=Scalar(1))
+  {
+    if(beta==Scalar(0)) matrix(c, *m, *n, *ldc).setZero();
+    else                matrix(c, *m, *n, *ldc) *= beta;
+  }
+
+  internal::gemm_blocking_space<ColMajor,Scalar,Scalar,Dynamic,Dynamic,Dynamic> blocking(*m,*n,*k);
+
+  int code = OP(*opa) | (OP(*opb) << 2);
+  func[code](*m, *n, *k, a, *lda, b, *ldb, c, *ldc, alpha, blocking, 0);
+  return 0;
+}
+
+int EIGEN_BLAS_FUNC(trsm)(char *side, char *uplo, char *opa, char *diag, int *m, int *n, RealScalar *palpha,  RealScalar *pa, int *lda, RealScalar *pb, int *ldb)
+{
+//   std::cerr << "in trsm " << *side << " " << *uplo << " " << *opa << " " << *diag << " " << *m << "," << *n << " " << *palpha << " " << *lda << " " << *ldb<< "\n";
+  typedef void (*functype)(DenseIndex, DenseIndex, const Scalar *, DenseIndex, Scalar *, DenseIndex, internal::level3_blocking<Scalar,Scalar>&);
+  static functype func[32];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<32; ++k)
+      func[k] = 0;
+
+    func[NOTR  | (LEFT  << 2) | (UP << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Upper|0,          false,ColMajor,ColMajor>::run);
+    func[TR    | (LEFT  << 2) | (UP << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Lower|0,          false,RowMajor,ColMajor>::run);
+    func[ADJ   | (LEFT  << 2) | (UP << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Lower|0,          Conj, RowMajor,ColMajor>::run);
+
+    func[NOTR  | (RIGHT << 2) | (UP << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Upper|0,          false,ColMajor,ColMajor>::run);
+    func[TR    | (RIGHT << 2) | (UP << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Lower|0,          false,RowMajor,ColMajor>::run);
+    func[ADJ   | (RIGHT << 2) | (UP << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Lower|0,          Conj, RowMajor,ColMajor>::run);
+
+    func[NOTR  | (LEFT  << 2) | (LO << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Lower|0,          false,ColMajor,ColMajor>::run);
+    func[TR    | (LEFT  << 2) | (LO << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Upper|0,          false,RowMajor,ColMajor>::run);
+    func[ADJ   | (LEFT  << 2) | (LO << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Upper|0,          Conj, RowMajor,ColMajor>::run);
+
+    func[NOTR  | (RIGHT << 2) | (LO << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Lower|0,          false,ColMajor,ColMajor>::run);
+    func[TR    | (RIGHT << 2) | (LO << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Upper|0,          false,RowMajor,ColMajor>::run);
+    func[ADJ   | (RIGHT << 2) | (LO << 3) | (NUNIT << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Upper|0,          Conj, RowMajor,ColMajor>::run);
+
+
+    func[NOTR  | (LEFT  << 2) | (UP << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Upper|UnitDiag,false,ColMajor,ColMajor>::run);
+    func[TR    | (LEFT  << 2) | (UP << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Lower|UnitDiag,false,RowMajor,ColMajor>::run);
+    func[ADJ   | (LEFT  << 2) | (UP << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Lower|UnitDiag,Conj, RowMajor,ColMajor>::run);
+
+    func[NOTR  | (RIGHT << 2) | (UP << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Upper|UnitDiag,false,ColMajor,ColMajor>::run);
+    func[TR    | (RIGHT << 2) | (UP << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Lower|UnitDiag,false,RowMajor,ColMajor>::run);
+    func[ADJ   | (RIGHT << 2) | (UP << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Lower|UnitDiag,Conj, RowMajor,ColMajor>::run);
+
+    func[NOTR  | (LEFT  << 2) | (LO << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Lower|UnitDiag,false,ColMajor,ColMajor>::run);
+    func[TR    | (LEFT  << 2) | (LO << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Upper|UnitDiag,false,RowMajor,ColMajor>::run);
+    func[ADJ   | (LEFT  << 2) | (LO << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheLeft, Upper|UnitDiag,Conj, RowMajor,ColMajor>::run);
+
+    func[NOTR  | (RIGHT << 2) | (LO << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Lower|UnitDiag,false,ColMajor,ColMajor>::run);
+    func[TR    | (RIGHT << 2) | (LO << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Upper|UnitDiag,false,RowMajor,ColMajor>::run);
+    func[ADJ   | (RIGHT << 2) | (LO << 3) | (UNIT  << 4)] = (internal::triangular_solve_matrix<Scalar,DenseIndex,OnTheRight,Upper|UnitDiag,Conj, RowMajor,ColMajor>::run);
+
+    init = true;
+  }
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* b = reinterpret_cast<Scalar*>(pb);
+  Scalar  alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+  if(SIDE(*side)==INVALID)                                            info = 1;
+  else if(UPLO(*uplo)==INVALID)                                       info = 2;
+  else if(OP(*opa)==INVALID)                                          info = 3;
+  else if(DIAG(*diag)==INVALID)                                       info = 4;
+  else if(*m<0)                                                       info = 5;
+  else if(*n<0)                                                       info = 6;
+  else if(*lda<std::max(1,(SIDE(*side)==LEFT)?*m:*n))                 info = 9;
+  else if(*ldb<std::max(1,*m))                                        info = 11;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"TRSM ",&info,6);
+
+  int code = OP(*opa) | (SIDE(*side) << 2) | (UPLO(*uplo) << 3) | (DIAG(*diag) << 4);
+  
+  if(SIDE(*side)==LEFT)
+  {
+    internal::gemm_blocking_space<ColMajor,Scalar,Scalar,Dynamic,Dynamic,Dynamic,4> blocking(*m,*n,*m);
+    func[code](*m, *n, a, *lda, b, *ldb, blocking);
+  }
+  else
+  {
+    internal::gemm_blocking_space<ColMajor,Scalar,Scalar,Dynamic,Dynamic,Dynamic,4> blocking(*m,*n,*n);
+    func[code](*n, *m, a, *lda, b, *ldb, blocking);
+  }
+
+  if(alpha!=Scalar(1))
+    matrix(b,*m,*n,*ldb) *= alpha;
+
+  return 0;
+}
+
+
+// b = alpha*op(a)*b  for side = 'L'or'l'
+// b = alpha*b*op(a)  for side = 'R'or'r'
+int EIGEN_BLAS_FUNC(trmm)(char *side, char *uplo, char *opa, char *diag, int *m, int *n, RealScalar *palpha,  RealScalar *pa, int *lda, RealScalar *pb, int *ldb)
+{
+//   std::cerr << "in trmm " << *side << " " << *uplo << " " << *opa << " " << *diag << " " << *m << " " << *n << " " << *lda << " " << *ldb << " " << *palpha << "\n";
+  typedef void (*functype)(DenseIndex, DenseIndex, DenseIndex, const Scalar *, DenseIndex, const Scalar *, DenseIndex, Scalar *, DenseIndex, const Scalar&, internal::level3_blocking<Scalar,Scalar>&);
+  static functype func[32];
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<32; ++k)
+      func[k] = 0;
+
+    func[NOTR  | (LEFT  << 2) | (UP << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|0,          true, ColMajor,false,ColMajor,false,ColMajor>::run);
+    func[TR    | (LEFT  << 2) | (UP << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|0,          true, RowMajor,false,ColMajor,false,ColMajor>::run);
+    func[ADJ   | (LEFT  << 2) | (UP << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|0,          true, RowMajor,Conj, ColMajor,false,ColMajor>::run);
+
+    func[NOTR  | (RIGHT << 2) | (UP << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|0,          false,ColMajor,false,ColMajor,false,ColMajor>::run);
+    func[TR    | (RIGHT << 2) | (UP << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|0,          false,ColMajor,false,RowMajor,false,ColMajor>::run);
+    func[ADJ   | (RIGHT << 2) | (UP << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|0,          false,ColMajor,false,RowMajor,Conj, ColMajor>::run);
+
+    func[NOTR  | (LEFT  << 2) | (LO << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|0,          true, ColMajor,false,ColMajor,false,ColMajor>::run);
+    func[TR    | (LEFT  << 2) | (LO << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|0,          true, RowMajor,false,ColMajor,false,ColMajor>::run);
+    func[ADJ   | (LEFT  << 2) | (LO << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|0,          true, RowMajor,Conj, ColMajor,false,ColMajor>::run);
+
+    func[NOTR  | (RIGHT << 2) | (LO << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|0,          false,ColMajor,false,ColMajor,false,ColMajor>::run);
+    func[TR    | (RIGHT << 2) | (LO << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|0,          false,ColMajor,false,RowMajor,false,ColMajor>::run);
+    func[ADJ   | (RIGHT << 2) | (LO << 3) | (NUNIT << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|0,          false,ColMajor,false,RowMajor,Conj, ColMajor>::run);
+
+    func[NOTR  | (LEFT  << 2) | (UP << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|UnitDiag,true, ColMajor,false,ColMajor,false,ColMajor>::run);
+    func[TR    | (LEFT  << 2) | (UP << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|UnitDiag,true, RowMajor,false,ColMajor,false,ColMajor>::run);
+    func[ADJ   | (LEFT  << 2) | (UP << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|UnitDiag,true, RowMajor,Conj, ColMajor,false,ColMajor>::run);
+
+    func[NOTR  | (RIGHT << 2) | (UP << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|UnitDiag,false,ColMajor,false,ColMajor,false,ColMajor>::run);
+    func[TR    | (RIGHT << 2) | (UP << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|UnitDiag,false,ColMajor,false,RowMajor,false,ColMajor>::run);
+    func[ADJ   | (RIGHT << 2) | (UP << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|UnitDiag,false,ColMajor,false,RowMajor,Conj, ColMajor>::run);
+
+    func[NOTR  | (LEFT  << 2) | (LO << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|UnitDiag,true, ColMajor,false,ColMajor,false,ColMajor>::run);
+    func[TR    | (LEFT  << 2) | (LO << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|UnitDiag,true, RowMajor,false,ColMajor,false,ColMajor>::run);
+    func[ADJ   | (LEFT  << 2) | (LO << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|UnitDiag,true, RowMajor,Conj, ColMajor,false,ColMajor>::run);
+
+    func[NOTR  | (RIGHT << 2) | (LO << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Lower|UnitDiag,false,ColMajor,false,ColMajor,false,ColMajor>::run);
+    func[TR    | (RIGHT << 2) | (LO << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|UnitDiag,false,ColMajor,false,RowMajor,false,ColMajor>::run);
+    func[ADJ   | (RIGHT << 2) | (LO << 3) | (UNIT  << 4)] = (internal::product_triangular_matrix_matrix<Scalar,DenseIndex,Upper|UnitDiag,false,ColMajor,false,RowMajor,Conj, ColMajor>::run);
+
+    init = true;
+  }
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* b = reinterpret_cast<Scalar*>(pb);
+  Scalar  alpha = *reinterpret_cast<Scalar*>(palpha);
+
+  int info = 0;
+  if(SIDE(*side)==INVALID)                                            info = 1;
+  else if(UPLO(*uplo)==INVALID)                                       info = 2;
+  else if(OP(*opa)==INVALID)                                          info = 3;
+  else if(DIAG(*diag)==INVALID)                                       info = 4;
+  else if(*m<0)                                                       info = 5;
+  else if(*n<0)                                                       info = 6;
+  else if(*lda<std::max(1,(SIDE(*side)==LEFT)?*m:*n))                 info = 9;
+  else if(*ldb<std::max(1,*m))                                        info = 11;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"TRMM ",&info,6);
+
+  int code = OP(*opa) | (SIDE(*side) << 2) | (UPLO(*uplo) << 3) | (DIAG(*diag) << 4);
+
+  if(*m==0 || *n==0)
+    return 1;
+
+  // FIXME find a way to avoid this copy
+  Matrix<Scalar,Dynamic,Dynamic,ColMajor> tmp = matrix(b,*m,*n,*ldb);
+  matrix(b,*m,*n,*ldb).setZero();
+
+  if(SIDE(*side)==LEFT)
+  {
+    internal::gemm_blocking_space<ColMajor,Scalar,Scalar,Dynamic,Dynamic,Dynamic,4> blocking(*m,*n,*m);
+    func[code](*m, *n, *m, a, *lda, tmp.data(), tmp.outerStride(), b, *ldb, alpha, blocking);
+  }
+  else
+  {
+    internal::gemm_blocking_space<ColMajor,Scalar,Scalar,Dynamic,Dynamic,Dynamic,4> blocking(*m,*n,*n);
+    func[code](*m, *n, *n, tmp.data(), tmp.outerStride(), a, *lda, b, *ldb, alpha, blocking);
+  }
+  return 1;
+}
+
+// c = alpha*a*b + beta*c  for side = 'L'or'l'
+// c = alpha*b*a + beta*c  for side = 'R'or'r
+int EIGEN_BLAS_FUNC(symm)(char *side, char *uplo, int *m, int *n, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *pb, int *ldb, RealScalar *pbeta, RealScalar *pc, int *ldc)
+{
+//   std::cerr << "in symm " << *side << " " << *uplo << " " << *m << "x" << *n << " lda:" << *lda << " ldb:" << *ldb << " ldc:" << *ldc << " alpha:" << *palpha << " beta:" << *pbeta << "\n";
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* b = reinterpret_cast<Scalar*>(pb);
+  Scalar* c = reinterpret_cast<Scalar*>(pc);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+  Scalar beta  = *reinterpret_cast<Scalar*>(pbeta);
+
+  int info = 0;
+  if(SIDE(*side)==INVALID)                                            info = 1;
+  else if(UPLO(*uplo)==INVALID)                                       info = 2;
+  else if(*m<0)                                                       info = 3;
+  else if(*n<0)                                                       info = 4;
+  else if(*lda<std::max(1,(SIDE(*side)==LEFT)?*m:*n))                 info = 7;
+  else if(*ldb<std::max(1,*m))                                        info = 9;
+  else if(*ldc<std::max(1,*m))                                        info = 12;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"SYMM ",&info,6);
+
+  if(beta!=Scalar(1))
+  {
+    if(beta==Scalar(0)) matrix(c, *m, *n, *ldc).setZero();
+    else                matrix(c, *m, *n, *ldc) *= beta;
+  }
+
+  if(*m==0 || *n==0)
+  {
+    return 1;
+  }
+
+  #if ISCOMPLEX
+  // FIXME add support for symmetric complex matrix
+  int size = (SIDE(*side)==LEFT) ? (*m) : (*n);
+  Matrix<Scalar,Dynamic,Dynamic,ColMajor> matA(size,size);
+  if(UPLO(*uplo)==UP)
+  {
+    matA.triangularView<Upper>() = matrix(a,size,size,*lda);
+    matA.triangularView<Lower>() = matrix(a,size,size,*lda).transpose();
+  }
+  else if(UPLO(*uplo)==LO)
+  {
+    matA.triangularView<Lower>() = matrix(a,size,size,*lda);
+    matA.triangularView<Upper>() = matrix(a,size,size,*lda).transpose();
+  }
+  if(SIDE(*side)==LEFT)
+    matrix(c, *m, *n, *ldc) += alpha * matA * matrix(b, *m, *n, *ldb);
+  else if(SIDE(*side)==RIGHT)
+    matrix(c, *m, *n, *ldc) += alpha * matrix(b, *m, *n, *ldb) * matA;
+  #else
+  if(SIDE(*side)==LEFT)
+    if(UPLO(*uplo)==UP)       internal::product_selfadjoint_matrix<Scalar, DenseIndex, RowMajor,true,false, ColMajor,false,false, ColMajor>::run(*m, *n, a, *lda, b, *ldb, c, *ldc, alpha);
+    else if(UPLO(*uplo)==LO)  internal::product_selfadjoint_matrix<Scalar, DenseIndex, ColMajor,true,false, ColMajor,false,false, ColMajor>::run(*m, *n, a, *lda, b, *ldb, c, *ldc, alpha);
+    else                      return 0;
+  else if(SIDE(*side)==RIGHT)
+    if(UPLO(*uplo)==UP)       internal::product_selfadjoint_matrix<Scalar, DenseIndex, ColMajor,false,false, RowMajor,true,false, ColMajor>::run(*m, *n, b, *ldb, a, *lda, c, *ldc, alpha);
+    else if(UPLO(*uplo)==LO)  internal::product_selfadjoint_matrix<Scalar, DenseIndex, ColMajor,false,false, ColMajor,true,false, ColMajor>::run(*m, *n, b, *ldb, a, *lda, c, *ldc, alpha);
+    else                      return 0;
+  else
+    return 0;
+  #endif
+
+  return 0;
+}
+
+// c = alpha*a*a' + beta*c  for op = 'N'or'n'
+// c = alpha*a'*a + beta*c  for op = 'T'or't','C'or'c'
+int EIGEN_BLAS_FUNC(syrk)(char *uplo, char *op, int *n, int *k, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *pbeta, RealScalar *pc, int *ldc)
+{
+//   std::cerr << "in syrk " << *uplo << " " << *op << " " << *n << " " << *k << " " << *palpha << " " << *lda << " " << *pbeta << " " << *ldc << "\n";
+  #if !ISCOMPLEX
+  typedef void (*functype)(DenseIndex, DenseIndex, const Scalar *, DenseIndex, const Scalar *, DenseIndex, Scalar *, DenseIndex, const Scalar&);
+  static functype func[8];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<8; ++k)
+      func[k] = 0;
+
+    func[NOTR  | (UP << 2)] = (internal::general_matrix_matrix_triangular_product<DenseIndex,Scalar,ColMajor,false,Scalar,RowMajor,ColMajor,Conj, Upper>::run);
+    func[TR    | (UP << 2)] = (internal::general_matrix_matrix_triangular_product<DenseIndex,Scalar,RowMajor,false,Scalar,ColMajor,ColMajor,Conj, Upper>::run);
+    func[ADJ   | (UP << 2)] = (internal::general_matrix_matrix_triangular_product<DenseIndex,Scalar,RowMajor,Conj, Scalar,ColMajor,ColMajor,false,Upper>::run);
+
+    func[NOTR  | (LO << 2)] = (internal::general_matrix_matrix_triangular_product<DenseIndex,Scalar,ColMajor,false,Scalar,RowMajor,ColMajor,Conj, Lower>::run);
+    func[TR    | (LO << 2)] = (internal::general_matrix_matrix_triangular_product<DenseIndex,Scalar,RowMajor,false,Scalar,ColMajor,ColMajor,Conj, Lower>::run);
+    func[ADJ   | (LO << 2)] = (internal::general_matrix_matrix_triangular_product<DenseIndex,Scalar,RowMajor,Conj, Scalar,ColMajor,ColMajor,false,Lower>::run);
+
+    init = true;
+  }
+  #endif
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* c = reinterpret_cast<Scalar*>(pc);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+  Scalar beta  = *reinterpret_cast<Scalar*>(pbeta);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(OP(*op)==INVALID)                                           info = 2;
+  else if(*n<0)                                                       info = 3;
+  else if(*k<0)                                                       info = 4;
+  else if(*lda<std::max(1,(OP(*op)==NOTR)?*n:*k))                     info = 7;
+  else if(*ldc<std::max(1,*n))                                        info = 10;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"SYRK ",&info,6);
+
+  if(beta!=Scalar(1))
+  {
+    if(UPLO(*uplo)==UP)
+      if(beta==Scalar(0)) matrix(c, *n, *n, *ldc).triangularView<Upper>().setZero();
+      else                matrix(c, *n, *n, *ldc).triangularView<Upper>() *= beta;
+    else
+      if(beta==Scalar(0)) matrix(c, *n, *n, *ldc).triangularView<Lower>().setZero();
+      else                matrix(c, *n, *n, *ldc).triangularView<Lower>() *= beta;
+  }
+
+  #if ISCOMPLEX
+  // FIXME add support for symmetric complex matrix
+  if(UPLO(*uplo)==UP)
+  {
+    if(OP(*op)==NOTR)
+      matrix(c, *n, *n, *ldc).triangularView<Upper>() += alpha * matrix(a,*n,*k,*lda) * matrix(a,*n,*k,*lda).transpose();
+    else
+      matrix(c, *n, *n, *ldc).triangularView<Upper>() += alpha * matrix(a,*k,*n,*lda).transpose() * matrix(a,*k,*n,*lda);
+  }
+  else
+  {
+    if(OP(*op)==NOTR)
+      matrix(c, *n, *n, *ldc).triangularView<Lower>() += alpha * matrix(a,*n,*k,*lda) * matrix(a,*n,*k,*lda).transpose();
+    else
+      matrix(c, *n, *n, *ldc).triangularView<Lower>() += alpha * matrix(a,*k,*n,*lda).transpose() * matrix(a,*k,*n,*lda);
+  }
+  #else
+  int code = OP(*op) | (UPLO(*uplo) << 2);
+  func[code](*n, *k, a, *lda, a, *lda, c, *ldc, alpha);
+  #endif
+
+  return 0;
+}
+
+// c = alpha*a*b' + alpha*b*a' + beta*c  for op = 'N'or'n'
+// c = alpha*a'*b + alpha*b'*a + beta*c  for op = 'T'or't'
+int EIGEN_BLAS_FUNC(syr2k)(char *uplo, char *op, int *n, int *k, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *pb, int *ldb, RealScalar *pbeta, RealScalar *pc, int *ldc)
+{
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* b = reinterpret_cast<Scalar*>(pb);
+  Scalar* c = reinterpret_cast<Scalar*>(pc);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+  Scalar beta  = *reinterpret_cast<Scalar*>(pbeta);
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if(OP(*op)==INVALID)                                           info = 2;
+  else if(*n<0)                                                       info = 3;
+  else if(*k<0)                                                       info = 4;
+  else if(*lda<std::max(1,(OP(*op)==NOTR)?*n:*k))                     info = 7;
+  else if(*ldb<std::max(1,(OP(*op)==NOTR)?*n:*k))                     info = 9;
+  else if(*ldc<std::max(1,*n))                                        info = 12;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"SYR2K",&info,6);
+
+  if(beta!=Scalar(1))
+  {
+    if(UPLO(*uplo)==UP)
+      if(beta==Scalar(0)) matrix(c, *n, *n, *ldc).triangularView<Upper>().setZero();
+      else                matrix(c, *n, *n, *ldc).triangularView<Upper>() *= beta;
+    else
+      if(beta==Scalar(0)) matrix(c, *n, *n, *ldc).triangularView<Lower>().setZero();
+      else                matrix(c, *n, *n, *ldc).triangularView<Lower>() *= beta;
+  }
+
+  if(*k==0)
+    return 1;
+
+  if(OP(*op)==NOTR)
+  {
+    if(UPLO(*uplo)==UP)
+    {
+      matrix(c, *n, *n, *ldc).triangularView<Upper>()
+        += alpha *matrix(a, *n, *k, *lda)*matrix(b, *n, *k, *ldb).transpose()
+        +  alpha*matrix(b, *n, *k, *ldb)*matrix(a, *n, *k, *lda).transpose();
+    }
+    else if(UPLO(*uplo)==LO)
+      matrix(c, *n, *n, *ldc).triangularView<Lower>()
+        += alpha*matrix(a, *n, *k, *lda)*matrix(b, *n, *k, *ldb).transpose()
+        +  alpha*matrix(b, *n, *k, *ldb)*matrix(a, *n, *k, *lda).transpose();
+  }
+  else if(OP(*op)==TR || OP(*op)==ADJ)
+  {
+    if(UPLO(*uplo)==UP)
+      matrix(c, *n, *n, *ldc).triangularView<Upper>()
+        += alpha*matrix(a, *k, *n, *lda).transpose()*matrix(b, *k, *n, *ldb)
+        +  alpha*matrix(b, *k, *n, *ldb).transpose()*matrix(a, *k, *n, *lda);
+    else if(UPLO(*uplo)==LO)
+      matrix(c, *n, *n, *ldc).triangularView<Lower>()
+        += alpha*matrix(a, *k, *n, *lda).transpose()*matrix(b, *k, *n, *ldb)
+        +  alpha*matrix(b, *k, *n, *ldb).transpose()*matrix(a, *k, *n, *lda);
+  }
+
+  return 0;
+}
+
+
+#if ISCOMPLEX
+
+// c = alpha*a*b + beta*c  for side = 'L'or'l'
+// c = alpha*b*a + beta*c  for side = 'R'or'r
+int EIGEN_BLAS_FUNC(hemm)(char *side, char *uplo, int *m, int *n, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *pb, int *ldb, RealScalar *pbeta, RealScalar *pc, int *ldc)
+{
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* b = reinterpret_cast<Scalar*>(pb);
+  Scalar* c = reinterpret_cast<Scalar*>(pc);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+  Scalar beta  = *reinterpret_cast<Scalar*>(pbeta);
+
+//   std::cerr << "in hemm " << *side << " " << *uplo << " " << *m << " " << *n << " " << alpha << " " << *lda << " " << beta << " " << *ldc << "\n";
+
+  int info = 0;
+  if(SIDE(*side)==INVALID)                                            info = 1;
+  else if(UPLO(*uplo)==INVALID)                                       info = 2;
+  else if(*m<0)                                                       info = 3;
+  else if(*n<0)                                                       info = 4;
+  else if(*lda<std::max(1,(SIDE(*side)==LEFT)?*m:*n))                 info = 7;
+  else if(*ldb<std::max(1,*m))                                        info = 9;
+  else if(*ldc<std::max(1,*m))                                        info = 12;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"HEMM ",&info,6);
+
+  if(beta==Scalar(0))       matrix(c, *m, *n, *ldc).setZero();
+  else if(beta!=Scalar(1))  matrix(c, *m, *n, *ldc) *= beta;
+
+  if(*m==0 || *n==0)
+  {
+    return 1;
+  }
+
+  if(SIDE(*side)==LEFT)
+  {
+    if(UPLO(*uplo)==UP)       internal::product_selfadjoint_matrix<Scalar,DenseIndex,RowMajor,true,Conj,  ColMajor,false,false, ColMajor>
+                                ::run(*m, *n, a, *lda, b, *ldb, c, *ldc, alpha);
+    else if(UPLO(*uplo)==LO)  internal::product_selfadjoint_matrix<Scalar,DenseIndex,ColMajor,true,false, ColMajor,false,false, ColMajor>
+                                ::run(*m, *n, a, *lda, b, *ldb, c, *ldc, alpha);
+    else                      return 0;
+  }
+  else if(SIDE(*side)==RIGHT)
+  {
+    if(UPLO(*uplo)==UP)       matrix(c,*m,*n,*ldc) += alpha * matrix(b,*m,*n,*ldb) * matrix(a,*n,*n,*lda).selfadjointView<Upper>();/*internal::product_selfadjoint_matrix<Scalar,DenseIndex,ColMajor,false,false, RowMajor,true,Conj,  ColMajor>
+                                ::run(*m, *n, b, *ldb, a, *lda, c, *ldc, alpha);*/
+    else if(UPLO(*uplo)==LO)  internal::product_selfadjoint_matrix<Scalar,DenseIndex,ColMajor,false,false, ColMajor,true,false, ColMajor>
+                                ::run(*m, *n, b, *ldb, a, *lda, c, *ldc, alpha);
+    else                      return 0;
+  }
+  else
+  {
+    return 0;
+  }
+
+  return 0;
+}
+
+// c = alpha*a*conj(a') + beta*c  for op = 'N'or'n'
+// c = alpha*conj(a')*a + beta*c  for op  = 'C'or'c'
+int EIGEN_BLAS_FUNC(herk)(char *uplo, char *op, int *n, int *k, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *pbeta, RealScalar *pc, int *ldc)
+{
+  typedef void (*functype)(DenseIndex, DenseIndex, const Scalar *, DenseIndex, const Scalar *, DenseIndex, Scalar *, DenseIndex, const Scalar&);
+  static functype func[8];
+
+  static bool init = false;
+  if(!init)
+  {
+    for(int k=0; k<8; ++k)
+      func[k] = 0;
+
+    func[NOTR  | (UP << 2)] = (internal::general_matrix_matrix_triangular_product<DenseIndex,Scalar,ColMajor,false,Scalar,RowMajor,Conj, ColMajor,Upper>::run);
+    func[ADJ   | (UP << 2)] = (internal::general_matrix_matrix_triangular_product<DenseIndex,Scalar,RowMajor,Conj, Scalar,ColMajor,false,ColMajor,Upper>::run);
+
+    func[NOTR  | (LO << 2)] = (internal::general_matrix_matrix_triangular_product<DenseIndex,Scalar,ColMajor,false,Scalar,RowMajor,Conj, ColMajor,Lower>::run);
+    func[ADJ   | (LO << 2)] = (internal::general_matrix_matrix_triangular_product<DenseIndex,Scalar,RowMajor,Conj, Scalar,ColMajor,false,ColMajor,Lower>::run);
+
+    init = true;
+  }
+
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* c = reinterpret_cast<Scalar*>(pc);
+  RealScalar alpha = *palpha;
+  RealScalar beta  = *pbeta;
+
+//   std::cerr << "in herk " << *uplo << " " << *op << " " << *n << " " << *k << " " << alpha << " " << *lda << " " << beta << " " << *ldc << "\n";
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if((OP(*op)==INVALID) || (OP(*op)==TR))                        info = 2;
+  else if(*n<0)                                                       info = 3;
+  else if(*k<0)                                                       info = 4;
+  else if(*lda<std::max(1,(OP(*op)==NOTR)?*n:*k))                     info = 7;
+  else if(*ldc<std::max(1,*n))                                        info = 10;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"HERK ",&info,6);
+
+  int code = OP(*op) | (UPLO(*uplo) << 2);
+
+  if(beta!=RealScalar(1))
+  {
+    if(UPLO(*uplo)==UP)
+      if(beta==Scalar(0)) matrix(c, *n, *n, *ldc).triangularView<Upper>().setZero();
+      else                matrix(c, *n, *n, *ldc).triangularView<StrictlyUpper>() *= beta;
+    else
+      if(beta==Scalar(0)) matrix(c, *n, *n, *ldc).triangularView<Lower>().setZero();
+      else                matrix(c, *n, *n, *ldc).triangularView<StrictlyLower>() *= beta;
+  
+    if(beta!=Scalar(0))
+    {
+      matrix(c, *n, *n, *ldc).diagonal().real() *= beta;
+      matrix(c, *n, *n, *ldc).diagonal().imag().setZero();
+    }
+  }
+
+  if(*k>0 && alpha!=RealScalar(0))
+  {
+    func[code](*n, *k, a, *lda, a, *lda, c, *ldc, alpha);
+    matrix(c, *n, *n, *ldc).diagonal().imag().setZero();
+  }
+  return 0;
+}
+
+// c = alpha*a*conj(b') + conj(alpha)*b*conj(a') + beta*c,  for op = 'N'or'n'
+// c = alpha*conj(a')*b + conj(alpha)*conj(b')*a + beta*c,  for op = 'C'or'c'
+int EIGEN_BLAS_FUNC(her2k)(char *uplo, char *op, int *n, int *k, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *pb, int *ldb, RealScalar *pbeta, RealScalar *pc, int *ldc)
+{
+  Scalar* a = reinterpret_cast<Scalar*>(pa);
+  Scalar* b = reinterpret_cast<Scalar*>(pb);
+  Scalar* c = reinterpret_cast<Scalar*>(pc);
+  Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
+  RealScalar beta  = *pbeta;
+
+  int info = 0;
+  if(UPLO(*uplo)==INVALID)                                            info = 1;
+  else if((OP(*op)==INVALID) || (OP(*op)==TR))                        info = 2;
+  else if(*n<0)                                                       info = 3;
+  else if(*k<0)                                                       info = 4;
+  else if(*lda<std::max(1,(OP(*op)==NOTR)?*n:*k))                     info = 7;
+  else if(*lda<std::max(1,(OP(*op)==NOTR)?*n:*k))                     info = 9;
+  else if(*ldc<std::max(1,*n))                                        info = 12;
+  if(info)
+    return xerbla_(SCALAR_SUFFIX_UP"HER2K",&info,6);
+
+  if(beta!=RealScalar(1))
+  {
+    if(UPLO(*uplo)==UP)
+      if(beta==Scalar(0)) matrix(c, *n, *n, *ldc).triangularView<Upper>().setZero();
+      else                matrix(c, *n, *n, *ldc).triangularView<StrictlyUpper>() *= beta;
+    else
+      if(beta==Scalar(0)) matrix(c, *n, *n, *ldc).triangularView<Lower>().setZero();
+      else                matrix(c, *n, *n, *ldc).triangularView<StrictlyLower>() *= beta;
+
+    if(beta!=Scalar(0))
+    {
+      matrix(c, *n, *n, *ldc).diagonal().real() *= beta;
+      matrix(c, *n, *n, *ldc).diagonal().imag().setZero();
+    }
+  }
+  else if(*k>0 && alpha!=Scalar(0))
+    matrix(c, *n, *n, *ldc).diagonal().imag().setZero();
+
+  if(*k==0)
+    return 1;
+
+  if(OP(*op)==NOTR)
+  {
+    if(UPLO(*uplo)==UP)
+    {
+      matrix(c, *n, *n, *ldc).triangularView<Upper>()
+        +=            alpha *matrix(a, *n, *k, *lda)*matrix(b, *n, *k, *ldb).adjoint()
+        +  numext::conj(alpha)*matrix(b, *n, *k, *ldb)*matrix(a, *n, *k, *lda).adjoint();
+    }
+    else if(UPLO(*uplo)==LO)
+      matrix(c, *n, *n, *ldc).triangularView<Lower>()
+        += alpha*matrix(a, *n, *k, *lda)*matrix(b, *n, *k, *ldb).adjoint()
+        +  numext::conj(alpha)*matrix(b, *n, *k, *ldb)*matrix(a, *n, *k, *lda).adjoint();
+  }
+  else if(OP(*op)==ADJ)
+  {
+    if(UPLO(*uplo)==UP)
+      matrix(c, *n, *n, *ldc).triangularView<Upper>()
+        +=             alpha*matrix(a, *k, *n, *lda).adjoint()*matrix(b, *k, *n, *ldb)
+        +  numext::conj(alpha)*matrix(b, *k, *n, *ldb).adjoint()*matrix(a, *k, *n, *lda);
+    else if(UPLO(*uplo)==LO)
+      matrix(c, *n, *n, *ldc).triangularView<Lower>()
+        +=             alpha*matrix(a, *k, *n, *lda).adjoint()*matrix(b, *k, *n, *ldb)
+        +  numext::conj(alpha)*matrix(b, *k, *n, *ldb).adjoint()*matrix(a, *k, *n, *lda);
+  }
+
+  return 1;
+}
+
+#endif // ISCOMPLEX
diff --git a/eigen/blas/lsame.f b/eigen/blas/lsame.f
new file mode 100644
index 0000000..f536902
--- /dev/null
+++ b/eigen/blas/lsame.f
@@ -0,0 +1,85 @@
+      LOGICAL FUNCTION LSAME(CA,CB)
+*
+*  -- LAPACK auxiliary routine (version 3.1) --
+*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+*     November 2006
+*
+*     .. 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
+*     ..
+*
+*     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
diff --git a/eigen/blas/single.cpp b/eigen/blas/single.cpp
new file mode 100644
index 0000000..836e3ee
--- /dev/null
+++ b/eigen/blas/single.cpp
@@ -0,0 +1,22 @@
+// This file is part of Eigen, a lightweight C++ template library
+// for linear algebra.
+//
+// Copyright (C) 2009 Gael Guennebaud <gael.guennebaud@inria.fr>
+//
+// This Source Code Form is subject to the terms of the Mozilla
+// Public License v. 2.0. If a copy of the MPL was not distributed
+// with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+#define SCALAR        float
+#define SCALAR_SUFFIX s
+#define SCALAR_SUFFIX_UP "S"
+#define ISCOMPLEX     0
+
+#include "level1_impl.h"
+#include "level1_real_impl.h"
+#include "level2_impl.h"
+#include "level2_real_impl.h"
+#include "level3_impl.h"
+
+float BLASFUNC(sdsdot)(int* n, float* alpha, float* x, int* incx, float* y, int* incy)
+{ return *alpha + BLASFUNC(dsdot)(n, x, incx, y, incy); }
diff --git a/eigen/blas/srotm.f b/eigen/blas/srotm.f
new file mode 100644
index 0000000..fc5a593
--- /dev/null
+++ b/eigen/blas/srotm.f
@@ -0,0 +1,148 @@
+      SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM)
+*     .. Scalar Arguments ..
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      REAL SPARAM(5),SX(*),SY(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*     APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
+*
+*     (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
+*     (DX**T)
+*
+*     SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
+*     LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
+*     WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+*
+*     SFLAG=-1.E0     SFLAG=0.E0        SFLAG=1.E0     SFLAG=-2.E0
+*
+*       (SH11  SH12)    (1.E0  SH12)    (SH11  1.E0)    (1.E0  0.E0)
+*     H=(          )    (          )    (          )    (          )
+*       (SH21  SH22),   (SH21  1.E0),   (-1.E0 SH22),   (0.E0  1.E0).
+*     SEE  SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
+*
+*
+*  Arguments
+*  =========
+*
+*  N      (input) INTEGER
+*         number of elements in input vector(s)
+*
+*  SX     (input/output) REAL array, dimension N
+*         double precision vector with N elements
+*
+*  INCX   (input) INTEGER
+*         storage spacing between elements of SX
+*
+*  SY     (input/output) REAL array, dimension N
+*         double precision vector with N elements
+*
+*  INCY   (input) INTEGER
+*         storage spacing between elements of SY
+*
+*  SPARAM (input/output)  REAL array, dimension 5
+*     SPARAM(1)=SFLAG
+*     SPARAM(2)=SH11
+*     SPARAM(3)=SH21
+*     SPARAM(4)=SH12
+*     SPARAM(5)=SH22
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO
+      INTEGER I,KX,KY,NSTEPS
+*     ..
+*     .. Data statements ..
+      DATA ZERO,TWO/0.E0,2.E0/
+*     ..
+*
+      SFLAG = SPARAM(1)
+      IF (N.LE.0 .OR. (SFLAG+TWO.EQ.ZERO)) GO TO 140
+      IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70
+*
+      NSTEPS = N*INCX
+      IF (SFLAG) 50,10,30
+   10 CONTINUE
+      SH12 = SPARAM(4)
+      SH21 = SPARAM(3)
+      DO 20 I = 1,NSTEPS,INCX
+          W = SX(I)
+          Z = SY(I)
+          SX(I) = W + Z*SH12
+          SY(I) = W*SH21 + Z
+   20 CONTINUE
+      GO TO 140
+   30 CONTINUE
+      SH11 = SPARAM(2)
+      SH22 = SPARAM(5)
+      DO 40 I = 1,NSTEPS,INCX
+          W = SX(I)
+          Z = SY(I)
+          SX(I) = W*SH11 + Z
+          SY(I) = -W + SH22*Z
+   40 CONTINUE
+      GO TO 140
+   50 CONTINUE
+      SH11 = SPARAM(2)
+      SH12 = SPARAM(4)
+      SH21 = SPARAM(3)
+      SH22 = SPARAM(5)
+      DO 60 I = 1,NSTEPS,INCX
+          W = SX(I)
+          Z = SY(I)
+          SX(I) = W*SH11 + Z*SH12
+          SY(I) = W*SH21 + Z*SH22
+   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)*INCY
+*
+      IF (SFLAG) 120,80,100
+   80 CONTINUE
+      SH12 = SPARAM(4)
+      SH21 = SPARAM(3)
+      DO 90 I = 1,N
+          W = SX(KX)
+          Z = SY(KY)
+          SX(KX) = W + Z*SH12
+          SY(KY) = W*SH21 + Z
+          KX = KX + INCX
+          KY = KY + INCY
+   90 CONTINUE
+      GO TO 140
+  100 CONTINUE
+      SH11 = SPARAM(2)
+      SH22 = SPARAM(5)
+      DO 110 I = 1,N
+          W = SX(KX)
+          Z = SY(KY)
+          SX(KX) = W*SH11 + Z
+          SY(KY) = -W + SH22*Z
+          KX = KX + INCX
+          KY = KY + INCY
+  110 CONTINUE
+      GO TO 140
+  120 CONTINUE
+      SH11 = SPARAM(2)
+      SH12 = SPARAM(4)
+      SH21 = SPARAM(3)
+      SH22 = SPARAM(5)
+      DO 130 I = 1,N
+          W = SX(KX)
+          Z = SY(KY)
+          SX(KX) = W*SH11 + Z*SH12
+          SY(KY) = W*SH21 + Z*SH22
+          KX = KX + INCX
+          KY = KY + INCY
+  130 CONTINUE
+  140 CONTINUE
+      RETURN
+      END
diff --git a/eigen/blas/srotmg.f b/eigen/blas/srotmg.f
new file mode 100644
index 0000000..7b3bd42
--- /dev/null
+++ b/eigen/blas/srotmg.f
@@ -0,0 +1,208 @@
+      SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM)
+*     .. Scalar Arguments ..
+      REAL SD1,SD2,SX1,SY1
+*     ..
+*     .. Array Arguments ..
+      REAL SPARAM(5)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*     CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
+*     THE SECOND COMPONENT OF THE 2-VECTOR  (SQRT(SD1)*SX1,SQRT(SD2)*
+*     SY2)**T.
+*     WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+*
+*     SFLAG=-1.E0     SFLAG=0.E0        SFLAG=1.E0     SFLAG=-2.E0
+*
+*       (SH11  SH12)    (1.E0  SH12)    (SH11  1.E0)    (1.E0  0.E0)
+*     H=(          )    (          )    (          )    (          )
+*       (SH21  SH22),   (SH21  1.E0),   (-1.E0 SH22),   (0.E0  1.E0).
+*     LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22
+*     RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE
+*     VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.)
+*
+*     THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
+*     INEXACT.  THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
+*     OF SD1 AND SD2.  ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
+*
+*
+*  Arguments
+*  =========
+*
+*
+*  SD1    (input/output) REAL
+*
+*  SD2    (input/output) REAL
+*
+*  SX1    (input/output) REAL
+*
+*  SY1    (input) REAL
+*
+*
+*  SPARAM (input/output)  REAL array, dimension 5
+*     SPARAM(1)=SFLAG
+*     SPARAM(2)=SH11
+*     SPARAM(3)=SH21
+*     SPARAM(4)=SH12
+*     SPARAM(5)=SH22
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL GAM,GAMSQ,ONE,RGAMSQ,SFLAG,SH11,SH12,SH21,SH22,SP1,SP2,SQ1,
+     +     SQ2,STEMP,SU,TWO,ZERO
+      INTEGER IGO
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS
+*     ..
+*     .. Data statements ..
+*
+      DATA ZERO,ONE,TWO/0.E0,1.E0,2.E0/
+      DATA GAM,GAMSQ,RGAMSQ/4096.E0,1.67772E7,5.96046E-8/
+*     ..
+
+      IF (.NOT.SD1.LT.ZERO) GO TO 10
+*       GO ZERO-H-D-AND-SX1..
+      GO TO 60
+   10 CONTINUE
+*     CASE-SD1-NONNEGATIVE
+      SP2 = SD2*SY1
+      IF (.NOT.SP2.EQ.ZERO) GO TO 20
+      SFLAG = -TWO
+      GO TO 260
+*     REGULAR-CASE..
+   20 CONTINUE
+      SP1 = SD1*SX1
+      SQ2 = SP2*SY1
+      SQ1 = SP1*SX1
+*
+      IF (.NOT.ABS(SQ1).GT.ABS(SQ2)) GO TO 40
+      SH21 = -SY1/SX1
+      SH12 = SP2/SP1
+*
+      SU = ONE - SH12*SH21
+*
+      IF (.NOT.SU.LE.ZERO) GO TO 30
+*         GO ZERO-H-D-AND-SX1..
+      GO TO 60
+   30 CONTINUE
+      SFLAG = ZERO
+      SD1 = SD1/SU
+      SD2 = SD2/SU
+      SX1 = SX1*SU
+*         GO SCALE-CHECK..
+      GO TO 100
+   40 CONTINUE
+      IF (.NOT.SQ2.LT.ZERO) GO TO 50
+*         GO ZERO-H-D-AND-SX1..
+      GO TO 60
+   50 CONTINUE
+      SFLAG = ONE
+      SH11 = SP1/SP2
+      SH22 = SX1/SY1
+      SU = ONE + SH11*SH22
+      STEMP = SD2/SU
+      SD2 = SD1/SU
+      SD1 = STEMP
+      SX1 = SY1*SU
+*         GO SCALE-CHECK
+      GO TO 100
+*     PROCEDURE..ZERO-H-D-AND-SX1..
+   60 CONTINUE
+      SFLAG = -ONE
+      SH11 = ZERO
+      SH12 = ZERO
+      SH21 = ZERO
+      SH22 = ZERO
+*
+      SD1 = ZERO
+      SD2 = ZERO
+      SX1 = ZERO
+*         RETURN..
+      GO TO 220
+*     PROCEDURE..FIX-H..
+   70 CONTINUE
+      IF (.NOT.SFLAG.GE.ZERO) GO TO 90
+*
+      IF (.NOT.SFLAG.EQ.ZERO) GO TO 80
+      SH11 = ONE
+      SH22 = ONE
+      SFLAG = -ONE
+      GO TO 90
+   80 CONTINUE
+      SH21 = -ONE
+      SH12 = ONE
+      SFLAG = -ONE
+   90 CONTINUE
+      GO TO IGO(120,150,180,210)
+*     PROCEDURE..SCALE-CHECK
+  100 CONTINUE
+  110 CONTINUE
+      IF (.NOT.SD1.LE.RGAMSQ) GO TO 130
+      IF (SD1.EQ.ZERO) GO TO 160
+      ASSIGN 120 TO IGO
+*              FIX-H..
+      GO TO 70
+  120 CONTINUE
+      SD1 = SD1*GAM**2
+      SX1 = SX1/GAM
+      SH11 = SH11/GAM
+      SH12 = SH12/GAM
+      GO TO 110
+  130 CONTINUE
+  140 CONTINUE
+      IF (.NOT.SD1.GE.GAMSQ) GO TO 160
+      ASSIGN 150 TO IGO
+*              FIX-H..
+      GO TO 70
+  150 CONTINUE
+      SD1 = SD1/GAM**2
+      SX1 = SX1*GAM
+      SH11 = SH11*GAM
+      SH12 = SH12*GAM
+      GO TO 140
+  160 CONTINUE
+  170 CONTINUE
+      IF (.NOT.ABS(SD2).LE.RGAMSQ) GO TO 190
+      IF (SD2.EQ.ZERO) GO TO 220
+      ASSIGN 180 TO IGO
+*              FIX-H..
+      GO TO 70
+  180 CONTINUE
+      SD2 = SD2*GAM**2
+      SH21 = SH21/GAM
+      SH22 = SH22/GAM
+      GO TO 170
+  190 CONTINUE
+  200 CONTINUE
+      IF (.NOT.ABS(SD2).GE.GAMSQ) GO TO 220
+      ASSIGN 210 TO IGO
+*              FIX-H..
+      GO TO 70
+  210 CONTINUE
+      SD2 = SD2/GAM**2
+      SH21 = SH21*GAM
+      SH22 = SH22*GAM
+      GO TO 200
+  220 CONTINUE
+      IF (SFLAG) 250,230,240
+  230 CONTINUE
+      SPARAM(3) = SH21
+      SPARAM(4) = SH12
+      GO TO 260
+  240 CONTINUE
+      SPARAM(2) = SH11
+      SPARAM(5) = SH22
+      GO TO 260
+  250 CONTINUE
+      SPARAM(2) = SH11
+      SPARAM(3) = SH21
+      SPARAM(4) = SH12
+      SPARAM(5) = SH22
+  260 CONTINUE
+      SPARAM(1) = SFLAG
+      RETURN
+      END
diff --git a/eigen/blas/ssbmv.f b/eigen/blas/ssbmv.f
new file mode 100644
index 0000000..16893a2
--- /dev/null
+++ b/eigen/blas/ssbmv.f
@@ -0,0 +1,306 @@
+      SUBROUTINE SSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*     .. Scalar Arguments ..
+      REAL ALPHA,BETA
+      INTEGER INCX,INCY,K,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      REAL A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  SSBMV  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.
+*
+*  Arguments
+*  ==========
+*
+*  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  - REAL            .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - REAL             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      - REAL             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   - REAL            .
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  Y      - REAL             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.
+*
+*  Further Details
+*  ===============
+*
+*  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 ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL 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
+*     ..
+*
+*     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('SSBMV ',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 SSBMV .
+*
+      END
diff --git a/eigen/blas/sspmv.f b/eigen/blas/sspmv.f
new file mode 100644
index 0000000..0b84498
--- /dev/null
+++ b/eigen/blas/sspmv.f
@@ -0,0 +1,265 @@
+      SUBROUTINE SSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
+*     .. Scalar Arguments ..
+      REAL ALPHA,BETA
+      INTEGER INCX,INCY,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      REAL AP(*),X(*),Y(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  SSPMV  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.
+*
+*  Arguments
+*  ==========
+*
+*  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  - REAL            .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  AP     - REAL             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      - REAL             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   - REAL            .
+*           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      - REAL             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.
+*
+*  Further Details
+*  ===============
+*
+*  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 ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*
+*     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('SSPMV ',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 SSPMV .
+*
+      END
diff --git a/eigen/blas/stbmv.f b/eigen/blas/stbmv.f
new file mode 100644
index 0000000..c0b8f11
--- /dev/null
+++ b/eigen/blas/stbmv.f
@@ -0,0 +1,335 @@
+      SUBROUTINE STBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+*     .. Scalar Arguments ..
+      INTEGER INCX,K,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      REAL A(LDA,*),X(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  STBMV  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.
+*
+*  Arguments
+*  ==========
+*
+*  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      - REAL             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      - REAL             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.
+*
+*  Further Details
+*  ===============
+*
+*  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 ..
+      REAL ZERO
+      PARAMETER (ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL 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
+*     ..
+*
+*     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('STBMV ',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 STBMV .
+*
+      END
diff --git a/eigen/blas/testing/CMakeLists.txt b/eigen/blas/testing/CMakeLists.txt
new file mode 100644
index 0000000..3ab8026
--- /dev/null
+++ b/eigen/blas/testing/CMakeLists.txt
@@ -0,0 +1,40 @@
+
+macro(ei_add_blas_test testname)
+
+  set(targetname ${testname})
+
+  set(filename ${testname}.f)
+  add_executable(${targetname} ${filename})
+
+  target_link_libraries(${targetname} eigen_blas)
+
+  if(EIGEN_STANDARD_LIBRARIES_TO_LINK_TO)
+    target_link_libraries(${targetname} ${EIGEN_STANDARD_LIBRARIES_TO_LINK_TO})
+  endif()
+
+  target_link_libraries(${targetname} ${EXTERNAL_LIBS})
+
+  add_test(${testname} "${Eigen_SOURCE_DIR}/blas/testing/runblastest.sh" "${testname}" "${Eigen_SOURCE_DIR}/blas/testing/${testname}.dat")
+  add_dependencies(buildtests ${targetname})
+  
+endmacro(ei_add_blas_test)
+
+ei_add_blas_test(sblat1)
+ei_add_blas_test(sblat2)
+ei_add_blas_test(sblat3)
+
+ei_add_blas_test(dblat1)
+ei_add_blas_test(dblat2)
+ei_add_blas_test(dblat3)
+
+ei_add_blas_test(cblat1)
+ei_add_blas_test(cblat2)
+ei_add_blas_test(cblat3)
+
+ei_add_blas_test(zblat1)
+ei_add_blas_test(zblat2)
+ei_add_blas_test(zblat3)
+
+# add_custom_target(level1)
+# add_dependencies(level1 sblat1)
+
diff --git a/eigen/blas/testing/cblat1.f b/eigen/blas/testing/cblat1.f
new file mode 100644
index 0000000..a4c996f
--- /dev/null
+++ b/eigen/blas/testing/cblat1.f
@@ -0,0 +1,681 @@
+      PROGRAM CBLAT1
+*     Test program for the COMPLEX    Level 1 BLAS.
+*     Based upon the original BLAS test routine together with:
+*     F06GAF Example Program Text
+*     .. Parameters ..
+      INTEGER          NOUT
+      PARAMETER        (NOUT=6)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, MODE, N
+      LOGICAL          PASS
+*     .. Local Scalars ..
+      REAL             SFAC
+      INTEGER          IC
+*     .. External Subroutines ..
+      EXTERNAL         CHECK1, CHECK2, HEADER
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Data statements ..
+      DATA             SFAC/9.765625E-4/
+*     .. Executable Statements ..
+      WRITE (NOUT,99999)
+      DO 20 IC = 1, 10
+         ICASE = IC
+         CALL HEADER
+*
+*        Initialize PASS, INCX, INCY, and MODE for a new case.
+*        The value 9999 for INCX, INCY or MODE will appear in the
+*        detailed  output, if any, for cases that do not involve
+*        these parameters.
+*
+         PASS = .TRUE.
+         INCX = 9999
+         INCY = 9999
+         MODE = 9999
+         IF (ICASE.LE.5) THEN
+            CALL CHECK2(SFAC)
+         ELSE IF (ICASE.GE.6) THEN
+            CALL CHECK1(SFAC)
+         END IF
+*        -- Print
+         IF (PASS) WRITE (NOUT,99998)
+   20 CONTINUE
+      STOP
+*
+99999 FORMAT (' Complex BLAS Test Program Results',/1X)
+99998 FORMAT ('                                    ----- PASS -----')
+      END
+      SUBROUTINE HEADER
+*     .. Parameters ..
+      INTEGER          NOUT
+      PARAMETER        (NOUT=6)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, MODE, N
+      LOGICAL          PASS
+*     .. Local Arrays ..
+      CHARACTER*6      L(10)
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Data statements ..
+      DATA             L(1)/'CDOTC '/
+      DATA             L(2)/'CDOTU '/
+      DATA             L(3)/'CAXPY '/
+      DATA             L(4)/'CCOPY '/
+      DATA             L(5)/'CSWAP '/
+      DATA             L(6)/'SCNRM2'/
+      DATA             L(7)/'SCASUM'/
+      DATA             L(8)/'CSCAL '/
+      DATA             L(9)/'CSSCAL'/
+      DATA             L(10)/'ICAMAX'/
+*     .. Executable Statements ..
+      WRITE (NOUT,99999) ICASE, L(ICASE)
+      RETURN
+*
+99999 FORMAT (/' Test of subprogram number',I3,12X,A6)
+      END
+      SUBROUTINE CHECK1(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      REAL              SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, MODE, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      COMPLEX           CA
+      REAL              SA
+      INTEGER           I, J, LEN, NP1
+*     .. Local Arrays ..
+      COMPLEX           CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
+     +                  MWPCS(5), MWPCT(5)
+      REAL              STRUE2(5), STRUE4(5)
+      INTEGER           ITRUE3(5)
+*     .. External Functions ..
+      REAL              SCASUM, SCNRM2
+      INTEGER           ICAMAX
+      EXTERNAL          SCASUM, SCNRM2, ICAMAX
+*     .. External Subroutines ..
+      EXTERNAL          CSCAL, CSSCAL, CTEST, ITEST1, STEST1
+*     .. Intrinsic Functions ..
+      INTRINSIC         MAX
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Data statements ..
+      DATA              SA, CA/0.3E0, (0.4E0,-0.7E0)/
+      DATA              ((CV(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
+     +                  (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
+     +                  (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
+     +                  (1.0E0,2.0E0), (0.3E0,-0.4E0), (3.0E0,4.0E0),
+     +                  (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
+     +                  (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
+     +                  (0.1E0,-0.3E0), (0.5E0,-0.1E0), (5.0E0,6.0E0),
+     +                  (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
+     +                  (5.0E0,6.0E0), (5.0E0,6.0E0), (0.1E0,0.1E0),
+     +                  (-0.6E0,0.1E0), (0.1E0,-0.3E0), (7.0E0,8.0E0),
+     +                  (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
+     +                  (7.0E0,8.0E0), (0.3E0,0.1E0), (0.1E0,0.4E0),
+     +                  (0.4E0,0.1E0), (0.1E0,0.2E0), (2.0E0,3.0E0),
+     +                  (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/
+      DATA              ((CV(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
+     +                  (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
+     +                  (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
+     +                  (4.0E0,5.0E0), (0.3E0,-0.4E0), (6.0E0,7.0E0),
+     +                  (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
+     +                  (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
+     +                  (0.1E0,-0.3E0), (8.0E0,9.0E0), (0.5E0,-0.1E0),
+     +                  (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
+     +                  (2.0E0,5.0E0), (2.0E0,5.0E0), (0.1E0,0.1E0),
+     +                  (3.0E0,6.0E0), (-0.6E0,0.1E0), (4.0E0,7.0E0),
+     +                  (0.1E0,-0.3E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
+     +                  (7.0E0,2.0E0), (0.3E0,0.1E0), (5.0E0,8.0E0),
+     +                  (0.1E0,0.4E0), (6.0E0,9.0E0), (0.4E0,0.1E0),
+     +                  (8.0E0,3.0E0), (0.1E0,0.2E0), (9.0E0,4.0E0)/
+      DATA              STRUE2/0.0E0, 0.5E0, 0.6E0, 0.7E0, 0.7E0/
+      DATA              STRUE4/0.0E0, 0.7E0, 1.0E0, 1.3E0, 1.7E0/
+      DATA              ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
+     +                  (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
+     +                  (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
+     +                  (1.0E0,2.0E0), (-0.16E0,-0.37E0), (3.0E0,4.0E0),
+     +                  (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
+     +                  (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
+     +                  (-0.17E0,-0.19E0), (0.13E0,-0.39E0),
+     +                  (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
+     +                  (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
+     +                  (0.11E0,-0.03E0), (-0.17E0,0.46E0),
+     +                  (-0.17E0,-0.19E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
+     +                  (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
+     +                  (0.19E0,-0.17E0), (0.32E0,0.09E0),
+     +                  (0.23E0,-0.24E0), (0.18E0,0.01E0),
+     +                  (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0),
+     +                  (2.0E0,3.0E0)/
+      DATA              ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
+     +                  (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
+     +                  (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
+     +                  (4.0E0,5.0E0), (-0.16E0,-0.37E0), (6.0E0,7.0E0),
+     +                  (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
+     +                  (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
+     +                  (-0.17E0,-0.19E0), (8.0E0,9.0E0),
+     +                  (0.13E0,-0.39E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
+     +                  (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
+     +                  (0.11E0,-0.03E0), (3.0E0,6.0E0),
+     +                  (-0.17E0,0.46E0), (4.0E0,7.0E0),
+     +                  (-0.17E0,-0.19E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
+     +                  (7.0E0,2.0E0), (0.19E0,-0.17E0), (5.0E0,8.0E0),
+     +                  (0.32E0,0.09E0), (6.0E0,9.0E0),
+     +                  (0.23E0,-0.24E0), (8.0E0,3.0E0),
+     +                  (0.18E0,0.01E0), (9.0E0,4.0E0)/
+      DATA              ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
+     +                  (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
+     +                  (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
+     +                  (1.0E0,2.0E0), (0.09E0,-0.12E0), (3.0E0,4.0E0),
+     +                  (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
+     +                  (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
+     +                  (0.03E0,-0.09E0), (0.15E0,-0.03E0),
+     +                  (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
+     +                  (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
+     +                  (0.03E0,0.03E0), (-0.18E0,0.03E0),
+     +                  (0.03E0,-0.09E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
+     +                  (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
+     +                  (0.09E0,0.03E0), (0.03E0,0.12E0),
+     +                  (0.12E0,0.03E0), (0.03E0,0.06E0), (2.0E0,3.0E0),
+     +                  (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/
+      DATA              ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
+     +                  (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
+     +                  (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
+     +                  (4.0E0,5.0E0), (0.09E0,-0.12E0), (6.0E0,7.0E0),
+     +                  (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
+     +                  (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
+     +                  (0.03E0,-0.09E0), (8.0E0,9.0E0),
+     +                  (0.15E0,-0.03E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
+     +                  (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
+     +                  (0.03E0,0.03E0), (3.0E0,6.0E0),
+     +                  (-0.18E0,0.03E0), (4.0E0,7.0E0),
+     +                  (0.03E0,-0.09E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
+     +                  (7.0E0,2.0E0), (0.09E0,0.03E0), (5.0E0,8.0E0),
+     +                  (0.03E0,0.12E0), (6.0E0,9.0E0), (0.12E0,0.03E0),
+     +                  (8.0E0,3.0E0), (0.03E0,0.06E0), (9.0E0,4.0E0)/
+      DATA              ITRUE3/0, 1, 2, 2, 2/
+*     .. Executable Statements ..
+      DO 60 INCX = 1, 2
+         DO 40 NP1 = 1, 5
+            N = NP1 - 1
+            LEN = 2*MAX(N,1)
+*           .. Set vector arguments ..
+            DO 20 I = 1, LEN
+               CX(I) = CV(I,NP1,INCX)
+   20       CONTINUE
+            IF (ICASE.EQ.6) THEN
+*              .. SCNRM2 ..
+               CALL STEST1(SCNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1),
+     +                     SFAC)
+            ELSE IF (ICASE.EQ.7) THEN
+*              .. SCASUM ..
+               CALL STEST1(SCASUM(N,CX,INCX),STRUE4(NP1),STRUE4(NP1),
+     +                     SFAC)
+            ELSE IF (ICASE.EQ.8) THEN
+*              .. CSCAL ..
+               CALL CSCAL(N,CA,CX,INCX)
+               CALL CTEST(LEN,CX,CTRUE5(1,NP1,INCX),CTRUE5(1,NP1,INCX),
+     +                    SFAC)
+            ELSE IF (ICASE.EQ.9) THEN
+*              .. CSSCAL ..
+               CALL CSSCAL(N,SA,CX,INCX)
+               CALL CTEST(LEN,CX,CTRUE6(1,NP1,INCX),CTRUE6(1,NP1,INCX),
+     +                    SFAC)
+            ELSE IF (ICASE.EQ.10) THEN
+*              .. ICAMAX ..
+               CALL ITEST1(ICAMAX(N,CX,INCX),ITRUE3(NP1))
+            ELSE
+               WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
+               STOP
+            END IF
+*
+   40    CONTINUE
+   60 CONTINUE
+*
+      INCX = 1
+      IF (ICASE.EQ.8) THEN
+*        CSCAL
+*        Add a test for alpha equal to zero.
+         CA = (0.0E0,0.0E0)
+         DO 80 I = 1, 5
+            MWPCT(I) = (0.0E0,0.0E0)
+            MWPCS(I) = (1.0E0,1.0E0)
+   80    CONTINUE
+         CALL CSCAL(5,CA,CX,INCX)
+         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
+      ELSE IF (ICASE.EQ.9) THEN
+*        CSSCAL
+*        Add a test for alpha equal to zero.
+         SA = 0.0E0
+         DO 100 I = 1, 5
+            MWPCT(I) = (0.0E0,0.0E0)
+            MWPCS(I) = (1.0E0,1.0E0)
+  100    CONTINUE
+         CALL CSSCAL(5,SA,CX,INCX)
+         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
+*        Add a test for alpha equal to one.
+         SA = 1.0E0
+         DO 120 I = 1, 5
+            MWPCT(I) = CX(I)
+            MWPCS(I) = CX(I)
+  120    CONTINUE
+         CALL CSSCAL(5,SA,CX,INCX)
+         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
+*        Add a test for alpha equal to minus one.
+         SA = -1.0E0
+         DO 140 I = 1, 5
+            MWPCT(I) = -CX(I)
+            MWPCS(I) = -CX(I)
+  140    CONTINUE
+         CALL CSSCAL(5,SA,CX,INCX)
+         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
+      END IF
+      RETURN
+      END
+      SUBROUTINE CHECK2(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      REAL              SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, MODE, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      COMPLEX           CA
+      INTEGER           I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
+*     .. Local Arrays ..
+      COMPLEX           CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
+     +                  CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
+     +                  CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
+      INTEGER           INCXS(4), INCYS(4), LENS(4,2), NS(4)
+*     .. External Functions ..
+      COMPLEX           CDOTC, CDOTU
+      EXTERNAL          CDOTC, CDOTU
+*     .. External Subroutines ..
+      EXTERNAL          CAXPY, CCOPY, CSWAP, CTEST
+*     .. Intrinsic Functions ..
+      INTRINSIC         ABS, MIN
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Data statements ..
+      DATA              CA/(0.4E0,-0.7E0)/
+      DATA              INCXS/1, 2, -2, -1/
+      DATA              INCYS/1, -2, 1, -2/
+      DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
+      DATA              NS/0, 1, 2, 4/
+      DATA              CX1/(0.7E0,-0.8E0), (-0.4E0,-0.7E0),
+     +                  (-0.1E0,-0.9E0), (0.2E0,-0.8E0),
+     +                  (-0.9E0,-0.4E0), (0.1E0,0.4E0), (-0.6E0,0.6E0)/
+      DATA              CY1/(0.6E0,-0.6E0), (-0.9E0,0.5E0),
+     +                  (0.7E0,-0.6E0), (0.1E0,-0.5E0), (-0.1E0,-0.2E0),
+     +                  (-0.5E0,-0.3E0), (0.8E0,-0.7E0)/
+      DATA              ((CT8(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.32E0,-1.41E0),
+     +                  (-1.55E0,0.5E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.32E0,-1.41E0), (-1.55E0,0.5E0),
+     +                  (0.03E0,-0.89E0), (-0.38E0,-0.96E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
+      DATA              ((CT8(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (-0.07E0,-0.89E0),
+     +                  (-0.9E0,0.5E0), (0.42E0,-1.41E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.78E0,0.06E0), (-0.9E0,0.5E0),
+     +                  (0.06E0,-0.13E0), (0.1E0,-0.5E0),
+     +                  (-0.77E0,-0.49E0), (-0.5E0,-0.3E0),
+     +                  (0.52E0,-1.51E0)/
+      DATA              ((CT8(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (-0.07E0,-0.89E0),
+     +                  (-1.18E0,-0.31E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.78E0,0.06E0), (-1.54E0,0.97E0),
+     +                  (0.03E0,-0.89E0), (-0.18E0,-1.31E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
+      DATA              ((CT8(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.32E0,-1.41E0), (-0.9E0,0.5E0),
+     +                  (0.05E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.32E0,-1.41E0),
+     +                  (-0.9E0,0.5E0), (0.05E0,-0.6E0), (0.1E0,-0.5E0),
+     +                  (-0.77E0,-0.49E0), (-0.5E0,-0.3E0),
+     +                  (0.32E0,-1.16E0)/
+      DATA              CT7/(0.0E0,0.0E0), (-0.06E0,-0.90E0),
+     +                  (0.65E0,-0.47E0), (-0.34E0,-1.22E0),
+     +                  (0.0E0,0.0E0), (-0.06E0,-0.90E0),
+     +                  (-0.59E0,-1.46E0), (-1.04E0,-0.04E0),
+     +                  (0.0E0,0.0E0), (-0.06E0,-0.90E0),
+     +                  (-0.83E0,0.59E0), (0.07E0,-0.37E0),
+     +                  (0.0E0,0.0E0), (-0.06E0,-0.90E0),
+     +                  (-0.76E0,-1.15E0), (-1.33E0,-1.82E0)/
+      DATA              CT6/(0.0E0,0.0E0), (0.90E0,0.06E0),
+     +                  (0.91E0,-0.77E0), (1.80E0,-0.10E0),
+     +                  (0.0E0,0.0E0), (0.90E0,0.06E0), (1.45E0,0.74E0),
+     +                  (0.20E0,0.90E0), (0.0E0,0.0E0), (0.90E0,0.06E0),
+     +                  (-0.55E0,0.23E0), (0.83E0,-0.39E0),
+     +                  (0.0E0,0.0E0), (0.90E0,0.06E0), (1.04E0,0.79E0),
+     +                  (1.95E0,1.22E0)/
+      DATA              ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7E0,-0.8E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.6E0,-0.6E0), (-0.9E0,0.5E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0),
+     +                  (-0.9E0,0.5E0), (0.7E0,-0.6E0), (0.1E0,-0.5E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
+      DATA              ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7E0,-0.8E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.7E0,-0.6E0), (-0.4E0,-0.7E0),
+     +                  (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.8E0,-0.7E0),
+     +                  (-0.4E0,-0.7E0), (-0.1E0,-0.2E0),
+     +                  (0.2E0,-0.8E0), (0.7E0,-0.6E0), (0.1E0,0.4E0),
+     +                  (0.6E0,-0.6E0)/
+      DATA              ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7E0,-0.8E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (-0.9E0,0.5E0), (-0.4E0,-0.7E0),
+     +                  (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.1E0,-0.5E0),
+     +                  (-0.4E0,-0.7E0), (0.7E0,-0.6E0), (0.2E0,-0.8E0),
+     +                  (-0.9E0,0.5E0), (0.1E0,0.4E0), (0.6E0,-0.6E0)/
+      DATA              ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7E0,-0.8E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.6E0,-0.6E0), (0.7E0,-0.6E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0),
+     +                  (0.7E0,-0.6E0), (-0.1E0,-0.2E0), (0.8E0,-0.7E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
+      DATA              ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.4E0,-0.7E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0),
+     +                  (-0.4E0,-0.7E0), (-0.1E0,-0.9E0),
+     +                  (0.2E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0)/
+      DATA              ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (-0.1E0,-0.9E0), (-0.9E0,0.5E0),
+     +                  (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0),
+     +                  (-0.9E0,0.5E0), (-0.9E0,-0.4E0), (0.1E0,-0.5E0),
+     +                  (-0.1E0,-0.9E0), (-0.5E0,-0.3E0),
+     +                  (0.7E0,-0.8E0)/
+      DATA              ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (-0.1E0,-0.9E0), (0.7E0,-0.8E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0),
+     +                  (-0.9E0,-0.4E0), (-0.1E0,-0.9E0),
+     +                  (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0)/
+      DATA              ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.9E0,0.5E0),
+     +                  (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0),
+     +                  (-0.9E0,0.5E0), (-0.4E0,-0.7E0), (0.1E0,-0.5E0),
+     +                  (-0.1E0,-0.9E0), (-0.5E0,-0.3E0),
+     +                  (0.2E0,-0.8E0)/
+      DATA              CSIZE1/(0.0E0,0.0E0), (0.9E0,0.9E0),
+     +                  (1.63E0,1.73E0), (2.90E0,2.78E0)/
+      DATA              CSIZE3/(0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (1.17E0,1.17E0),
+     +                  (1.17E0,1.17E0), (1.17E0,1.17E0),
+     +                  (1.17E0,1.17E0), (1.17E0,1.17E0),
+     +                  (1.17E0,1.17E0), (1.17E0,1.17E0)/
+      DATA              CSIZE2/(0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
+     +                  (0.0E0,0.0E0), (0.0E0,0.0E0), (1.54E0,1.54E0),
+     +                  (1.54E0,1.54E0), (1.54E0,1.54E0),
+     +                  (1.54E0,1.54E0), (1.54E0,1.54E0),
+     +                  (1.54E0,1.54E0), (1.54E0,1.54E0)/
+*     .. Executable Statements ..
+      DO 60 KI = 1, 4
+         INCX = INCXS(KI)
+         INCY = INCYS(KI)
+         MX = ABS(INCX)
+         MY = ABS(INCY)
+*
+         DO 40 KN = 1, 4
+            N = NS(KN)
+            KSIZE = MIN(2,KN)
+            LENX = LENS(KN,MX)
+            LENY = LENS(KN,MY)
+*           .. initialize all argument arrays ..
+            DO 20 I = 1, 7
+               CX(I) = CX1(I)
+               CY(I) = CY1(I)
+   20       CONTINUE
+            IF (ICASE.EQ.1) THEN
+*              .. CDOTC ..
+               CDOT(1) = CDOTC(N,CX,INCX,CY,INCY)
+               CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC)
+            ELSE IF (ICASE.EQ.2) THEN
+*              .. CDOTU ..
+               CDOT(1) = CDOTU(N,CX,INCX,CY,INCY)
+               CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC)
+            ELSE IF (ICASE.EQ.3) THEN
+*              .. CAXPY ..
+               CALL CAXPY(N,CA,CX,INCX,CY,INCY)
+               CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC)
+            ELSE IF (ICASE.EQ.4) THEN
+*              .. CCOPY ..
+               CALL CCOPY(N,CX,INCX,CY,INCY)
+               CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
+            ELSE IF (ICASE.EQ.5) THEN
+*              .. CSWAP ..
+               CALL CSWAP(N,CX,INCX,CY,INCY)
+               CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0)
+               CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
+            ELSE
+               WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
+               STOP
+            END IF
+*
+   40    CONTINUE
+   60 CONTINUE
+      RETURN
+      END
+      SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
+*     ********************************* STEST **************************
+*
+*     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
+*     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
+*     NEGLIGIBLE.
+*
+*     C. L. LAWSON, JPL, 1974 DEC 10
+*
+*     .. Parameters ..
+      INTEGER          NOUT
+      PARAMETER        (NOUT=6)
+*     .. Scalar Arguments ..
+      REAL             SFAC
+      INTEGER          LEN
+*     .. Array Arguments ..
+      REAL             SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, MODE, N
+      LOGICAL          PASS
+*     .. Local Scalars ..
+      REAL             SD
+      INTEGER          I
+*     .. External Functions ..
+      REAL             SDIFF
+      EXTERNAL         SDIFF
+*     .. Intrinsic Functions ..
+      INTRINSIC        ABS
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Executable Statements ..
+*
+      DO 40 I = 1, LEN
+         SD = SCOMP(I) - STRUE(I)
+         IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0)
+     +       GO TO 40
+*
+*                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
+*
+         IF ( .NOT. PASS) GO TO 20
+*                             PRINT FAIL MESSAGE AND HEADER.
+         PASS = .FALSE.
+         WRITE (NOUT,99999)
+         WRITE (NOUT,99998)
+   20    WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I),
+     +     STRUE(I), SD, SSIZE(I)
+   40 CONTINUE
+      RETURN
+*
+99999 FORMAT ('                                       FAIL')
+99998 FORMAT (/' CASE  N INCX INCY MODE  I                            ',
+     +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
+     +       '     SIZE(I)',/1X)
+99997 FORMAT (1X,I4,I3,3I5,I3,2E36.8,2E12.4)
+      END
+      SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
+*     ************************* STEST1 *****************************
+*
+*     THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
+*     REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
+*     ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
+*
+*     C.L. LAWSON, JPL, 1978 DEC 6
+*
+*     .. Scalar Arguments ..
+      REAL              SCOMP1, SFAC, STRUE1
+*     .. Array Arguments ..
+      REAL              SSIZE(*)
+*     .. Local Arrays ..
+      REAL              SCOMP(1), STRUE(1)
+*     .. External Subroutines ..
+      EXTERNAL          STEST
+*     .. Executable Statements ..
+*
+      SCOMP(1) = SCOMP1
+      STRUE(1) = STRUE1
+      CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
+*
+      RETURN
+      END
+      REAL             FUNCTION SDIFF(SA,SB)
+*     ********************************* SDIFF **************************
+*     COMPUTES DIFFERENCE OF TWO NUMBERS.  C. L. LAWSON, JPL 1974 FEB 15
+*
+*     .. Scalar Arguments ..
+      REAL                            SA, SB
+*     .. Executable Statements ..
+      SDIFF = SA - SB
+      RETURN
+      END
+      SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC)
+*     **************************** CTEST *****************************
+*
+*     C.L. LAWSON, JPL, 1978 DEC 6
+*
+*     .. Scalar Arguments ..
+      REAL             SFAC
+      INTEGER          LEN
+*     .. Array Arguments ..
+      COMPLEX          CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
+*     .. Local Scalars ..
+      INTEGER          I
+*     .. Local Arrays ..
+      REAL             SCOMP(20), SSIZE(20), STRUE(20)
+*     .. External Subroutines ..
+      EXTERNAL         STEST
+*     .. Intrinsic Functions ..
+      INTRINSIC        AIMAG, REAL
+*     .. Executable Statements ..
+      DO 20 I = 1, LEN
+         SCOMP(2*I-1) = REAL(CCOMP(I))
+         SCOMP(2*I) = AIMAG(CCOMP(I))
+         STRUE(2*I-1) = REAL(CTRUE(I))
+         STRUE(2*I) = AIMAG(CTRUE(I))
+         SSIZE(2*I-1) = REAL(CSIZE(I))
+         SSIZE(2*I) = AIMAG(CSIZE(I))
+   20 CONTINUE
+*
+      CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC)
+      RETURN
+      END
+      SUBROUTINE ITEST1(ICOMP,ITRUE)
+*     ********************************* ITEST1 *************************
+*
+*     THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
+*     EQUALITY.
+*     C. L. LAWSON, JPL, 1974 DEC 10
+*
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      INTEGER           ICOMP, ITRUE
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, MODE, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      INTEGER           ID
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Executable Statements ..
+      IF (ICOMP.EQ.ITRUE) GO TO 40
+*
+*                            HERE ICOMP IS NOT EQUAL TO ITRUE.
+*
+      IF ( .NOT. PASS) GO TO 20
+*                             PRINT FAIL MESSAGE AND HEADER.
+      PASS = .FALSE.
+      WRITE (NOUT,99999)
+      WRITE (NOUT,99998)
+   20 ID = ICOMP - ITRUE
+      WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID
+   40 CONTINUE
+      RETURN
+*
+99999 FORMAT ('                                       FAIL')
+99998 FORMAT (/' CASE  N INCX INCY MODE                               ',
+     +       ' COMP                                TRUE     DIFFERENCE',
+     +       /1X)
+99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
+      END
diff --git a/eigen/blas/testing/cblat2.dat b/eigen/blas/testing/cblat2.dat
new file mode 100644
index 0000000..ae98730
--- /dev/null
+++ b/eigen/blas/testing/cblat2.dat
@@ -0,0 +1,35 @@
+'cblat2.summ'     NAME OF SUMMARY OUTPUT FILE
+6                 UNIT NUMBER OF SUMMARY FILE
+'cblat2.snap'     NAME OF SNAPSHOT OUTPUT FILE
+-1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
+T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+16.0     THRESHOLD VALUE OF TEST RATIO
+6                 NUMBER OF VALUES OF N
+0 1 2 3 5 9       VALUES OF N
+4                 NUMBER OF VALUES OF K
+0 1 2 4           VALUES OF K
+4                 NUMBER OF VALUES OF INCX AND INCY
+1 2 -1 -2         VALUES OF INCX AND INCY
+3                 NUMBER OF VALUES OF ALPHA
+(0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
+3                 NUMBER OF VALUES OF BETA
+(0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
+CGEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+CGBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+CHEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+CHBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+CHPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+CTRMV  T PUT F FOR NO TEST. SAME COLUMNS.
+CTBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+CTPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+CTRSV  T PUT F FOR NO TEST. SAME COLUMNS.
+CTBSV  T PUT F FOR NO TEST. SAME COLUMNS.
+CTPSV  T PUT F FOR NO TEST. SAME COLUMNS.
+CGERC  T PUT F FOR NO TEST. SAME COLUMNS.
+CGERU  T PUT F FOR NO TEST. SAME COLUMNS.
+CHER   T PUT F FOR NO TEST. SAME COLUMNS.
+CHPR   T PUT F FOR NO TEST. SAME COLUMNS.
+CHER2  T PUT F FOR NO TEST. SAME COLUMNS.
+CHPR2  T PUT F FOR NO TEST. SAME COLUMNS.
diff --git a/eigen/blas/testing/cblat2.f b/eigen/blas/testing/cblat2.f
new file mode 100644
index 0000000..20f1881
--- /dev/null
+++ b/eigen/blas/testing/cblat2.f
@@ -0,0 +1,3241 @@
+      PROGRAM CBLAT2
+*
+*  Test program for the COMPLEX          Level 2 Blas.
+*
+*  The program must be driven by a short data file. The first 18 records
+*  of the file are read using list-directed input, the last 17 records
+*  are read using the format ( A6, L2 ). An annotated example of a data
+*  file can be obtained by deleting the first 3 characters from the
+*  following 35 lines:
+*  'CBLAT2.SUMM'     NAME OF SUMMARY OUTPUT FILE
+*  6                 UNIT NUMBER OF SUMMARY FILE
+*  'CBLA2T.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
+*  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+*  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+*  F        LOGICAL FLAG, T TO STOP ON FAILURES.
+*  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+*  16.0     THRESHOLD VALUE OF TEST RATIO
+*  6                 NUMBER OF VALUES OF N
+*  0 1 2 3 5 9       VALUES OF N
+*  4                 NUMBER OF VALUES OF K
+*  0 1 2 4           VALUES OF K
+*  4                 NUMBER OF VALUES OF INCX AND INCY
+*  1 2 -1 -2         VALUES OF INCX AND INCY
+*  3                 NUMBER OF VALUES OF ALPHA
+*  (0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
+*  3                 NUMBER OF VALUES OF BETA
+*  (0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
+*  CGEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CGBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CHEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CHBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CHPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CTRMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CTBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CTPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CTRSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CTBSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CTPSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CGERC  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CGERU  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CHER   T PUT F FOR NO TEST. SAME COLUMNS.
+*  CHPR   T PUT F FOR NO TEST. SAME COLUMNS.
+*  CHER2  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CHPR2  T PUT F FOR NO TEST. SAME COLUMNS.
+*
+*     See:
+*
+*        Dongarra J. J., Du Croz J. J., Hammarling S.  and Hanson R. J..
+*        An  extended  set of Fortran  Basic Linear Algebra Subprograms.
+*
+*        Technical  Memoranda  Nos. 41 (revision 3) and 81,  Mathematics
+*        and  Computer Science  Division,  Argonne  National Laboratory,
+*        9700 South Cass Avenue, Argonne, Illinois 60439, US.
+*
+*        Or
+*
+*        NAG  Technical Reports TR3/87 and TR4/87,  Numerical Algorithms
+*        Group  Ltd.,  NAG  Central  Office,  256  Banbury  Road, Oxford
+*        OX2 7DE, UK,  and  Numerical Algorithms Group Inc.,  1101  31st
+*        Street,  Suite 100,  Downers Grove,  Illinois 60515-1263,  USA.
+*
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      INTEGER            NIN
+      PARAMETER          ( NIN = 5 )
+      INTEGER            NSUBS
+      PARAMETER          ( NSUBS = 17 )
+      COMPLEX            ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
+      REAL               RZERO, RHALF, RONE
+      PARAMETER          ( RZERO = 0.0, RHALF = 0.5, RONE = 1.0 )
+      INTEGER            NMAX, INCMAX
+      PARAMETER          ( NMAX = 65, INCMAX = 2 )
+      INTEGER            NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX
+      PARAMETER          ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7,
+     $                   NALMAX = 7, NBEMAX = 7 )
+*     .. Local Scalars ..
+      REAL               EPS, ERR, THRESH
+      INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
+     $                   TSTERR
+      CHARACTER*1        TRANS
+      CHARACTER*6        SNAMET
+      CHARACTER*32       SNAPS, SUMMRY
+*     .. Local Arrays ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ),
+     $                   ALF( NALMAX ), AS( NMAX*NMAX ), BET( NBEMAX ),
+     $                   X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( 2*NMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDMAX ), INC( NINMAX ), KB( NKBMAX )
+      LOGICAL            LTEST( NSUBS )
+      CHARACTER*6        SNAMES( NSUBS )
+*     .. External Functions ..
+      REAL               SDIFF
+      LOGICAL            LCE
+      EXTERNAL           SDIFF, LCE
+*     .. External Subroutines ..
+      EXTERNAL           CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CCHK6,
+     $                   CCHKE, CMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Data statements ..
+      DATA               SNAMES/'CGEMV ', 'CGBMV ', 'CHEMV ', 'CHBMV ',
+     $                   'CHPMV ', 'CTRMV ', 'CTBMV ', 'CTPMV ',
+     $                   'CTRSV ', 'CTBSV ', 'CTPSV ', 'CGERC ',
+     $                   'CGERU ', 'CHER  ', 'CHPR  ', 'CHER2 ',
+     $                   'CHPR2 '/
+*     .. Executable Statements ..
+*
+*     Read name and unit number for summary output file and open file.
+*
+      READ( NIN, FMT = * )SUMMRY
+      READ( NIN, FMT = * )NOUT
+      OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+      NOUTC = NOUT
+*
+*     Read name and unit number for snapshot output file and open file.
+*
+      READ( NIN, FMT = * )SNAPS
+      READ( NIN, FMT = * )NTRA
+      TRACE = NTRA.GE.0
+      IF( TRACE )THEN
+         OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+      END IF
+*     Read the flag that directs rewinding of the snapshot file.
+      READ( NIN, FMT = * )REWI
+      REWI = REWI.AND.TRACE
+*     Read the flag that directs stopping on any failure.
+      READ( NIN, FMT = * )SFATAL
+*     Read the flag that indicates whether error exits are to be tested.
+      READ( NIN, FMT = * )TSTERR
+*     Read the threshold value of the test ratio
+      READ( NIN, FMT = * )THRESH
+*
+*     Read and check the parameter values for the tests.
+*
+*     Values of N
+      READ( NIN, FMT = * )NIDIM
+      IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'N', NIDMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
+      DO 10 I = 1, NIDIM
+         IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
+            WRITE( NOUT, FMT = 9996 )NMAX
+            GO TO 230
+         END IF
+   10 CONTINUE
+*     Values of K
+      READ( NIN, FMT = * )NKB
+      IF( NKB.LT.1.OR.NKB.GT.NKBMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'K', NKBMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( KB( I ), I = 1, NKB )
+      DO 20 I = 1, NKB
+         IF( KB( I ).LT.0 )THEN
+            WRITE( NOUT, FMT = 9995 )
+            GO TO 230
+         END IF
+   20 CONTINUE
+*     Values of INCX and INCY
+      READ( NIN, FMT = * )NINC
+      IF( NINC.LT.1.OR.NINC.GT.NINMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'INCX AND INCY', NINMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( INC( I ), I = 1, NINC )
+      DO 30 I = 1, NINC
+         IF( INC( I ).EQ.0.OR.ABS( INC( I ) ).GT.INCMAX )THEN
+            WRITE( NOUT, FMT = 9994 )INCMAX
+            GO TO 230
+         END IF
+   30 CONTINUE
+*     Values of ALPHA
+      READ( NIN, FMT = * )NALF
+      IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
+*     Values of BETA
+      READ( NIN, FMT = * )NBET
+      IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
+*
+*     Report values of parameters.
+*
+      WRITE( NOUT, FMT = 9993 )
+      WRITE( NOUT, FMT = 9992 )( IDIM( I ), I = 1, NIDIM )
+      WRITE( NOUT, FMT = 9991 )( KB( I ), I = 1, NKB )
+      WRITE( NOUT, FMT = 9990 )( INC( I ), I = 1, NINC )
+      WRITE( NOUT, FMT = 9989 )( ALF( I ), I = 1, NALF )
+      WRITE( NOUT, FMT = 9988 )( BET( I ), I = 1, NBET )
+      IF( .NOT.TSTERR )THEN
+         WRITE( NOUT, FMT = * )
+         WRITE( NOUT, FMT = 9980 )
+      END IF
+      WRITE( NOUT, FMT = * )
+      WRITE( NOUT, FMT = 9999 )THRESH
+      WRITE( NOUT, FMT = * )
+*
+*     Read names of subroutines and flags which indicate
+*     whether they are to be tested.
+*
+      DO 40 I = 1, NSUBS
+         LTEST( I ) = .FALSE.
+   40 CONTINUE
+   50 READ( NIN, FMT = 9984, END = 80 )SNAMET, LTESTT
+      DO 60 I = 1, NSUBS
+         IF( SNAMET.EQ.SNAMES( I ) )
+     $      GO TO 70
+   60 CONTINUE
+      WRITE( NOUT, FMT = 9986 )SNAMET
+      STOP
+   70 LTEST( I ) = LTESTT
+      GO TO 50
+*
+   80 CONTINUE
+      CLOSE ( NIN )
+*
+*     Compute EPS (the machine precision).
+*
+      EPS = RONE
+   90 CONTINUE
+      IF( SDIFF( RONE + EPS, RONE ).EQ.RZERO )
+     $   GO TO 100
+      EPS = RHALF*EPS
+      GO TO 90
+  100 CONTINUE
+      EPS = EPS + EPS
+      WRITE( NOUT, FMT = 9998 )EPS
+*
+*     Check the reliability of CMVCH using exact data.
+*
+      N = MIN( 32, NMAX )
+      DO 120 J = 1, N
+         DO 110 I = 1, N
+            A( I, J ) = MAX( I - J + 1, 0 )
+  110    CONTINUE
+         X( J ) = J
+         Y( J ) = ZERO
+  120 CONTINUE
+      DO 130 J = 1, N
+         YY( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3
+  130 CONTINUE
+*     YY holds the exact result. On exit from CMVCH YT holds
+*     the result computed by CMVCH.
+      TRANS = 'N'
+      CALL CMVCH( TRANS, N, N, ONE, A, NMAX, X, 1, ZERO, Y, 1, YT, G,
+     $            YY, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LCE( YY, YT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9985 )TRANS, SAME, ERR
+         STOP
+      END IF
+      TRANS = 'T'
+      CALL CMVCH( TRANS, N, N, ONE, A, NMAX, X, -1, ZERO, Y, -1, YT, G,
+     $            YY, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LCE( YY, YT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9985 )TRANS, SAME, ERR
+         STOP
+      END IF
+*
+*     Test each subroutine in turn.
+*
+      DO 210 ISNUM = 1, NSUBS
+         WRITE( NOUT, FMT = * )
+         IF( .NOT.LTEST( ISNUM ) )THEN
+*           Subprogram is not to be tested.
+            WRITE( NOUT, FMT = 9983 )SNAMES( ISNUM )
+         ELSE
+            SRNAMT = SNAMES( ISNUM )
+*           Test error exits.
+            IF( TSTERR )THEN
+               CALL CCHKE( ISNUM, SNAMES( ISNUM ), NOUT )
+               WRITE( NOUT, FMT = * )
+            END IF
+*           Test computations.
+            INFOT = 0
+            OK = .TRUE.
+            FATAL = .FALSE.
+            GO TO ( 140, 140, 150, 150, 150, 160, 160,
+     $              160, 160, 160, 160, 170, 170, 180,
+     $              180, 190, 190 )ISNUM
+*           Test CGEMV, 01, and CGBMV, 02.
+  140       CALL CCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF,
+     $                  NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS,
+     $                  X, XX, XS, Y, YY, YS, YT, G )
+            GO TO 200
+*           Test CHEMV, 03, CHBMV, 04, and CHPMV, 05.
+  150       CALL CCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF,
+     $                  NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS,
+     $                  X, XX, XS, Y, YY, YS, YT, G )
+            GO TO 200
+*           Test CTRMV, 06, CTBMV, 07, CTPMV, 08,
+*           CTRSV, 09, CTBSV, 10, and CTPSV, 11.
+  160       CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z )
+            GO TO 200
+*           Test CGERC, 12, CGERU, 13.
+  170       CALL CCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+            GO TO 200
+*           Test CHER, 14, and CHPR, 15.
+  180       CALL CCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+            GO TO 200
+*           Test CHER2, 16, and CHPR2, 17.
+  190       CALL CCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+*
+  200       IF( FATAL.AND.SFATAL )
+     $         GO TO 220
+         END IF
+  210 CONTINUE
+      WRITE( NOUT, FMT = 9982 )
+      GO TO 240
+*
+  220 CONTINUE
+      WRITE( NOUT, FMT = 9981 )
+      GO TO 240
+*
+  230 CONTINUE
+      WRITE( NOUT, FMT = 9987 )
+*
+  240 CONTINUE
+      IF( TRACE )
+     $   CLOSE ( NTRA )
+      CLOSE ( NOUT )
+      STOP
+*
+ 9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
+     $      'S THAN', F8.2 )
+ 9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, E9.1 )
+ 9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
+     $      'THAN ', I2 )
+ 9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 )
+ 9995 FORMAT( ' VALUE OF K IS LESS THAN 0' )
+ 9994 FORMAT( ' ABSOLUTE VALUE OF INCX OR INCY IS 0 OR GREATER THAN ',
+     $      I2 )
+ 9993 FORMAT( ' TESTS OF THE COMPLEX          LEVEL 2 BLAS', //' THE F',
+     $      'OLLOWING PARAMETER VALUES WILL BE USED:' )
+ 9992 FORMAT( '   FOR N              ', 9I6 )
+ 9991 FORMAT( '   FOR K              ', 7I6 )
+ 9990 FORMAT( '   FOR INCX AND INCY  ', 7I6 )
+ 9989 FORMAT( '   FOR ALPHA          ',
+     $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
+ 9988 FORMAT( '   FOR BETA           ',
+     $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
+ 9987 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
+     $      /' ******* TESTS ABANDONED *******' )
+ 9986 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+     $      'ESTS ABANDONED *******' )
+ 9985 FORMAT( ' ERROR IN CMVCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
+     $      'ATED WRONGLY.', /' CMVCH WAS CALLED WITH TRANS = ', A1,
+     $      ' AND RETURNED SAME = ', L1, ' AND ERR = ', F12.3, '.', /
+     $   ' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.'
+     $      , /' ******* TESTS ABANDONED *******' )
+ 9984 FORMAT( A6, L2 )
+ 9983 FORMAT( 1X, A6, ' WAS NOT TESTED' )
+ 9982 FORMAT( /' END OF TESTS' )
+ 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
+ 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
+*
+*     End of CBLAT2.
+*
+      END
+      SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET,
+     $                  BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX,
+     $                  XS, Y, YY, YS, YT, G )
+*
+*  Tests CGEMV and CGBMV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, HALF
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), HALF = ( 0.5, 0.0 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), BET( NBET ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
+     $                   Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, ALS, BETA, BLS, TRANSL
+      REAL               ERR, ERRMAX
+      INTEGER            I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY,
+     $                   INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA,
+     $                   LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK,
+     $                   NL, NS
+      LOGICAL            BANDED, FULL, NULL, RESET, SAME, TRAN
+      CHARACTER*1        TRANS, TRANSS
+      CHARACTER*3        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CGBMV, CGEMV, CMAKE, CMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'NTC'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'E'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 11
+      ELSE IF( BANDED )THEN
+         NARGS = 13
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 120 IN = 1, NIDIM
+         N = IDIM( IN )
+         ND = N/2 + 1
+*
+         DO 110 IM = 1, 2
+            IF( IM.EQ.1 )
+     $         M = MAX( N - ND, 0 )
+            IF( IM.EQ.2 )
+     $         M = MIN( N + ND, NMAX )
+*
+            IF( BANDED )THEN
+               NK = NKB
+            ELSE
+               NK = 1
+            END IF
+            DO 100 IKU = 1, NK
+               IF( BANDED )THEN
+                  KU = KB( IKU )
+                  KL = MAX( KU - 1, 0 )
+               ELSE
+                  KU = N - 1
+                  KL = M - 1
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               IF( BANDED )THEN
+                  LDA = KL + KU + 1
+               ELSE
+                  LDA = M
+               END IF
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 100
+               LAA = LDA*N
+               NULL = N.LE.0.OR.M.LE.0
+*
+*              Generate the matrix A.
+*
+               TRANSL = ZERO
+               CALL CMAKE( SNAME( 2: 3 ), ' ', ' ', M, N, A, NMAX, AA,
+     $                     LDA, KL, KU, RESET, TRANSL )
+*
+               DO 90 IC = 1, 3
+                  TRANS = ICH( IC: IC )
+                  TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C'
+*
+                  IF( TRAN )THEN
+                     ML = N
+                     NL = M
+                  ELSE
+                     ML = M
+                     NL = N
+                  END IF
+*
+                  DO 80 IX = 1, NINC
+                     INCX = INC( IX )
+                     LX = ABS( INCX )*NL
+*
+*                    Generate the vector X.
+*
+                     TRANSL = HALF
+                     CALL CMAKE( 'GE', ' ', ' ', 1, NL, X, 1, XX,
+     $                           ABS( INCX ), 0, NL - 1, RESET, TRANSL )
+                     IF( NL.GT.1 )THEN
+                        X( NL/2 ) = ZERO
+                        XX( 1 + ABS( INCX )*( NL/2 - 1 ) ) = ZERO
+                     END IF
+*
+                     DO 70 IY = 1, NINC
+                        INCY = INC( IY )
+                        LY = ABS( INCY )*ML
+*
+                        DO 60 IA = 1, NALF
+                           ALPHA = ALF( IA )
+*
+                           DO 50 IB = 1, NBET
+                              BETA = BET( IB )
+*
+*                             Generate the vector Y.
+*
+                              TRANSL = ZERO
+                              CALL CMAKE( 'GE', ' ', ' ', 1, ML, Y, 1,
+     $                                    YY, ABS( INCY ), 0, ML - 1,
+     $                                    RESET, TRANSL )
+*
+                              NC = NC + 1
+*
+*                             Save every datum before calling the
+*                             subroutine.
+*
+                              TRANSS = TRANS
+                              MS = M
+                              NS = N
+                              KLS = KL
+                              KUS = KU
+                              ALS = ALPHA
+                              DO 10 I = 1, LAA
+                                 AS( I ) = AA( I )
+   10                         CONTINUE
+                              LDAS = LDA
+                              DO 20 I = 1, LX
+                                 XS( I ) = XX( I )
+   20                         CONTINUE
+                              INCXS = INCX
+                              BLS = BETA
+                              DO 30 I = 1, LY
+                                 YS( I ) = YY( I )
+   30                         CONTINUE
+                              INCYS = INCY
+*
+*                             Call the subroutine.
+*
+                              IF( FULL )THEN
+                                 IF( TRACE )
+     $                              WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                              TRANS, M, N, ALPHA, LDA, INCX, BETA,
+     $                              INCY
+                                 IF( REWI )
+     $                              REWIND NTRA
+                                 CALL CGEMV( TRANS, M, N, ALPHA, AA,
+     $                                       LDA, XX, INCX, BETA, YY,
+     $                                       INCY )
+                              ELSE IF( BANDED )THEN
+                                 IF( TRACE )
+     $                              WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                              TRANS, M, N, KL, KU, ALPHA, LDA,
+     $                              INCX, BETA, INCY
+                                 IF( REWI )
+     $                              REWIND NTRA
+                                 CALL CGBMV( TRANS, M, N, KL, KU, ALPHA,
+     $                                       AA, LDA, XX, INCX, BETA,
+     $                                       YY, INCY )
+                              END IF
+*
+*                             Check if error-exit was taken incorrectly.
+*
+                              IF( .NOT.OK )THEN
+                                 WRITE( NOUT, FMT = 9993 )
+                                 FATAL = .TRUE.
+                                 GO TO 130
+                              END IF
+*
+*                             See what data changed inside subroutines.
+*
+                              ISAME( 1 ) = TRANS.EQ.TRANSS
+                              ISAME( 2 ) = MS.EQ.M
+                              ISAME( 3 ) = NS.EQ.N
+                              IF( FULL )THEN
+                                 ISAME( 4 ) = ALS.EQ.ALPHA
+                                 ISAME( 5 ) = LCE( AS, AA, LAA )
+                                 ISAME( 6 ) = LDAS.EQ.LDA
+                                 ISAME( 7 ) = LCE( XS, XX, LX )
+                                 ISAME( 8 ) = INCXS.EQ.INCX
+                                 ISAME( 9 ) = BLS.EQ.BETA
+                                 IF( NULL )THEN
+                                    ISAME( 10 ) = LCE( YS, YY, LY )
+                                 ELSE
+                                    ISAME( 10 ) = LCERES( 'GE', ' ', 1,
+     $                                            ML, YS, YY,
+     $                                            ABS( INCY ) )
+                                 END IF
+                                 ISAME( 11 ) = INCYS.EQ.INCY
+                              ELSE IF( BANDED )THEN
+                                 ISAME( 4 ) = KLS.EQ.KL
+                                 ISAME( 5 ) = KUS.EQ.KU
+                                 ISAME( 6 ) = ALS.EQ.ALPHA
+                                 ISAME( 7 ) = LCE( AS, AA, LAA )
+                                 ISAME( 8 ) = LDAS.EQ.LDA
+                                 ISAME( 9 ) = LCE( XS, XX, LX )
+                                 ISAME( 10 ) = INCXS.EQ.INCX
+                                 ISAME( 11 ) = BLS.EQ.BETA
+                                 IF( NULL )THEN
+                                    ISAME( 12 ) = LCE( YS, YY, LY )
+                                 ELSE
+                                    ISAME( 12 ) = LCERES( 'GE', ' ', 1,
+     $                                            ML, YS, YY,
+     $                                            ABS( INCY ) )
+                                 END IF
+                                 ISAME( 13 ) = INCYS.EQ.INCY
+                              END IF
+*
+*                             If data was incorrectly changed, report
+*                             and return.
+*
+                              SAME = .TRUE.
+                              DO 40 I = 1, NARGS
+                                 SAME = SAME.AND.ISAME( I )
+                                 IF( .NOT.ISAME( I ) )
+     $                              WRITE( NOUT, FMT = 9998 )I
+   40                         CONTINUE
+                              IF( .NOT.SAME )THEN
+                                 FATAL = .TRUE.
+                                 GO TO 130
+                              END IF
+*
+                              IF( .NOT.NULL )THEN
+*
+*                                Check the result.
+*
+                                 CALL CMVCH( TRANS, M, N, ALPHA, A,
+     $                                       NMAX, X, INCX, BETA, Y,
+     $                                       INCY, YT, G, YY, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                                 ERRMAX = MAX( ERRMAX, ERR )
+*                                If got really bad answer, report and
+*                                return.
+                                 IF( FATAL )
+     $                              GO TO 130
+                              ELSE
+*                                Avoid repeating tests with M.le.0 or
+*                                N.le.0.
+                                 GO TO 110
+                              END IF
+*
+   50                      CONTINUE
+*
+   60                   CONTINUE
+*
+   70                CONTINUE
+*
+   80             CONTINUE
+*
+   90          CONTINUE
+*
+  100       CONTINUE
+*
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 140
+*
+  130 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA,
+     $      INCX, BETA, INCY
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU,
+     $      ALPHA, LDA, INCX, BETA, INCY
+      END IF
+*
+  140 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 4( I3, ',' ), '(',
+     $      F4.1, ',', F4.1, '), A,', I3, ', X,', I2, ',(', F4.1, ',',
+     $      F4.1, '), Y,', I2, ') .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), '(',
+     $      F4.1, ',', F4.1, '), A,', I3, ', X,', I2, ',(', F4.1, ',',
+     $      F4.1, '), Y,', I2, ')         .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK1.
+*
+      END
+      SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET,
+     $                  BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX,
+     $                  XS, Y, YY, YS, YT, G )
+*
+*  Tests CHEMV, CHBMV and CHPMV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, HALF
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), HALF = ( 0.5, 0.0 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), BET( NBET ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
+     $                   Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, ALS, BETA, BLS, TRANSL
+      REAL               ERR, ERRMAX
+      INTEGER            I, IA, IB, IC, IK, IN, INCX, INCXS, INCY,
+     $                   INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY,
+     $                   N, NARGS, NC, NK, NS
+      LOGICAL            BANDED, FULL, NULL, PACKED, RESET, SAME
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CHBMV, CHEMV, CHPMV, CMAKE, CMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'E'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 10
+      ELSE IF( BANDED )THEN
+         NARGS = 11
+      ELSE IF( PACKED )THEN
+         NARGS = 9
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 110 IN = 1, NIDIM
+         N = IDIM( IN )
+*
+         IF( BANDED )THEN
+            NK = NKB
+         ELSE
+            NK = 1
+         END IF
+         DO 100 IK = 1, NK
+            IF( BANDED )THEN
+               K = KB( IK )
+            ELSE
+               K = N - 1
+            END IF
+*           Set LDA to 1 more than minimum value if room.
+            IF( BANDED )THEN
+               LDA = K + 1
+            ELSE
+               LDA = N
+            END IF
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 100
+            IF( PACKED )THEN
+               LAA = ( N*( N + 1 ) )/2
+            ELSE
+               LAA = LDA*N
+            END IF
+            NULL = N.LE.0
+*
+            DO 90 IC = 1, 2
+               UPLO = ICH( IC: IC )
+*
+*              Generate the matrix A.
+*
+               TRANSL = ZERO
+               CALL CMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A, NMAX, AA,
+     $                     LDA, K, K, RESET, TRANSL )
+*
+               DO 80 IX = 1, NINC
+                  INCX = INC( IX )
+                  LX = ABS( INCX )*N
+*
+*                 Generate the vector X.
+*
+                  TRANSL = HALF
+                  CALL CMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX,
+     $                        ABS( INCX ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     X( N/2 ) = ZERO
+                     XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 70 IY = 1, NINC
+                     INCY = INC( IY )
+                     LY = ABS( INCY )*N
+*
+                     DO 60 IA = 1, NALF
+                        ALPHA = ALF( IA )
+*
+                        DO 50 IB = 1, NBET
+                           BETA = BET( IB )
+*
+*                          Generate the vector Y.
+*
+                           TRANSL = ZERO
+                           CALL CMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                                 ABS( INCY ), 0, N - 1, RESET,
+     $                                 TRANSL )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           UPLOS = UPLO
+                           NS = N
+                           KS = K
+                           ALS = ALPHA
+                           DO 10 I = 1, LAA
+                              AS( I ) = AA( I )
+   10                      CONTINUE
+                           LDAS = LDA
+                           DO 20 I = 1, LX
+                              XS( I ) = XX( I )
+   20                      CONTINUE
+                           INCXS = INCX
+                           BLS = BETA
+                           DO 30 I = 1, LY
+                              YS( I ) = YY( I )
+   30                      CONTINUE
+                           INCYS = INCY
+*
+*                          Call the subroutine.
+*
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, N, ALPHA, LDA, INCX, BETA, INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CHEMV( UPLO, N, ALPHA, AA, LDA, XX,
+     $                                    INCX, BETA, YY, INCY )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, N, K, ALPHA, LDA, INCX, BETA,
+     $                           INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CHBMV( UPLO, N, K, ALPHA, AA, LDA,
+     $                                    XX, INCX, BETA, YY, INCY )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, N, ALPHA, INCX, BETA, INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CHPMV( UPLO, N, ALPHA, AA, XX, INCX,
+     $                                    BETA, YY, INCY )
+                           END IF
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9992 )
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = UPLO.EQ.UPLOS
+                           ISAME( 2 ) = NS.EQ.N
+                           IF( FULL )THEN
+                              ISAME( 3 ) = ALS.EQ.ALPHA
+                              ISAME( 4 ) = LCE( AS, AA, LAA )
+                              ISAME( 5 ) = LDAS.EQ.LDA
+                              ISAME( 6 ) = LCE( XS, XX, LX )
+                              ISAME( 7 ) = INCXS.EQ.INCX
+                              ISAME( 8 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 9 ) = LCE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 9 ) = LCERES( 'GE', ' ', 1, N,
+     $                                        YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 10 ) = INCYS.EQ.INCY
+                           ELSE IF( BANDED )THEN
+                              ISAME( 3 ) = KS.EQ.K
+                              ISAME( 4 ) = ALS.EQ.ALPHA
+                              ISAME( 5 ) = LCE( AS, AA, LAA )
+                              ISAME( 6 ) = LDAS.EQ.LDA
+                              ISAME( 7 ) = LCE( XS, XX, LX )
+                              ISAME( 8 ) = INCXS.EQ.INCX
+                              ISAME( 9 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 10 ) = LCE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 10 ) = LCERES( 'GE', ' ', 1, N,
+     $                                         YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 11 ) = INCYS.EQ.INCY
+                           ELSE IF( PACKED )THEN
+                              ISAME( 3 ) = ALS.EQ.ALPHA
+                              ISAME( 4 ) = LCE( AS, AA, LAA )
+                              ISAME( 5 ) = LCE( XS, XX, LX )
+                              ISAME( 6 ) = INCXS.EQ.INCX
+                              ISAME( 7 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 8 ) = LCE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 8 ) = LCERES( 'GE', ' ', 1, N,
+     $                                        YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 9 ) = INCYS.EQ.INCY
+                           END IF
+*
+*                          If data was incorrectly changed, report and
+*                          return.
+*
+                           SAME = .TRUE.
+                           DO 40 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   40                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+*
+*                             Check the result.
+*
+                              CALL CMVCH( 'N', N, N, ALPHA, A, NMAX, X,
+     $                                    INCX, BETA, Y, INCY, YT, G,
+     $                                    YY, EPS, ERR, FATAL, NOUT,
+     $                                    .TRUE. )
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 120
+                           ELSE
+*                             Avoid repeating tests with N.le.0
+                              GO TO 110
+                           END IF
+*
+   50                   CONTINUE
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, LDA, INCX,
+     $      BETA, INCY
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, K, ALPHA, LDA,
+     $      INCX, BETA, INCY
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, N, ALPHA, INCX,
+     $      BETA, INCY
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',(', F4.1, ',',
+     $      F4.1, '), AP, X,', I2, ',(', F4.1, ',', F4.1, '), Y,', I2,
+     $      ')                .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), '(',
+     $      F4.1, ',', F4.1, '), A,', I3, ', X,', I2, ',(', F4.1, ',',
+     $      F4.1, '), Y,', I2, ')         .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',(', F4.1, ',',
+     $      F4.1, '), A,', I3, ', X,', I2, ',(', F4.1, ',', F4.1, '), ',
+     $      'Y,', I2, ')             .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK2.
+*
+      END
+      SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, XT, G, Z )
+*
+*  Tests CTRMV, CTBMV, CTPMV, CTRSV, CTBSV and CTPSV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, HALF, ONE
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), HALF = ( 0.5, 0.0 ),
+     $                   ONE = ( 1.0, 0.0 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NIDIM, NINC, NKB, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ),
+     $                   AS( NMAX*NMAX ), X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XT( NMAX ), XX( NMAX*INCMAX ), Z( NMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      COMPLEX            TRANSL
+      REAL               ERR, ERRMAX
+      INTEGER            I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K,
+     $                   KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS
+      LOGICAL            BANDED, FULL, NULL, PACKED, RESET, SAME
+      CHARACTER*1        DIAG, DIAGS, TRANS, TRANSS, UPLO, UPLOS
+      CHARACTER*2        ICHD, ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CMAKE, CMVCH, CTBMV, CTBSV, CTPMV, CTPSV,
+     $                   CTRMV, CTRSV
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'R'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 8
+      ELSE IF( BANDED )THEN
+         NARGS = 9
+      ELSE IF( PACKED )THEN
+         NARGS = 7
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*     Set up zero vector for CMVCH.
+      DO 10 I = 1, NMAX
+         Z( I ) = ZERO
+   10 CONTINUE
+*
+      DO 110 IN = 1, NIDIM
+         N = IDIM( IN )
+*
+         IF( BANDED )THEN
+            NK = NKB
+         ELSE
+            NK = 1
+         END IF
+         DO 100 IK = 1, NK
+            IF( BANDED )THEN
+               K = KB( IK )
+            ELSE
+               K = N - 1
+            END IF
+*           Set LDA to 1 more than minimum value if room.
+            IF( BANDED )THEN
+               LDA = K + 1
+            ELSE
+               LDA = N
+            END IF
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 100
+            IF( PACKED )THEN
+               LAA = ( N*( N + 1 ) )/2
+            ELSE
+               LAA = LDA*N
+            END IF
+            NULL = N.LE.0
+*
+            DO 90 ICU = 1, 2
+               UPLO = ICHU( ICU: ICU )
+*
+               DO 80 ICT = 1, 3
+                  TRANS = ICHT( ICT: ICT )
+*
+                  DO 70 ICD = 1, 2
+                     DIAG = ICHD( ICD: ICD )
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL CMAKE( SNAME( 2: 3 ), UPLO, DIAG, N, N, A,
+     $                           NMAX, AA, LDA, K, K, RESET, TRANSL )
+*
+                     DO 60 IX = 1, NINC
+                        INCX = INC( IX )
+                        LX = ABS( INCX )*N
+*
+*                       Generate the vector X.
+*
+                        TRANSL = HALF
+                        CALL CMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX,
+     $                              ABS( INCX ), 0, N - 1, RESET,
+     $                              TRANSL )
+                        IF( N.GT.1 )THEN
+                           X( N/2 ) = ZERO
+                           XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+                        END IF
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        DIAGS = DIAG
+                        NS = N
+                        KS = K
+                        DO 20 I = 1, LAA
+                           AS( I ) = AA( I )
+   20                   CONTINUE
+                        LDAS = LDA
+                        DO 30 I = 1, LX
+                           XS( I ) = XX( I )
+   30                   CONTINUE
+                        INCXS = INCX
+*
+*                       Call the subroutine.
+*
+                        IF( SNAME( 4: 5 ).EQ.'MV' )THEN
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CTRMV( UPLO, TRANS, DIAG, N, AA, LDA,
+     $                                    XX, INCX )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, K, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CTBMV( UPLO, TRANS, DIAG, N, K, AA,
+     $                                    LDA, XX, INCX )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CTPMV( UPLO, TRANS, DIAG, N, AA, XX,
+     $                                    INCX )
+                           END IF
+                        ELSE IF( SNAME( 4: 5 ).EQ.'SV' )THEN
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CTRSV( UPLO, TRANS, DIAG, N, AA, LDA,
+     $                                    XX, INCX )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, K, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CTBSV( UPLO, TRANS, DIAG, N, K, AA,
+     $                                    LDA, XX, INCX )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CTPSV( UPLO, TRANS, DIAG, N, AA, XX,
+     $                                    INCX )
+                           END IF
+                        END IF
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9992 )
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLO.EQ.UPLOS
+                        ISAME( 2 ) = TRANS.EQ.TRANSS
+                        ISAME( 3 ) = DIAG.EQ.DIAGS
+                        ISAME( 4 ) = NS.EQ.N
+                        IF( FULL )THEN
+                           ISAME( 5 ) = LCE( AS, AA, LAA )
+                           ISAME( 6 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 7 ) = LCE( XS, XX, LX )
+                           ELSE
+                              ISAME( 7 ) = LCERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 8 ) = INCXS.EQ.INCX
+                        ELSE IF( BANDED )THEN
+                           ISAME( 5 ) = KS.EQ.K
+                           ISAME( 6 ) = LCE( AS, AA, LAA )
+                           ISAME( 7 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 8 ) = LCE( XS, XX, LX )
+                           ELSE
+                              ISAME( 8 ) = LCERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 9 ) = INCXS.EQ.INCX
+                        ELSE IF( PACKED )THEN
+                           ISAME( 5 ) = LCE( AS, AA, LAA )
+                           IF( NULL )THEN
+                              ISAME( 6 ) = LCE( XS, XX, LX )
+                           ELSE
+                              ISAME( 6 ) = LCERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 7 ) = INCXS.EQ.INCX
+                        END IF
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+                           IF( SNAME( 4: 5 ).EQ.'MV' )THEN
+*
+*                             Check the result.
+*
+                              CALL CMVCH( TRANS, N, N, ONE, A, NMAX, X,
+     $                                    INCX, ZERO, Z, INCX, XT, G,
+     $                                    XX, EPS, ERR, FATAL, NOUT,
+     $                                    .TRUE. )
+                           ELSE IF( SNAME( 4: 5 ).EQ.'SV' )THEN
+*
+*                             Compute approximation to original vector.
+*
+                              DO 50 I = 1, N
+                                 Z( I ) = XX( 1 + ( I - 1 )*
+     $                                    ABS( INCX ) )
+                                 XX( 1 + ( I - 1 )*ABS( INCX ) )
+     $                              = X( I )
+   50                         CONTINUE
+                              CALL CMVCH( TRANS, N, N, ONE, A, NMAX, Z,
+     $                                    INCX, ZERO, X, INCX, XT, G,
+     $                                    XX, EPS, ERR, FATAL, NOUT,
+     $                                    .FALSE. )
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 120
+                        ELSE
+*                          Avoid repeating tests with N.le.0.
+                           GO TO 110
+                        END IF
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, DIAG, N, LDA,
+     $      INCX
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, DIAG, N, K,
+     $      LDA, INCX
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANS, DIAG, N, INCX
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', AP, ',
+     $      'X,', I2, ')                                      .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), 2( I3, ',' ),
+     $      ' A,', I3, ', X,', I2, ')                               .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', A,',
+     $      I3, ', X,', I2, ')                                   .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK3.
+*
+      END
+      SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests CGERC and CGERU.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, HALF, ONE
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), HALF = ( 0.5, 0.0 ),
+     $                   ONE = ( 1.0, 0.0 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, ALS, TRANSL
+      REAL               ERR, ERRMAX
+      INTEGER            I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX,
+     $                   IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS,
+     $                   NC, ND, NS
+      LOGICAL            CONJ, NULL, RESET, SAME
+*     .. Local Arrays ..
+      COMPLEX            W( 1 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CGERC, CGERU, CMAKE, CMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, CONJG, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+      CONJ = SNAME( 5: 5 ).EQ.'C'
+*     Define the number of arguments.
+      NARGS = 9
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 120 IN = 1, NIDIM
+         N = IDIM( IN )
+         ND = N/2 + 1
+*
+         DO 110 IM = 1, 2
+            IF( IM.EQ.1 )
+     $         M = MAX( N - ND, 0 )
+            IF( IM.EQ.2 )
+     $         M = MIN( N + ND, NMAX )
+*
+*           Set LDA to 1 more than minimum value if room.
+            LDA = M
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 110
+            LAA = LDA*N
+            NULL = N.LE.0.OR.M.LE.0
+*
+            DO 100 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*M
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL CMAKE( 'GE', ' ', ' ', 1, M, X, 1, XX, ABS( INCX ),
+     $                     0, M - 1, RESET, TRANSL )
+               IF( M.GT.1 )THEN
+                  X( M/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( M/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 90 IY = 1, NINC
+                  INCY = INC( IY )
+                  LY = ABS( INCY )*N
+*
+*                 Generate the vector Y.
+*
+                  TRANSL = ZERO
+                  CALL CMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                        ABS( INCY ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     Y( N/2 ) = ZERO
+                     YY( 1 + ABS( INCY )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 80 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL CMAKE( SNAME( 2: 3 ), ' ', ' ', M, N, A, NMAX,
+     $                           AA, LDA, M - 1, N - 1, RESET, TRANSL )
+*
+                     NC = NC + 1
+*
+*                    Save every datum before calling the subroutine.
+*
+                     MS = M
+                     NS = N
+                     ALS = ALPHA
+                     DO 10 I = 1, LAA
+                        AS( I ) = AA( I )
+   10                CONTINUE
+                     LDAS = LDA
+                     DO 20 I = 1, LX
+                        XS( I ) = XX( I )
+   20                CONTINUE
+                     INCXS = INCX
+                     DO 30 I = 1, LY
+                        YS( I ) = YY( I )
+   30                CONTINUE
+                     INCYS = INCY
+*
+*                    Call the subroutine.
+*
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9994 )NC, SNAME, M, N,
+     $                  ALPHA, INCX, INCY, LDA
+                     IF( CONJ )THEN
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL CGERC( M, N, ALPHA, XX, INCX, YY, INCY, AA,
+     $                              LDA )
+                     ELSE
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL CGERU( M, N, ALPHA, XX, INCX, YY, INCY, AA,
+     $                              LDA )
+                     END IF
+*
+*                    Check if error-exit was taken incorrectly.
+*
+                     IF( .NOT.OK )THEN
+                        WRITE( NOUT, FMT = 9993 )
+                        FATAL = .TRUE.
+                        GO TO 140
+                     END IF
+*
+*                    See what data changed inside subroutine.
+*
+                     ISAME( 1 ) = MS.EQ.M
+                     ISAME( 2 ) = NS.EQ.N
+                     ISAME( 3 ) = ALS.EQ.ALPHA
+                     ISAME( 4 ) = LCE( XS, XX, LX )
+                     ISAME( 5 ) = INCXS.EQ.INCX
+                     ISAME( 6 ) = LCE( YS, YY, LY )
+                     ISAME( 7 ) = INCYS.EQ.INCY
+                     IF( NULL )THEN
+                        ISAME( 8 ) = LCE( AS, AA, LAA )
+                     ELSE
+                        ISAME( 8 ) = LCERES( 'GE', ' ', M, N, AS, AA,
+     $                               LDA )
+                     END IF
+                     ISAME( 9 ) = LDAS.EQ.LDA
+*
+*                    If data was incorrectly changed, report and return.
+*
+                     SAME = .TRUE.
+                     DO 40 I = 1, NARGS
+                        SAME = SAME.AND.ISAME( I )
+                        IF( .NOT.ISAME( I ) )
+     $                     WRITE( NOUT, FMT = 9998 )I
+   40                CONTINUE
+                     IF( .NOT.SAME )THEN
+                        FATAL = .TRUE.
+                        GO TO 140
+                     END IF
+*
+                     IF( .NOT.NULL )THEN
+*
+*                       Check the result column by column.
+*
+                        IF( INCX.GT.0 )THEN
+                           DO 50 I = 1, M
+                              Z( I ) = X( I )
+   50                      CONTINUE
+                        ELSE
+                           DO 60 I = 1, M
+                              Z( I ) = X( M - I + 1 )
+   60                      CONTINUE
+                        END IF
+                        DO 70 J = 1, N
+                           IF( INCY.GT.0 )THEN
+                              W( 1 ) = Y( J )
+                           ELSE
+                              W( 1 ) = Y( N - J + 1 )
+                           END IF
+                           IF( CONJ )
+     $                        W( 1 ) = CONJG( W( 1 ) )
+                           CALL CMVCH( 'N', M, 1, ALPHA, Z, NMAX, W, 1,
+     $                                 ONE, A( 1, J ), 1, YT, G,
+     $                                 AA( 1 + ( J - 1 )*LDA ), EPS,
+     $                                 ERR, FATAL, NOUT, .TRUE. )
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 130
+   70                   CONTINUE
+                     ELSE
+*                       Avoid repeating tests with M.le.0 or N.le.0.
+                        GO TO 110
+                     END IF
+*
+   80             CONTINUE
+*
+   90          CONTINUE
+*
+  100       CONTINUE
+*
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 150
+*
+  130 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  140 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA
+*
+  150 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( I3, ',' ), '(', F4.1, ',', F4.1,
+     $      '), X,', I2, ', Y,', I2, ', A,', I3, ')                   ',
+     $      '      .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK4.
+*
+      END
+      SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests CHER and CHPR.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, HALF, ONE
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), HALF = ( 0.5, 0.0 ),
+     $                   ONE = ( 1.0, 0.0 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, TRANSL
+      REAL               ERR, ERRMAX, RALPHA, RALS
+      INTEGER            I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA,
+     $                   LDA, LDAS, LJ, LX, N, NARGS, NC, NS
+      LOGICAL            FULL, NULL, PACKED, RESET, SAME, UPPER
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      COMPLEX            W( 1 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CHER, CHPR, CMAKE, CMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, CMPLX, CONJG, MAX, REAL
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'E'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 7
+      ELSE IF( PACKED )THEN
+         NARGS = 6
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 100 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDA to 1 more than minimum value if room.
+         LDA = N
+         IF( LDA.LT.NMAX )
+     $      LDA = LDA + 1
+*        Skip tests if not enough room.
+         IF( LDA.GT.NMAX )
+     $      GO TO 100
+         IF( PACKED )THEN
+            LAA = ( N*( N + 1 ) )/2
+         ELSE
+            LAA = LDA*N
+         END IF
+*
+         DO 90 IC = 1, 2
+            UPLO = ICH( IC: IC )
+            UPPER = UPLO.EQ.'U'
+*
+            DO 80 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*N
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL CMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX, ABS( INCX ),
+     $                     0, N - 1, RESET, TRANSL )
+               IF( N.GT.1 )THEN
+                  X( N/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 70 IA = 1, NALF
+                  RALPHA = REAL( ALF( IA ) )
+                  ALPHA = CMPLX( RALPHA, RZERO )
+                  NULL = N.LE.0.OR.RALPHA.EQ.RZERO
+*
+*                 Generate the matrix A.
+*
+                  TRANSL = ZERO
+                  CALL CMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A, NMAX,
+     $                        AA, LDA, N - 1, N - 1, RESET, TRANSL )
+*
+                  NC = NC + 1
+*
+*                 Save every datum before calling the subroutine.
+*
+                  UPLOS = UPLO
+                  NS = N
+                  RALS = RALPHA
+                  DO 10 I = 1, LAA
+                     AS( I ) = AA( I )
+   10             CONTINUE
+                  LDAS = LDA
+                  DO 20 I = 1, LX
+                     XS( I ) = XX( I )
+   20             CONTINUE
+                  INCXS = INCX
+*
+*                 Call the subroutine.
+*
+                  IF( FULL )THEN
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO, N,
+     $                  RALPHA, INCX, LDA
+                     IF( REWI )
+     $                  REWIND NTRA
+                     CALL CHER( UPLO, N, RALPHA, XX, INCX, AA, LDA )
+                  ELSE IF( PACKED )THEN
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO, N,
+     $                  RALPHA, INCX
+                     IF( REWI )
+     $                  REWIND NTRA
+                     CALL CHPR( UPLO, N, RALPHA, XX, INCX, AA )
+                  END IF
+*
+*                 Check if error-exit was taken incorrectly.
+*
+                  IF( .NOT.OK )THEN
+                     WRITE( NOUT, FMT = 9992 )
+                     FATAL = .TRUE.
+                     GO TO 120
+                  END IF
+*
+*                 See what data changed inside subroutines.
+*
+                  ISAME( 1 ) = UPLO.EQ.UPLOS
+                  ISAME( 2 ) = NS.EQ.N
+                  ISAME( 3 ) = RALS.EQ.RALPHA
+                  ISAME( 4 ) = LCE( XS, XX, LX )
+                  ISAME( 5 ) = INCXS.EQ.INCX
+                  IF( NULL )THEN
+                     ISAME( 6 ) = LCE( AS, AA, LAA )
+                  ELSE
+                     ISAME( 6 ) = LCERES( SNAME( 2: 3 ), UPLO, N, N, AS,
+     $                            AA, LDA )
+                  END IF
+                  IF( .NOT.PACKED )THEN
+                     ISAME( 7 ) = LDAS.EQ.LDA
+                  END IF
+*
+*                 If data was incorrectly changed, report and return.
+*
+                  SAME = .TRUE.
+                  DO 30 I = 1, NARGS
+                     SAME = SAME.AND.ISAME( I )
+                     IF( .NOT.ISAME( I ) )
+     $                  WRITE( NOUT, FMT = 9998 )I
+   30             CONTINUE
+                  IF( .NOT.SAME )THEN
+                     FATAL = .TRUE.
+                     GO TO 120
+                  END IF
+*
+                  IF( .NOT.NULL )THEN
+*
+*                    Check the result column by column.
+*
+                     IF( INCX.GT.0 )THEN
+                        DO 40 I = 1, N
+                           Z( I ) = X( I )
+   40                   CONTINUE
+                     ELSE
+                        DO 50 I = 1, N
+                           Z( I ) = X( N - I + 1 )
+   50                   CONTINUE
+                     END IF
+                     JA = 1
+                     DO 60 J = 1, N
+                        W( 1 ) = CONJG( Z( J ) )
+                        IF( UPPER )THEN
+                           JJ = 1
+                           LJ = J
+                        ELSE
+                           JJ = J
+                           LJ = N - J + 1
+                        END IF
+                        CALL CMVCH( 'N', LJ, 1, ALPHA, Z( JJ ), LJ, W,
+     $                              1, ONE, A( JJ, J ), 1, YT, G,
+     $                              AA( JA ), EPS, ERR, FATAL, NOUT,
+     $                              .TRUE. )
+                        IF( FULL )THEN
+                           IF( UPPER )THEN
+                              JA = JA + LDA
+                           ELSE
+                              JA = JA + LDA + 1
+                           END IF
+                        ELSE
+                           JA = JA + LJ
+                        END IF
+                        ERRMAX = MAX( ERRMAX, ERR )
+*                       If got really bad answer, report and return.
+                        IF( FATAL )
+     $                     GO TO 110
+   60                CONTINUE
+                  ELSE
+*                    Avoid repeating tests if N.le.0.
+                     IF( N.LE.0 )
+     $                  GO TO 100
+                  END IF
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  110 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, RALPHA, INCX, LDA
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, RALPHA, INCX
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', AP)                                         .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', A,', I3, ')                                      .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK5.
+*
+      END
+      SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests CHER2 and CHPR2.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, HALF, ONE
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), HALF = ( 0.5, 0.0 ),
+     $                   ONE = ( 1.0, 0.0 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX, 2 )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, ALS, TRANSL
+      REAL               ERR, ERRMAX
+      INTEGER            I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX,
+     $                   IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N,
+     $                   NARGS, NC, NS
+      LOGICAL            FULL, NULL, PACKED, RESET, SAME, UPPER
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      COMPLEX            W( 2 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CHER2, CHPR2, CMAKE, CMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, CONJG, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'E'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 9
+      ELSE IF( PACKED )THEN
+         NARGS = 8
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 140 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDA to 1 more than minimum value if room.
+         LDA = N
+         IF( LDA.LT.NMAX )
+     $      LDA = LDA + 1
+*        Skip tests if not enough room.
+         IF( LDA.GT.NMAX )
+     $      GO TO 140
+         IF( PACKED )THEN
+            LAA = ( N*( N + 1 ) )/2
+         ELSE
+            LAA = LDA*N
+         END IF
+*
+         DO 130 IC = 1, 2
+            UPLO = ICH( IC: IC )
+            UPPER = UPLO.EQ.'U'
+*
+            DO 120 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*N
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL CMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX, ABS( INCX ),
+     $                     0, N - 1, RESET, TRANSL )
+               IF( N.GT.1 )THEN
+                  X( N/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 110 IY = 1, NINC
+                  INCY = INC( IY )
+                  LY = ABS( INCY )*N
+*
+*                 Generate the vector Y.
+*
+                  TRANSL = ZERO
+                  CALL CMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                        ABS( INCY ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     Y( N/2 ) = ZERO
+                     YY( 1 + ABS( INCY )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 100 IA = 1, NALF
+                     ALPHA = ALF( IA )
+                     NULL = N.LE.0.OR.ALPHA.EQ.ZERO
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL CMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A,
+     $                           NMAX, AA, LDA, N - 1, N - 1, RESET,
+     $                           TRANSL )
+*
+                     NC = NC + 1
+*
+*                    Save every datum before calling the subroutine.
+*
+                     UPLOS = UPLO
+                     NS = N
+                     ALS = ALPHA
+                     DO 10 I = 1, LAA
+                        AS( I ) = AA( I )
+   10                CONTINUE
+                     LDAS = LDA
+                     DO 20 I = 1, LX
+                        XS( I ) = XX( I )
+   20                CONTINUE
+                     INCXS = INCX
+                     DO 30 I = 1, LY
+                        YS( I ) = YY( I )
+   30                CONTINUE
+                     INCYS = INCY
+*
+*                    Call the subroutine.
+*
+                     IF( FULL )THEN
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO, N,
+     $                     ALPHA, INCX, INCY, LDA
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL CHER2( UPLO, N, ALPHA, XX, INCX, YY, INCY,
+     $                              AA, LDA )
+                     ELSE IF( PACKED )THEN
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO, N,
+     $                     ALPHA, INCX, INCY
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL CHPR2( UPLO, N, ALPHA, XX, INCX, YY, INCY,
+     $                              AA )
+                     END IF
+*
+*                    Check if error-exit was taken incorrectly.
+*
+                     IF( .NOT.OK )THEN
+                        WRITE( NOUT, FMT = 9992 )
+                        FATAL = .TRUE.
+                        GO TO 160
+                     END IF
+*
+*                    See what data changed inside subroutines.
+*
+                     ISAME( 1 ) = UPLO.EQ.UPLOS
+                     ISAME( 2 ) = NS.EQ.N
+                     ISAME( 3 ) = ALS.EQ.ALPHA
+                     ISAME( 4 ) = LCE( XS, XX, LX )
+                     ISAME( 5 ) = INCXS.EQ.INCX
+                     ISAME( 6 ) = LCE( YS, YY, LY )
+                     ISAME( 7 ) = INCYS.EQ.INCY
+                     IF( NULL )THEN
+                        ISAME( 8 ) = LCE( AS, AA, LAA )
+                     ELSE
+                        ISAME( 8 ) = LCERES( SNAME( 2: 3 ), UPLO, N, N,
+     $                               AS, AA, LDA )
+                     END IF
+                     IF( .NOT.PACKED )THEN
+                        ISAME( 9 ) = LDAS.EQ.LDA
+                     END IF
+*
+*                    If data was incorrectly changed, report and return.
+*
+                     SAME = .TRUE.
+                     DO 40 I = 1, NARGS
+                        SAME = SAME.AND.ISAME( I )
+                        IF( .NOT.ISAME( I ) )
+     $                     WRITE( NOUT, FMT = 9998 )I
+   40                CONTINUE
+                     IF( .NOT.SAME )THEN
+                        FATAL = .TRUE.
+                        GO TO 160
+                     END IF
+*
+                     IF( .NOT.NULL )THEN
+*
+*                       Check the result column by column.
+*
+                        IF( INCX.GT.0 )THEN
+                           DO 50 I = 1, N
+                              Z( I, 1 ) = X( I )
+   50                      CONTINUE
+                        ELSE
+                           DO 60 I = 1, N
+                              Z( I, 1 ) = X( N - I + 1 )
+   60                      CONTINUE
+                        END IF
+                        IF( INCY.GT.0 )THEN
+                           DO 70 I = 1, N
+                              Z( I, 2 ) = Y( I )
+   70                      CONTINUE
+                        ELSE
+                           DO 80 I = 1, N
+                              Z( I, 2 ) = Y( N - I + 1 )
+   80                      CONTINUE
+                        END IF
+                        JA = 1
+                        DO 90 J = 1, N
+                           W( 1 ) = ALPHA*CONJG( Z( J, 2 ) )
+                           W( 2 ) = CONJG( ALPHA )*CONJG( Z( J, 1 ) )
+                           IF( UPPER )THEN
+                              JJ = 1
+                              LJ = J
+                           ELSE
+                              JJ = J
+                              LJ = N - J + 1
+                           END IF
+                           CALL CMVCH( 'N', LJ, 2, ONE, Z( JJ, 1 ),
+     $                                 NMAX, W, 1, ONE, A( JJ, J ), 1,
+     $                                 YT, G, AA( JA ), EPS, ERR, FATAL,
+     $                                 NOUT, .TRUE. )
+                           IF( FULL )THEN
+                              IF( UPPER )THEN
+                                 JA = JA + LDA
+                              ELSE
+                                 JA = JA + LDA + 1
+                              END IF
+                           ELSE
+                              JA = JA + LJ
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 150
+   90                   CONTINUE
+                     ELSE
+*                       Avoid repeating tests with N.le.0.
+                        IF( N.LE.0 )
+     $                     GO TO 140
+                     END IF
+*
+  100             CONTINUE
+*
+  110          CONTINUE
+*
+  120       CONTINUE
+*
+  130    CONTINUE
+*
+  140 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 170
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  160 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, INCX,
+     $      INCY, LDA
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, ALPHA, INCX, INCY
+      END IF
+*
+  170 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',(', F4.1, ',',
+     $      F4.1, '), X,', I2, ', Y,', I2, ', AP)                     ',
+     $      '       .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',(', F4.1, ',',
+     $      F4.1, '), X,', I2, ', Y,', I2, ', A,', I3, ')             ',
+     $      '            .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK6.
+*
+      END
+      SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT )
+*
+*  Tests the error exits from the Level 2 Blas.
+*  Requires a special version of the error-handling routine XERBLA.
+*  ALPHA, RALPHA, BETA, A, X and Y should not need to be defined.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            ISNUM, NOUT
+      CHARACTER*6        SRNAMT
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, BETA
+      REAL               RALPHA
+*     .. Local Arrays ..
+      COMPLEX            A( 1, 1 ), X( 1 ), Y( 1 )
+*     .. External Subroutines ..
+      EXTERNAL           CGBMV, CGEMV, CGERC, CGERU, CHBMV, CHEMV, CHER,
+     $                   CHER2, CHKXER, CHPMV, CHPR, CHPR2, CTBMV,
+     $                   CTBSV, CTPMV, CTPSV, CTRMV, CTRSV
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+*     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
+*     if anything is wrong.
+      OK = .TRUE.
+*     LERR is set to .TRUE. by the special version of XERBLA each time
+*     it is called, and is then tested and re-set by CHKXER.
+      LERR = .FALSE.
+      GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
+     $        90, 100, 110, 120, 130, 140, 150, 160,
+     $        170 )ISNUM
+   10 INFOT = 1
+      CALL CGEMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CGEMV( 'N', -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGEMV( 'N', 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CGEMV( 'N', 2, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGEMV( 'N', 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CGEMV( 'N', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   20 INFOT = 1
+      CALL CGBMV( '/', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CGBMV( 'N', -1, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGBMV( 'N', 0, -1, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CGBMV( 'N', 0, 0, -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGBMV( 'N', 2, 0, 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGBMV( 'N', 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL CGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   30 INFOT = 1
+      CALL CHEMV( '/', 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CHEMV( 'U', -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CHEMV( 'U', 2, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHEMV( 'U', 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CHEMV( 'U', 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   40 INFOT = 1
+      CALL CHBMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CHBMV( 'U', -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHBMV( 'U', 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CHBMV( 'U', 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CHBMV( 'U', 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CHBMV( 'U', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   50 INFOT = 1
+      CALL CHPMV( '/', 0, ALPHA, A, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CHPMV( 'U', -1, ALPHA, A, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CHPMV( 'U', 0, ALPHA, A, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CHPMV( 'U', 0, ALPHA, A, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   60 INFOT = 1
+      CALL CTRMV( '/', 'N', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CTRMV( 'U', '/', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CTRMV( 'U', 'N', '/', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CTRMV( 'U', 'N', 'N', -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMV( 'U', 'N', 'N', 2, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CTRMV( 'U', 'N', 'N', 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   70 INFOT = 1
+      CALL CTBMV( '/', 'N', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CTBMV( 'U', '/', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CTBMV( 'U', 'N', '/', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CTBMV( 'U', 'N', 'N', -1, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTBMV( 'U', 'N', 'N', 0, -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CTBMV( 'U', 'N', 'N', 0, 1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTBMV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   80 INFOT = 1
+      CALL CTPMV( '/', 'N', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CTPMV( 'U', '/', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CTPMV( 'U', 'N', '/', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CTPMV( 'U', 'N', 'N', -1, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CTPMV( 'U', 'N', 'N', 0, A, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   90 INFOT = 1
+      CALL CTRSV( '/', 'N', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CTRSV( 'U', '/', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CTRSV( 'U', 'N', '/', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CTRSV( 'U', 'N', 'N', -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSV( 'U', 'N', 'N', 2, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CTRSV( 'U', 'N', 'N', 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  100 INFOT = 1
+      CALL CTBSV( '/', 'N', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CTBSV( 'U', '/', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CTBSV( 'U', 'N', '/', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CTBSV( 'U', 'N', 'N', -1, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTBSV( 'U', 'N', 'N', 0, -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CTBSV( 'U', 'N', 'N', 0, 1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTBSV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  110 INFOT = 1
+      CALL CTPSV( '/', 'N', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CTPSV( 'U', '/', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CTPSV( 'U', 'N', '/', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CTPSV( 'U', 'N', 'N', -1, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CTPSV( 'U', 'N', 'N', 0, A, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  120 INFOT = 1
+      CALL CGERC( -1, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CGERC( 0, -1, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGERC( 0, 0, ALPHA, X, 0, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CGERC( 0, 0, ALPHA, X, 1, Y, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CGERC( 2, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  130 INFOT = 1
+      CALL CGERU( -1, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CGERU( 0, -1, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGERU( 0, 0, ALPHA, X, 0, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CGERU( 0, 0, ALPHA, X, 1, Y, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CGERU( 2, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  140 INFOT = 1
+      CALL CHER( '/', 0, RALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CHER( 'U', -1, RALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CHER( 'U', 0, RALPHA, X, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHER( 'U', 2, RALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  150 INFOT = 1
+      CALL CHPR( '/', 0, RALPHA, X, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CHPR( 'U', -1, RALPHA, X, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CHPR( 'U', 0, RALPHA, X, 0, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  160 INFOT = 1
+      CALL CHER2( '/', 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CHER2( 'U', -1, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CHER2( 'U', 0, ALPHA, X, 0, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHER2( 'U', 0, ALPHA, X, 1, Y, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CHER2( 'U', 2, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  170 INFOT = 1
+      CALL CHPR2( '/', 0, ALPHA, X, 1, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CHPR2( 'U', -1, ALPHA, X, 1, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CHPR2( 'U', 0, ALPHA, X, 0, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHPR2( 'U', 0, ALPHA, X, 1, Y, 0, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+  180 IF( OK )THEN
+         WRITE( NOUT, FMT = 9999 )SRNAMT
+      ELSE
+         WRITE( NOUT, FMT = 9998 )SRNAMT
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+     $      '**' )
+*
+*     End of CCHKE.
+*
+      END
+      SUBROUTINE CMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL,
+     $                  KU, RESET, TRANSL )
+*
+*  Generates values for an M by N matrix A within the bandwidth
+*  defined by KL and KU.
+*  Stores the values in the array AA in the data structure required
+*  by the routine, with unwanted elements set to rogue value.
+*
+*  TYPE is 'GE', 'GB', 'HE', 'HB', 'HP', 'TR', 'TB' OR 'TP'.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
+      COMPLEX            ROGUE
+      PARAMETER          ( ROGUE = ( -1.0E10, 1.0E10 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+      REAL               RROGUE
+      PARAMETER          ( RROGUE = -1.0E10 )
+*     .. Scalar Arguments ..
+      COMPLEX            TRANSL
+      INTEGER            KL, KU, LDA, M, N, NMAX
+      LOGICAL            RESET
+      CHARACTER*1        DIAG, UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, * ), AA( * )
+*     .. Local Scalars ..
+      INTEGER            I, I1, I2, I3, IBEG, IEND, IOFF, J, JJ, KK
+      LOGICAL            GEN, LOWER, SYM, TRI, UNIT, UPPER
+*     .. External Functions ..
+      COMPLEX            CBEG
+      EXTERNAL           CBEG
+*     .. Intrinsic Functions ..
+      INTRINSIC          CMPLX, CONJG, MAX, MIN, REAL
+*     .. Executable Statements ..
+      GEN = TYPE( 1: 1 ).EQ.'G'
+      SYM = TYPE( 1: 1 ).EQ.'H'
+      TRI = TYPE( 1: 1 ).EQ.'T'
+      UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U'
+      LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L'
+      UNIT = TRI.AND.DIAG.EQ.'U'
+*
+*     Generate data in array A.
+*
+      DO 20 J = 1, N
+         DO 10 I = 1, M
+            IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
+     $          THEN
+               IF( ( I.LE.J.AND.J - I.LE.KU ).OR.
+     $             ( I.GE.J.AND.I - J.LE.KL ) )THEN
+                  A( I, J ) = CBEG( RESET ) + TRANSL
+               ELSE
+                  A( I, J ) = ZERO
+               END IF
+               IF( I.NE.J )THEN
+                  IF( SYM )THEN
+                     A( J, I ) = CONJG( A( I, J ) )
+                  ELSE IF( TRI )THEN
+                     A( J, I ) = ZERO
+                  END IF
+               END IF
+            END IF
+   10    CONTINUE
+         IF( SYM )
+     $      A( J, J ) = CMPLX( REAL( A( J, J ) ), RZERO )
+         IF( TRI )
+     $      A( J, J ) = A( J, J ) + ONE
+         IF( UNIT )
+     $      A( J, J ) = ONE
+   20 CONTINUE
+*
+*     Store elements in array AS in data structure required by routine.
+*
+      IF( TYPE.EQ.'GE' )THEN
+         DO 50 J = 1, N
+            DO 30 I = 1, M
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   30       CONTINUE
+            DO 40 I = M + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   40       CONTINUE
+   50    CONTINUE
+      ELSE IF( TYPE.EQ.'GB' )THEN
+         DO 90 J = 1, N
+            DO 60 I1 = 1, KU + 1 - J
+               AA( I1 + ( J - 1 )*LDA ) = ROGUE
+   60       CONTINUE
+            DO 70 I2 = I1, MIN( KL + KU + 1, KU + 1 + M - J )
+               AA( I2 + ( J - 1 )*LDA ) = A( I2 + J - KU - 1, J )
+   70       CONTINUE
+            DO 80 I3 = I2, LDA
+               AA( I3 + ( J - 1 )*LDA ) = ROGUE
+   80       CONTINUE
+   90    CONTINUE
+      ELSE IF( TYPE.EQ.'HE'.OR.TYPE.EQ.'TR' )THEN
+         DO 130 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IF( UNIT )THEN
+                  IEND = J - 1
+               ELSE
+                  IEND = J
+               END IF
+            ELSE
+               IF( UNIT )THEN
+                  IBEG = J + 1
+               ELSE
+                  IBEG = J
+               END IF
+               IEND = N
+            END IF
+            DO 100 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  100       CONTINUE
+            DO 110 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+  110       CONTINUE
+            DO 120 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  120       CONTINUE
+            IF( SYM )THEN
+               JJ = J + ( J - 1 )*LDA
+               AA( JJ ) = CMPLX( REAL( AA( JJ ) ), RROGUE )
+            END IF
+  130    CONTINUE
+      ELSE IF( TYPE.EQ.'HB'.OR.TYPE.EQ.'TB' )THEN
+         DO 170 J = 1, N
+            IF( UPPER )THEN
+               KK = KL + 1
+               IBEG = MAX( 1, KL + 2 - J )
+               IF( UNIT )THEN
+                  IEND = KL
+               ELSE
+                  IEND = KL + 1
+               END IF
+            ELSE
+               KK = 1
+               IF( UNIT )THEN
+                  IBEG = 2
+               ELSE
+                  IBEG = 1
+               END IF
+               IEND = MIN( KL + 1, 1 + M - J )
+            END IF
+            DO 140 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  140       CONTINUE
+            DO 150 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I + J - KK, J )
+  150       CONTINUE
+            DO 160 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  160       CONTINUE
+            IF( SYM )THEN
+               JJ = KK + ( J - 1 )*LDA
+               AA( JJ ) = CMPLX( REAL( AA( JJ ) ), RROGUE )
+            END IF
+  170    CONTINUE
+      ELSE IF( TYPE.EQ.'HP'.OR.TYPE.EQ.'TP' )THEN
+         IOFF = 0
+         DO 190 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 180 I = IBEG, IEND
+               IOFF = IOFF + 1
+               AA( IOFF ) = A( I, J )
+               IF( I.EQ.J )THEN
+                  IF( UNIT )
+     $               AA( IOFF ) = ROGUE
+                  IF( SYM )
+     $               AA( IOFF ) = CMPLX( REAL( AA( IOFF ) ), RROGUE )
+               END IF
+  180       CONTINUE
+  190    CONTINUE
+      END IF
+      RETURN
+*
+*     End of CMAKE.
+*
+      END
+      SUBROUTINE CMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y,
+     $                  INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV )
+*
+*  Checks the results of the computational tests.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ) )
+      REAL               RZERO, RONE
+      PARAMETER          ( RZERO = 0.0, RONE = 1.0 )
+*     .. Scalar Arguments ..
+      COMPLEX            ALPHA, BETA
+      REAL               EPS, ERR
+      INTEGER            INCX, INCY, M, N, NMAX, NOUT
+      LOGICAL            FATAL, MV
+      CHARACTER*1        TRANS
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, * ), X( * ), Y( * ), YT( * ), YY( * )
+      REAL               G( * )
+*     .. Local Scalars ..
+      COMPLEX            C
+      REAL               ERRI
+      INTEGER            I, INCXL, INCYL, IY, J, JX, KX, KY, ML, NL
+      LOGICAL            CTRAN, TRAN
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, AIMAG, CONJG, MAX, REAL, SQRT
+*     .. Statement Functions ..
+      REAL               ABS1
+*     .. Statement Function definitions ..
+      ABS1( C ) = ABS( REAL( C ) ) + ABS( AIMAG( C ) )
+*     .. Executable Statements ..
+      TRAN = TRANS.EQ.'T'
+      CTRAN = TRANS.EQ.'C'
+      IF( TRAN.OR.CTRAN )THEN
+         ML = N
+         NL = M
+      ELSE
+         ML = M
+         NL = N
+      END IF
+      IF( INCX.LT.0 )THEN
+         KX = NL
+         INCXL = -1
+      ELSE
+         KX = 1
+         INCXL = 1
+      END IF
+      IF( INCY.LT.0 )THEN
+         KY = ML
+         INCYL = -1
+      ELSE
+         KY = 1
+         INCYL = 1
+      END IF
+*
+*     Compute expected result in YT using data in A, X and Y.
+*     Compute gauges in G.
+*
+      IY = KY
+      DO 40 I = 1, ML
+         YT( IY ) = ZERO
+         G( IY ) = RZERO
+         JX = KX
+         IF( TRAN )THEN
+            DO 10 J = 1, NL
+               YT( IY ) = YT( IY ) + A( J, I )*X( JX )
+               G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) )
+               JX = JX + INCXL
+   10       CONTINUE
+         ELSE IF( CTRAN )THEN
+            DO 20 J = 1, NL
+               YT( IY ) = YT( IY ) + CONJG( A( J, I ) )*X( JX )
+               G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) )
+               JX = JX + INCXL
+   20       CONTINUE
+         ELSE
+            DO 30 J = 1, NL
+               YT( IY ) = YT( IY ) + A( I, J )*X( JX )
+               G( IY ) = G( IY ) + ABS1( A( I, J ) )*ABS1( X( JX ) )
+               JX = JX + INCXL
+   30       CONTINUE
+         END IF
+         YT( IY ) = ALPHA*YT( IY ) + BETA*Y( IY )
+         G( IY ) = ABS1( ALPHA )*G( IY ) + ABS1( BETA )*ABS1( Y( IY ) )
+         IY = IY + INCYL
+   40 CONTINUE
+*
+*     Compute the error ratio for this result.
+*
+      ERR = ZERO
+      DO 50 I = 1, ML
+         ERRI = ABS( YT( I ) - YY( 1 + ( I - 1 )*ABS( INCY ) ) )/EPS
+         IF( G( I ).NE.RZERO )
+     $      ERRI = ERRI/G( I )
+         ERR = MAX( ERR, ERRI )
+         IF( ERR*SQRT( EPS ).GE.RONE )
+     $      GO TO 60
+   50 CONTINUE
+*     If the loop completes, all results are at least half accurate.
+      GO TO 80
+*
+*     Report fatal error.
+*
+   60 FATAL = .TRUE.
+      WRITE( NOUT, FMT = 9999 )
+      DO 70 I = 1, ML
+         IF( MV )THEN
+            WRITE( NOUT, FMT = 9998 )I, YT( I ),
+     $         YY( 1 + ( I - 1 )*ABS( INCY ) )
+         ELSE
+            WRITE( NOUT, FMT = 9998 )I,
+     $         YY( 1 + ( I - 1 )*ABS( INCY ) ), YT( I )
+         END IF
+   70 CONTINUE
+*
+   80 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
+     $      'F ACCURATE *******', /'                       EXPECTED RE',
+     $      'SULT                    COMPUTED RESULT' )
+ 9998 FORMAT( 1X, I7, 2( '  (', G15.6, ',', G15.6, ')' ) )
+*
+*     End of CMVCH.
+*
+      END
+      LOGICAL FUNCTION LCE( RI, RJ, LR )
+*
+*  Tests if two arrays are identical.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LR
+*     .. Array Arguments ..
+      COMPLEX            RI( * ), RJ( * )
+*     .. Local Scalars ..
+      INTEGER            I
+*     .. Executable Statements ..
+      DO 10 I = 1, LR
+         IF( RI( I ).NE.RJ( I ) )
+     $      GO TO 20
+   10 CONTINUE
+      LCE = .TRUE.
+      GO TO 30
+   20 CONTINUE
+      LCE = .FALSE.
+   30 RETURN
+*
+*     End of LCE.
+*
+      END
+      LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA )
+*
+*  Tests if selected elements in two arrays are equal.
+*
+*  TYPE is 'GE', 'HE' or 'HP'.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDA, M, N
+      CHARACTER*1        UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      COMPLEX            AA( LDA, * ), AS( LDA, * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J
+      LOGICAL            UPPER
+*     .. Executable Statements ..
+      UPPER = UPLO.EQ.'U'
+      IF( TYPE.EQ.'GE' )THEN
+         DO 20 J = 1, N
+            DO 10 I = M + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   10       CONTINUE
+   20    CONTINUE
+      ELSE IF( TYPE.EQ.'HE' )THEN
+         DO 50 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 30 I = 1, IBEG - 1
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   30       CONTINUE
+            DO 40 I = IEND + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   40       CONTINUE
+   50    CONTINUE
+      END IF
+*
+   60 CONTINUE
+      LCERES = .TRUE.
+      GO TO 80
+   70 CONTINUE
+      LCERES = .FALSE.
+   80 RETURN
+*
+*     End of LCERES.
+*
+      END
+      COMPLEX FUNCTION CBEG( RESET )
+*
+*  Generates complex numbers as pairs of random numbers uniformly
+*  distributed between -0.5 and 0.5.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      LOGICAL            RESET
+*     .. Local Scalars ..
+      INTEGER            I, IC, J, MI, MJ
+*     .. Save statement ..
+      SAVE               I, IC, J, MI, MJ
+*     .. Intrinsic Functions ..
+      INTRINSIC          CMPLX
+*     .. Executable Statements ..
+      IF( RESET )THEN
+*        Initialize local variables.
+         MI = 891
+         MJ = 457
+         I = 7
+         J = 7
+         IC = 0
+         RESET = .FALSE.
+      END IF
+*
+*     The sequence of values of I or J is bounded between 1 and 999.
+*     If initial I or J = 1,2,3,6,7 or 9, the period will be 50.
+*     If initial I or J = 4 or 8, the period will be 25.
+*     If initial I or J = 5, the period will be 10.
+*     IC is used to break up the period by skipping 1 value of I or J
+*     in 6.
+*
+      IC = IC + 1
+   10 I = I*MI
+      J = J*MJ
+      I = I - 1000*( I/1000 )
+      J = J - 1000*( J/1000 )
+      IF( IC.GE.5 )THEN
+         IC = 0
+         GO TO 10
+      END IF
+      CBEG = CMPLX( ( I - 500 )/1001.0, ( J - 500 )/1001.0 )
+      RETURN
+*
+*     End of CBEG.
+*
+      END
+      REAL FUNCTION SDIFF( X, Y )
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*
+*     .. Scalar Arguments ..
+      REAL               X, Y
+*     .. Executable Statements ..
+      SDIFF = X - Y
+      RETURN
+*
+*     End of SDIFF.
+*
+      END
+      SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+*  Tests whether XERBLA has detected an error when it should.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Executable Statements ..
+      IF( .NOT.LERR )THEN
+         WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
+         OK = .FALSE.
+      END IF
+      LERR = .FALSE.
+      RETURN
+*
+ 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
+     $      'ETECTED BY ', A6, ' *****' )
+*
+*     End of CHKXER.
+*
+      END
+      SUBROUTINE XERBLA( SRNAME, INFO )
+*
+*  This is a special version of XERBLA to be used only as part of
+*  the test program for testing error exits from the Level 2 BLAS
+*  routines.
+*
+*  XERBLA  is an error handler for the Level 2 BLAS routines.
+*
+*  It is called by the Level 2 BLAS routines if an input parameter is
+*  invalid.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO
+      CHARACTER*6        SRNAME
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUT, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Executable Statements ..
+      LERR = .TRUE.
+      IF( INFO.NE.INFOT )THEN
+         IF( INFOT.NE.0 )THEN
+            WRITE( NOUT, FMT = 9999 )INFO, INFOT
+         ELSE
+            WRITE( NOUT, FMT = 9997 )INFO
+         END IF
+         OK = .FALSE.
+      END IF
+      IF( SRNAME.NE.SRNAMT )THEN
+         WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
+         OK = .FALSE.
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
+     $      ' OF ', I2, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
+     $      'AD OF ', A6, ' *******' )
+ 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
+     $      ' *******' )
+*
+*     End of XERBLA
+*
+      END
+
diff --git a/eigen/blas/testing/cblat3.dat b/eigen/blas/testing/cblat3.dat
new file mode 100644
index 0000000..59881ea
--- /dev/null
+++ b/eigen/blas/testing/cblat3.dat
@@ -0,0 +1,23 @@
+'cblat3.summ'     NAME OF SUMMARY OUTPUT FILE
+6                 UNIT NUMBER OF SUMMARY FILE
+'cblat3.snap'     NAME OF SNAPSHOT OUTPUT FILE
+-1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
+F        LOGICAL FLAG, T TO TEST ERROR EXITS.
+16.0     THRESHOLD VALUE OF TEST RATIO
+6                 NUMBER OF VALUES OF N
+0 1 2 3 5 9       VALUES OF N
+3                 NUMBER OF VALUES OF ALPHA
+(0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
+3                 NUMBER OF VALUES OF BETA
+(0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
+CGEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+CHEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+CSYMM  T PUT F FOR NO TEST. SAME COLUMNS.
+CTRMM  T PUT F FOR NO TEST. SAME COLUMNS.
+CTRSM  T PUT F FOR NO TEST. SAME COLUMNS.
+CHERK  T PUT F FOR NO TEST. SAME COLUMNS.
+CSYRK  T PUT F FOR NO TEST. SAME COLUMNS.
+CHER2K T PUT F FOR NO TEST. SAME COLUMNS.
+CSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
diff --git a/eigen/blas/testing/cblat3.f b/eigen/blas/testing/cblat3.f
new file mode 100644
index 0000000..b26be91
--- /dev/null
+++ b/eigen/blas/testing/cblat3.f
@@ -0,0 +1,3439 @@
+      PROGRAM CBLAT3
+*
+*  Test program for the COMPLEX          Level 3 Blas.
+*
+*  The program must be driven by a short data file. The first 14 records
+*  of the file are read using list-directed input, the last 9 records
+*  are read using the format ( A6, L2 ). An annotated example of a data
+*  file can be obtained by deleting the first 3 characters from the
+*  following 23 lines:
+*  'CBLAT3.SUMM'     NAME OF SUMMARY OUTPUT FILE
+*  6                 UNIT NUMBER OF SUMMARY FILE
+*  'CBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
+*  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+*  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+*  F        LOGICAL FLAG, T TO STOP ON FAILURES.
+*  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+*  16.0     THRESHOLD VALUE OF TEST RATIO
+*  6                 NUMBER OF VALUES OF N
+*  0 1 2 3 5 9       VALUES OF N
+*  3                 NUMBER OF VALUES OF ALPHA
+*  (0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
+*  3                 NUMBER OF VALUES OF BETA
+*  (0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
+*  CGEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CHEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CSYMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CTRMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CTRSM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CHERK  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CSYRK  T PUT F FOR NO TEST. SAME COLUMNS.
+*  CHER2K T PUT F FOR NO TEST. SAME COLUMNS.
+*  CSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
+*
+*  See:
+*
+*     Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
+*     A Set of Level 3 Basic Linear Algebra Subprograms.
+*
+*     Technical Memorandum No.88 (Revision 1), Mathematics and
+*     Computer Science Division, Argonne National Laboratory, 9700
+*     South Cass Avenue, Argonne, Illinois 60439, US.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      INTEGER            NIN
+      PARAMETER          ( NIN = 5 )
+      INTEGER            NSUBS
+      PARAMETER          ( NSUBS = 9 )
+      COMPLEX            ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
+      REAL               RZERO, RHALF, RONE
+      PARAMETER          ( RZERO = 0.0, RHALF = 0.5, RONE = 1.0 )
+      INTEGER            NMAX
+      PARAMETER          ( NMAX = 65 )
+      INTEGER            NIDMAX, NALMAX, NBEMAX
+      PARAMETER          ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 )
+*     .. Local Scalars ..
+      REAL               EPS, ERR, THRESH
+      INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA
+      LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
+     $                   TSTERR
+      CHARACTER*1        TRANSA, TRANSB
+      CHARACTER*6        SNAMET
+      CHARACTER*32       SNAPS, SUMMRY
+*     .. Local Arrays ..
+      COMPLEX            AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
+     $                   ALF( NALMAX ), AS( NMAX*NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBEMAX ),
+     $                   BS( NMAX*NMAX ), C( NMAX, NMAX ),
+     $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
+     $                   W( 2*NMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDMAX )
+      LOGICAL            LTEST( NSUBS )
+      CHARACTER*6        SNAMES( NSUBS )
+*     .. External Functions ..
+      REAL               SDIFF
+      LOGICAL            LCE
+      EXTERNAL           SDIFF, LCE
+*     .. External Subroutines ..
+      EXTERNAL           CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CCHKE, CMMCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Data statements ..
+      DATA               SNAMES/'CGEMM ', 'CHEMM ', 'CSYMM ', 'CTRMM ',
+     $                   'CTRSM ', 'CHERK ', 'CSYRK ', 'CHER2K',
+     $                   'CSYR2K'/
+*     .. Executable Statements ..
+*
+*     Read name and unit number for summary output file and open file.
+*
+      READ( NIN, FMT = * )SUMMRY
+      READ( NIN, FMT = * )NOUT
+      OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+      NOUTC = NOUT
+*
+*     Read name and unit number for snapshot output file and open file.
+*
+      READ( NIN, FMT = * )SNAPS
+      READ( NIN, FMT = * )NTRA
+      TRACE = NTRA.GE.0
+      IF( TRACE )THEN
+         OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+      END IF
+*     Read the flag that directs rewinding of the snapshot file.
+      READ( NIN, FMT = * )REWI
+      REWI = REWI.AND.TRACE
+*     Read the flag that directs stopping on any failure.
+      READ( NIN, FMT = * )SFATAL
+*     Read the flag that indicates whether error exits are to be tested.
+      READ( NIN, FMT = * )TSTERR
+*     Read the threshold value of the test ratio
+      READ( NIN, FMT = * )THRESH
+*
+*     Read and check the parameter values for the tests.
+*
+*     Values of N
+      READ( NIN, FMT = * )NIDIM
+      IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'N', NIDMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
+      DO 10 I = 1, NIDIM
+         IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
+            WRITE( NOUT, FMT = 9996 )NMAX
+            GO TO 220
+         END IF
+   10 CONTINUE
+*     Values of ALPHA
+      READ( NIN, FMT = * )NALF
+      IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
+*     Values of BETA
+      READ( NIN, FMT = * )NBET
+      IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
+*
+*     Report values of parameters.
+*
+      WRITE( NOUT, FMT = 9995 )
+      WRITE( NOUT, FMT = 9994 )( IDIM( I ), I = 1, NIDIM )
+      WRITE( NOUT, FMT = 9993 )( ALF( I ), I = 1, NALF )
+      WRITE( NOUT, FMT = 9992 )( BET( I ), I = 1, NBET )
+      IF( .NOT.TSTERR )THEN
+         WRITE( NOUT, FMT = * )
+         WRITE( NOUT, FMT = 9984 )
+      END IF
+      WRITE( NOUT, FMT = * )
+      WRITE( NOUT, FMT = 9999 )THRESH
+      WRITE( NOUT, FMT = * )
+*
+*     Read names of subroutines and flags which indicate
+*     whether they are to be tested.
+*
+      DO 20 I = 1, NSUBS
+         LTEST( I ) = .FALSE.
+   20 CONTINUE
+   30 READ( NIN, FMT = 9988, END = 60 )SNAMET, LTESTT
+      DO 40 I = 1, NSUBS
+         IF( SNAMET.EQ.SNAMES( I ) )
+     $      GO TO 50
+   40 CONTINUE
+      WRITE( NOUT, FMT = 9990 )SNAMET
+      STOP
+   50 LTEST( I ) = LTESTT
+      GO TO 30
+*
+   60 CONTINUE
+      CLOSE ( NIN )
+*
+*     Compute EPS (the machine precision).
+*
+      EPS = RONE
+   70 CONTINUE
+      IF( SDIFF( RONE + EPS, RONE ).EQ.RZERO )
+     $   GO TO 80
+      EPS = RHALF*EPS
+      GO TO 70
+   80 CONTINUE
+      EPS = EPS + EPS
+      WRITE( NOUT, FMT = 9998 )EPS
+*
+*     Check the reliability of CMMCH using exact data.
+*
+      N = MIN( 32, NMAX )
+      DO 100 J = 1, N
+         DO 90 I = 1, N
+            AB( I, J ) = MAX( I - J + 1, 0 )
+   90    CONTINUE
+         AB( J, NMAX + 1 ) = J
+         AB( 1, NMAX + J ) = J
+         C( J, 1 ) = ZERO
+  100 CONTINUE
+      DO 110 J = 1, N
+         CC( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3
+  110 CONTINUE
+*     CC holds the exact result. On exit from CMMCH CT holds
+*     the result computed by CMMCH.
+      TRANSA = 'N'
+      TRANSB = 'N'
+      CALL CMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LCE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      TRANSB = 'C'
+      CALL CMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LCE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      DO 120 J = 1, N
+         AB( J, NMAX + 1 ) = N - J + 1
+         AB( 1, NMAX + J ) = N - J + 1
+  120 CONTINUE
+      DO 130 J = 1, N
+         CC( N - J + 1 ) = J*( ( J + 1 )*J )/2 -
+     $                     ( ( J + 1 )*J*( J - 1 ) )/3
+  130 CONTINUE
+      TRANSA = 'C'
+      TRANSB = 'N'
+      CALL CMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LCE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      TRANSB = 'C'
+      CALL CMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LCE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+*
+*     Test each subroutine in turn.
+*
+      DO 200 ISNUM = 1, NSUBS
+         WRITE( NOUT, FMT = * )
+         IF( .NOT.LTEST( ISNUM ) )THEN
+*           Subprogram is not to be tested.
+            WRITE( NOUT, FMT = 9987 )SNAMES( ISNUM )
+         ELSE
+            SRNAMT = SNAMES( ISNUM )
+*           Test error exits.
+            IF( TSTERR )THEN
+               CALL CCHKE( ISNUM, SNAMES( ISNUM ), NOUT )
+               WRITE( NOUT, FMT = * )
+            END IF
+*           Test computations.
+            INFOT = 0
+            OK = .TRUE.
+            FATAL = .FALSE.
+            GO TO ( 140, 150, 150, 160, 160, 170, 170,
+     $              180, 180 )ISNUM
+*           Test CGEMM, 01.
+  140       CALL CCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test CHEMM, 02, CSYMM, 03.
+  150       CALL CCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test CTRMM, 04, CTRSM, 05.
+  160       CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
+     $                  AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C )
+            GO TO 190
+*           Test CHERK, 06, CSYRK, 07.
+  170       CALL CCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test CHER2K, 08, CSYR2K, 09.
+  180       CALL CCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
+            GO TO 190
+*
+  190       IF( FATAL.AND.SFATAL )
+     $         GO TO 210
+         END IF
+  200 CONTINUE
+      WRITE( NOUT, FMT = 9986 )
+      GO TO 230
+*
+  210 CONTINUE
+      WRITE( NOUT, FMT = 9985 )
+      GO TO 230
+*
+  220 CONTINUE
+      WRITE( NOUT, FMT = 9991 )
+*
+  230 CONTINUE
+      IF( TRACE )
+     $   CLOSE ( NTRA )
+      CLOSE ( NOUT )
+      STOP
+*
+ 9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
+     $      'S THAN', F8.2 )
+ 9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, E9.1 )
+ 9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
+     $      'THAN ', I2 )
+ 9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 )
+ 9995 FORMAT( ' TESTS OF THE COMPLEX          LEVEL 3 BLAS', //' THE F',
+     $      'OLLOWING PARAMETER VALUES WILL BE USED:' )
+ 9994 FORMAT( '   FOR N              ', 9I6 )
+ 9993 FORMAT( '   FOR ALPHA          ',
+     $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
+ 9992 FORMAT( '   FOR BETA           ',
+     $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
+ 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
+     $      /' ******* TESTS ABANDONED *******' )
+ 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+     $      'ESTS ABANDONED *******' )
+ 9989 FORMAT( ' ERROR IN CMMCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
+     $      'ATED WRONGLY.', /' CMMCH WAS CALLED WITH TRANSA = ', A1,
+     $      ' AND TRANSB = ', A1, /' AND RETURNED SAME = ', L1, ' AND ',
+     $      'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
+     $      'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
+     $      '*******' )
+ 9988 FORMAT( A6, L2 )
+ 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
+ 9986 FORMAT( /' END OF TESTS' )
+ 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
+ 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
+*
+*     End of CBLAT3.
+*
+      END
+      SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests CGEMM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, ALS, BETA, BLS
+      REAL               ERR, ERRMAX
+      INTEGER            I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
+     $                   LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M,
+     $                   MA, MB, MS, N, NA, NARGS, NB, NC, NS
+      LOGICAL            NULL, RESET, SAME, TRANA, TRANB
+      CHARACTER*1        TRANAS, TRANBS, TRANSA, TRANSB
+      CHARACTER*3        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CGEMM, CMAKE, CMMCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'NTC'/
+*     .. Executable Statements ..
+*
+      NARGS = 13
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 110 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 100 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDC to 1 more than minimum value if room.
+            LDC = M
+            IF( LDC.LT.NMAX )
+     $         LDC = LDC + 1
+*           Skip tests if not enough room.
+            IF( LDC.GT.NMAX )
+     $         GO TO 100
+            LCC = LDC*N
+            NULL = N.LE.0.OR.M.LE.0
+*
+            DO 90 IK = 1, NIDIM
+               K = IDIM( IK )
+*
+               DO 80 ICA = 1, 3
+                  TRANSA = ICH( ICA: ICA )
+                  TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
+*
+                  IF( TRANA )THEN
+                     MA = K
+                     NA = M
+                  ELSE
+                     MA = M
+                     NA = K
+                  END IF
+*                 Set LDA to 1 more than minimum value if room.
+                  LDA = MA
+                  IF( LDA.LT.NMAX )
+     $               LDA = LDA + 1
+*                 Skip tests if not enough room.
+                  IF( LDA.GT.NMAX )
+     $               GO TO 80
+                  LAA = LDA*NA
+*
+*                 Generate the matrix A.
+*
+                  CALL CMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
+     $                        RESET, ZERO )
+*
+                  DO 70 ICB = 1, 3
+                     TRANSB = ICH( ICB: ICB )
+                     TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
+*
+                     IF( TRANB )THEN
+                        MB = N
+                        NB = K
+                     ELSE
+                        MB = K
+                        NB = N
+                     END IF
+*                    Set LDB to 1 more than minimum value if room.
+                     LDB = MB
+                     IF( LDB.LT.NMAX )
+     $                  LDB = LDB + 1
+*                    Skip tests if not enough room.
+                     IF( LDB.GT.NMAX )
+     $                  GO TO 70
+                     LBB = LDB*NB
+*
+*                    Generate the matrix B.
+*
+                     CALL CMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
+     $                           LDB, RESET, ZERO )
+*
+                     DO 60 IA = 1, NALF
+                        ALPHA = ALF( IA )
+*
+                        DO 50 IB = 1, NBET
+                           BETA = BET( IB )
+*
+*                          Generate the matrix C.
+*
+                           CALL CMAKE( 'GE', ' ', ' ', M, N, C, NMAX,
+     $                                 CC, LDC, RESET, ZERO )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           TRANAS = TRANSA
+                           TRANBS = TRANSB
+                           MS = M
+                           NS = N
+                           KS = K
+                           ALS = ALPHA
+                           DO 10 I = 1, LAA
+                              AS( I ) = AA( I )
+   10                      CONTINUE
+                           LDAS = LDA
+                           DO 20 I = 1, LBB
+                              BS( I ) = BB( I )
+   20                      CONTINUE
+                           LDBS = LDB
+                           BLS = BETA
+                           DO 30 I = 1, LCC
+                              CS( I ) = CC( I )
+   30                      CONTINUE
+                           LDCS = LDC
+*
+*                          Call the subroutine.
+*
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                        TRANSA, TRANSB, M, N, K, ALPHA, LDA, LDB,
+     $                        BETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL CGEMM( TRANSA, TRANSB, M, N, K, ALPHA,
+     $                                 AA, LDA, BB, LDB, BETA, CC, LDC )
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9994 )
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = TRANSA.EQ.TRANAS
+                           ISAME( 2 ) = TRANSB.EQ.TRANBS
+                           ISAME( 3 ) = MS.EQ.M
+                           ISAME( 4 ) = NS.EQ.N
+                           ISAME( 5 ) = KS.EQ.K
+                           ISAME( 6 ) = ALS.EQ.ALPHA
+                           ISAME( 7 ) = LCE( AS, AA, LAA )
+                           ISAME( 8 ) = LDAS.EQ.LDA
+                           ISAME( 9 ) = LCE( BS, BB, LBB )
+                           ISAME( 10 ) = LDBS.EQ.LDB
+                           ISAME( 11 ) = BLS.EQ.BETA
+                           IF( NULL )THEN
+                              ISAME( 12 ) = LCE( CS, CC, LCC )
+                           ELSE
+                              ISAME( 12 ) = LCERES( 'GE', ' ', M, N, CS,
+     $                                      CC, LDC )
+                           END IF
+                           ISAME( 13 ) = LDCS.EQ.LDC
+*
+*                          If data was incorrectly changed, report
+*                          and return.
+*
+                           SAME = .TRUE.
+                           DO 40 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   40                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+*
+*                             Check the result.
+*
+                              CALL CMMCH( TRANSA, TRANSB, M, N, K,
+     $                                    ALPHA, A, NMAX, B, NMAX, BETA,
+     $                                    C, NMAX, CT, G, CC, LDC, EPS,
+     $                                    ERR, FATAL, NOUT, .TRUE. )
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 120
+                           END IF
+*
+   50                   CONTINUE
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, M, N, K,
+     $   ALPHA, LDA, LDB, BETA, LDC
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',',
+     $      3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
+     $      ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK1.
+*
+      END
+      SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests CHEMM and CSYMM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, ALS, BETA, BLS
+      REAL               ERR, ERRMAX
+      INTEGER            I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC,
+     $                   LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA,
+     $                   NARGS, NC, NS
+      LOGICAL            CONJ, LEFT, NULL, RESET, SAME
+      CHARACTER*1        SIDE, SIDES, UPLO, UPLOS
+      CHARACTER*2        ICHS, ICHU
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CHEMM, CMAKE, CMMCH, CSYMM
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHS/'LR'/, ICHU/'UL'/
+*     .. Executable Statements ..
+      CONJ = SNAME( 2: 3 ).EQ.'HE'
+*
+      NARGS = 12
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 100 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 90 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDC to 1 more than minimum value if room.
+            LDC = M
+            IF( LDC.LT.NMAX )
+     $         LDC = LDC + 1
+*           Skip tests if not enough room.
+            IF( LDC.GT.NMAX )
+     $         GO TO 90
+            LCC = LDC*N
+            NULL = N.LE.0.OR.M.LE.0
+*           Set LDB to 1 more than minimum value if room.
+            LDB = M
+            IF( LDB.LT.NMAX )
+     $         LDB = LDB + 1
+*           Skip tests if not enough room.
+            IF( LDB.GT.NMAX )
+     $         GO TO 90
+            LBB = LDB*N
+*
+*           Generate the matrix B.
+*
+            CALL CMAKE( 'GE', ' ', ' ', M, N, B, NMAX, BB, LDB, RESET,
+     $                  ZERO )
+*
+            DO 80 ICS = 1, 2
+               SIDE = ICHS( ICS: ICS )
+               LEFT = SIDE.EQ.'L'
+*
+               IF( LEFT )THEN
+                  NA = M
+               ELSE
+                  NA = N
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = NA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 80
+               LAA = LDA*NA
+*
+               DO 70 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+*
+*                 Generate the hermitian or symmetric matrix A.
+*
+                  CALL CMAKE( SNAME( 2: 3 ), UPLO, ' ', NA, NA, A, NMAX,
+     $                        AA, LDA, RESET, ZERO )
+*
+                  DO 60 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 50 IB = 1, NBET
+                        BETA = BET( IB )
+*
+*                       Generate the matrix C.
+*
+                        CALL CMAKE( 'GE', ' ', ' ', M, N, C, NMAX, CC,
+     $                              LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the
+*                       subroutine.
+*
+                        SIDES = SIDE
+                        UPLOS = UPLO
+                        MS = M
+                        NS = N
+                        ALS = ALPHA
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        DO 20 I = 1, LBB
+                           BS( I ) = BB( I )
+   20                   CONTINUE
+                        LDBS = LDB
+                        BLS = BETA
+                        DO 30 I = 1, LCC
+                           CS( I ) = CC( I )
+   30                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9995 )NC, SNAME, SIDE,
+     $                     UPLO, M, N, ALPHA, LDA, LDB, BETA, LDC
+                        IF( REWI )
+     $                     REWIND NTRA
+                        IF( CONJ )THEN
+                           CALL CHEMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
+     $                                 BB, LDB, BETA, CC, LDC )
+                        ELSE
+                           CALL CSYMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
+     $                                 BB, LDB, BETA, CC, LDC )
+                        END IF
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9994 )
+                           FATAL = .TRUE.
+                           GO TO 110
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = SIDES.EQ.SIDE
+                        ISAME( 2 ) = UPLOS.EQ.UPLO
+                        ISAME( 3 ) = MS.EQ.M
+                        ISAME( 4 ) = NS.EQ.N
+                        ISAME( 5 ) = ALS.EQ.ALPHA
+                        ISAME( 6 ) = LCE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        ISAME( 8 ) = LCE( BS, BB, LBB )
+                        ISAME( 9 ) = LDBS.EQ.LDB
+                        ISAME( 10 ) = BLS.EQ.BETA
+                        IF( NULL )THEN
+                           ISAME( 11 ) = LCE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 11 ) = LCERES( 'GE', ' ', M, N, CS,
+     $                                   CC, LDC )
+                        END IF
+                        ISAME( 12 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 110
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result.
+*
+                           IF( LEFT )THEN
+                              CALL CMMCH( 'N', 'N', M, N, M, ALPHA, A,
+     $                                    NMAX, B, NMAX, BETA, C, NMAX,
+     $                                    CT, G, CC, LDC, EPS, ERR,
+     $                                    FATAL, NOUT, .TRUE. )
+                           ELSE
+                              CALL CMMCH( 'N', 'N', M, N, N, ALPHA, B,
+     $                                    NMAX, A, NMAX, BETA, C, NMAX,
+     $                                    CT, G, CC, LDC, EPS, ERR,
+     $                                    FATAL, NOUT, .TRUE. )
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and
+*                          return.
+                           IF( FATAL )
+     $                        GO TO 110
+                        END IF
+*
+   50                CONTINUE
+*
+   60             CONTINUE
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 120
+*
+  110 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, M, N, ALPHA, LDA,
+     $   LDB, BETA, LDC
+*
+  120 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
+     $      ',', F4.1, '), C,', I3, ')    .' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK2.
+*
+      END
+      SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS,
+     $                  B, BB, BS, CT, G, C )
+*
+*  Tests CTRMM and CTRSM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CT( NMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, ALS
+      REAL               ERR, ERRMAX
+      INTEGER            I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB,
+     $                   LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC,
+     $                   NS
+      LOGICAL            LEFT, NULL, RESET, SAME
+      CHARACTER*1        DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO,
+     $                   UPLOS
+      CHARACTER*2        ICHD, ICHS, ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CMAKE, CMMCH, CTRMM, CTRSM
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/
+*     .. Executable Statements ..
+*
+      NARGS = 11
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*     Set up zero matrix for CMMCH.
+      DO 20 J = 1, NMAX
+         DO 10 I = 1, NMAX
+            C( I, J ) = ZERO
+   10    CONTINUE
+   20 CONTINUE
+*
+      DO 140 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 130 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDB to 1 more than minimum value if room.
+            LDB = M
+            IF( LDB.LT.NMAX )
+     $         LDB = LDB + 1
+*           Skip tests if not enough room.
+            IF( LDB.GT.NMAX )
+     $         GO TO 130
+            LBB = LDB*N
+            NULL = M.LE.0.OR.N.LE.0
+*
+            DO 120 ICS = 1, 2
+               SIDE = ICHS( ICS: ICS )
+               LEFT = SIDE.EQ.'L'
+               IF( LEFT )THEN
+                  NA = M
+               ELSE
+                  NA = N
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = NA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 130
+               LAA = LDA*NA
+*
+               DO 110 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+*
+                  DO 100 ICT = 1, 3
+                     TRANSA = ICHT( ICT: ICT )
+*
+                     DO 90 ICD = 1, 2
+                        DIAG = ICHD( ICD: ICD )
+*
+                        DO 80 IA = 1, NALF
+                           ALPHA = ALF( IA )
+*
+*                          Generate the matrix A.
+*
+                           CALL CMAKE( 'TR', UPLO, DIAG, NA, NA, A,
+     $                                 NMAX, AA, LDA, RESET, ZERO )
+*
+*                          Generate the matrix B.
+*
+                           CALL CMAKE( 'GE', ' ', ' ', M, N, B, NMAX,
+     $                                 BB, LDB, RESET, ZERO )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           SIDES = SIDE
+                           UPLOS = UPLO
+                           TRANAS = TRANSA
+                           DIAGS = DIAG
+                           MS = M
+                           NS = N
+                           ALS = ALPHA
+                           DO 30 I = 1, LAA
+                              AS( I ) = AA( I )
+   30                      CONTINUE
+                           LDAS = LDA
+                           DO 40 I = 1, LBB
+                              BS( I ) = BB( I )
+   40                      CONTINUE
+                           LDBS = LDB
+*
+*                          Call the subroutine.
+*
+                           IF( SNAME( 4: 5 ).EQ.'MM' )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
+     $                           LDA, LDB
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CTRMM( SIDE, UPLO, TRANSA, DIAG, M,
+     $                                    N, ALPHA, AA, LDA, BB, LDB )
+                           ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
+     $                           LDA, LDB
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL CTRSM( SIDE, UPLO, TRANSA, DIAG, M,
+     $                                    N, ALPHA, AA, LDA, BB, LDB )
+                           END IF
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9994 )
+                              FATAL = .TRUE.
+                              GO TO 150
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = SIDES.EQ.SIDE
+                           ISAME( 2 ) = UPLOS.EQ.UPLO
+                           ISAME( 3 ) = TRANAS.EQ.TRANSA
+                           ISAME( 4 ) = DIAGS.EQ.DIAG
+                           ISAME( 5 ) = MS.EQ.M
+                           ISAME( 6 ) = NS.EQ.N
+                           ISAME( 7 ) = ALS.EQ.ALPHA
+                           ISAME( 8 ) = LCE( AS, AA, LAA )
+                           ISAME( 9 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 10 ) = LCE( BS, BB, LBB )
+                           ELSE
+                              ISAME( 10 ) = LCERES( 'GE', ' ', M, N, BS,
+     $                                      BB, LDB )
+                           END IF
+                           ISAME( 11 ) = LDBS.EQ.LDB
+*
+*                          If data was incorrectly changed, report and
+*                          return.
+*
+                           SAME = .TRUE.
+                           DO 50 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   50                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 150
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+                              IF( SNAME( 4: 5 ).EQ.'MM' )THEN
+*
+*                                Check the result.
+*
+                                 IF( LEFT )THEN
+                                    CALL CMMCH( TRANSA, 'N', M, N, M,
+     $                                          ALPHA, A, NMAX, B, NMAX,
+     $                                          ZERO, C, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .TRUE. )
+                                 ELSE
+                                    CALL CMMCH( 'N', TRANSA, M, N, N,
+     $                                          ALPHA, B, NMAX, A, NMAX,
+     $                                          ZERO, C, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .TRUE. )
+                                 END IF
+                              ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
+*
+*                                Compute approximation to original
+*                                matrix.
+*
+                                 DO 70 J = 1, N
+                                    DO 60 I = 1, M
+                                       C( I, J ) = BB( I + ( J - 1 )*
+     $                                             LDB )
+                                       BB( I + ( J - 1 )*LDB ) = ALPHA*
+     $                                    B( I, J )
+   60                               CONTINUE
+   70                            CONTINUE
+*
+                                 IF( LEFT )THEN
+                                    CALL CMMCH( TRANSA, 'N', M, N, M,
+     $                                          ONE, A, NMAX, C, NMAX,
+     $                                          ZERO, B, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .FALSE. )
+                                 ELSE
+                                    CALL CMMCH( 'N', TRANSA, M, N, N,
+     $                                          ONE, C, NMAX, A, NMAX,
+     $                                          ZERO, B, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .FALSE. )
+                                 END IF
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 150
+                           END IF
+*
+   80                   CONTINUE
+*
+   90                CONTINUE
+*
+  100             CONTINUE
+*
+  110          CONTINUE
+*
+  120       CONTINUE
+*
+  130    CONTINUE
+*
+  140 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 160
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, TRANSA, DIAG, M,
+     $   N, ALPHA, LDA, LDB
+*
+  160 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
+     $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ')         ',
+     $      '      .' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK3.
+*
+      END
+      SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests CHERK and CSYRK.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ) )
+      REAL               RONE, RZERO
+      PARAMETER          ( RONE = 1.0, RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, ALS, BETA, BETS
+      REAL               ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS
+      INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
+     $                   LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA,
+     $                   NARGS, NC, NS
+      LOGICAL            CONJ, NULL, RESET, SAME, TRAN, UPPER
+      CHARACTER*1        TRANS, TRANSS, TRANST, UPLO, UPLOS
+      CHARACTER*2        ICHT, ICHU
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CHERK, CMAKE, CMMCH, CSYRK
+*     .. Intrinsic Functions ..
+      INTRINSIC          CMPLX, MAX, REAL
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHT/'NC'/, ICHU/'UL'/
+*     .. Executable Statements ..
+      CONJ = SNAME( 2: 3 ).EQ.'HE'
+*
+      NARGS = 10
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 100 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDC to 1 more than minimum value if room.
+         LDC = N
+         IF( LDC.LT.NMAX )
+     $      LDC = LDC + 1
+*        Skip tests if not enough room.
+         IF( LDC.GT.NMAX )
+     $      GO TO 100
+         LCC = LDC*N
+*
+         DO 90 IK = 1, NIDIM
+            K = IDIM( IK )
+*
+            DO 80 ICT = 1, 2
+               TRANS = ICHT( ICT: ICT )
+               TRAN = TRANS.EQ.'C'
+               IF( TRAN.AND..NOT.CONJ )
+     $            TRANS = 'T'
+               IF( TRAN )THEN
+                  MA = K
+                  NA = N
+               ELSE
+                  MA = N
+                  NA = K
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = MA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 80
+               LAA = LDA*NA
+*
+*              Generate the matrix A.
+*
+               CALL CMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
+     $                     RESET, ZERO )
+*
+               DO 70 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+                  UPPER = UPLO.EQ.'U'
+*
+                  DO 60 IA = 1, NALF
+                     ALPHA = ALF( IA )
+                     IF( CONJ )THEN
+                        RALPHA = REAL( ALPHA )
+                        ALPHA = CMPLX( RALPHA, RZERO )
+                     END IF
+*
+                     DO 50 IB = 1, NBET
+                        BETA = BET( IB )
+                        IF( CONJ )THEN
+                           RBETA = REAL( BETA )
+                           BETA = CMPLX( RBETA, RZERO )
+                        END IF
+                        NULL = N.LE.0
+                        IF( CONJ )
+     $                     NULL = NULL.OR.( ( K.LE.0.OR.RALPHA.EQ.
+     $                            RZERO ).AND.RBETA.EQ.RONE )
+*
+*                       Generate the matrix C.
+*
+                        CALL CMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, C,
+     $                              NMAX, CC, LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        NS = N
+                        KS = K
+                        IF( CONJ )THEN
+                           RALS = RALPHA
+                        ELSE
+                           ALS = ALPHA
+                        END IF
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        IF( CONJ )THEN
+                           RBETS = RBETA
+                        ELSE
+                           BETS = BETA
+                        END IF
+                        DO 20 I = 1, LCC
+                           CS( I ) = CC( I )
+   20                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( CONJ )THEN
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
+     $                        TRANS, N, K, RALPHA, LDA, RBETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL CHERK( UPLO, TRANS, N, K, RALPHA, AA,
+     $                                 LDA, RBETA, CC, LDC )
+                        ELSE
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO,
+     $                        TRANS, N, K, ALPHA, LDA, BETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL CSYRK( UPLO, TRANS, N, K, ALPHA, AA,
+     $                                 LDA, BETA, CC, LDC )
+                        END IF
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9992 )
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLOS.EQ.UPLO
+                        ISAME( 2 ) = TRANSS.EQ.TRANS
+                        ISAME( 3 ) = NS.EQ.N
+                        ISAME( 4 ) = KS.EQ.K
+                        IF( CONJ )THEN
+                           ISAME( 5 ) = RALS.EQ.RALPHA
+                        ELSE
+                           ISAME( 5 ) = ALS.EQ.ALPHA
+                        END IF
+                        ISAME( 6 ) = LCE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        IF( CONJ )THEN
+                           ISAME( 8 ) = RBETS.EQ.RBETA
+                        ELSE
+                           ISAME( 8 ) = BETS.EQ.BETA
+                        END IF
+                        IF( NULL )THEN
+                           ISAME( 9 ) = LCE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 9 ) = LCERES( SNAME( 2: 3 ), UPLO, N,
+     $                                  N, CS, CC, LDC )
+                        END IF
+                        ISAME( 10 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 30 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   30                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result column by column.
+*
+                           IF( CONJ )THEN
+                              TRANST = 'C'
+                           ELSE
+                              TRANST = 'T'
+                           END IF
+                           JC = 1
+                           DO 40 J = 1, N
+                              IF( UPPER )THEN
+                                 JJ = 1
+                                 LJ = J
+                              ELSE
+                                 JJ = J
+                                 LJ = N - J + 1
+                              END IF
+                              IF( TRAN )THEN
+                                 CALL CMMCH( TRANST, 'N', LJ, 1, K,
+     $                                       ALPHA, A( 1, JJ ), NMAX,
+     $                                       A( 1, J ), NMAX, BETA,
+     $                                       C( JJ, J ), NMAX, CT, G,
+     $                                       CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              ELSE
+                                 CALL CMMCH( 'N', TRANST, LJ, 1, K,
+     $                                       ALPHA, A( JJ, 1 ), NMAX,
+     $                                       A( J, 1 ), NMAX, BETA,
+     $                                       C( JJ, J ), NMAX, CT, G,
+     $                                       CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              END IF
+                              IF( UPPER )THEN
+                                 JC = JC + LDC
+                              ELSE
+                                 JC = JC + LDC + 1
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 110
+   40                      CONTINUE
+                        END IF
+*
+   50                CONTINUE
+*
+   60             CONTINUE
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  110 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9995 )J
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( CONJ )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, RALPHA,
+     $      LDA, RBETA, LDC
+      ELSE
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
+     $      LDA, BETA, LDC
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')               ',
+     $      '          .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1,
+     $      '), C,', I3, ')          .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK4.
+*
+      END
+      SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
+*
+*  Tests CHER2K and CSYR2K.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
+      REAL               RONE, RZERO
+      PARAMETER          ( RONE = 1.0, RZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX            AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
+     $                   ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
+     $                   BET( NBET ), BS( NMAX*NMAX ), C( NMAX, NMAX ),
+     $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
+     $                   W( 2*NMAX )
+      REAL               G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, ALS, BETA, BETS
+      REAL               ERR, ERRMAX, RBETA, RBETS
+      INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB,
+     $                   K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS,
+     $                   LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS
+      LOGICAL            CONJ, NULL, RESET, SAME, TRAN, UPPER
+      CHARACTER*1        TRANS, TRANSS, TRANST, UPLO, UPLOS
+      CHARACTER*2        ICHT, ICHU
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LCE, LCERES
+      EXTERNAL           LCE, LCERES
+*     .. External Subroutines ..
+      EXTERNAL           CHER2K, CMAKE, CMMCH, CSYR2K
+*     .. Intrinsic Functions ..
+      INTRINSIC          CMPLX, CONJG, MAX, REAL
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHT/'NC'/, ICHU/'UL'/
+*     .. Executable Statements ..
+      CONJ = SNAME( 2: 3 ).EQ.'HE'
+*
+      NARGS = 12
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 130 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDC to 1 more than minimum value if room.
+         LDC = N
+         IF( LDC.LT.NMAX )
+     $      LDC = LDC + 1
+*        Skip tests if not enough room.
+         IF( LDC.GT.NMAX )
+     $      GO TO 130
+         LCC = LDC*N
+*
+         DO 120 IK = 1, NIDIM
+            K = IDIM( IK )
+*
+            DO 110 ICT = 1, 2
+               TRANS = ICHT( ICT: ICT )
+               TRAN = TRANS.EQ.'C'
+               IF( TRAN.AND..NOT.CONJ )
+     $            TRANS = 'T'
+               IF( TRAN )THEN
+                  MA = K
+                  NA = N
+               ELSE
+                  MA = N
+                  NA = K
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = MA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 110
+               LAA = LDA*NA
+*
+*              Generate the matrix A.
+*
+               IF( TRAN )THEN
+                  CALL CMAKE( 'GE', ' ', ' ', MA, NA, AB, 2*NMAX, AA,
+     $                        LDA, RESET, ZERO )
+               ELSE
+                  CALL CMAKE( 'GE', ' ', ' ', MA, NA, AB, NMAX, AA, LDA,
+     $                        RESET, ZERO )
+               END IF
+*
+*              Generate the matrix B.
+*
+               LDB = LDA
+               LBB = LAA
+               IF( TRAN )THEN
+                  CALL CMAKE( 'GE', ' ', ' ', MA, NA, AB( K + 1 ),
+     $                        2*NMAX, BB, LDB, RESET, ZERO )
+               ELSE
+                  CALL CMAKE( 'GE', ' ', ' ', MA, NA, AB( K*NMAX + 1 ),
+     $                        NMAX, BB, LDB, RESET, ZERO )
+               END IF
+*
+               DO 100 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+                  UPPER = UPLO.EQ.'U'
+*
+                  DO 90 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 80 IB = 1, NBET
+                        BETA = BET( IB )
+                        IF( CONJ )THEN
+                           RBETA = REAL( BETA )
+                           BETA = CMPLX( RBETA, RZERO )
+                        END IF
+                        NULL = N.LE.0
+                        IF( CONJ )
+     $                     NULL = NULL.OR.( ( K.LE.0.OR.ALPHA.EQ.
+     $                            ZERO ).AND.RBETA.EQ.RONE )
+*
+*                       Generate the matrix C.
+*
+                        CALL CMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, C,
+     $                              NMAX, CC, LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        NS = N
+                        KS = K
+                        ALS = ALPHA
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        DO 20 I = 1, LBB
+                           BS( I ) = BB( I )
+   20                   CONTINUE
+                        LDBS = LDB
+                        IF( CONJ )THEN
+                           RBETS = RBETA
+                        ELSE
+                           BETS = BETA
+                        END IF
+                        DO 30 I = 1, LCC
+                           CS( I ) = CC( I )
+   30                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( CONJ )THEN
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
+     $                        TRANS, N, K, ALPHA, LDA, LDB, RBETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL CHER2K( UPLO, TRANS, N, K, ALPHA, AA,
+     $                                  LDA, BB, LDB, RBETA, CC, LDC )
+                        ELSE
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO,
+     $                        TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL CSYR2K( UPLO, TRANS, N, K, ALPHA, AA,
+     $                                  LDA, BB, LDB, BETA, CC, LDC )
+                        END IF
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9992 )
+                           FATAL = .TRUE.
+                           GO TO 150
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLOS.EQ.UPLO
+                        ISAME( 2 ) = TRANSS.EQ.TRANS
+                        ISAME( 3 ) = NS.EQ.N
+                        ISAME( 4 ) = KS.EQ.K
+                        ISAME( 5 ) = ALS.EQ.ALPHA
+                        ISAME( 6 ) = LCE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        ISAME( 8 ) = LCE( BS, BB, LBB )
+                        ISAME( 9 ) = LDBS.EQ.LDB
+                        IF( CONJ )THEN
+                           ISAME( 10 ) = RBETS.EQ.RBETA
+                        ELSE
+                           ISAME( 10 ) = BETS.EQ.BETA
+                        END IF
+                        IF( NULL )THEN
+                           ISAME( 11 ) = LCE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 11 ) = LCERES( 'HE', UPLO, N, N, CS,
+     $                                   CC, LDC )
+                        END IF
+                        ISAME( 12 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 150
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result column by column.
+*
+                           IF( CONJ )THEN
+                              TRANST = 'C'
+                           ELSE
+                              TRANST = 'T'
+                           END IF
+                           JJAB = 1
+                           JC = 1
+                           DO 70 J = 1, N
+                              IF( UPPER )THEN
+                                 JJ = 1
+                                 LJ = J
+                              ELSE
+                                 JJ = J
+                                 LJ = N - J + 1
+                              END IF
+                              IF( TRAN )THEN
+                                 DO 50 I = 1, K
+                                    W( I ) = ALPHA*AB( ( J - 1 )*2*
+     $                                       NMAX + K + I )
+                                    IF( CONJ )THEN
+                                       W( K + I ) = CONJG( ALPHA )*
+     $                                              AB( ( J - 1 )*2*
+     $                                              NMAX + I )
+                                    ELSE
+                                       W( K + I ) = ALPHA*
+     $                                              AB( ( J - 1 )*2*
+     $                                              NMAX + I )
+                                    END IF
+   50                            CONTINUE
+                                 CALL CMMCH( TRANST, 'N', LJ, 1, 2*K,
+     $                                       ONE, AB( JJAB ), 2*NMAX, W,
+     $                                       2*NMAX, BETA, C( JJ, J ),
+     $                                       NMAX, CT, G, CC( JC ), LDC,
+     $                                       EPS, ERR, FATAL, NOUT,
+     $                                       .TRUE. )
+                              ELSE
+                                 DO 60 I = 1, K
+                                    IF( CONJ )THEN
+                                       W( I ) = ALPHA*CONJG( AB( ( K +
+     $                                          I - 1 )*NMAX + J ) )
+                                       W( K + I ) = CONJG( ALPHA*
+     $                                              AB( ( I - 1 )*NMAX +
+     $                                              J ) )
+                                    ELSE
+                                       W( I ) = ALPHA*AB( ( K + I - 1 )*
+     $                                          NMAX + J )
+                                       W( K + I ) = ALPHA*
+     $                                              AB( ( I - 1 )*NMAX +
+     $                                              J )
+                                    END IF
+   60                            CONTINUE
+                                 CALL CMMCH( 'N', 'N', LJ, 1, 2*K, ONE,
+     $                                       AB( JJ ), NMAX, W, 2*NMAX,
+     $                                       BETA, C( JJ, J ), NMAX, CT,
+     $                                       G, CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              END IF
+                              IF( UPPER )THEN
+                                 JC = JC + LDC
+                              ELSE
+                                 JC = JC + LDC + 1
+                                 IF( TRAN )
+     $                              JJAB = JJAB + 2*NMAX
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 140
+   70                      CONTINUE
+                        END IF
+*
+   80                CONTINUE
+*
+   90             CONTINUE
+*
+  100          CONTINUE
+*
+  110       CONTINUE
+*
+  120    CONTINUE
+*
+  130 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 160
+*
+  140 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9995 )J
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( CONJ )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
+     $      LDA, LDB, RBETA, LDC
+      ELSE
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
+     $      LDA, LDB, BETA, LDC
+      END IF
+*
+  160 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1,
+     $      ', C,', I3, ')           .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
+     $      ',', F4.1, '), C,', I3, ')    .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of CCHK5.
+*
+      END
+      SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT )
+*
+*  Tests the error exits from the Level 3 Blas.
+*  Requires a special version of the error-handling routine XERBLA.
+*  ALPHA, RALPHA, BETA, RBETA, A, B and C should not need to be defined.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            ISNUM, NOUT
+      CHARACTER*6        SRNAMT
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Local Scalars ..
+      COMPLEX            ALPHA, BETA
+      REAL               RALPHA, RBETA
+*     .. Local Arrays ..
+      COMPLEX            A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
+*     .. External Subroutines ..
+      EXTERNAL           CGEMM, CHEMM, CHER2K, CHERK, CHKXER, CSYMM,
+     $                   CSYR2K, CSYRK, CTRMM, CTRSM
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+*     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
+*     if anything is wrong.
+      OK = .TRUE.
+*     LERR is set to .TRUE. by the special version of XERBLA each time
+*     it is called, and is then tested and re-set by CHKXER.
+      LERR = .FALSE.
+      GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
+     $        90 )ISNUM
+   10 INFOT = 1
+      CALL CGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 1
+      CALL CGEMM( '/', 'C', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 1
+      CALL CGEMM( '/', 'T', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CGEMM( 'N', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CGEMM( 'C', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CGEMM( 'T', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGEMM( 'N', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGEMM( 'N', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGEMM( 'N', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGEMM( 'C', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGEMM( 'C', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGEMM( 'C', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGEMM( 'T', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGEMM( 'T', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CGEMM( 'T', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CGEMM( 'N', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CGEMM( 'N', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CGEMM( 'N', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CGEMM( 'C', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CGEMM( 'C', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CGEMM( 'C', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CGEMM( 'T', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CGEMM( 'T', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CGEMM( 'T', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGEMM( 'N', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGEMM( 'N', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGEMM( 'N', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGEMM( 'C', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGEMM( 'C', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGEMM( 'C', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGEMM( 'T', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGEMM( 'T', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CGEMM( 'T', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGEMM( 'N', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGEMM( 'C', 'N', 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGEMM( 'C', 'C', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGEMM( 'C', 'T', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGEMM( 'T', 'C', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL CGEMM( 'T', 'T', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CGEMM( 'N', 'N', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CGEMM( 'C', 'N', 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CGEMM( 'N', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CGEMM( 'C', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CGEMM( 'T', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CGEMM( 'N', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CGEMM( 'C', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CGEMM( 'T', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL CGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL CGEMM( 'N', 'C', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL CGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL CGEMM( 'C', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL CGEMM( 'C', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL CGEMM( 'C', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL CGEMM( 'T', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL CGEMM( 'T', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL CGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   20 INFOT = 1
+      CALL CHEMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CHEMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHEMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHEMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHEMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHEMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHEMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHEMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHEMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHEMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHEMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHEMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHEMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHEMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   30 INFOT = 1
+      CALL CSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CSYMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   40 INFOT = 1
+      CALL CTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CTRMM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CTRMM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CTRMM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'L', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'R', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'L', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'R', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRMM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'L', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'R', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'L', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'R', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRMM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'R', 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'R', 'L', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRMM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'R', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'R', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   50 INFOT = 1
+      CALL CTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CTRSM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CTRSM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CTRSM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'L', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'R', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'L', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'R', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL CTRSM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'L', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'R', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'L', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'R', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL CTRSM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'R', 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'R', 'L', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CTRSM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'R', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'R', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL CTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   60 INFOT = 1
+      CALL CHERK( '/', 'N', 0, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CHERK( 'U', 'T', 0, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHERK( 'U', 'N', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHERK( 'U', 'C', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHERK( 'L', 'N', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHERK( 'L', 'C', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHERK( 'U', 'N', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHERK( 'U', 'C', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHERK( 'L', 'N', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHERK( 'L', 'C', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHERK( 'U', 'N', 2, 0, RALPHA, A, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHERK( 'U', 'C', 0, 2, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHERK( 'L', 'N', 2, 0, RALPHA, A, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHERK( 'L', 'C', 0, 2, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CHERK( 'U', 'N', 2, 0, RALPHA, A, 2, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CHERK( 'U', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CHERK( 'L', 'N', 2, 0, RALPHA, A, 2, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CHERK( 'L', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   70 INFOT = 1
+      CALL CSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CSYRK( 'U', 'C', 0, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYRK( 'U', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYRK( 'U', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYRK( 'L', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYRK( 'L', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYRK( 'U', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYRK( 'U', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYRK( 'L', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYRK( 'L', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYRK( 'U', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYRK( 'U', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYRK( 'L', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYRK( 'L', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CSYRK( 'U', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CSYRK( 'U', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CSYRK( 'L', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL CSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   80 INFOT = 1
+      CALL CHER2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CHER2K( 'U', 'T', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHER2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHER2K( 'U', 'C', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHER2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CHER2K( 'L', 'C', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHER2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHER2K( 'U', 'C', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHER2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CHER2K( 'L', 'C', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHER2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHER2K( 'U', 'C', 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHER2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CHER2K( 'L', 'C', 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CHER2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CHER2K( 'U', 'C', 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CHER2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CHER2K( 'L', 'C', 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CHER2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CHER2K( 'U', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CHER2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CHER2K( 'L', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   90 INFOT = 1
+      CALL CSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL CSYR2K( 'U', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYR2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYR2K( 'U', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYR2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL CSYR2K( 'L', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYR2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYR2K( 'U', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYR2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL CSYR2K( 'L', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYR2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYR2K( 'U', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYR2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL CSYR2K( 'L', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CSYR2K( 'U', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL CSYR2K( 'L', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CSYR2K( 'U', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL CSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+  100 IF( OK )THEN
+         WRITE( NOUT, FMT = 9999 )SRNAMT
+      ELSE
+         WRITE( NOUT, FMT = 9998 )SRNAMT
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+     $      '**' )
+*
+*     End of CCHKE.
+*
+      END
+      SUBROUTINE CMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
+     $                  TRANSL )
+*
+*  Generates values for an M by N matrix A.
+*  Stores the values in the array AA in the data structure required
+*  by the routine, with unwanted elements set to rogue value.
+*
+*  TYPE is 'GE', 'HE', 'SY' or 'TR'.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
+      COMPLEX            ROGUE
+      PARAMETER          ( ROGUE = ( -1.0E10, 1.0E10 ) )
+      REAL               RZERO
+      PARAMETER          ( RZERO = 0.0 )
+      REAL               RROGUE
+      PARAMETER          ( RROGUE = -1.0E10 )
+*     .. Scalar Arguments ..
+      COMPLEX            TRANSL
+      INTEGER            LDA, M, N, NMAX
+      LOGICAL            RESET
+      CHARACTER*1        DIAG, UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      COMPLEX            A( NMAX, * ), AA( * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J, JJ
+      LOGICAL            GEN, HER, LOWER, SYM, TRI, UNIT, UPPER
+*     .. External Functions ..
+      COMPLEX            CBEG
+      EXTERNAL           CBEG
+*     .. Intrinsic Functions ..
+      INTRINSIC          CMPLX, CONJG, REAL
+*     .. Executable Statements ..
+      GEN = TYPE.EQ.'GE'
+      HER = TYPE.EQ.'HE'
+      SYM = TYPE.EQ.'SY'
+      TRI = TYPE.EQ.'TR'
+      UPPER = ( HER.OR.SYM.OR.TRI ).AND.UPLO.EQ.'U'
+      LOWER = ( HER.OR.SYM.OR.TRI ).AND.UPLO.EQ.'L'
+      UNIT = TRI.AND.DIAG.EQ.'U'
+*
+*     Generate data in array A.
+*
+      DO 20 J = 1, N
+         DO 10 I = 1, M
+            IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
+     $          THEN
+               A( I, J ) = CBEG( RESET ) + TRANSL
+               IF( I.NE.J )THEN
+*                 Set some elements to zero
+                  IF( N.GT.3.AND.J.EQ.N/2 )
+     $               A( I, J ) = ZERO
+                  IF( HER )THEN
+                     A( J, I ) = CONJG( A( I, J ) )
+                  ELSE IF( SYM )THEN
+                     A( J, I ) = A( I, J )
+                  ELSE IF( TRI )THEN
+                     A( J, I ) = ZERO
+                  END IF
+               END IF
+            END IF
+   10    CONTINUE
+         IF( HER )
+     $      A( J, J ) = CMPLX( REAL( A( J, J ) ), RZERO )
+         IF( TRI )
+     $      A( J, J ) = A( J, J ) + ONE
+         IF( UNIT )
+     $      A( J, J ) = ONE
+   20 CONTINUE
+*
+*     Store elements in array AS in data structure required by routine.
+*
+      IF( TYPE.EQ.'GE' )THEN
+         DO 50 J = 1, N
+            DO 30 I = 1, M
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   30       CONTINUE
+            DO 40 I = M + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   40       CONTINUE
+   50    CONTINUE
+      ELSE IF( TYPE.EQ.'HE'.OR.TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN
+         DO 90 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IF( UNIT )THEN
+                  IEND = J - 1
+               ELSE
+                  IEND = J
+               END IF
+            ELSE
+               IF( UNIT )THEN
+                  IBEG = J + 1
+               ELSE
+                  IBEG = J
+               END IF
+               IEND = N
+            END IF
+            DO 60 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   60       CONTINUE
+            DO 70 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   70       CONTINUE
+            DO 80 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   80       CONTINUE
+            IF( HER )THEN
+               JJ = J + ( J - 1 )*LDA
+               AA( JJ ) = CMPLX( REAL( AA( JJ ) ), RROGUE )
+            END IF
+   90    CONTINUE
+      END IF
+      RETURN
+*
+*     End of CMAKE.
+*
+      END
+      SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
+     $                  BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
+     $                  NOUT, MV )
+*
+*  Checks the results of the computational tests.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX            ZERO
+      PARAMETER          ( ZERO = ( 0.0, 0.0 ) )
+      REAL               RZERO, RONE
+      PARAMETER          ( RZERO = 0.0, RONE = 1.0 )
+*     .. Scalar Arguments ..
+      COMPLEX            ALPHA, BETA
+      REAL               EPS, ERR
+      INTEGER            KK, LDA, LDB, LDC, LDCC, M, N, NOUT
+      LOGICAL            FATAL, MV
+      CHARACTER*1        TRANSA, TRANSB
+*     .. Array Arguments ..
+      COMPLEX            A( LDA, * ), B( LDB, * ), C( LDC, * ),
+     $                   CC( LDCC, * ), CT( * )
+      REAL               G( * )
+*     .. Local Scalars ..
+      COMPLEX            CL
+      REAL               ERRI
+      INTEGER            I, J, K
+      LOGICAL            CTRANA, CTRANB, TRANA, TRANB
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, AIMAG, CONJG, MAX, REAL, SQRT
+*     .. Statement Functions ..
+      REAL               ABS1
+*     .. Statement Function definitions ..
+      ABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) )
+*     .. Executable Statements ..
+      TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
+      TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
+      CTRANA = TRANSA.EQ.'C'
+      CTRANB = TRANSB.EQ.'C'
+*
+*     Compute expected result, one column at a time, in CT using data
+*     in A, B and C.
+*     Compute gauges in G.
+*
+      DO 220 J = 1, N
+*
+         DO 10 I = 1, M
+            CT( I ) = ZERO
+            G( I ) = RZERO
+   10    CONTINUE
+         IF( .NOT.TRANA.AND..NOT.TRANB )THEN
+            DO 30 K = 1, KK
+               DO 20 I = 1, M
+                  CT( I ) = CT( I ) + A( I, K )*B( K, J )
+                  G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) )
+   20          CONTINUE
+   30       CONTINUE
+         ELSE IF( TRANA.AND..NOT.TRANB )THEN
+            IF( CTRANA )THEN
+               DO 50 K = 1, KK
+                  DO 40 I = 1, M
+                     CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J )
+                     G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                        ABS1( B( K, J ) )
+   40             CONTINUE
+   50          CONTINUE
+            ELSE
+               DO 70 K = 1, KK
+                  DO 60 I = 1, M
+                     CT( I ) = CT( I ) + A( K, I )*B( K, J )
+                     G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                        ABS1( B( K, J ) )
+   60             CONTINUE
+   70          CONTINUE
+            END IF
+         ELSE IF( .NOT.TRANA.AND.TRANB )THEN
+            IF( CTRANB )THEN
+               DO 90 K = 1, KK
+                  DO 80 I = 1, M
+                     CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) )
+                     G( I ) = G( I ) + ABS1( A( I, K ) )*
+     $                        ABS1( B( J, K ) )
+   80             CONTINUE
+   90          CONTINUE
+            ELSE
+               DO 110 K = 1, KK
+                  DO 100 I = 1, M
+                     CT( I ) = CT( I ) + A( I, K )*B( J, K )
+                     G( I ) = G( I ) + ABS1( A( I, K ) )*
+     $                        ABS1( B( J, K ) )
+  100             CONTINUE
+  110          CONTINUE
+            END IF
+         ELSE IF( TRANA.AND.TRANB )THEN
+            IF( CTRANA )THEN
+               IF( CTRANB )THEN
+                  DO 130 K = 1, KK
+                     DO 120 I = 1, M
+                        CT( I ) = CT( I ) + CONJG( A( K, I ) )*
+     $                            CONJG( B( J, K ) )
+                        G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                           ABS1( B( J, K ) )
+  120                CONTINUE
+  130             CONTINUE
+               ELSE
+                  DO 150 K = 1, KK
+                     DO 140 I = 1, M
+                        CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K )
+                        G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                           ABS1( B( J, K ) )
+  140                CONTINUE
+  150             CONTINUE
+               END IF
+            ELSE
+               IF( CTRANB )THEN
+                  DO 170 K = 1, KK
+                     DO 160 I = 1, M
+                        CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) )
+                        G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                           ABS1( B( J, K ) )
+  160                CONTINUE
+  170             CONTINUE
+               ELSE
+                  DO 190 K = 1, KK
+                     DO 180 I = 1, M
+                        CT( I ) = CT( I ) + A( K, I )*B( J, K )
+                        G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                           ABS1( B( J, K ) )
+  180                CONTINUE
+  190             CONTINUE
+               END IF
+            END IF
+         END IF
+         DO 200 I = 1, M
+            CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
+            G( I ) = ABS1( ALPHA )*G( I ) +
+     $               ABS1( BETA )*ABS1( C( I, J ) )
+  200    CONTINUE
+*
+*        Compute the error ratio for this result.
+*
+         ERR = ZERO
+         DO 210 I = 1, M
+            ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS
+            IF( G( I ).NE.RZERO )
+     $         ERRI = ERRI/G( I )
+            ERR = MAX( ERR, ERRI )
+            IF( ERR*SQRT( EPS ).GE.RONE )
+     $         GO TO 230
+  210    CONTINUE
+*
+  220 CONTINUE
+*
+*     If the loop completes, all results are at least half accurate.
+      GO TO 250
+*
+*     Report fatal error.
+*
+  230 FATAL = .TRUE.
+      WRITE( NOUT, FMT = 9999 )
+      DO 240 I = 1, M
+         IF( MV )THEN
+            WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
+         ELSE
+            WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
+         END IF
+  240 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9997 )J
+*
+  250 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
+     $      'F ACCURATE *******', /'                       EXPECTED RE',
+     $      'SULT                    COMPUTED RESULT' )
+ 9998 FORMAT( 1X, I7, 2( '  (', G15.6, ',', G15.6, ')' ) )
+ 9997 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+*
+*     End of CMMCH.
+*
+      END
+      LOGICAL FUNCTION LCE( RI, RJ, LR )
+*
+*  Tests if two arrays are identical.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LR
+*     .. Array Arguments ..
+      COMPLEX            RI( * ), RJ( * )
+*     .. Local Scalars ..
+      INTEGER            I
+*     .. Executable Statements ..
+      DO 10 I = 1, LR
+         IF( RI( I ).NE.RJ( I ) )
+     $      GO TO 20
+   10 CONTINUE
+      LCE = .TRUE.
+      GO TO 30
+   20 CONTINUE
+      LCE = .FALSE.
+   30 RETURN
+*
+*     End of LCE.
+*
+      END
+      LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA )
+*
+*  Tests if selected elements in two arrays are equal.
+*
+*  TYPE is 'GE' or 'HE' or 'SY'.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDA, M, N
+      CHARACTER*1        UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      COMPLEX            AA( LDA, * ), AS( LDA, * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J
+      LOGICAL            UPPER
+*     .. Executable Statements ..
+      UPPER = UPLO.EQ.'U'
+      IF( TYPE.EQ.'GE' )THEN
+         DO 20 J = 1, N
+            DO 10 I = M + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   10       CONTINUE
+   20    CONTINUE
+      ELSE IF( TYPE.EQ.'HE'.OR.TYPE.EQ.'SY' )THEN
+         DO 50 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 30 I = 1, IBEG - 1
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   30       CONTINUE
+            DO 40 I = IEND + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   40       CONTINUE
+   50    CONTINUE
+      END IF
+*
+   60 CONTINUE
+      LCERES = .TRUE.
+      GO TO 80
+   70 CONTINUE
+      LCERES = .FALSE.
+   80 RETURN
+*
+*     End of LCERES.
+*
+      END
+      COMPLEX FUNCTION CBEG( RESET )
+*
+*  Generates complex numbers as pairs of random numbers uniformly
+*  distributed between -0.5 and 0.5.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      LOGICAL            RESET
+*     .. Local Scalars ..
+      INTEGER            I, IC, J, MI, MJ
+*     .. Save statement ..
+      SAVE               I, IC, J, MI, MJ
+*     .. Intrinsic Functions ..
+      INTRINSIC          CMPLX
+*     .. Executable Statements ..
+      IF( RESET )THEN
+*        Initialize local variables.
+         MI = 891
+         MJ = 457
+         I = 7
+         J = 7
+         IC = 0
+         RESET = .FALSE.
+      END IF
+*
+*     The sequence of values of I or J is bounded between 1 and 999.
+*     If initial I or J = 1,2,3,6,7 or 9, the period will be 50.
+*     If initial I or J = 4 or 8, the period will be 25.
+*     If initial I or J = 5, the period will be 10.
+*     IC is used to break up the period by skipping 1 value of I or J
+*     in 6.
+*
+      IC = IC + 1
+   10 I = I*MI
+      J = J*MJ
+      I = I - 1000*( I/1000 )
+      J = J - 1000*( J/1000 )
+      IF( IC.GE.5 )THEN
+         IC = 0
+         GO TO 10
+      END IF
+      CBEG = CMPLX( ( I - 500 )/1001.0, ( J - 500 )/1001.0 )
+      RETURN
+*
+*     End of CBEG.
+*
+      END
+      REAL FUNCTION SDIFF( X, Y )
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      REAL               X, Y
+*     .. Executable Statements ..
+      SDIFF = X - Y
+      RETURN
+*
+*     End of SDIFF.
+*
+      END
+      SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+*  Tests whether XERBLA has detected an error when it should.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Executable Statements ..
+      IF( .NOT.LERR )THEN
+         WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
+         OK = .FALSE.
+      END IF
+      LERR = .FALSE.
+      RETURN
+*
+ 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
+     $      'ETECTED BY ', A6, ' *****' )
+*
+*     End of CHKXER.
+*
+      END
+      SUBROUTINE XERBLA( SRNAME, INFO )
+*
+*  This is a special version of XERBLA to be used only as part of
+*  the test program for testing error exits from the Level 3 BLAS
+*  routines.
+*
+*  XERBLA  is an error handler for the Level 3 BLAS routines.
+*
+*  It is called by the Level 3 BLAS routines if an input parameter is
+*  invalid.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO
+      CHARACTER*6        SRNAME
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUT, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Executable Statements ..
+      LERR = .TRUE.
+      IF( INFO.NE.INFOT )THEN
+         IF( INFOT.NE.0 )THEN
+            WRITE( NOUT, FMT = 9999 )INFO, INFOT
+         ELSE
+            WRITE( NOUT, FMT = 9997 )INFO
+         END IF
+         OK = .FALSE.
+      END IF
+      IF( SRNAME.NE.SRNAMT )THEN
+         WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
+         OK = .FALSE.
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
+     $      ' OF ', I2, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
+     $      'AD OF ', A6, ' *******' )
+ 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
+     $      ' *******' )
+*
+*     End of XERBLA
+*
+      END
+
diff --git a/eigen/blas/testing/dblat1.f b/eigen/blas/testing/dblat1.f
new file mode 100644
index 0000000..30691f9
--- /dev/null
+++ b/eigen/blas/testing/dblat1.f
@@ -0,0 +1,1065 @@
+*> \brief \b DBLAT1
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       PROGRAM DBLAT1
+* 
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    Test program for the DOUBLE PRECISION Level 1 BLAS.
+*>
+*>    Based upon the original BLAS test routine together with:
+*>    F06EAF Example Program Text
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date April 2012
+*
+*> \ingroup double_blas_testing
+*
+*  =====================================================================
+      PROGRAM DBLAT1
+*
+*  -- Reference BLAS test routine (version 3.4.1) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     April 2012
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      INTEGER          NOUT
+      PARAMETER        (NOUT=6)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, N
+      LOGICAL          PASS
+*     .. Local Scalars ..
+      DOUBLE PRECISION SFAC
+      INTEGER          IC
+*     .. External Subroutines ..
+      EXTERNAL         CHECK0, CHECK1, CHECK2, CHECK3, HEADER
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      DATA             SFAC/9.765625D-4/
+*     .. Executable Statements ..
+      WRITE (NOUT,99999)
+      DO 20 IC = 1, 13
+         ICASE = IC
+         CALL HEADER
+*
+*        .. Initialize  PASS,  INCX,  and INCY for a new case. ..
+*        .. the value 9999 for INCX or INCY will appear in the ..
+*        .. detailed  output, if any, for cases  that do not involve ..
+*        .. these parameters ..
+*
+         PASS = .TRUE.
+         INCX = 9999
+         INCY = 9999
+         IF (ICASE.EQ.3 .OR. ICASE.EQ.11) THEN
+            CALL CHECK0(SFAC)
+         ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR.
+     +            ICASE.EQ.10) THEN
+            CALL CHECK1(SFAC)
+         ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR.
+     +            ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13) THEN
+            CALL CHECK2(SFAC)
+         ELSE IF (ICASE.EQ.4) THEN
+            CALL CHECK3(SFAC)
+         END IF
+*        -- Print
+         IF (PASS) WRITE (NOUT,99998)
+   20 CONTINUE
+      STOP
+*
+99999 FORMAT (' Real BLAS Test Program Results',/1X)
+99998 FORMAT ('                                    ----- PASS -----')
+      END
+      SUBROUTINE HEADER
+*     .. Parameters ..
+      INTEGER          NOUT
+      PARAMETER        (NOUT=6)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, N
+      LOGICAL          PASS
+*     .. Local Arrays ..
+      CHARACTER*6      L(13)
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      DATA             L(1)/' DDOT '/
+      DATA             L(2)/'DAXPY '/
+      DATA             L(3)/'DROTG '/
+      DATA             L(4)/' DROT '/
+      DATA             L(5)/'DCOPY '/
+      DATA             L(6)/'DSWAP '/
+      DATA             L(7)/'DNRM2 '/
+      DATA             L(8)/'DASUM '/
+      DATA             L(9)/'DSCAL '/
+      DATA             L(10)/'IDAMAX'/
+      DATA             L(11)/'DROTMG'/
+      DATA             L(12)/'DROTM '/
+      DATA             L(13)/'DSDOT '/
+*     .. Executable Statements ..
+      WRITE (NOUT,99999) ICASE, L(ICASE)
+      RETURN
+*
+99999 FORMAT (/' Test of subprogram number',I3,12X,A6)
+      END
+      SUBROUTINE CHECK0(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION  SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      DOUBLE PRECISION  SA, SB, SC, SS, D12
+      INTEGER           I, K
+*     .. Local Arrays ..
+      DOUBLE PRECISION  DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
+     $                  DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
+*     .. External Subroutines ..
+      EXTERNAL          DROTG, DROTMG, STEST1
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      DATA              DA1/0.3D0, 0.4D0, -0.3D0, -0.4D0, -0.3D0, 0.0D0,
+     +                  0.0D0, 1.0D0/
+      DATA              DB1/0.4D0, 0.3D0, 0.4D0, 0.3D0, -0.4D0, 0.0D0,
+     +                  1.0D0, 0.0D0/
+      DATA              DC1/0.6D0, 0.8D0, -0.6D0, 0.8D0, 0.6D0, 1.0D0,
+     +                  0.0D0, 1.0D0/
+      DATA              DS1/0.8D0, 0.6D0, 0.8D0, -0.6D0, 0.8D0, 0.0D0,
+     +                  1.0D0, 0.0D0/
+      DATA              DATRUE/0.5D0, 0.5D0, 0.5D0, -0.5D0, -0.5D0,
+     +                  0.0D0, 1.0D0, 1.0D0/
+      DATA              DBTRUE/0.0D0, 0.6D0, 0.0D0, -0.6D0, 0.0D0,
+     +                  0.0D0, 1.0D0, 0.0D0/
+*     INPUT FOR MODIFIED GIVENS
+      DATA DAB/ .1D0,.3D0,1.2D0,.2D0,
+     A          .7D0, .2D0, .6D0, 4.2D0,
+     B          0.D0,0.D0,0.D0,0.D0,
+     C          4.D0, -1.D0, 2.D0, 4.D0,
+     D          6.D-10, 2.D-2, 1.D5, 10.D0,
+     E          4.D10, 2.D-2, 1.D-5, 10.D0,
+     F          2.D-10, 4.D-2, 1.D5, 10.D0,
+     G          2.D10, 4.D-2, 1.D-5, 10.D0,
+     H          4.D0, -2.D0, 8.D0, 4.D0    /
+*    TRUE RESULTS FOR MODIFIED GIVENS
+      DATA DTRUE/0.D0,0.D0, 1.3D0, .2D0, 0.D0,0.D0,0.D0, .5D0, 0.D0,
+     A           0.D0,0.D0, 4.5D0, 4.2D0, 1.D0, .5D0, 0.D0,0.D0,0.D0,
+     B           0.D0,0.D0,0.D0,0.D0, -2.D0, 0.D0,0.D0,0.D0,0.D0,
+     C           0.D0,0.D0,0.D0, 4.D0, -1.D0, 0.D0,0.D0,0.D0,0.D0,
+     D           0.D0, 15.D-3, 0.D0, 10.D0, -1.D0, 0.D0, -1.D-4,
+     E           0.D0, 1.D0,
+     F           0.D0,0.D0, 6144.D-5, 10.D0, -1.D0, 4096.D0, -1.D6,
+     G           0.D0, 1.D0,
+     H           0.D0,0.D0,15.D0,10.D0,-1.D0, 5.D-5, 0.D0,1.D0,0.D0,
+     I           0.D0,0.D0, 15.D0, 10.D0, -1. D0, 5.D5, -4096.D0,
+     J           1.D0, 4096.D-6,
+     K           0.D0,0.D0, 7.D0, 4.D0, 0.D0,0.D0, -.5D0, -.25D0, 0.D0/
+*                   4096 = 2 ** 12
+      DATA D12  /4096.D0/
+      DTRUE(1,1) = 12.D0 / 130.D0
+      DTRUE(2,1) = 36.D0 / 130.D0
+      DTRUE(7,1) = -1.D0 / 6.D0
+      DTRUE(1,2) = 14.D0 / 75.D0
+      DTRUE(2,2) = 49.D0 / 75.D0
+      DTRUE(9,2) = 1.D0 / 7.D0
+      DTRUE(1,5) = 45.D-11 * (D12 * D12)
+      DTRUE(3,5) = 4.D5 / (3.D0 * D12)
+      DTRUE(6,5) = 1.D0 / D12
+      DTRUE(8,5) = 1.D4 / (3.D0 * D12)
+      DTRUE(1,6) = 4.D10 / (1.5D0 * D12 * D12)
+      DTRUE(2,6) = 2.D-2 / 1.5D0
+      DTRUE(8,6) = 5.D-7 * D12
+      DTRUE(1,7) = 4.D0 / 150.D0
+      DTRUE(2,7) = (2.D-10 / 1.5D0) * (D12 * D12)
+      DTRUE(7,7) = -DTRUE(6,5)
+      DTRUE(9,7) = 1.D4 / D12
+      DTRUE(1,8) = DTRUE(1,7)
+      DTRUE(2,8) = 2.D10 / (1.5D0 * D12 * D12)
+      DTRUE(1,9) = 32.D0 / 7.D0
+      DTRUE(2,9) = -16.D0 / 7.D0
+*     .. Executable Statements ..
+*
+*     Compute true values which cannot be prestored
+*     in decimal notation
+*
+      DBTRUE(1) = 1.0D0/0.6D0
+      DBTRUE(3) = -1.0D0/0.6D0
+      DBTRUE(5) = 1.0D0/0.6D0
+*
+      DO 20 K = 1, 8
+*        .. Set N=K for identification in output if any ..
+         N = K
+         IF (ICASE.EQ.3) THEN
+*           .. DROTG ..
+            IF (K.GT.8) GO TO 40
+            SA = DA1(K)
+            SB = DB1(K)
+            CALL DROTG(SA,SB,SC,SS)
+            CALL STEST1(SA,DATRUE(K),DATRUE(K),SFAC)
+            CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC)
+            CALL STEST1(SC,DC1(K),DC1(K),SFAC)
+            CALL STEST1(SS,DS1(K),DS1(K),SFAC)
+         ELSEIF (ICASE.EQ.11) THEN
+*           .. DROTMG ..
+            DO I=1,4
+               DTEMP(I)= DAB(I,K)
+               DTEMP(I+4) = 0.0
+            END DO
+            DTEMP(9) = 0.0
+            CALL DROTMG(DTEMP(1),DTEMP(2),DTEMP(3),DTEMP(4),DTEMP(5))
+            CALL STEST(9,DTEMP,DTRUE(1,K),DTRUE(1,K),SFAC)
+         ELSE
+            WRITE (NOUT,*) ' Shouldn''t be here in CHECK0'
+            STOP
+         END IF
+   20 CONTINUE
+   40 RETURN
+      END
+      SUBROUTINE CHECK1(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION  SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      INTEGER           I, LEN, NP1
+*     .. Local Arrays ..
+      DOUBLE PRECISION  DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
+     +                  SA(10), STEMP(1), STRUE(8), SX(8)
+      INTEGER           ITRUE2(5)
+*     .. External Functions ..
+      DOUBLE PRECISION  DASUM, DNRM2
+      INTEGER           IDAMAX
+      EXTERNAL          DASUM, DNRM2, IDAMAX
+*     .. External Subroutines ..
+      EXTERNAL          ITEST1, DSCAL, STEST, STEST1
+*     .. Intrinsic Functions ..
+      INTRINSIC         MAX
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      DATA              SA/0.3D0, -1.0D0, 0.0D0, 1.0D0, 0.3D0, 0.3D0,
+     +                  0.3D0, 0.3D0, 0.3D0, 0.3D0/
+      DATA              DV/0.1D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
+     +                  2.0D0, 2.0D0, 0.3D0, 3.0D0, 3.0D0, 3.0D0, 3.0D0,
+     +                  3.0D0, 3.0D0, 3.0D0, 0.3D0, -0.4D0, 4.0D0,
+     +                  4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 0.2D0,
+     +                  -0.6D0, 0.3D0, 5.0D0, 5.0D0, 5.0D0, 5.0D0,
+     +                  5.0D0, 0.1D0, -0.3D0, 0.5D0, -0.1D0, 6.0D0,
+     +                  6.0D0, 6.0D0, 6.0D0, 0.1D0, 8.0D0, 8.0D0, 8.0D0,
+     +                  8.0D0, 8.0D0, 8.0D0, 8.0D0, 0.3D0, 9.0D0, 9.0D0,
+     +                  9.0D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 0.3D0, 2.0D0,
+     +                  -0.4D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
+     +                  0.2D0, 3.0D0, -0.6D0, 5.0D0, 0.3D0, 2.0D0,
+     +                  2.0D0, 2.0D0, 0.1D0, 4.0D0, -0.3D0, 6.0D0,
+     +                  -0.5D0, 7.0D0, -0.1D0, 3.0D0/
+      DATA              DTRUE1/0.0D0, 0.3D0, 0.5D0, 0.7D0, 0.6D0/
+      DATA              DTRUE3/0.0D0, 0.3D0, 0.7D0, 1.1D0, 1.0D0/
+      DATA              DTRUE5/0.10D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
+     +                  2.0D0, 2.0D0, 2.0D0, -0.3D0, 3.0D0, 3.0D0,
+     +                  3.0D0, 3.0D0, 3.0D0, 3.0D0, 3.0D0, 0.0D0, 0.0D0,
+     +                  4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0,
+     +                  0.20D0, -0.60D0, 0.30D0, 5.0D0, 5.0D0, 5.0D0,
+     +                  5.0D0, 5.0D0, 0.03D0, -0.09D0, 0.15D0, -0.03D0,
+     +                  6.0D0, 6.0D0, 6.0D0, 6.0D0, 0.10D0, 8.0D0,
+     +                  8.0D0, 8.0D0, 8.0D0, 8.0D0, 8.0D0, 8.0D0,
+     +                  0.09D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0,
+     +                  9.0D0, 9.0D0, 0.09D0, 2.0D0, -0.12D0, 2.0D0,
+     +                  2.0D0, 2.0D0, 2.0D0, 2.0D0, 0.06D0, 3.0D0,
+     +                  -0.18D0, 5.0D0, 0.09D0, 2.0D0, 2.0D0, 2.0D0,
+     +                  0.03D0, 4.0D0, -0.09D0, 6.0D0, -0.15D0, 7.0D0,
+     +                  -0.03D0, 3.0D0/
+      DATA              ITRUE2/0, 1, 2, 2, 3/
+*     .. Executable Statements ..
+      DO 80 INCX = 1, 2
+         DO 60 NP1 = 1, 5
+            N = NP1 - 1
+            LEN = 2*MAX(N,1)
+*           .. Set vector arguments ..
+            DO 20 I = 1, LEN
+               SX(I) = DV(I,NP1,INCX)
+   20       CONTINUE
+*
+            IF (ICASE.EQ.7) THEN
+*              .. DNRM2 ..
+               STEMP(1) = DTRUE1(NP1)
+               CALL STEST1(DNRM2(N,SX,INCX),STEMP(1),STEMP,SFAC)
+            ELSE IF (ICASE.EQ.8) THEN
+*              .. DASUM ..
+               STEMP(1) = DTRUE3(NP1)
+               CALL STEST1(DASUM(N,SX,INCX),STEMP(1),STEMP,SFAC)
+            ELSE IF (ICASE.EQ.9) THEN
+*              .. DSCAL ..
+               CALL DSCAL(N,SA((INCX-1)*5+NP1),SX,INCX)
+               DO 40 I = 1, LEN
+                  STRUE(I) = DTRUE5(I,NP1,INCX)
+   40          CONTINUE
+               CALL STEST(LEN,SX,STRUE,STRUE,SFAC)
+            ELSE IF (ICASE.EQ.10) THEN
+*              .. IDAMAX ..
+               CALL ITEST1(IDAMAX(N,SX,INCX),ITRUE2(NP1))
+            ELSE
+               WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
+               STOP
+            END IF
+   60    CONTINUE
+   80 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CHECK2(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION  SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      DOUBLE PRECISION  SA
+      INTEGER           I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
+     $                  MX, MY 
+*     .. Local Arrays ..
+      DOUBLE PRECISION  DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
+     $                  DT8(7,4,4), DX1(7),
+     $                  DY1(7), SSIZE1(4), SSIZE2(14,2), SSIZE(7),
+     $                  STX(7), STY(7), SX(7), SY(7),
+     $                  DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4),
+     $                  DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4),
+     $                  DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4),
+     $                  DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5)
+      INTEGER           INCXS(4), INCYS(4), LENS(4,2), NS(4)
+*     .. External Functions ..
+      DOUBLE PRECISION  DDOT, DSDOT
+      EXTERNAL          DDOT, DSDOT
+*     .. External Subroutines ..
+      EXTERNAL          DAXPY, DCOPY, DROTM, DSWAP, STEST, STEST1
+*     .. Intrinsic Functions ..
+      INTRINSIC         ABS, MIN
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      EQUIVALENCE (DT19X(1,1,1),DT19XA(1,1,1)),(DT19X(1,1,5),
+     A   DT19XB(1,1,1)),(DT19X(1,1,9),DT19XC(1,1,1)),
+     B   (DT19X(1,1,13),DT19XD(1,1,1))
+      EQUIVALENCE (DT19Y(1,1,1),DT19YA(1,1,1)),(DT19Y(1,1,5),
+     A   DT19YB(1,1,1)),(DT19Y(1,1,9),DT19YC(1,1,1)),
+     B   (DT19Y(1,1,13),DT19YD(1,1,1))
+
+      DATA              SA/0.3D0/
+      DATA              INCXS/1, 2, -2, -1/
+      DATA              INCYS/1, -2, 1, -2/
+      DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
+      DATA              NS/0, 1, 2, 4/
+      DATA              DX1/0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.9D0, -0.3D0,
+     +                  -0.4D0/
+      DATA              DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0,
+     +                  0.8D0/
+      DATA              DT7/0.0D0, 0.30D0, 0.21D0, 0.62D0, 0.0D0,
+     +                  0.30D0, -0.07D0, 0.85D0, 0.0D0, 0.30D0, -0.79D0,
+     +                  -0.74D0, 0.0D0, 0.30D0, 0.33D0, 1.27D0/
+      DATA              DT8/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.68D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.68D0, -0.87D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.68D0, -0.87D0, 0.15D0,
+     +                  0.94D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.68D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.35D0, -0.9D0, 0.48D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.38D0, -0.9D0, 0.57D0, 0.7D0, -0.75D0,
+     +                  0.2D0, 0.98D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.68D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.35D0, -0.72D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.38D0,
+     +                  -0.63D0, 0.15D0, 0.88D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.68D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.7D0,
+     +                  -0.75D0, 0.2D0, 1.04D0/
+      DATA              DT10X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.5D0, -0.9D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.5D0, -0.9D0, 0.3D0, 0.7D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.3D0, 0.1D0, 0.5D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.8D0, 0.1D0, -0.6D0,
+     +                  0.8D0, 0.3D0, -0.3D0, 0.5D0, 0.6D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.9D0,
+     +                  0.1D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0,
+     +                  0.1D0, 0.3D0, 0.8D0, -0.9D0, -0.3D0, 0.5D0,
+     +                  0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.5D0, 0.3D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.5D0, 0.3D0, -0.6D0, 0.8D0, 0.0D0, 0.0D0,
+     +                  0.0D0/
+      DATA              DT10Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.6D0, 0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, -0.5D0, -0.9D0, 0.6D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, -0.4D0, -0.9D0, 0.9D0,
+     +                  0.7D0, -0.5D0, 0.2D0, 0.6D0, 0.5D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.5D0,
+     +                  0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  -0.4D0, 0.9D0, -0.5D0, 0.6D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.6D0, -0.9D0, 0.1D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.6D0, -0.9D0, 0.1D0, 0.7D0,
+     +                  -0.5D0, 0.2D0, 0.8D0/
+      DATA              SSIZE1/0.0D0, 0.3D0, 1.6D0, 3.2D0/
+      DATA              SSIZE2/0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
+     +                  1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
+     +                  1.17D0, 1.17D0, 1.17D0/
+*
+*                         FOR DROTM
+*
+      DATA DPAR/-2.D0,  0.D0,0.D0,0.D0,0.D0,
+     A          -1.D0,  2.D0, -3.D0, -4.D0,  5.D0,
+     B           0.D0,  0.D0,  2.D0, -3.D0,  0.D0,
+     C           1.D0,  5.D0,  2.D0,  0.D0, -4.D0/
+*                        TRUE X RESULTS F0R ROTATIONS DROTM
+      DATA DT19XA/.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     A            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     B            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     C            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     D            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     E           -.8D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     F           -.9D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     G           3.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     H            .6D0,   .1D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     I           -.8D0,  3.8D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     J           -.9D0,  2.8D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     K           3.5D0,  -.4D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     L            .6D0,   .1D0,  -.5D0,   .8D0,          0.D0,0.D0,0.D0,
+     M           -.8D0,  3.8D0, -2.2D0, -1.2D0,          0.D0,0.D0,0.D0,
+     N           -.9D0,  2.8D0, -1.4D0, -1.3D0,          0.D0,0.D0,0.D0,
+     O           3.5D0,  -.4D0, -2.2D0,  4.7D0,          0.D0,0.D0,0.D0/
+*
+      DATA DT19XB/.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     A            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     B            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     C            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     D            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     E           -.8D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     F           -.9D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     G           3.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     H            .6D0,   .1D0,  -.5D0,             0.D0,0.D0,0.D0,0.D0,
+     I           0.D0,    .1D0, -3.0D0,             0.D0,0.D0,0.D0,0.D0,
+     J           -.3D0,   .1D0, -2.0D0,             0.D0,0.D0,0.D0,0.D0,
+     K           3.3D0,   .1D0, -2.0D0,             0.D0,0.D0,0.D0,0.D0,
+     L            .6D0,   .1D0,  -.5D0,   .8D0,   .9D0,  -.3D0,  -.4D0,
+     M          -2.0D0,   .1D0,  1.4D0,   .8D0,   .6D0,  -.3D0, -2.8D0,
+     N          -1.8D0,   .1D0,  1.3D0,   .8D0,  0.D0,   -.3D0, -1.9D0,
+     O           3.8D0,   .1D0, -3.1D0,   .8D0,  4.8D0,  -.3D0, -1.5D0 /
+*
+      DATA DT19XC/.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     A            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     B            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     C            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     D            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     E           -.8D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     F           -.9D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     G           3.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     H            .6D0,   .1D0,  -.5D0,             0.D0,0.D0,0.D0,0.D0,
+     I           4.8D0,   .1D0, -3.0D0,             0.D0,0.D0,0.D0,0.D0,
+     J           3.3D0,   .1D0, -2.0D0,             0.D0,0.D0,0.D0,0.D0,
+     K           2.1D0,   .1D0, -2.0D0,             0.D0,0.D0,0.D0,0.D0,
+     L            .6D0,   .1D0,  -.5D0,   .8D0,   .9D0,  -.3D0,  -.4D0,
+     M          -1.6D0,   .1D0, -2.2D0,   .8D0,  5.4D0,  -.3D0, -2.8D0,
+     N          -1.5D0,   .1D0, -1.4D0,   .8D0,  3.6D0,  -.3D0, -1.9D0,
+     O           3.7D0,   .1D0, -2.2D0,   .8D0,  3.6D0,  -.3D0, -1.5D0 /
+*
+      DATA DT19XD/.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     A            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     B            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     C            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     D            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     E           -.8D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     F           -.9D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     G           3.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     H            .6D0,   .1D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     I           -.8D0, -1.0D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     J           -.9D0,  -.8D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     K           3.5D0,   .8D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     L            .6D0,   .1D0,  -.5D0,   .8D0,          0.D0,0.D0,0.D0,
+     M           -.8D0, -1.0D0,  1.4D0, -1.6D0,          0.D0,0.D0,0.D0,
+     N           -.9D0,  -.8D0,  1.3D0, -1.6D0,          0.D0,0.D0,0.D0,
+     O           3.5D0,   .8D0, -3.1D0,  4.8D0,          0.D0,0.D0,0.D0/
+*                        TRUE Y RESULTS FOR ROTATIONS DROTM
+      DATA DT19YA/.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     A            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     B            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     C            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     D            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     E            .7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     F           1.7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     G          -2.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     H            .5D0,  -.9D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     I            .7D0, -4.8D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     J           1.7D0,  -.7D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     K          -2.6D0,  3.5D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     L            .5D0,  -.9D0,   .3D0,   .7D0,          0.D0,0.D0,0.D0,
+     M            .7D0, -4.8D0,  3.0D0,  1.1D0,          0.D0,0.D0,0.D0,
+     N           1.7D0,  -.7D0,  -.7D0,  2.3D0,          0.D0,0.D0,0.D0,
+     O          -2.6D0,  3.5D0,  -.7D0, -3.6D0,          0.D0,0.D0,0.D0/
+*
+      DATA DT19YB/.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     A            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     B            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     C            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     D            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     E            .7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     F           1.7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     G          -2.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     H            .5D0,  -.9D0,   .3D0,             0.D0,0.D0,0.D0,0.D0,
+     I           4.0D0,  -.9D0,  -.3D0,             0.D0,0.D0,0.D0,0.D0,
+     J           -.5D0,  -.9D0,  1.5D0,             0.D0,0.D0,0.D0,0.D0,
+     K          -1.5D0,  -.9D0, -1.8D0,             0.D0,0.D0,0.D0,0.D0,
+     L            .5D0,  -.9D0,   .3D0,   .7D0,  -.6D0,   .2D0,   .8D0,
+     M           3.7D0,  -.9D0, -1.2D0,   .7D0, -1.5D0,   .2D0,  2.2D0,
+     N           -.3D0,  -.9D0,  2.1D0,   .7D0, -1.6D0,   .2D0,  2.0D0,
+     O          -1.6D0,  -.9D0, -2.1D0,   .7D0,  2.9D0,   .2D0, -3.8D0 /
+*
+      DATA DT19YC/.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     A            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     B            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     C            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     D            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     E            .7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     F           1.7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     G          -2.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     H            .5D0,  -.9D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     I           4.0D0, -6.3D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     J           -.5D0,   .3D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     K          -1.5D0,  3.0D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
+     L            .5D0,  -.9D0,   .3D0,   .7D0,          0.D0,0.D0,0.D0,
+     M           3.7D0, -7.2D0,  3.0D0,  1.7D0,          0.D0,0.D0,0.D0,
+     N           -.3D0,   .9D0,  -.7D0,  1.9D0,          0.D0,0.D0,0.D0,
+     O          -1.6D0,  2.7D0,  -.7D0, -3.4D0,          0.D0,0.D0,0.D0/
+*
+      DATA DT19YD/.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     A            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     B            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     C            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     D            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     E            .7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     F           1.7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     G          -2.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
+     H            .5D0,  -.9D0,   .3D0,             0.D0,0.D0,0.D0,0.D0,
+     I            .7D0,  -.9D0,  1.2D0,             0.D0,0.D0,0.D0,0.D0,
+     J           1.7D0,  -.9D0,   .5D0,             0.D0,0.D0,0.D0,0.D0,
+     K          -2.6D0,  -.9D0, -1.3D0,             0.D0,0.D0,0.D0,0.D0,
+     L            .5D0,  -.9D0,   .3D0,   .7D0,  -.6D0,   .2D0,   .8D0,
+     M            .7D0,  -.9D0,  1.2D0,   .7D0, -1.5D0,   .2D0,  1.6D0,
+     N           1.7D0,  -.9D0,   .5D0,   .7D0, -1.6D0,   .2D0,  2.4D0,
+     O          -2.6D0,  -.9D0, -1.3D0,   .7D0,  2.9D0,   .2D0, -4.0D0 /
+*    
+*     .. Executable Statements ..
+*
+      DO 120 KI = 1, 4
+         INCX = INCXS(KI)
+         INCY = INCYS(KI)
+         MX = ABS(INCX)
+         MY = ABS(INCY)
+*
+         DO 100 KN = 1, 4
+            N = NS(KN)
+            KSIZE = MIN(2,KN)
+            LENX = LENS(KN,MX)
+            LENY = LENS(KN,MY)
+*           .. Initialize all argument arrays ..
+            DO 20 I = 1, 7
+               SX(I) = DX1(I)
+               SY(I) = DY1(I)
+   20       CONTINUE
+*
+            IF (ICASE.EQ.1) THEN
+*              .. DDOT ..
+               CALL STEST1(DDOT(N,SX,INCX,SY,INCY),DT7(KN,KI),SSIZE1(KN)
+     +                     ,SFAC)
+            ELSE IF (ICASE.EQ.2) THEN
+*              .. DAXPY ..
+               CALL DAXPY(N,SA,SX,INCX,SY,INCY)
+               DO 40 J = 1, LENY
+                  STY(J) = DT8(J,KN,KI)
+   40          CONTINUE
+               CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
+            ELSE IF (ICASE.EQ.5) THEN
+*              .. DCOPY ..
+               DO 60 I = 1, 7
+                  STY(I) = DT10Y(I,KN,KI)
+   60          CONTINUE
+               CALL DCOPY(N,SX,INCX,SY,INCY)
+               CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0)
+            ELSE IF (ICASE.EQ.6) THEN
+*              .. DSWAP ..
+               CALL DSWAP(N,SX,INCX,SY,INCY)
+               DO 80 I = 1, 7
+                  STX(I) = DT10X(I,KN,KI)
+                  STY(I) = DT10Y(I,KN,KI)
+   80          CONTINUE
+               CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0D0)
+               CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0)
+            ELSE IF (ICASE.EQ.12) THEN
+*              .. DROTM ..
+               KNI=KN+4*(KI-1)
+               DO KPAR=1,4
+                  DO I=1,7
+                     SX(I) = DX1(I)
+                     SY(I) = DY1(I)
+                     STX(I)= DT19X(I,KPAR,KNI)
+                     STY(I)= DT19Y(I,KPAR,KNI)
+                  END DO
+*
+                  DO I=1,5
+                     DTEMP(I) = DPAR(I,KPAR)
+                  END DO
+*
+                  DO  I=1,LENX
+                     SSIZE(I)=STX(I)
+                  END DO
+*                   SEE REMARK ABOVE ABOUT DT11X(1,2,7)
+*                       AND DT11X(5,3,8).
+                  IF ((KPAR .EQ. 2) .AND. (KNI .EQ. 7))
+     $               SSIZE(1) = 2.4D0
+                  IF ((KPAR .EQ. 3) .AND. (KNI .EQ. 8))
+     $               SSIZE(5) = 1.8D0
+*
+                  CALL   DROTM(N,SX,INCX,SY,INCY,DTEMP)
+                  CALL   STEST(LENX,SX,STX,SSIZE,SFAC)
+                  CALL   STEST(LENY,SY,STY,STY,SFAC)
+               END DO
+            ELSE IF (ICASE.EQ.13) THEN
+*              .. DSDOT ..
+            CALL TESTDSDOT(REAL(DSDOT(N,REAL(SX),INCX,REAL(SY),INCY)),
+     $                 REAL(DT7(KN,KI)),REAL(SSIZE1(KN)), .3125E-1)
+            ELSE
+               WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
+               STOP
+            END IF
+  100    CONTINUE
+  120 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CHECK3(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION  SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      DOUBLE PRECISION  SC, SS
+      INTEGER           I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
+*     .. Local Arrays ..
+      DOUBLE PRECISION  COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
+     +                  DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5),
+     +                  MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5),
+     +                  MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7),
+     +                  SY(7)
+      INTEGER           INCXS(4), INCYS(4), LENS(4,2), MWPINX(11),
+     +                  MWPINY(11), MWPN(11), NS(4)
+*     .. External Subroutines ..
+      EXTERNAL          DROT, STEST
+*     .. Intrinsic Functions ..
+      INTRINSIC         ABS, MIN
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      DATA              INCXS/1, 2, -2, -1/
+      DATA              INCYS/1, -2, 1, -2/
+      DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
+      DATA              NS/0, 1, 2, 4/
+      DATA              DX1/0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.9D0, -0.3D0,
+     +                  -0.4D0/
+      DATA              DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0,
+     +                  0.8D0/
+      DATA              SC, SS/0.8D0, 0.6D0/
+      DATA              DT9X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.78D0, -0.46D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.78D0, -0.46D0, -0.22D0,
+     +                  1.06D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.78D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.66D0, 0.1D0, -0.1D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.96D0, 0.1D0, -0.76D0, 0.8D0, 0.90D0,
+     +                  -0.3D0, -0.02D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.78D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.06D0, 0.1D0,
+     +                  -0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.90D0,
+     +                  0.1D0, -0.22D0, 0.8D0, 0.18D0, -0.3D0, -0.02D0,
+     +                  0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.78D0, 0.26D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.78D0, 0.26D0, -0.76D0, 1.12D0,
+     +                  0.0D0, 0.0D0, 0.0D0/
+      DATA              DT9Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.54D0,
+     +                  0.08D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.04D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0,
+     +                  -0.9D0, -0.12D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.64D0, -0.9D0, -0.30D0, 0.7D0, -0.18D0, 0.2D0,
+     +                  0.28D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.7D0, -1.08D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.64D0, -1.26D0,
+     +                  0.54D0, 0.20D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.7D0,
+     +                  -0.18D0, 0.2D0, 0.16D0/
+      DATA              SSIZE2/0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+     +                  0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
+     +                  1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
+     +                  1.17D0, 1.17D0, 1.17D0/
+*     .. Executable Statements ..
+*
+      DO 60 KI = 1, 4
+         INCX = INCXS(KI)
+         INCY = INCYS(KI)
+         MX = ABS(INCX)
+         MY = ABS(INCY)
+*
+         DO 40 KN = 1, 4
+            N = NS(KN)
+            KSIZE = MIN(2,KN)
+            LENX = LENS(KN,MX)
+            LENY = LENS(KN,MY)
+*
+            IF (ICASE.EQ.4) THEN
+*              .. DROT ..
+               DO 20 I = 1, 7
+                  SX(I) = DX1(I)
+                  SY(I) = DY1(I)
+                  STX(I) = DT9X(I,KN,KI)
+                  STY(I) = DT9Y(I,KN,KI)
+   20          CONTINUE
+               CALL DROT(N,SX,INCX,SY,INCY,SC,SS)
+               CALL STEST(LENX,SX,STX,SSIZE2(1,KSIZE),SFAC)
+               CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
+            ELSE
+               WRITE (NOUT,*) ' Shouldn''t be here in CHECK3'
+               STOP
+            END IF
+   40    CONTINUE
+   60 CONTINUE
+*
+      MWPC(1) = 1
+      DO 80 I = 2, 11
+         MWPC(I) = 0
+   80 CONTINUE
+      MWPS(1) = 0
+      DO 100 I = 2, 6
+         MWPS(I) = 1
+  100 CONTINUE
+      DO 120 I = 7, 11
+         MWPS(I) = -1
+  120 CONTINUE
+      MWPINX(1) = 1
+      MWPINX(2) = 1
+      MWPINX(3) = 1
+      MWPINX(4) = -1
+      MWPINX(5) = 1
+      MWPINX(6) = -1
+      MWPINX(7) = 1
+      MWPINX(8) = 1
+      MWPINX(9) = -1
+      MWPINX(10) = 1
+      MWPINX(11) = -1
+      MWPINY(1) = 1
+      MWPINY(2) = 1
+      MWPINY(3) = -1
+      MWPINY(4) = -1
+      MWPINY(5) = 2
+      MWPINY(6) = 1
+      MWPINY(7) = 1
+      MWPINY(8) = -1
+      MWPINY(9) = -1
+      MWPINY(10) = 2
+      MWPINY(11) = 1
+      DO 140 I = 1, 11
+         MWPN(I) = 5
+  140 CONTINUE
+      MWPN(5) = 3
+      MWPN(10) = 3
+      DO 160 I = 1, 5
+         MWPX(I) = I
+         MWPY(I) = I
+         MWPTX(1,I) = I
+         MWPTY(1,I) = I
+         MWPTX(2,I) = I
+         MWPTY(2,I) = -I
+         MWPTX(3,I) = 6 - I
+         MWPTY(3,I) = I - 6
+         MWPTX(4,I) = I
+         MWPTY(4,I) = -I
+         MWPTX(6,I) = 6 - I
+         MWPTY(6,I) = I - 6
+         MWPTX(7,I) = -I
+         MWPTY(7,I) = I
+         MWPTX(8,I) = I - 6
+         MWPTY(8,I) = 6 - I
+         MWPTX(9,I) = -I
+         MWPTY(9,I) = I
+         MWPTX(11,I) = I - 6
+         MWPTY(11,I) = 6 - I
+  160 CONTINUE
+      MWPTX(5,1) = 1
+      MWPTX(5,2) = 3
+      MWPTX(5,3) = 5
+      MWPTX(5,4) = 4
+      MWPTX(5,5) = 5
+      MWPTY(5,1) = -1
+      MWPTY(5,2) = 2
+      MWPTY(5,3) = -2
+      MWPTY(5,4) = 4
+      MWPTY(5,5) = -3
+      MWPTX(10,1) = -1
+      MWPTX(10,2) = -3
+      MWPTX(10,3) = -5
+      MWPTX(10,4) = 4
+      MWPTX(10,5) = 5
+      MWPTY(10,1) = 1
+      MWPTY(10,2) = 2
+      MWPTY(10,3) = 2
+      MWPTY(10,4) = 4
+      MWPTY(10,5) = 3
+      DO 200 I = 1, 11
+         INCX = MWPINX(I)
+         INCY = MWPINY(I)
+         DO 180 K = 1, 5
+            COPYX(K) = MWPX(K)
+            COPYY(K) = MWPY(K)
+            MWPSTX(K) = MWPTX(I,K)
+            MWPSTY(K) = MWPTY(I,K)
+  180    CONTINUE
+         CALL DROT(MWPN(I),COPYX,INCX,COPYY,INCY,MWPC(I),MWPS(I))
+         CALL STEST(5,COPYX,MWPSTX,MWPSTX,SFAC)
+         CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC)
+  200 CONTINUE
+      RETURN
+      END
+      SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
+*     ********************************* STEST **************************
+*
+*     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
+*     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
+*     NEGLIGIBLE.
+*
+*     C. L. LAWSON, JPL, 1974 DEC 10
+*
+*     .. Parameters ..
+      INTEGER          NOUT
+      DOUBLE PRECISION ZERO
+      PARAMETER        (NOUT=6, ZERO=0.0D0)
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION SFAC
+      INTEGER          LEN
+*     .. Array Arguments ..
+      DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, N
+      LOGICAL          PASS
+*     .. Local Scalars ..
+      DOUBLE PRECISION SD
+      INTEGER          I
+*     .. External Functions ..
+      DOUBLE PRECISION SDIFF
+      EXTERNAL         SDIFF
+*     .. Intrinsic Functions ..
+      INTRINSIC        ABS
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Executable Statements ..
+*
+      DO 40 I = 1, LEN
+         SD = SCOMP(I) - STRUE(I)
+         IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
+     +       GO TO 40
+*
+*                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
+*
+         IF ( .NOT. PASS) GO TO 20
+*                             PRINT FAIL MESSAGE AND HEADER.
+         PASS = .FALSE.
+         WRITE (NOUT,99999)
+         WRITE (NOUT,99998)
+   20    WRITE (NOUT,99997) ICASE, N, INCX, INCY, I, SCOMP(I),
+     +     STRUE(I), SD, SSIZE(I)
+   40 CONTINUE
+      RETURN
+*
+99999 FORMAT ('                                       FAIL')
+99998 FORMAT (/' CASE  N INCX INCY  I                            ',
+     +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
+     +       '     SIZE(I)',/1X)
+99997 FORMAT (1X,I4,I3,2I5,I3,2D36.8,2D12.4)
+      END
+      SUBROUTINE TESTDSDOT(SCOMP,STRUE,SSIZE,SFAC)
+*     ********************************* STEST **************************
+*
+*     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
+*     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
+*     NEGLIGIBLE.
+*
+*     C. L. LAWSON, JPL, 1974 DEC 10
+*
+*     .. Parameters ..
+      INTEGER          NOUT
+      REAL             ZERO
+      PARAMETER        (NOUT=6, ZERO=0.0E0)
+*     .. Scalar Arguments ..
+      REAL             SFAC, SCOMP, SSIZE, STRUE
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, N
+      LOGICAL          PASS
+*     .. Local Scalars ..
+      REAL             SD
+*     .. Intrinsic Functions ..
+      INTRINSIC        ABS
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Executable Statements ..
+*
+         SD = SCOMP - STRUE
+         IF (ABS(SFAC*SD) .LE. ABS(SSIZE) * EPSILON(ZERO))
+     +       GO TO 40
+*
+*                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
+*
+         IF ( .NOT. PASS) GO TO 20
+*                             PRINT FAIL MESSAGE AND HEADER.
+         PASS = .FALSE.
+         WRITE (NOUT,99999)
+         WRITE (NOUT,99998)
+   20    WRITE (NOUT,99997) ICASE, N, INCX, INCY, SCOMP,
+     +     STRUE, SD, SSIZE
+   40 CONTINUE
+      RETURN
+*
+99999 FORMAT ('                                       FAIL')
+99998 FORMAT (/' CASE  N INCX INCY                           ',
+     +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
+     +       '     SIZE(I)',/1X)
+99997 FORMAT (1X,I4,I3,1I5,I3,2E36.8,2E12.4)
+      END
+      SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
+*     ************************* STEST1 *****************************
+*
+*     THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
+*     REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
+*     ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
+*
+*     C.L. LAWSON, JPL, 1978 DEC 6
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION  SCOMP1, SFAC, STRUE1
+*     .. Array Arguments ..
+      DOUBLE PRECISION  SSIZE(*)
+*     .. Local Arrays ..
+      DOUBLE PRECISION  SCOMP(1), STRUE(1)
+*     .. External Subroutines ..
+      EXTERNAL          STEST
+*     .. Executable Statements ..
+*
+      SCOMP(1) = SCOMP1
+      STRUE(1) = STRUE1
+      CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
+*
+      RETURN
+      END
+      DOUBLE PRECISION FUNCTION SDIFF(SA,SB)
+*     ********************************* SDIFF **************************
+*     COMPUTES DIFFERENCE OF TWO NUMBERS.  C. L. LAWSON, JPL 1974 FEB 15
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION                SA, SB
+*     .. Executable Statements ..
+      SDIFF = SA - SB
+      RETURN
+      END
+      SUBROUTINE ITEST1(ICOMP,ITRUE)
+*     ********************************* ITEST1 *************************
+*
+*     THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
+*     EQUALITY.
+*     C. L. LAWSON, JPL, 1974 DEC 10
+*
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      INTEGER           ICOMP, ITRUE
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      INTEGER           ID
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Executable Statements ..
+*
+      IF (ICOMP.EQ.ITRUE) GO TO 40
+*
+*                            HERE ICOMP IS NOT EQUAL TO ITRUE.
+*
+      IF ( .NOT. PASS) GO TO 20
+*                             PRINT FAIL MESSAGE AND HEADER.
+      PASS = .FALSE.
+      WRITE (NOUT,99999)
+      WRITE (NOUT,99998)
+   20 ID = ICOMP - ITRUE
+      WRITE (NOUT,99997) ICASE, N, INCX, INCY, ICOMP, ITRUE, ID
+   40 CONTINUE
+      RETURN
+*
+99999 FORMAT ('                                       FAIL')
+99998 FORMAT (/' CASE  N INCX INCY                               ',
+     +       ' COMP                                TRUE     DIFFERENCE',
+     +       /1X)
+99997 FORMAT (1X,I4,I3,2I5,2I36,I12)
+      END
diff --git a/eigen/blas/testing/dblat2.dat b/eigen/blas/testing/dblat2.dat
new file mode 100644
index 0000000..3755b83
--- /dev/null
+++ b/eigen/blas/testing/dblat2.dat
@@ -0,0 +1,34 @@
+'dblat2.summ'     NAME OF SUMMARY OUTPUT FILE
+6                 UNIT NUMBER OF SUMMARY FILE
+'dblat2.snap'     NAME OF SNAPSHOT OUTPUT FILE
+-1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
+T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+16.0     THRESHOLD VALUE OF TEST RATIO
+6                 NUMBER OF VALUES OF N
+0 1 2 3 5 9       VALUES OF N
+4                 NUMBER OF VALUES OF K
+0 1 2 4           VALUES OF K
+4                 NUMBER OF VALUES OF INCX AND INCY
+1 2 -1 -2         VALUES OF INCX AND INCY
+3                 NUMBER OF VALUES OF ALPHA
+0.0 1.0 0.7       VALUES OF ALPHA
+3                 NUMBER OF VALUES OF BETA
+0.0 1.0 0.9       VALUES OF BETA
+DGEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+DGBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+DSYMV  T PUT F FOR NO TEST. SAME COLUMNS.
+DSBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+DSPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+DTRMV  T PUT F FOR NO TEST. SAME COLUMNS.
+DTBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+DTPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+DTRSV  T PUT F FOR NO TEST. SAME COLUMNS.
+DTBSV  T PUT F FOR NO TEST. SAME COLUMNS.
+DTPSV  T PUT F FOR NO TEST. SAME COLUMNS.
+DGER   T PUT F FOR NO TEST. SAME COLUMNS.
+DSYR   T PUT F FOR NO TEST. SAME COLUMNS.
+DSPR   T PUT F FOR NO TEST. SAME COLUMNS.
+DSYR2  T PUT F FOR NO TEST. SAME COLUMNS.
+DSPR2  T PUT F FOR NO TEST. SAME COLUMNS.
diff --git a/eigen/blas/testing/dblat2.f b/eigen/blas/testing/dblat2.f
new file mode 100644
index 0000000..4002d43
--- /dev/null
+++ b/eigen/blas/testing/dblat2.f
@@ -0,0 +1,3138 @@
+      PROGRAM DBLAT2
+*
+*  Test program for the DOUBLE PRECISION Level 2 Blas.
+*
+*  The program must be driven by a short data file. The first 18 records
+*  of the file are read using list-directed input, the last 16 records
+*  are read using the format ( A6, L2 ). An annotated example of a data
+*  file can be obtained by deleting the first 3 characters from the
+*  following 34 lines:
+*  'DBLAT2.SUMM'     NAME OF SUMMARY OUTPUT FILE
+*  6                 UNIT NUMBER OF SUMMARY FILE
+*  'DBLAT2.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
+*  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+*  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+*  F        LOGICAL FLAG, T TO STOP ON FAILURES.
+*  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+*  16.0     THRESHOLD VALUE OF TEST RATIO
+*  6                 NUMBER OF VALUES OF N
+*  0 1 2 3 5 9       VALUES OF N
+*  4                 NUMBER OF VALUES OF K
+*  0 1 2 4           VALUES OF K
+*  4                 NUMBER OF VALUES OF INCX AND INCY
+*  1 2 -1 -2         VALUES OF INCX AND INCY
+*  3                 NUMBER OF VALUES OF ALPHA
+*  0.0 1.0 0.7       VALUES OF ALPHA
+*  3                 NUMBER OF VALUES OF BETA
+*  0.0 1.0 0.9       VALUES OF BETA
+*  DGEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DGBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DSYMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DSBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DSPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DTRMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DTBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DTPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DTRSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DTBSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DTPSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DGER   T PUT F FOR NO TEST. SAME COLUMNS.
+*  DSYR   T PUT F FOR NO TEST. SAME COLUMNS.
+*  DSPR   T PUT F FOR NO TEST. SAME COLUMNS.
+*  DSYR2  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DSPR2  T PUT F FOR NO TEST. SAME COLUMNS.
+*
+*     See:
+*
+*        Dongarra J. J., Du Croz J. J., Hammarling S.  and Hanson R. J..
+*        An  extended  set of Fortran  Basic Linear Algebra Subprograms.
+*
+*        Technical  Memoranda  Nos. 41 (revision 3) and 81,  Mathematics
+*        and  Computer Science  Division,  Argonne  National Laboratory,
+*        9700 South Cass Avenue, Argonne, Illinois 60439, US.
+*
+*        Or
+*
+*        NAG  Technical Reports TR3/87 and TR4/87,  Numerical Algorithms
+*        Group  Ltd.,  NAG  Central  Office,  256  Banbury  Road, Oxford
+*        OX2 7DE, UK,  and  Numerical Algorithms Group Inc.,  1101  31st
+*        Street,  Suite 100,  Downers Grove,  Illinois 60515-1263,  USA.
+*
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      INTEGER            NIN
+      PARAMETER          ( NIN = 5 )
+      INTEGER            NSUBS
+      PARAMETER          ( NSUBS = 16 )
+      DOUBLE PRECISION   ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
+      INTEGER            NMAX, INCMAX
+      PARAMETER          ( NMAX = 65, INCMAX = 2 )
+      INTEGER            NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX
+      PARAMETER          ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7,
+     $                   NALMAX = 7, NBEMAX = 7 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   EPS, ERR, THRESH
+      INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
+     $                   TSTERR
+      CHARACTER*1        TRANS
+      CHARACTER*6        SNAMET
+      CHARACTER*32       SNAPS, SUMMRY
+*     .. Local Arrays ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ),
+     $                   ALF( NALMAX ), AS( NMAX*NMAX ), BET( NBEMAX ),
+     $                   G( NMAX ), X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( 2*NMAX )
+      INTEGER            IDIM( NIDMAX ), INC( NINMAX ), KB( NKBMAX )
+      LOGICAL            LTEST( NSUBS )
+      CHARACTER*6        SNAMES( NSUBS )
+*     .. External Functions ..
+      DOUBLE PRECISION   DDIFF
+      LOGICAL            LDE
+      EXTERNAL           DDIFF, LDE
+*     .. External Subroutines ..
+      EXTERNAL           DCHK1, DCHK2, DCHK3, DCHK4, DCHK5, DCHK6,
+     $                   DCHKE, DMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Data statements ..
+      DATA               SNAMES/'DGEMV ', 'DGBMV ', 'DSYMV ', 'DSBMV ',
+     $                   'DSPMV ', 'DTRMV ', 'DTBMV ', 'DTPMV ',
+     $                   'DTRSV ', 'DTBSV ', 'DTPSV ', 'DGER  ',
+     $                   'DSYR  ', 'DSPR  ', 'DSYR2 ', 'DSPR2 '/
+*     .. Executable Statements ..
+*
+*     Read name and unit number for summary output file and open file.
+*
+      READ( NIN, FMT = * )SUMMRY
+      READ( NIN, FMT = * )NOUT
+      OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+      NOUTC = NOUT
+*
+*     Read name and unit number for snapshot output file and open file.
+*
+      READ( NIN, FMT = * )SNAPS
+      READ( NIN, FMT = * )NTRA
+      TRACE = NTRA.GE.0
+      IF( TRACE )THEN
+         OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+      END IF
+*     Read the flag that directs rewinding of the snapshot file.
+      READ( NIN, FMT = * )REWI
+      REWI = REWI.AND.TRACE
+*     Read the flag that directs stopping on any failure.
+      READ( NIN, FMT = * )SFATAL
+*     Read the flag that indicates whether error exits are to be tested.
+      READ( NIN, FMT = * )TSTERR
+*     Read the threshold value of the test ratio
+      READ( NIN, FMT = * )THRESH
+*
+*     Read and check the parameter values for the tests.
+*
+*     Values of N
+      READ( NIN, FMT = * )NIDIM
+      IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'N', NIDMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
+      DO 10 I = 1, NIDIM
+         IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
+            WRITE( NOUT, FMT = 9996 )NMAX
+            GO TO 230
+         END IF
+   10 CONTINUE
+*     Values of K
+      READ( NIN, FMT = * )NKB
+      IF( NKB.LT.1.OR.NKB.GT.NKBMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'K', NKBMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( KB( I ), I = 1, NKB )
+      DO 20 I = 1, NKB
+         IF( KB( I ).LT.0 )THEN
+            WRITE( NOUT, FMT = 9995 )
+            GO TO 230
+         END IF
+   20 CONTINUE
+*     Values of INCX and INCY
+      READ( NIN, FMT = * )NINC
+      IF( NINC.LT.1.OR.NINC.GT.NINMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'INCX AND INCY', NINMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( INC( I ), I = 1, NINC )
+      DO 30 I = 1, NINC
+         IF( INC( I ).EQ.0.OR.ABS( INC( I ) ).GT.INCMAX )THEN
+            WRITE( NOUT, FMT = 9994 )INCMAX
+            GO TO 230
+         END IF
+   30 CONTINUE
+*     Values of ALPHA
+      READ( NIN, FMT = * )NALF
+      IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
+*     Values of BETA
+      READ( NIN, FMT = * )NBET
+      IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
+*
+*     Report values of parameters.
+*
+      WRITE( NOUT, FMT = 9993 )
+      WRITE( NOUT, FMT = 9992 )( IDIM( I ), I = 1, NIDIM )
+      WRITE( NOUT, FMT = 9991 )( KB( I ), I = 1, NKB )
+      WRITE( NOUT, FMT = 9990 )( INC( I ), I = 1, NINC )
+      WRITE( NOUT, FMT = 9989 )( ALF( I ), I = 1, NALF )
+      WRITE( NOUT, FMT = 9988 )( BET( I ), I = 1, NBET )
+      IF( .NOT.TSTERR )THEN
+         WRITE( NOUT, FMT = * )
+         WRITE( NOUT, FMT = 9980 )
+      END IF
+      WRITE( NOUT, FMT = * )
+      WRITE( NOUT, FMT = 9999 )THRESH
+      WRITE( NOUT, FMT = * )
+*
+*     Read names of subroutines and flags which indicate
+*     whether they are to be tested.
+*
+      DO 40 I = 1, NSUBS
+         LTEST( I ) = .FALSE.
+   40 CONTINUE
+   50 READ( NIN, FMT = 9984, END = 80 )SNAMET, LTESTT
+      DO 60 I = 1, NSUBS
+         IF( SNAMET.EQ.SNAMES( I ) )
+     $      GO TO 70
+   60 CONTINUE
+      WRITE( NOUT, FMT = 9986 )SNAMET
+      STOP
+   70 LTEST( I ) = LTESTT
+      GO TO 50
+*
+   80 CONTINUE
+      CLOSE ( NIN )
+*
+*     Compute EPS (the machine precision).
+*
+      EPS = ONE
+   90 CONTINUE
+      IF( DDIFF( ONE + EPS, ONE ).EQ.ZERO )
+     $   GO TO 100
+      EPS = HALF*EPS
+      GO TO 90
+  100 CONTINUE
+      EPS = EPS + EPS
+      WRITE( NOUT, FMT = 9998 )EPS
+*
+*     Check the reliability of DMVCH using exact data.
+*
+      N = MIN( 32, NMAX )
+      DO 120 J = 1, N
+         DO 110 I = 1, N
+            A( I, J ) = MAX( I - J + 1, 0 )
+  110    CONTINUE
+         X( J ) = J
+         Y( J ) = ZERO
+  120 CONTINUE
+      DO 130 J = 1, N
+         YY( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3
+  130 CONTINUE
+*     YY holds the exact result. On exit from DMVCH YT holds
+*     the result computed by DMVCH.
+      TRANS = 'N'
+      CALL DMVCH( TRANS, N, N, ONE, A, NMAX, X, 1, ZERO, Y, 1, YT, G,
+     $            YY, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LDE( YY, YT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9985 )TRANS, SAME, ERR
+         STOP
+      END IF
+      TRANS = 'T'
+      CALL DMVCH( TRANS, N, N, ONE, A, NMAX, X, -1, ZERO, Y, -1, YT, G,
+     $            YY, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LDE( YY, YT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9985 )TRANS, SAME, ERR
+         STOP
+      END IF
+*
+*     Test each subroutine in turn.
+*
+      DO 210 ISNUM = 1, NSUBS
+         WRITE( NOUT, FMT = * )
+         IF( .NOT.LTEST( ISNUM ) )THEN
+*           Subprogram is not to be tested.
+            WRITE( NOUT, FMT = 9983 )SNAMES( ISNUM )
+         ELSE
+            SRNAMT = SNAMES( ISNUM )
+*           Test error exits.
+            IF( TSTERR )THEN
+               CALL DCHKE( ISNUM, SNAMES( ISNUM ), NOUT )
+               WRITE( NOUT, FMT = * )
+            END IF
+*           Test computations.
+            INFOT = 0
+            OK = .TRUE.
+            FATAL = .FALSE.
+            GO TO ( 140, 140, 150, 150, 150, 160, 160,
+     $              160, 160, 160, 160, 170, 180, 180,
+     $              190, 190 )ISNUM
+*           Test DGEMV, 01, and DGBMV, 02.
+  140       CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF,
+     $                  NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS,
+     $                  X, XX, XS, Y, YY, YS, YT, G )
+            GO TO 200
+*           Test DSYMV, 03, DSBMV, 04, and DSPMV, 05.
+  150       CALL DCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF,
+     $                  NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS,
+     $                  X, XX, XS, Y, YY, YS, YT, G )
+            GO TO 200
+*           Test DTRMV, 06, DTBMV, 07, DTPMV, 08,
+*           DTRSV, 09, DTBSV, 10, and DTPSV, 11.
+  160       CALL DCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z )
+            GO TO 200
+*           Test DGER, 12.
+  170       CALL DCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+            GO TO 200
+*           Test DSYR, 13, and DSPR, 14.
+  180       CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+            GO TO 200
+*           Test DSYR2, 15, and DSPR2, 16.
+  190       CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+*
+  200       IF( FATAL.AND.SFATAL )
+     $         GO TO 220
+         END IF
+  210 CONTINUE
+      WRITE( NOUT, FMT = 9982 )
+      GO TO 240
+*
+  220 CONTINUE
+      WRITE( NOUT, FMT = 9981 )
+      GO TO 240
+*
+  230 CONTINUE
+      WRITE( NOUT, FMT = 9987 )
+*
+  240 CONTINUE
+      IF( TRACE )
+     $   CLOSE ( NTRA )
+      CLOSE ( NOUT )
+      STOP
+*
+ 9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
+     $      'S THAN', F8.2 )
+ 9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, D9.1 )
+ 9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
+     $      'THAN ', I2 )
+ 9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 )
+ 9995 FORMAT( ' VALUE OF K IS LESS THAN 0' )
+ 9994 FORMAT( ' ABSOLUTE VALUE OF INCX OR INCY IS 0 OR GREATER THAN ',
+     $      I2 )
+ 9993 FORMAT( ' TESTS OF THE DOUBLE PRECISION LEVEL 2 BLAS', //' THE F',
+     $      'OLLOWING PARAMETER VALUES WILL BE USED:' )
+ 9992 FORMAT( '   FOR N              ', 9I6 )
+ 9991 FORMAT( '   FOR K              ', 7I6 )
+ 9990 FORMAT( '   FOR INCX AND INCY  ', 7I6 )
+ 9989 FORMAT( '   FOR ALPHA          ', 7F6.1 )
+ 9988 FORMAT( '   FOR BETA           ', 7F6.1 )
+ 9987 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
+     $      /' ******* TESTS ABANDONED *******' )
+ 9986 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+     $      'ESTS ABANDONED *******' )
+ 9985 FORMAT( ' ERROR IN DMVCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
+     $      'ATED WRONGLY.', /' DMVCH WAS CALLED WITH TRANS = ', A1,
+     $      ' AND RETURNED SAME = ', L1, ' AND ERR = ', F12.3, '.', /
+     $   ' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.'
+     $      , /' ******* TESTS ABANDONED *******' )
+ 9984 FORMAT( A6, L2 )
+ 9983 FORMAT( 1X, A6, ' WAS NOT TESTED' )
+ 9982 FORMAT( /' END OF TESTS' )
+ 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
+ 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
+*
+*     End of DBLAT2.
+*
+      END
+      SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET,
+     $                  BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX,
+     $                  XS, Y, YY, YS, YT, G )
+*
+*  Tests DGEMV and DGBMV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, HALF
+      PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), BET( NBET ), G( NMAX ),
+     $                   X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL
+      INTEGER            I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY,
+     $                   INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA,
+     $                   LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK,
+     $                   NL, NS
+      LOGICAL            BANDED, FULL, NULL, RESET, SAME, TRAN
+      CHARACTER*1        TRANS, TRANSS
+      CHARACTER*3        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DGBMV, DGEMV, DMAKE, DMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'NTC'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'E'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 11
+      ELSE IF( BANDED )THEN
+         NARGS = 13
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 120 IN = 1, NIDIM
+         N = IDIM( IN )
+         ND = N/2 + 1
+*
+         DO 110 IM = 1, 2
+            IF( IM.EQ.1 )
+     $         M = MAX( N - ND, 0 )
+            IF( IM.EQ.2 )
+     $         M = MIN( N + ND, NMAX )
+*
+            IF( BANDED )THEN
+               NK = NKB
+            ELSE
+               NK = 1
+            END IF
+            DO 100 IKU = 1, NK
+               IF( BANDED )THEN
+                  KU = KB( IKU )
+                  KL = MAX( KU - 1, 0 )
+               ELSE
+                  KU = N - 1
+                  KL = M - 1
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               IF( BANDED )THEN
+                  LDA = KL + KU + 1
+               ELSE
+                  LDA = M
+               END IF
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 100
+               LAA = LDA*N
+               NULL = N.LE.0.OR.M.LE.0
+*
+*              Generate the matrix A.
+*
+               TRANSL = ZERO
+               CALL DMAKE( SNAME( 2: 3 ), ' ', ' ', M, N, A, NMAX, AA,
+     $                     LDA, KL, KU, RESET, TRANSL )
+*
+               DO 90 IC = 1, 3
+                  TRANS = ICH( IC: IC )
+                  TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C'
+*
+                  IF( TRAN )THEN
+                     ML = N
+                     NL = M
+                  ELSE
+                     ML = M
+                     NL = N
+                  END IF
+*
+                  DO 80 IX = 1, NINC
+                     INCX = INC( IX )
+                     LX = ABS( INCX )*NL
+*
+*                    Generate the vector X.
+*
+                     TRANSL = HALF
+                     CALL DMAKE( 'GE', ' ', ' ', 1, NL, X, 1, XX,
+     $                           ABS( INCX ), 0, NL - 1, RESET, TRANSL )
+                     IF( NL.GT.1 )THEN
+                        X( NL/2 ) = ZERO
+                        XX( 1 + ABS( INCX )*( NL/2 - 1 ) ) = ZERO
+                     END IF
+*
+                     DO 70 IY = 1, NINC
+                        INCY = INC( IY )
+                        LY = ABS( INCY )*ML
+*
+                        DO 60 IA = 1, NALF
+                           ALPHA = ALF( IA )
+*
+                           DO 50 IB = 1, NBET
+                              BETA = BET( IB )
+*
+*                             Generate the vector Y.
+*
+                              TRANSL = ZERO
+                              CALL DMAKE( 'GE', ' ', ' ', 1, ML, Y, 1,
+     $                                    YY, ABS( INCY ), 0, ML - 1,
+     $                                    RESET, TRANSL )
+*
+                              NC = NC + 1
+*
+*                             Save every datum before calling the
+*                             subroutine.
+*
+                              TRANSS = TRANS
+                              MS = M
+                              NS = N
+                              KLS = KL
+                              KUS = KU
+                              ALS = ALPHA
+                              DO 10 I = 1, LAA
+                                 AS( I ) = AA( I )
+   10                         CONTINUE
+                              LDAS = LDA
+                              DO 20 I = 1, LX
+                                 XS( I ) = XX( I )
+   20                         CONTINUE
+                              INCXS = INCX
+                              BLS = BETA
+                              DO 30 I = 1, LY
+                                 YS( I ) = YY( I )
+   30                         CONTINUE
+                              INCYS = INCY
+*
+*                             Call the subroutine.
+*
+                              IF( FULL )THEN
+                                 IF( TRACE )
+     $                              WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                              TRANS, M, N, ALPHA, LDA, INCX, BETA,
+     $                              INCY
+                                 IF( REWI )
+     $                              REWIND NTRA
+                                 CALL DGEMV( TRANS, M, N, ALPHA, AA,
+     $                                       LDA, XX, INCX, BETA, YY,
+     $                                       INCY )
+                              ELSE IF( BANDED )THEN
+                                 IF( TRACE )
+     $                              WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                              TRANS, M, N, KL, KU, ALPHA, LDA,
+     $                              INCX, BETA, INCY
+                                 IF( REWI )
+     $                              REWIND NTRA
+                                 CALL DGBMV( TRANS, M, N, KL, KU, ALPHA,
+     $                                       AA, LDA, XX, INCX, BETA,
+     $                                       YY, INCY )
+                              END IF
+*
+*                             Check if error-exit was taken incorrectly.
+*
+                              IF( .NOT.OK )THEN
+                                 WRITE( NOUT, FMT = 9993 )
+                                 FATAL = .TRUE.
+                                 GO TO 130
+                              END IF
+*
+*                             See what data changed inside subroutines.
+*
+                              ISAME( 1 ) = TRANS.EQ.TRANSS
+                              ISAME( 2 ) = MS.EQ.M
+                              ISAME( 3 ) = NS.EQ.N
+                              IF( FULL )THEN
+                                 ISAME( 4 ) = ALS.EQ.ALPHA
+                                 ISAME( 5 ) = LDE( AS, AA, LAA )
+                                 ISAME( 6 ) = LDAS.EQ.LDA
+                                 ISAME( 7 ) = LDE( XS, XX, LX )
+                                 ISAME( 8 ) = INCXS.EQ.INCX
+                                 ISAME( 9 ) = BLS.EQ.BETA
+                                 IF( NULL )THEN
+                                    ISAME( 10 ) = LDE( YS, YY, LY )
+                                 ELSE
+                                    ISAME( 10 ) = LDERES( 'GE', ' ', 1,
+     $                                            ML, YS, YY,
+     $                                            ABS( INCY ) )
+                                 END IF
+                                 ISAME( 11 ) = INCYS.EQ.INCY
+                              ELSE IF( BANDED )THEN
+                                 ISAME( 4 ) = KLS.EQ.KL
+                                 ISAME( 5 ) = KUS.EQ.KU
+                                 ISAME( 6 ) = ALS.EQ.ALPHA
+                                 ISAME( 7 ) = LDE( AS, AA, LAA )
+                                 ISAME( 8 ) = LDAS.EQ.LDA
+                                 ISAME( 9 ) = LDE( XS, XX, LX )
+                                 ISAME( 10 ) = INCXS.EQ.INCX
+                                 ISAME( 11 ) = BLS.EQ.BETA
+                                 IF( NULL )THEN
+                                    ISAME( 12 ) = LDE( YS, YY, LY )
+                                 ELSE
+                                    ISAME( 12 ) = LDERES( 'GE', ' ', 1,
+     $                                            ML, YS, YY,
+     $                                            ABS( INCY ) )
+                                 END IF
+                                 ISAME( 13 ) = INCYS.EQ.INCY
+                              END IF
+*
+*                             If data was incorrectly changed, report
+*                             and return.
+*
+                              SAME = .TRUE.
+                              DO 40 I = 1, NARGS
+                                 SAME = SAME.AND.ISAME( I )
+                                 IF( .NOT.ISAME( I ) )
+     $                              WRITE( NOUT, FMT = 9998 )I
+   40                         CONTINUE
+                              IF( .NOT.SAME )THEN
+                                 FATAL = .TRUE.
+                                 GO TO 130
+                              END IF
+*
+                              IF( .NOT.NULL )THEN
+*
+*                                Check the result.
+*
+                                 CALL DMVCH( TRANS, M, N, ALPHA, A,
+     $                                       NMAX, X, INCX, BETA, Y,
+     $                                       INCY, YT, G, YY, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                                 ERRMAX = MAX( ERRMAX, ERR )
+*                                If got really bad answer, report and
+*                                return.
+                                 IF( FATAL )
+     $                              GO TO 130
+                              ELSE
+*                                Avoid repeating tests with M.le.0 or
+*                                N.le.0.
+                                 GO TO 110
+                              END IF
+*
+   50                      CONTINUE
+*
+   60                   CONTINUE
+*
+   70                CONTINUE
+*
+   80             CONTINUE
+*
+   90          CONTINUE
+*
+  100       CONTINUE
+*
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 140
+*
+  130 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA,
+     $      INCX, BETA, INCY
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU,
+     $      ALPHA, LDA, INCX, BETA, INCY
+      END IF
+*
+  140 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 4( I3, ',' ), F4.1,
+     $      ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, ') .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), F4.1,
+     $      ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2,
+     $      ')         .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK1.
+*
+      END
+      SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET,
+     $                  BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX,
+     $                  XS, Y, YY, YS, YT, G )
+*
+*  Tests DSYMV, DSBMV and DSPMV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, HALF
+      PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), BET( NBET ), G( NMAX ),
+     $                   X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL
+      INTEGER            I, IA, IB, IC, IK, IN, INCX, INCXS, INCY,
+     $                   INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY,
+     $                   N, NARGS, NC, NK, NS
+      LOGICAL            BANDED, FULL, NULL, PACKED, RESET, SAME
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DMAKE, DMVCH, DSBMV, DSPMV, DSYMV
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'Y'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 10
+      ELSE IF( BANDED )THEN
+         NARGS = 11
+      ELSE IF( PACKED )THEN
+         NARGS = 9
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 110 IN = 1, NIDIM
+         N = IDIM( IN )
+*
+         IF( BANDED )THEN
+            NK = NKB
+         ELSE
+            NK = 1
+         END IF
+         DO 100 IK = 1, NK
+            IF( BANDED )THEN
+               K = KB( IK )
+            ELSE
+               K = N - 1
+            END IF
+*           Set LDA to 1 more than minimum value if room.
+            IF( BANDED )THEN
+               LDA = K + 1
+            ELSE
+               LDA = N
+            END IF
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 100
+            IF( PACKED )THEN
+               LAA = ( N*( N + 1 ) )/2
+            ELSE
+               LAA = LDA*N
+            END IF
+            NULL = N.LE.0
+*
+            DO 90 IC = 1, 2
+               UPLO = ICH( IC: IC )
+*
+*              Generate the matrix A.
+*
+               TRANSL = ZERO
+               CALL DMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A, NMAX, AA,
+     $                     LDA, K, K, RESET, TRANSL )
+*
+               DO 80 IX = 1, NINC
+                  INCX = INC( IX )
+                  LX = ABS( INCX )*N
+*
+*                 Generate the vector X.
+*
+                  TRANSL = HALF
+                  CALL DMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX,
+     $                        ABS( INCX ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     X( N/2 ) = ZERO
+                     XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 70 IY = 1, NINC
+                     INCY = INC( IY )
+                     LY = ABS( INCY )*N
+*
+                     DO 60 IA = 1, NALF
+                        ALPHA = ALF( IA )
+*
+                        DO 50 IB = 1, NBET
+                           BETA = BET( IB )
+*
+*                          Generate the vector Y.
+*
+                           TRANSL = ZERO
+                           CALL DMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                                 ABS( INCY ), 0, N - 1, RESET,
+     $                                 TRANSL )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           UPLOS = UPLO
+                           NS = N
+                           KS = K
+                           ALS = ALPHA
+                           DO 10 I = 1, LAA
+                              AS( I ) = AA( I )
+   10                      CONTINUE
+                           LDAS = LDA
+                           DO 20 I = 1, LX
+                              XS( I ) = XX( I )
+   20                      CONTINUE
+                           INCXS = INCX
+                           BLS = BETA
+                           DO 30 I = 1, LY
+                              YS( I ) = YY( I )
+   30                      CONTINUE
+                           INCYS = INCY
+*
+*                          Call the subroutine.
+*
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, N, ALPHA, LDA, INCX, BETA, INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DSYMV( UPLO, N, ALPHA, AA, LDA, XX,
+     $                                    INCX, BETA, YY, INCY )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, N, K, ALPHA, LDA, INCX, BETA,
+     $                           INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DSBMV( UPLO, N, K, ALPHA, AA, LDA,
+     $                                    XX, INCX, BETA, YY, INCY )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, N, ALPHA, INCX, BETA, INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DSPMV( UPLO, N, ALPHA, AA, XX, INCX,
+     $                                    BETA, YY, INCY )
+                           END IF
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9992 )
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = UPLO.EQ.UPLOS
+                           ISAME( 2 ) = NS.EQ.N
+                           IF( FULL )THEN
+                              ISAME( 3 ) = ALS.EQ.ALPHA
+                              ISAME( 4 ) = LDE( AS, AA, LAA )
+                              ISAME( 5 ) = LDAS.EQ.LDA
+                              ISAME( 6 ) = LDE( XS, XX, LX )
+                              ISAME( 7 ) = INCXS.EQ.INCX
+                              ISAME( 8 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 9 ) = LDE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 9 ) = LDERES( 'GE', ' ', 1, N,
+     $                                        YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 10 ) = INCYS.EQ.INCY
+                           ELSE IF( BANDED )THEN
+                              ISAME( 3 ) = KS.EQ.K
+                              ISAME( 4 ) = ALS.EQ.ALPHA
+                              ISAME( 5 ) = LDE( AS, AA, LAA )
+                              ISAME( 6 ) = LDAS.EQ.LDA
+                              ISAME( 7 ) = LDE( XS, XX, LX )
+                              ISAME( 8 ) = INCXS.EQ.INCX
+                              ISAME( 9 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 10 ) = LDE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 10 ) = LDERES( 'GE', ' ', 1, N,
+     $                                         YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 11 ) = INCYS.EQ.INCY
+                           ELSE IF( PACKED )THEN
+                              ISAME( 3 ) = ALS.EQ.ALPHA
+                              ISAME( 4 ) = LDE( AS, AA, LAA )
+                              ISAME( 5 ) = LDE( XS, XX, LX )
+                              ISAME( 6 ) = INCXS.EQ.INCX
+                              ISAME( 7 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 8 ) = LDE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 8 ) = LDERES( 'GE', ' ', 1, N,
+     $                                        YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 9 ) = INCYS.EQ.INCY
+                           END IF
+*
+*                          If data was incorrectly changed, report and
+*                          return.
+*
+                           SAME = .TRUE.
+                           DO 40 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   40                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+*
+*                             Check the result.
+*
+                              CALL DMVCH( 'N', N, N, ALPHA, A, NMAX, X,
+     $                                    INCX, BETA, Y, INCY, YT, G,
+     $                                    YY, EPS, ERR, FATAL, NOUT,
+     $                                    .TRUE. )
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 120
+                           ELSE
+*                             Avoid repeating tests with N.le.0
+                              GO TO 110
+                           END IF
+*
+   50                   CONTINUE
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, LDA, INCX,
+     $      BETA, INCY
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, K, ALPHA, LDA,
+     $      INCX, BETA, INCY
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, N, ALPHA, INCX,
+     $      BETA, INCY
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', AP',
+     $      ', X,', I2, ',', F4.1, ', Y,', I2, ')                .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), F4.1,
+     $      ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2,
+     $      ')         .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', A,',
+     $      I3, ', X,', I2, ',', F4.1, ', Y,', I2, ')             .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK2.
+*
+      END
+      SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, XT, G, Z )
+*
+*  Tests DTRMV, DTBMV, DTPMV, DTRSV, DTBSV and DTPSV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NIDIM, NINC, NKB, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ),
+     $                   AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XT( NMAX ),
+     $                   XX( NMAX*INCMAX ), Z( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ERR, ERRMAX, TRANSL
+      INTEGER            I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K,
+     $                   KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS
+      LOGICAL            BANDED, FULL, NULL, PACKED, RESET, SAME
+      CHARACTER*1        DIAG, DIAGS, TRANS, TRANSS, UPLO, UPLOS
+      CHARACTER*2        ICHD, ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DMAKE, DMVCH, DTBMV, DTBSV, DTPMV, DTPSV,
+     $                   DTRMV, DTRSV
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'R'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 8
+      ELSE IF( BANDED )THEN
+         NARGS = 9
+      ELSE IF( PACKED )THEN
+         NARGS = 7
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*     Set up zero vector for DMVCH.
+      DO 10 I = 1, NMAX
+         Z( I ) = ZERO
+   10 CONTINUE
+*
+      DO 110 IN = 1, NIDIM
+         N = IDIM( IN )
+*
+         IF( BANDED )THEN
+            NK = NKB
+         ELSE
+            NK = 1
+         END IF
+         DO 100 IK = 1, NK
+            IF( BANDED )THEN
+               K = KB( IK )
+            ELSE
+               K = N - 1
+            END IF
+*           Set LDA to 1 more than minimum value if room.
+            IF( BANDED )THEN
+               LDA = K + 1
+            ELSE
+               LDA = N
+            END IF
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 100
+            IF( PACKED )THEN
+               LAA = ( N*( N + 1 ) )/2
+            ELSE
+               LAA = LDA*N
+            END IF
+            NULL = N.LE.0
+*
+            DO 90 ICU = 1, 2
+               UPLO = ICHU( ICU: ICU )
+*
+               DO 80 ICT = 1, 3
+                  TRANS = ICHT( ICT: ICT )
+*
+                  DO 70 ICD = 1, 2
+                     DIAG = ICHD( ICD: ICD )
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL DMAKE( SNAME( 2: 3 ), UPLO, DIAG, N, N, A,
+     $                           NMAX, AA, LDA, K, K, RESET, TRANSL )
+*
+                     DO 60 IX = 1, NINC
+                        INCX = INC( IX )
+                        LX = ABS( INCX )*N
+*
+*                       Generate the vector X.
+*
+                        TRANSL = HALF
+                        CALL DMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX,
+     $                              ABS( INCX ), 0, N - 1, RESET,
+     $                              TRANSL )
+                        IF( N.GT.1 )THEN
+                           X( N/2 ) = ZERO
+                           XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+                        END IF
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        DIAGS = DIAG
+                        NS = N
+                        KS = K
+                        DO 20 I = 1, LAA
+                           AS( I ) = AA( I )
+   20                   CONTINUE
+                        LDAS = LDA
+                        DO 30 I = 1, LX
+                           XS( I ) = XX( I )
+   30                   CONTINUE
+                        INCXS = INCX
+*
+*                       Call the subroutine.
+*
+                        IF( SNAME( 4: 5 ).EQ.'MV' )THEN
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DTRMV( UPLO, TRANS, DIAG, N, AA, LDA,
+     $                                    XX, INCX )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, K, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DTBMV( UPLO, TRANS, DIAG, N, K, AA,
+     $                                    LDA, XX, INCX )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DTPMV( UPLO, TRANS, DIAG, N, AA, XX,
+     $                                    INCX )
+                           END IF
+                        ELSE IF( SNAME( 4: 5 ).EQ.'SV' )THEN
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DTRSV( UPLO, TRANS, DIAG, N, AA, LDA,
+     $                                    XX, INCX )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, K, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DTBSV( UPLO, TRANS, DIAG, N, K, AA,
+     $                                    LDA, XX, INCX )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DTPSV( UPLO, TRANS, DIAG, N, AA, XX,
+     $                                    INCX )
+                           END IF
+                        END IF
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9992 )
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLO.EQ.UPLOS
+                        ISAME( 2 ) = TRANS.EQ.TRANSS
+                        ISAME( 3 ) = DIAG.EQ.DIAGS
+                        ISAME( 4 ) = NS.EQ.N
+                        IF( FULL )THEN
+                           ISAME( 5 ) = LDE( AS, AA, LAA )
+                           ISAME( 6 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 7 ) = LDE( XS, XX, LX )
+                           ELSE
+                              ISAME( 7 ) = LDERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 8 ) = INCXS.EQ.INCX
+                        ELSE IF( BANDED )THEN
+                           ISAME( 5 ) = KS.EQ.K
+                           ISAME( 6 ) = LDE( AS, AA, LAA )
+                           ISAME( 7 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 8 ) = LDE( XS, XX, LX )
+                           ELSE
+                              ISAME( 8 ) = LDERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 9 ) = INCXS.EQ.INCX
+                        ELSE IF( PACKED )THEN
+                           ISAME( 5 ) = LDE( AS, AA, LAA )
+                           IF( NULL )THEN
+                              ISAME( 6 ) = LDE( XS, XX, LX )
+                           ELSE
+                              ISAME( 6 ) = LDERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 7 ) = INCXS.EQ.INCX
+                        END IF
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+                           IF( SNAME( 4: 5 ).EQ.'MV' )THEN
+*
+*                             Check the result.
+*
+                              CALL DMVCH( TRANS, N, N, ONE, A, NMAX, X,
+     $                                    INCX, ZERO, Z, INCX, XT, G,
+     $                                    XX, EPS, ERR, FATAL, NOUT,
+     $                                    .TRUE. )
+                           ELSE IF( SNAME( 4: 5 ).EQ.'SV' )THEN
+*
+*                             Compute approximation to original vector.
+*
+                              DO 50 I = 1, N
+                                 Z( I ) = XX( 1 + ( I - 1 )*
+     $                                    ABS( INCX ) )
+                                 XX( 1 + ( I - 1 )*ABS( INCX ) )
+     $                              = X( I )
+   50                         CONTINUE
+                              CALL DMVCH( TRANS, N, N, ONE, A, NMAX, Z,
+     $                                    INCX, ZERO, X, INCX, XT, G,
+     $                                    XX, EPS, ERR, FATAL, NOUT,
+     $                                    .FALSE. )
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 120
+                        ELSE
+*                          Avoid repeating tests with N.le.0.
+                           GO TO 110
+                        END IF
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, DIAG, N, LDA,
+     $      INCX
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, DIAG, N, K,
+     $      LDA, INCX
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANS, DIAG, N, INCX
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', AP, ',
+     $      'X,', I2, ')                        .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), 2( I3, ',' ),
+     $      ' A,', I3, ', X,', I2, ')                 .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', A,',
+     $      I3, ', X,', I2, ')                     .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK3.
+*
+      END
+      SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests DGER.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
+     $                   Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, ALS, ERR, ERRMAX, TRANSL
+      INTEGER            I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX,
+     $                   IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS,
+     $                   NC, ND, NS
+      LOGICAL            NULL, RESET, SAME
+*     .. Local Arrays ..
+      DOUBLE PRECISION   W( 1 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DGER, DMAKE, DMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+*     Define the number of arguments.
+      NARGS = 9
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 120 IN = 1, NIDIM
+         N = IDIM( IN )
+         ND = N/2 + 1
+*
+         DO 110 IM = 1, 2
+            IF( IM.EQ.1 )
+     $         M = MAX( N - ND, 0 )
+            IF( IM.EQ.2 )
+     $         M = MIN( N + ND, NMAX )
+*
+*           Set LDA to 1 more than minimum value if room.
+            LDA = M
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 110
+            LAA = LDA*N
+            NULL = N.LE.0.OR.M.LE.0
+*
+            DO 100 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*M
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL DMAKE( 'GE', ' ', ' ', 1, M, X, 1, XX, ABS( INCX ),
+     $                     0, M - 1, RESET, TRANSL )
+               IF( M.GT.1 )THEN
+                  X( M/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( M/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 90 IY = 1, NINC
+                  INCY = INC( IY )
+                  LY = ABS( INCY )*N
+*
+*                 Generate the vector Y.
+*
+                  TRANSL = ZERO
+                  CALL DMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                        ABS( INCY ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     Y( N/2 ) = ZERO
+                     YY( 1 + ABS( INCY )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 80 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL DMAKE( SNAME( 2: 3 ), ' ', ' ', M, N, A, NMAX,
+     $                           AA, LDA, M - 1, N - 1, RESET, TRANSL )
+*
+                     NC = NC + 1
+*
+*                    Save every datum before calling the subroutine.
+*
+                     MS = M
+                     NS = N
+                     ALS = ALPHA
+                     DO 10 I = 1, LAA
+                        AS( I ) = AA( I )
+   10                CONTINUE
+                     LDAS = LDA
+                     DO 20 I = 1, LX
+                        XS( I ) = XX( I )
+   20                CONTINUE
+                     INCXS = INCX
+                     DO 30 I = 1, LY
+                        YS( I ) = YY( I )
+   30                CONTINUE
+                     INCYS = INCY
+*
+*                    Call the subroutine.
+*
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9994 )NC, SNAME, M, N,
+     $                  ALPHA, INCX, INCY, LDA
+                     IF( REWI )
+     $                  REWIND NTRA
+                     CALL DGER( M, N, ALPHA, XX, INCX, YY, INCY, AA,
+     $                          LDA )
+*
+*                    Check if error-exit was taken incorrectly.
+*
+                     IF( .NOT.OK )THEN
+                        WRITE( NOUT, FMT = 9993 )
+                        FATAL = .TRUE.
+                        GO TO 140
+                     END IF
+*
+*                    See what data changed inside subroutine.
+*
+                     ISAME( 1 ) = MS.EQ.M
+                     ISAME( 2 ) = NS.EQ.N
+                     ISAME( 3 ) = ALS.EQ.ALPHA
+                     ISAME( 4 ) = LDE( XS, XX, LX )
+                     ISAME( 5 ) = INCXS.EQ.INCX
+                     ISAME( 6 ) = LDE( YS, YY, LY )
+                     ISAME( 7 ) = INCYS.EQ.INCY
+                     IF( NULL )THEN
+                        ISAME( 8 ) = LDE( AS, AA, LAA )
+                     ELSE
+                        ISAME( 8 ) = LDERES( 'GE', ' ', M, N, AS, AA,
+     $                               LDA )
+                     END IF
+                     ISAME( 9 ) = LDAS.EQ.LDA
+*
+*                    If data was incorrectly changed, report and return.
+*
+                     SAME = .TRUE.
+                     DO 40 I = 1, NARGS
+                        SAME = SAME.AND.ISAME( I )
+                        IF( .NOT.ISAME( I ) )
+     $                     WRITE( NOUT, FMT = 9998 )I
+   40                CONTINUE
+                     IF( .NOT.SAME )THEN
+                        FATAL = .TRUE.
+                        GO TO 140
+                     END IF
+*
+                     IF( .NOT.NULL )THEN
+*
+*                       Check the result column by column.
+*
+                        IF( INCX.GT.0 )THEN
+                           DO 50 I = 1, M
+                              Z( I ) = X( I )
+   50                      CONTINUE
+                        ELSE
+                           DO 60 I = 1, M
+                              Z( I ) = X( M - I + 1 )
+   60                      CONTINUE
+                        END IF
+                        DO 70 J = 1, N
+                           IF( INCY.GT.0 )THEN
+                              W( 1 ) = Y( J )
+                           ELSE
+                              W( 1 ) = Y( N - J + 1 )
+                           END IF
+                           CALL DMVCH( 'N', M, 1, ALPHA, Z, NMAX, W, 1,
+     $                                 ONE, A( 1, J ), 1, YT, G,
+     $                                 AA( 1 + ( J - 1 )*LDA ), EPS,
+     $                                 ERR, FATAL, NOUT, .TRUE. )
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 130
+   70                   CONTINUE
+                     ELSE
+*                       Avoid repeating tests with M.le.0 or N.le.0.
+                        GO TO 110
+                     END IF
+*
+   80             CONTINUE
+*
+   90          CONTINUE
+*
+  100       CONTINUE
+*
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 150
+*
+  130 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  140 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA
+*
+  150 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( I3, ',' ), F4.1, ', X,', I2,
+     $      ', Y,', I2, ', A,', I3, ')                  .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK4.
+*
+      END
+      SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests DSYR and DSPR.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
+     $                   Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, ALS, ERR, ERRMAX, TRANSL
+      INTEGER            I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA,
+     $                   LDA, LDAS, LJ, LX, N, NARGS, NC, NS
+      LOGICAL            FULL, NULL, PACKED, RESET, SAME, UPPER
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      DOUBLE PRECISION   W( 1 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DMAKE, DMVCH, DSPR, DSYR
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'Y'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 7
+      ELSE IF( PACKED )THEN
+         NARGS = 6
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 100 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDA to 1 more than minimum value if room.
+         LDA = N
+         IF( LDA.LT.NMAX )
+     $      LDA = LDA + 1
+*        Skip tests if not enough room.
+         IF( LDA.GT.NMAX )
+     $      GO TO 100
+         IF( PACKED )THEN
+            LAA = ( N*( N + 1 ) )/2
+         ELSE
+            LAA = LDA*N
+         END IF
+*
+         DO 90 IC = 1, 2
+            UPLO = ICH( IC: IC )
+            UPPER = UPLO.EQ.'U'
+*
+            DO 80 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*N
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL DMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX, ABS( INCX ),
+     $                     0, N - 1, RESET, TRANSL )
+               IF( N.GT.1 )THEN
+                  X( N/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 70 IA = 1, NALF
+                  ALPHA = ALF( IA )
+                  NULL = N.LE.0.OR.ALPHA.EQ.ZERO
+*
+*                 Generate the matrix A.
+*
+                  TRANSL = ZERO
+                  CALL DMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A, NMAX,
+     $                        AA, LDA, N - 1, N - 1, RESET, TRANSL )
+*
+                  NC = NC + 1
+*
+*                 Save every datum before calling the subroutine.
+*
+                  UPLOS = UPLO
+                  NS = N
+                  ALS = ALPHA
+                  DO 10 I = 1, LAA
+                     AS( I ) = AA( I )
+   10             CONTINUE
+                  LDAS = LDA
+                  DO 20 I = 1, LX
+                     XS( I ) = XX( I )
+   20             CONTINUE
+                  INCXS = INCX
+*
+*                 Call the subroutine.
+*
+                  IF( FULL )THEN
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO, N,
+     $                  ALPHA, INCX, LDA
+                     IF( REWI )
+     $                  REWIND NTRA
+                     CALL DSYR( UPLO, N, ALPHA, XX, INCX, AA, LDA )
+                  ELSE IF( PACKED )THEN
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO, N,
+     $                  ALPHA, INCX
+                     IF( REWI )
+     $                  REWIND NTRA
+                     CALL DSPR( UPLO, N, ALPHA, XX, INCX, AA )
+                  END IF
+*
+*                 Check if error-exit was taken incorrectly.
+*
+                  IF( .NOT.OK )THEN
+                     WRITE( NOUT, FMT = 9992 )
+                     FATAL = .TRUE.
+                     GO TO 120
+                  END IF
+*
+*                 See what data changed inside subroutines.
+*
+                  ISAME( 1 ) = UPLO.EQ.UPLOS
+                  ISAME( 2 ) = NS.EQ.N
+                  ISAME( 3 ) = ALS.EQ.ALPHA
+                  ISAME( 4 ) = LDE( XS, XX, LX )
+                  ISAME( 5 ) = INCXS.EQ.INCX
+                  IF( NULL )THEN
+                     ISAME( 6 ) = LDE( AS, AA, LAA )
+                  ELSE
+                     ISAME( 6 ) = LDERES( SNAME( 2: 3 ), UPLO, N, N, AS,
+     $                            AA, LDA )
+                  END IF
+                  IF( .NOT.PACKED )THEN
+                     ISAME( 7 ) = LDAS.EQ.LDA
+                  END IF
+*
+*                 If data was incorrectly changed, report and return.
+*
+                  SAME = .TRUE.
+                  DO 30 I = 1, NARGS
+                     SAME = SAME.AND.ISAME( I )
+                     IF( .NOT.ISAME( I ) )
+     $                  WRITE( NOUT, FMT = 9998 )I
+   30             CONTINUE
+                  IF( .NOT.SAME )THEN
+                     FATAL = .TRUE.
+                     GO TO 120
+                  END IF
+*
+                  IF( .NOT.NULL )THEN
+*
+*                    Check the result column by column.
+*
+                     IF( INCX.GT.0 )THEN
+                        DO 40 I = 1, N
+                           Z( I ) = X( I )
+   40                   CONTINUE
+                     ELSE
+                        DO 50 I = 1, N
+                           Z( I ) = X( N - I + 1 )
+   50                   CONTINUE
+                     END IF
+                     JA = 1
+                     DO 60 J = 1, N
+                        W( 1 ) = Z( J )
+                        IF( UPPER )THEN
+                           JJ = 1
+                           LJ = J
+                        ELSE
+                           JJ = J
+                           LJ = N - J + 1
+                        END IF
+                        CALL DMVCH( 'N', LJ, 1, ALPHA, Z( JJ ), LJ, W,
+     $                              1, ONE, A( JJ, J ), 1, YT, G,
+     $                              AA( JA ), EPS, ERR, FATAL, NOUT,
+     $                              .TRUE. )
+                        IF( FULL )THEN
+                           IF( UPPER )THEN
+                              JA = JA + LDA
+                           ELSE
+                              JA = JA + LDA + 1
+                           END IF
+                        ELSE
+                           JA = JA + LJ
+                        END IF
+                        ERRMAX = MAX( ERRMAX, ERR )
+*                       If got really bad answer, report and return.
+                        IF( FATAL )
+     $                     GO TO 110
+   60                CONTINUE
+                  ELSE
+*                    Avoid repeating tests if N.le.0.
+                     IF( N.LE.0 )
+     $                  GO TO 100
+                  END IF
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  110 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, INCX, LDA
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, ALPHA, INCX
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', AP)                           .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', A,', I3, ')                        .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK5.
+*
+      END
+      SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests DSYR2 and DSPR2.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
+     $                   Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX, 2 )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, ALS, ERR, ERRMAX, TRANSL
+      INTEGER            I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX,
+     $                   IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N,
+     $                   NARGS, NC, NS
+      LOGICAL            FULL, NULL, PACKED, RESET, SAME, UPPER
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      DOUBLE PRECISION   W( 2 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DMAKE, DMVCH, DSPR2, DSYR2
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'Y'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 9
+      ELSE IF( PACKED )THEN
+         NARGS = 8
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 140 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDA to 1 more than minimum value if room.
+         LDA = N
+         IF( LDA.LT.NMAX )
+     $      LDA = LDA + 1
+*        Skip tests if not enough room.
+         IF( LDA.GT.NMAX )
+     $      GO TO 140
+         IF( PACKED )THEN
+            LAA = ( N*( N + 1 ) )/2
+         ELSE
+            LAA = LDA*N
+         END IF
+*
+         DO 130 IC = 1, 2
+            UPLO = ICH( IC: IC )
+            UPPER = UPLO.EQ.'U'
+*
+            DO 120 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*N
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL DMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX, ABS( INCX ),
+     $                     0, N - 1, RESET, TRANSL )
+               IF( N.GT.1 )THEN
+                  X( N/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 110 IY = 1, NINC
+                  INCY = INC( IY )
+                  LY = ABS( INCY )*N
+*
+*                 Generate the vector Y.
+*
+                  TRANSL = ZERO
+                  CALL DMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                        ABS( INCY ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     Y( N/2 ) = ZERO
+                     YY( 1 + ABS( INCY )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 100 IA = 1, NALF
+                     ALPHA = ALF( IA )
+                     NULL = N.LE.0.OR.ALPHA.EQ.ZERO
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL DMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A,
+     $                           NMAX, AA, LDA, N - 1, N - 1, RESET,
+     $                           TRANSL )
+*
+                     NC = NC + 1
+*
+*                    Save every datum before calling the subroutine.
+*
+                     UPLOS = UPLO
+                     NS = N
+                     ALS = ALPHA
+                     DO 10 I = 1, LAA
+                        AS( I ) = AA( I )
+   10                CONTINUE
+                     LDAS = LDA
+                     DO 20 I = 1, LX
+                        XS( I ) = XX( I )
+   20                CONTINUE
+                     INCXS = INCX
+                     DO 30 I = 1, LY
+                        YS( I ) = YY( I )
+   30                CONTINUE
+                     INCYS = INCY
+*
+*                    Call the subroutine.
+*
+                     IF( FULL )THEN
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO, N,
+     $                     ALPHA, INCX, INCY, LDA
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL DSYR2( UPLO, N, ALPHA, XX, INCX, YY, INCY,
+     $                              AA, LDA )
+                     ELSE IF( PACKED )THEN
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO, N,
+     $                     ALPHA, INCX, INCY
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL DSPR2( UPLO, N, ALPHA, XX, INCX, YY, INCY,
+     $                              AA )
+                     END IF
+*
+*                    Check if error-exit was taken incorrectly.
+*
+                     IF( .NOT.OK )THEN
+                        WRITE( NOUT, FMT = 9992 )
+                        FATAL = .TRUE.
+                        GO TO 160
+                     END IF
+*
+*                    See what data changed inside subroutines.
+*
+                     ISAME( 1 ) = UPLO.EQ.UPLOS
+                     ISAME( 2 ) = NS.EQ.N
+                     ISAME( 3 ) = ALS.EQ.ALPHA
+                     ISAME( 4 ) = LDE( XS, XX, LX )
+                     ISAME( 5 ) = INCXS.EQ.INCX
+                     ISAME( 6 ) = LDE( YS, YY, LY )
+                     ISAME( 7 ) = INCYS.EQ.INCY
+                     IF( NULL )THEN
+                        ISAME( 8 ) = LDE( AS, AA, LAA )
+                     ELSE
+                        ISAME( 8 ) = LDERES( SNAME( 2: 3 ), UPLO, N, N,
+     $                               AS, AA, LDA )
+                     END IF
+                     IF( .NOT.PACKED )THEN
+                        ISAME( 9 ) = LDAS.EQ.LDA
+                     END IF
+*
+*                    If data was incorrectly changed, report and return.
+*
+                     SAME = .TRUE.
+                     DO 40 I = 1, NARGS
+                        SAME = SAME.AND.ISAME( I )
+                        IF( .NOT.ISAME( I ) )
+     $                     WRITE( NOUT, FMT = 9998 )I
+   40                CONTINUE
+                     IF( .NOT.SAME )THEN
+                        FATAL = .TRUE.
+                        GO TO 160
+                     END IF
+*
+                     IF( .NOT.NULL )THEN
+*
+*                       Check the result column by column.
+*
+                        IF( INCX.GT.0 )THEN
+                           DO 50 I = 1, N
+                              Z( I, 1 ) = X( I )
+   50                      CONTINUE
+                        ELSE
+                           DO 60 I = 1, N
+                              Z( I, 1 ) = X( N - I + 1 )
+   60                      CONTINUE
+                        END IF
+                        IF( INCY.GT.0 )THEN
+                           DO 70 I = 1, N
+                              Z( I, 2 ) = Y( I )
+   70                      CONTINUE
+                        ELSE
+                           DO 80 I = 1, N
+                              Z( I, 2 ) = Y( N - I + 1 )
+   80                      CONTINUE
+                        END IF
+                        JA = 1
+                        DO 90 J = 1, N
+                           W( 1 ) = Z( J, 2 )
+                           W( 2 ) = Z( J, 1 )
+                           IF( UPPER )THEN
+                              JJ = 1
+                              LJ = J
+                           ELSE
+                              JJ = J
+                              LJ = N - J + 1
+                           END IF
+                           CALL DMVCH( 'N', LJ, 2, ALPHA, Z( JJ, 1 ),
+     $                                 NMAX, W, 1, ONE, A( JJ, J ), 1,
+     $                                 YT, G, AA( JA ), EPS, ERR, FATAL,
+     $                                 NOUT, .TRUE. )
+                           IF( FULL )THEN
+                              IF( UPPER )THEN
+                                 JA = JA + LDA
+                              ELSE
+                                 JA = JA + LDA + 1
+                              END IF
+                           ELSE
+                              JA = JA + LJ
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 150
+   90                   CONTINUE
+                     ELSE
+*                       Avoid repeating tests with N.le.0.
+                        IF( N.LE.0 )
+     $                     GO TO 140
+                     END IF
+*
+  100             CONTINUE
+*
+  110          CONTINUE
+*
+  120       CONTINUE
+*
+  130    CONTINUE
+*
+  140 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 170
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  160 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, INCX,
+     $      INCY, LDA
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, ALPHA, INCX, INCY
+      END IF
+*
+  170 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', Y,', I2, ', AP)                     .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', Y,', I2, ', A,', I3, ')                  .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK6.
+*
+      END
+      SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT )
+*
+*  Tests the error exits from the Level 2 Blas.
+*  Requires a special version of the error-handling routine XERBLA.
+*  ALPHA, BETA, A, X and Y should not need to be defined.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            ISNUM, NOUT
+      CHARACTER*6        SRNAMT
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, BETA
+*     .. Local Arrays ..
+      DOUBLE PRECISION   A( 1, 1 ), X( 1 ), Y( 1 )
+*     .. External Subroutines ..
+      EXTERNAL           CHKXER, DGBMV, DGEMV, DGER, DSBMV, DSPMV, DSPR,
+     $                   DSPR2, DSYMV, DSYR, DSYR2, DTBMV, DTBSV, DTPMV,
+     $                   DTPSV, DTRMV, DTRSV
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+*     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
+*     if anything is wrong.
+      OK = .TRUE.
+*     LERR is set to .TRUE. by the special version of XERBLA each time
+*     it is called, and is then tested and re-set by CHKXER.
+      LERR = .FALSE.
+      GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
+     $        90, 100, 110, 120, 130, 140, 150,
+     $        160 )ISNUM
+   10 INFOT = 1
+      CALL DGEMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DGEMV( 'N', -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DGEMV( 'N', 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DGEMV( 'N', 2, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL DGEMV( 'N', 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DGEMV( 'N', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   20 INFOT = 1
+      CALL DGBMV( '/', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DGBMV( 'N', -1, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DGBMV( 'N', 0, -1, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DGBMV( 'N', 0, 0, -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DGBMV( 'N', 2, 0, 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL DGBMV( 'N', 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL DGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL DGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   30 INFOT = 1
+      CALL DSYMV( '/', 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DSYMV( 'U', -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DSYMV( 'U', 2, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYMV( 'U', 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL DSYMV( 'U', 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   40 INFOT = 1
+      CALL DSBMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DSBMV( 'U', -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSBMV( 'U', 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DSBMV( 'U', 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL DSBMV( 'U', 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DSBMV( 'U', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   50 INFOT = 1
+      CALL DSPMV( '/', 0, ALPHA, A, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DSPMV( 'U', -1, ALPHA, A, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DSPMV( 'U', 0, ALPHA, A, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DSPMV( 'U', 0, ALPHA, A, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   60 INFOT = 1
+      CALL DTRMV( '/', 'N', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DTRMV( 'U', '/', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DTRMV( 'U', 'N', '/', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DTRMV( 'U', 'N', 'N', -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRMV( 'U', 'N', 'N', 2, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL DTRMV( 'U', 'N', 'N', 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   70 INFOT = 1
+      CALL DTBMV( '/', 'N', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DTBMV( 'U', '/', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DTBMV( 'U', 'N', '/', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DTBMV( 'U', 'N', 'N', -1, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTBMV( 'U', 'N', 'N', 0, -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DTBMV( 'U', 'N', 'N', 0, 1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTBMV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   80 INFOT = 1
+      CALL DTPMV( '/', 'N', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DTPMV( 'U', '/', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DTPMV( 'U', 'N', '/', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DTPMV( 'U', 'N', 'N', -1, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DTPMV( 'U', 'N', 'N', 0, A, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   90 INFOT = 1
+      CALL DTRSV( '/', 'N', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DTRSV( 'U', '/', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DTRSV( 'U', 'N', '/', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DTRSV( 'U', 'N', 'N', -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRSV( 'U', 'N', 'N', 2, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL DTRSV( 'U', 'N', 'N', 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  100 INFOT = 1
+      CALL DTBSV( '/', 'N', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DTBSV( 'U', '/', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DTBSV( 'U', 'N', '/', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DTBSV( 'U', 'N', 'N', -1, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTBSV( 'U', 'N', 'N', 0, -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DTBSV( 'U', 'N', 'N', 0, 1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTBSV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  110 INFOT = 1
+      CALL DTPSV( '/', 'N', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DTPSV( 'U', '/', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DTPSV( 'U', 'N', '/', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DTPSV( 'U', 'N', 'N', -1, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DTPSV( 'U', 'N', 'N', 0, A, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  120 INFOT = 1
+      CALL DGER( -1, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DGER( 0, -1, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DGER( 0, 0, ALPHA, X, 0, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DGER( 0, 0, ALPHA, X, 1, Y, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DGER( 2, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  130 INFOT = 1
+      CALL DSYR( '/', 0, ALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DSYR( 'U', -1, ALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DSYR( 'U', 0, ALPHA, X, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYR( 'U', 2, ALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  140 INFOT = 1
+      CALL DSPR( '/', 0, ALPHA, X, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DSPR( 'U', -1, ALPHA, X, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DSPR( 'U', 0, ALPHA, X, 0, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  150 INFOT = 1
+      CALL DSYR2( '/', 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DSYR2( 'U', -1, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DSYR2( 'U', 0, ALPHA, X, 0, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYR2( 'U', 0, ALPHA, X, 1, Y, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DSYR2( 'U', 2, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  160 INFOT = 1
+      CALL DSPR2( '/', 0, ALPHA, X, 1, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DSPR2( 'U', -1, ALPHA, X, 1, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DSPR2( 'U', 0, ALPHA, X, 0, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSPR2( 'U', 0, ALPHA, X, 1, Y, 0, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+  170 IF( OK )THEN
+         WRITE( NOUT, FMT = 9999 )SRNAMT
+      ELSE
+         WRITE( NOUT, FMT = 9998 )SRNAMT
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+     $      '**' )
+*
+*     End of DCHKE.
+*
+      END
+      SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL,
+     $                  KU, RESET, TRANSL )
+*
+*  Generates values for an M by N matrix A within the bandwidth
+*  defined by KL and KU.
+*  Stores the values in the array AA in the data structure required
+*  by the routine, with unwanted elements set to rogue value.
+*
+*  TYPE is 'GE', 'GB', 'SY', 'SB', 'SP', 'TR', 'TB' OR 'TP'.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+      DOUBLE PRECISION   ROGUE
+      PARAMETER          ( ROGUE = -1.0D10 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   TRANSL
+      INTEGER            KL, KU, LDA, M, N, NMAX
+      LOGICAL            RESET
+      CHARACTER*1        DIAG, UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, * ), AA( * )
+*     .. Local Scalars ..
+      INTEGER            I, I1, I2, I3, IBEG, IEND, IOFF, J, KK
+      LOGICAL            GEN, LOWER, SYM, TRI, UNIT, UPPER
+*     .. External Functions ..
+      DOUBLE PRECISION   DBEG
+      EXTERNAL           DBEG
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     .. Executable Statements ..
+      GEN = TYPE( 1: 1 ).EQ.'G'
+      SYM = TYPE( 1: 1 ).EQ.'S'
+      TRI = TYPE( 1: 1 ).EQ.'T'
+      UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U'
+      LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L'
+      UNIT = TRI.AND.DIAG.EQ.'U'
+*
+*     Generate data in array A.
+*
+      DO 20 J = 1, N
+         DO 10 I = 1, M
+            IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
+     $          THEN
+               IF( ( I.LE.J.AND.J - I.LE.KU ).OR.
+     $             ( I.GE.J.AND.I - J.LE.KL ) )THEN
+                  A( I, J ) = DBEG( RESET ) + TRANSL
+               ELSE
+                  A( I, J ) = ZERO
+               END IF
+               IF( I.NE.J )THEN
+                  IF( SYM )THEN
+                     A( J, I ) = A( I, J )
+                  ELSE IF( TRI )THEN
+                     A( J, I ) = ZERO
+                  END IF
+               END IF
+            END IF
+   10    CONTINUE
+         IF( TRI )
+     $      A( J, J ) = A( J, J ) + ONE
+         IF( UNIT )
+     $      A( J, J ) = ONE
+   20 CONTINUE
+*
+*     Store elements in array AS in data structure required by routine.
+*
+      IF( TYPE.EQ.'GE' )THEN
+         DO 50 J = 1, N
+            DO 30 I = 1, M
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   30       CONTINUE
+            DO 40 I = M + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   40       CONTINUE
+   50    CONTINUE
+      ELSE IF( TYPE.EQ.'GB' )THEN
+         DO 90 J = 1, N
+            DO 60 I1 = 1, KU + 1 - J
+               AA( I1 + ( J - 1 )*LDA ) = ROGUE
+   60       CONTINUE
+            DO 70 I2 = I1, MIN( KL + KU + 1, KU + 1 + M - J )
+               AA( I2 + ( J - 1 )*LDA ) = A( I2 + J - KU - 1, J )
+   70       CONTINUE
+            DO 80 I3 = I2, LDA
+               AA( I3 + ( J - 1 )*LDA ) = ROGUE
+   80       CONTINUE
+   90    CONTINUE
+      ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN
+         DO 130 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IF( UNIT )THEN
+                  IEND = J - 1
+               ELSE
+                  IEND = J
+               END IF
+            ELSE
+               IF( UNIT )THEN
+                  IBEG = J + 1
+               ELSE
+                  IBEG = J
+               END IF
+               IEND = N
+            END IF
+            DO 100 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  100       CONTINUE
+            DO 110 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+  110       CONTINUE
+            DO 120 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  120       CONTINUE
+  130    CONTINUE
+      ELSE IF( TYPE.EQ.'SB'.OR.TYPE.EQ.'TB' )THEN
+         DO 170 J = 1, N
+            IF( UPPER )THEN
+               KK = KL + 1
+               IBEG = MAX( 1, KL + 2 - J )
+               IF( UNIT )THEN
+                  IEND = KL
+               ELSE
+                  IEND = KL + 1
+               END IF
+            ELSE
+               KK = 1
+               IF( UNIT )THEN
+                  IBEG = 2
+               ELSE
+                  IBEG = 1
+               END IF
+               IEND = MIN( KL + 1, 1 + M - J )
+            END IF
+            DO 140 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  140       CONTINUE
+            DO 150 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I + J - KK, J )
+  150       CONTINUE
+            DO 160 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  160       CONTINUE
+  170    CONTINUE
+      ELSE IF( TYPE.EQ.'SP'.OR.TYPE.EQ.'TP' )THEN
+         IOFF = 0
+         DO 190 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 180 I = IBEG, IEND
+               IOFF = IOFF + 1
+               AA( IOFF ) = A( I, J )
+               IF( I.EQ.J )THEN
+                  IF( UNIT )
+     $               AA( IOFF ) = ROGUE
+               END IF
+  180       CONTINUE
+  190    CONTINUE
+      END IF
+      RETURN
+*
+*     End of DMAKE.
+*
+      END
+      SUBROUTINE DMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y,
+     $                  INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV )
+*
+*  Checks the results of the computational tests.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA, BETA, EPS, ERR
+      INTEGER            INCX, INCY, M, N, NMAX, NOUT
+      LOGICAL            FATAL, MV
+      CHARACTER*1        TRANS
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, * ), G( * ), X( * ), Y( * ), YT( * ),
+     $                   YY( * )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ERRI
+      INTEGER            I, INCXL, INCYL, IY, J, JX, KX, KY, ML, NL
+      LOGICAL            TRAN
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, SQRT
+*     .. Executable Statements ..
+      TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C'
+      IF( TRAN )THEN
+         ML = N
+         NL = M
+      ELSE
+         ML = M
+         NL = N
+      END IF
+      IF( INCX.LT.0 )THEN
+         KX = NL
+         INCXL = -1
+      ELSE
+         KX = 1
+         INCXL = 1
+      END IF
+      IF( INCY.LT.0 )THEN
+         KY = ML
+         INCYL = -1
+      ELSE
+         KY = 1
+         INCYL = 1
+      END IF
+*
+*     Compute expected result in YT using data in A, X and Y.
+*     Compute gauges in G.
+*
+      IY = KY
+      DO 30 I = 1, ML
+         YT( IY ) = ZERO
+         G( IY ) = ZERO
+         JX = KX
+         IF( TRAN )THEN
+            DO 10 J = 1, NL
+               YT( IY ) = YT( IY ) + A( J, I )*X( JX )
+               G( IY ) = G( IY ) + ABS( A( J, I )*X( JX ) )
+               JX = JX + INCXL
+   10       CONTINUE
+         ELSE
+            DO 20 J = 1, NL
+               YT( IY ) = YT( IY ) + A( I, J )*X( JX )
+               G( IY ) = G( IY ) + ABS( A( I, J )*X( JX ) )
+               JX = JX + INCXL
+   20       CONTINUE
+         END IF
+         YT( IY ) = ALPHA*YT( IY ) + BETA*Y( IY )
+         G( IY ) = ABS( ALPHA )*G( IY ) + ABS( BETA*Y( IY ) )
+         IY = IY + INCYL
+   30 CONTINUE
+*
+*     Compute the error ratio for this result.
+*
+      ERR = ZERO
+      DO 40 I = 1, ML
+         ERRI = ABS( YT( I ) - YY( 1 + ( I - 1 )*ABS( INCY ) ) )/EPS
+         IF( G( I ).NE.ZERO )
+     $      ERRI = ERRI/G( I )
+         ERR = MAX( ERR, ERRI )
+         IF( ERR*SQRT( EPS ).GE.ONE )
+     $      GO TO 50
+   40 CONTINUE
+*     If the loop completes, all results are at least half accurate.
+      GO TO 70
+*
+*     Report fatal error.
+*
+   50 FATAL = .TRUE.
+      WRITE( NOUT, FMT = 9999 )
+      DO 60 I = 1, ML
+         IF( MV )THEN
+            WRITE( NOUT, FMT = 9998 )I, YT( I ),
+     $         YY( 1 + ( I - 1 )*ABS( INCY ) )
+         ELSE
+            WRITE( NOUT, FMT = 9998 )I,
+     $         YY( 1 + ( I - 1 )*ABS( INCY ) ), YT( I )
+         END IF
+   60 CONTINUE
+*
+   70 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
+     $      'F ACCURATE *******', /'           EXPECTED RESULT   COMPU',
+     $      'TED RESULT' )
+ 9998 FORMAT( 1X, I7, 2G18.6 )
+*
+*     End of DMVCH.
+*
+      END
+      LOGICAL FUNCTION LDE( RI, RJ, LR )
+*
+*  Tests if two arrays are identical.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LR
+*     .. Array Arguments ..
+      DOUBLE PRECISION   RI( * ), RJ( * )
+*     .. Local Scalars ..
+      INTEGER            I
+*     .. Executable Statements ..
+      DO 10 I = 1, LR
+         IF( RI( I ).NE.RJ( I ) )
+     $      GO TO 20
+   10 CONTINUE
+      LDE = .TRUE.
+      GO TO 30
+   20 CONTINUE
+      LDE = .FALSE.
+   30 RETURN
+*
+*     End of LDE.
+*
+      END
+      LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA )
+*
+*  Tests if selected elements in two arrays are equal.
+*
+*  TYPE is 'GE', 'SY' or 'SP'.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDA, M, N
+      CHARACTER*1        UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      DOUBLE PRECISION   AA( LDA, * ), AS( LDA, * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J
+      LOGICAL            UPPER
+*     .. Executable Statements ..
+      UPPER = UPLO.EQ.'U'
+      IF( TYPE.EQ.'GE' )THEN
+         DO 20 J = 1, N
+            DO 10 I = M + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   10       CONTINUE
+   20    CONTINUE
+      ELSE IF( TYPE.EQ.'SY' )THEN
+         DO 50 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 30 I = 1, IBEG - 1
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   30       CONTINUE
+            DO 40 I = IEND + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   40       CONTINUE
+   50    CONTINUE
+      END IF
+*
+   60 CONTINUE
+      LDERES = .TRUE.
+      GO TO 80
+   70 CONTINUE
+      LDERES = .FALSE.
+   80 RETURN
+*
+*     End of LDERES.
+*
+      END
+      DOUBLE PRECISION FUNCTION DBEG( RESET )
+*
+*  Generates random numbers uniformly distributed between -0.5 and 0.5.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      LOGICAL            RESET
+*     .. Local Scalars ..
+      INTEGER            I, IC, MI
+*     .. Save statement ..
+      SAVE               I, IC, MI
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE
+*     .. Executable Statements ..
+      IF( RESET )THEN
+*        Initialize local variables.
+         MI = 891
+         I = 7
+         IC = 0
+         RESET = .FALSE.
+      END IF
+*
+*     The sequence of values of I is bounded between 1 and 999.
+*     If initial I = 1,2,3,6,7 or 9, the period will be 50.
+*     If initial I = 4 or 8, the period will be 25.
+*     If initial I = 5, the period will be 10.
+*     IC is used to break up the period by skipping 1 value of I in 6.
+*
+      IC = IC + 1
+   10 I = I*MI
+      I = I - 1000*( I/1000 )
+      IF( IC.GE.5 )THEN
+         IC = 0
+         GO TO 10
+      END IF
+      DBEG = DBLE( I - 500 )/1001.0D0
+      RETURN
+*
+*     End of DBEG.
+*
+      END
+      DOUBLE PRECISION FUNCTION DDIFF( X, Y )
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   X, Y
+*     .. Executable Statements ..
+      DDIFF = X - Y
+      RETURN
+*
+*     End of DDIFF.
+*
+      END
+      SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+*  Tests whether XERBLA has detected an error when it should.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Executable Statements ..
+      IF( .NOT.LERR )THEN
+         WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
+         OK = .FALSE.
+      END IF
+      LERR = .FALSE.
+      RETURN
+*
+ 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
+     $      'ETECTED BY ', A6, ' *****' )
+*
+*     End of CHKXER.
+*
+      END
+      SUBROUTINE XERBLA( SRNAME, INFO )
+*
+*  This is a special version of XERBLA to be used only as part of
+*  the test program for testing error exits from the Level 2 BLAS
+*  routines.
+*
+*  XERBLA  is an error handler for the Level 2 BLAS routines.
+*
+*  It is called by the Level 2 BLAS routines if an input parameter is
+*  invalid.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO
+      CHARACTER*6        SRNAME
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUT, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Executable Statements ..
+      LERR = .TRUE.
+      IF( INFO.NE.INFOT )THEN
+         IF( INFOT.NE.0 )THEN
+            WRITE( NOUT, FMT = 9999 )INFO, INFOT
+         ELSE
+            WRITE( NOUT, FMT = 9997 )INFO
+         END IF
+         OK = .FALSE.
+      END IF
+      IF( SRNAME.NE.SRNAMT )THEN
+         WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
+         OK = .FALSE.
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
+     $      ' OF ', I2, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
+     $      'AD OF ', A6, ' *******' )
+ 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
+     $      ' *******' )
+*
+*     End of XERBLA
+*
+      END
+
diff --git a/eigen/blas/testing/dblat3.dat b/eigen/blas/testing/dblat3.dat
new file mode 100644
index 0000000..5cbc2e6
--- /dev/null
+++ b/eigen/blas/testing/dblat3.dat
@@ -0,0 +1,20 @@
+'dblat3.summ'     NAME OF SUMMARY OUTPUT FILE
+6                 UNIT NUMBER OF SUMMARY FILE
+'dblat3.snap'     NAME OF SNAPSHOT OUTPUT FILE
+-1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
+T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+16.0     THRESHOLD VALUE OF TEST RATIO
+6                 NUMBER OF VALUES OF N
+0 1 2 3 5 9       VALUES OF N
+3                 NUMBER OF VALUES OF ALPHA
+0.0 1.0 0.7       VALUES OF ALPHA
+3                 NUMBER OF VALUES OF BETA
+0.0 1.0 1.3       VALUES OF BETA
+DGEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+DSYMM  T PUT F FOR NO TEST. SAME COLUMNS.
+DTRMM  T PUT F FOR NO TEST. SAME COLUMNS.
+DTRSM  T PUT F FOR NO TEST. SAME COLUMNS.
+DSYRK  T PUT F FOR NO TEST. SAME COLUMNS.
+DSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
diff --git a/eigen/blas/testing/dblat3.f b/eigen/blas/testing/dblat3.f
new file mode 100644
index 0000000..082e03e
--- /dev/null
+++ b/eigen/blas/testing/dblat3.f
@@ -0,0 +1,2823 @@
+      PROGRAM DBLAT3
+*
+*  Test program for the DOUBLE PRECISION Level 3 Blas.
+*
+*  The program must be driven by a short data file. The first 14 records
+*  of the file are read using list-directed input, the last 6 records
+*  are read using the format ( A6, L2 ). An annotated example of a data
+*  file can be obtained by deleting the first 3 characters from the
+*  following 20 lines:
+*  'DBLAT3.SUMM'     NAME OF SUMMARY OUTPUT FILE
+*  6                 UNIT NUMBER OF SUMMARY FILE
+*  'DBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
+*  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+*  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+*  F        LOGICAL FLAG, T TO STOP ON FAILURES.
+*  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+*  16.0     THRESHOLD VALUE OF TEST RATIO
+*  6                 NUMBER OF VALUES OF N
+*  0 1 2 3 5 9       VALUES OF N
+*  3                 NUMBER OF VALUES OF ALPHA
+*  0.0 1.0 0.7       VALUES OF ALPHA
+*  3                 NUMBER OF VALUES OF BETA
+*  0.0 1.0 1.3       VALUES OF BETA
+*  DGEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DSYMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DTRMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DTRSM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DSYRK  T PUT F FOR NO TEST. SAME COLUMNS.
+*  DSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
+*
+*  See:
+*
+*     Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
+*     A Set of Level 3 Basic Linear Algebra Subprograms.
+*
+*     Technical Memorandum No.88 (Revision 1), Mathematics and
+*     Computer Science Division, Argonne National Laboratory, 9700
+*     South Cass Avenue, Argonne, Illinois 60439, US.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      INTEGER            NIN
+      PARAMETER          ( NIN = 5 )
+      INTEGER            NSUBS
+      PARAMETER          ( NSUBS = 6 )
+      DOUBLE PRECISION   ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 )
+      INTEGER            NMAX
+      PARAMETER          ( NMAX = 65 )
+      INTEGER            NIDMAX, NALMAX, NBEMAX
+      PARAMETER          ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   EPS, ERR, THRESH
+      INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA
+      LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
+     $                   TSTERR
+      CHARACTER*1        TRANSA, TRANSB
+      CHARACTER*6        SNAMET
+      CHARACTER*32       SNAPS, SUMMRY
+*     .. Local Arrays ..
+      DOUBLE PRECISION   AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
+     $                   ALF( NALMAX ), AS( NMAX*NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBEMAX ),
+     $                   BS( NMAX*NMAX ), C( NMAX, NMAX ),
+     $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
+     $                   G( NMAX ), W( 2*NMAX )
+      INTEGER            IDIM( NIDMAX )
+      LOGICAL            LTEST( NSUBS )
+      CHARACTER*6        SNAMES( NSUBS )
+*     .. External Functions ..
+      DOUBLE PRECISION   DDIFF
+      LOGICAL            LDE
+      EXTERNAL           DDIFF, LDE
+*     .. External Subroutines ..
+      EXTERNAL           DCHK1, DCHK2, DCHK3, DCHK4, DCHK5, DCHKE, DMMCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Data statements ..
+      DATA               SNAMES/'DGEMM ', 'DSYMM ', 'DTRMM ', 'DTRSM ',
+     $                   'DSYRK ', 'DSYR2K'/
+*     .. Executable Statements ..
+*
+*     Read name and unit number for summary output file and open file.
+*
+      READ( NIN, FMT = * )SUMMRY
+      READ( NIN, FMT = * )NOUT
+      OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+      NOUTC = NOUT
+*
+*     Read name and unit number for snapshot output file and open file.
+*
+      READ( NIN, FMT = * )SNAPS
+      READ( NIN, FMT = * )NTRA
+      TRACE = NTRA.GE.0
+      IF( TRACE )THEN
+         OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+      END IF
+*     Read the flag that directs rewinding of the snapshot file.
+      READ( NIN, FMT = * )REWI
+      REWI = REWI.AND.TRACE
+*     Read the flag that directs stopping on any failure.
+      READ( NIN, FMT = * )SFATAL
+*     Read the flag that indicates whether error exits are to be tested.
+      READ( NIN, FMT = * )TSTERR
+*     Read the threshold value of the test ratio
+      READ( NIN, FMT = * )THRESH
+*
+*     Read and check the parameter values for the tests.
+*
+*     Values of N
+      READ( NIN, FMT = * )NIDIM
+      IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'N', NIDMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
+      DO 10 I = 1, NIDIM
+         IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
+            WRITE( NOUT, FMT = 9996 )NMAX
+            GO TO 220
+         END IF
+   10 CONTINUE
+*     Values of ALPHA
+      READ( NIN, FMT = * )NALF
+      IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
+*     Values of BETA
+      READ( NIN, FMT = * )NBET
+      IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
+*
+*     Report values of parameters.
+*
+      WRITE( NOUT, FMT = 9995 )
+      WRITE( NOUT, FMT = 9994 )( IDIM( I ), I = 1, NIDIM )
+      WRITE( NOUT, FMT = 9993 )( ALF( I ), I = 1, NALF )
+      WRITE( NOUT, FMT = 9992 )( BET( I ), I = 1, NBET )
+      IF( .NOT.TSTERR )THEN
+         WRITE( NOUT, FMT = * )
+         WRITE( NOUT, FMT = 9984 )
+      END IF
+      WRITE( NOUT, FMT = * )
+      WRITE( NOUT, FMT = 9999 )THRESH
+      WRITE( NOUT, FMT = * )
+*
+*     Read names of subroutines and flags which indicate
+*     whether they are to be tested.
+*
+      DO 20 I = 1, NSUBS
+         LTEST( I ) = .FALSE.
+   20 CONTINUE
+   30 READ( NIN, FMT = 9988, END = 60 )SNAMET, LTESTT
+      DO 40 I = 1, NSUBS
+         IF( SNAMET.EQ.SNAMES( I ) )
+     $      GO TO 50
+   40 CONTINUE
+      WRITE( NOUT, FMT = 9990 )SNAMET
+      STOP
+   50 LTEST( I ) = LTESTT
+      GO TO 30
+*
+   60 CONTINUE
+      CLOSE ( NIN )
+*
+*     Compute EPS (the machine precision).
+*
+      EPS = ONE
+   70 CONTINUE
+      IF( DDIFF( ONE + EPS, ONE ).EQ.ZERO )
+     $   GO TO 80
+      EPS = HALF*EPS
+      GO TO 70
+   80 CONTINUE
+      EPS = EPS + EPS
+      WRITE( NOUT, FMT = 9998 )EPS
+*
+*     Check the reliability of DMMCH using exact data.
+*
+      N = MIN( 32, NMAX )
+      DO 100 J = 1, N
+         DO 90 I = 1, N
+            AB( I, J ) = MAX( I - J + 1, 0 )
+   90    CONTINUE
+         AB( J, NMAX + 1 ) = J
+         AB( 1, NMAX + J ) = J
+         C( J, 1 ) = ZERO
+  100 CONTINUE
+      DO 110 J = 1, N
+         CC( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3
+  110 CONTINUE
+*     CC holds the exact result. On exit from DMMCH CT holds
+*     the result computed by DMMCH.
+      TRANSA = 'N'
+      TRANSB = 'N'
+      CALL DMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LDE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      TRANSB = 'T'
+      CALL DMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LDE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      DO 120 J = 1, N
+         AB( J, NMAX + 1 ) = N - J + 1
+         AB( 1, NMAX + J ) = N - J + 1
+  120 CONTINUE
+      DO 130 J = 1, N
+         CC( N - J + 1 ) = J*( ( J + 1 )*J )/2 -
+     $                     ( ( J + 1 )*J*( J - 1 ) )/3
+  130 CONTINUE
+      TRANSA = 'T'
+      TRANSB = 'N'
+      CALL DMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LDE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      TRANSB = 'T'
+      CALL DMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LDE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+*
+*     Test each subroutine in turn.
+*
+      DO 200 ISNUM = 1, NSUBS
+         WRITE( NOUT, FMT = * )
+         IF( .NOT.LTEST( ISNUM ) )THEN
+*           Subprogram is not to be tested.
+            WRITE( NOUT, FMT = 9987 )SNAMES( ISNUM )
+         ELSE
+            SRNAMT = SNAMES( ISNUM )
+*           Test error exits.
+            IF( TSTERR )THEN
+               CALL DCHKE( ISNUM, SNAMES( ISNUM ), NOUT )
+               WRITE( NOUT, FMT = * )
+            END IF
+*           Test computations.
+            INFOT = 0
+            OK = .TRUE.
+            FATAL = .FALSE.
+            GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM
+*           Test DGEMM, 01.
+  140       CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test DSYMM, 02.
+  150       CALL DCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test DTRMM, 03, DTRSM, 04.
+  160       CALL DCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
+     $                  AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C )
+            GO TO 190
+*           Test DSYRK, 05.
+  170       CALL DCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test DSYR2K, 06.
+  180       CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
+            GO TO 190
+*
+  190       IF( FATAL.AND.SFATAL )
+     $         GO TO 210
+         END IF
+  200 CONTINUE
+      WRITE( NOUT, FMT = 9986 )
+      GO TO 230
+*
+  210 CONTINUE
+      WRITE( NOUT, FMT = 9985 )
+      GO TO 230
+*
+  220 CONTINUE
+      WRITE( NOUT, FMT = 9991 )
+*
+  230 CONTINUE
+      IF( TRACE )
+     $   CLOSE ( NTRA )
+      CLOSE ( NOUT )
+      STOP
+*
+ 9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
+     $      'S THAN', F8.2 )
+ 9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, D9.1 )
+ 9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
+     $      'THAN ', I2 )
+ 9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 )
+ 9995 FORMAT( ' TESTS OF THE DOUBLE PRECISION LEVEL 3 BLAS', //' THE F',
+     $      'OLLOWING PARAMETER VALUES WILL BE USED:' )
+ 9994 FORMAT( '   FOR N              ', 9I6 )
+ 9993 FORMAT( '   FOR ALPHA          ', 7F6.1 )
+ 9992 FORMAT( '   FOR BETA           ', 7F6.1 )
+ 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
+     $      /' ******* TESTS ABANDONED *******' )
+ 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+     $      'ESTS ABANDONED *******' )
+ 9989 FORMAT( ' ERROR IN DMMCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
+     $      'ATED WRONGLY.', /' DMMCH WAS CALLED WITH TRANSA = ', A1,
+     $      ' AND TRANSB = ', A1, /' AND RETURNED SAME = ', L1, ' AND ',
+     $      'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
+     $      'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
+     $      '*******' )
+ 9988 FORMAT( A6, L2 )
+ 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
+ 9986 FORMAT( /' END OF TESTS' )
+ 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
+ 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
+*
+*     End of DBLAT3.
+*
+      END
+      SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests DGEMM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, ALS, BETA, BLS, ERR, ERRMAX
+      INTEGER            I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
+     $                   LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M,
+     $                   MA, MB, MS, N, NA, NARGS, NB, NC, NS
+      LOGICAL            NULL, RESET, SAME, TRANA, TRANB
+      CHARACTER*1        TRANAS, TRANBS, TRANSA, TRANSB
+      CHARACTER*3        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DGEMM, DMAKE, DMMCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'NTC'/
+*     .. Executable Statements ..
+*
+      NARGS = 13
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 110 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 100 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDC to 1 more than minimum value if room.
+            LDC = M
+            IF( LDC.LT.NMAX )
+     $         LDC = LDC + 1
+*           Skip tests if not enough room.
+            IF( LDC.GT.NMAX )
+     $         GO TO 100
+            LCC = LDC*N
+            NULL = N.LE.0.OR.M.LE.0
+*
+            DO 90 IK = 1, NIDIM
+               K = IDIM( IK )
+*
+               DO 80 ICA = 1, 3
+                  TRANSA = ICH( ICA: ICA )
+                  TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
+*
+                  IF( TRANA )THEN
+                     MA = K
+                     NA = M
+                  ELSE
+                     MA = M
+                     NA = K
+                  END IF
+*                 Set LDA to 1 more than minimum value if room.
+                  LDA = MA
+                  IF( LDA.LT.NMAX )
+     $               LDA = LDA + 1
+*                 Skip tests if not enough room.
+                  IF( LDA.GT.NMAX )
+     $               GO TO 80
+                  LAA = LDA*NA
+*
+*                 Generate the matrix A.
+*
+                  CALL DMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
+     $                        RESET, ZERO )
+*
+                  DO 70 ICB = 1, 3
+                     TRANSB = ICH( ICB: ICB )
+                     TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
+*
+                     IF( TRANB )THEN
+                        MB = N
+                        NB = K
+                     ELSE
+                        MB = K
+                        NB = N
+                     END IF
+*                    Set LDB to 1 more than minimum value if room.
+                     LDB = MB
+                     IF( LDB.LT.NMAX )
+     $                  LDB = LDB + 1
+*                    Skip tests if not enough room.
+                     IF( LDB.GT.NMAX )
+     $                  GO TO 70
+                     LBB = LDB*NB
+*
+*                    Generate the matrix B.
+*
+                     CALL DMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
+     $                           LDB, RESET, ZERO )
+*
+                     DO 60 IA = 1, NALF
+                        ALPHA = ALF( IA )
+*
+                        DO 50 IB = 1, NBET
+                           BETA = BET( IB )
+*
+*                          Generate the matrix C.
+*
+                           CALL DMAKE( 'GE', ' ', ' ', M, N, C, NMAX,
+     $                                 CC, LDC, RESET, ZERO )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           TRANAS = TRANSA
+                           TRANBS = TRANSB
+                           MS = M
+                           NS = N
+                           KS = K
+                           ALS = ALPHA
+                           DO 10 I = 1, LAA
+                              AS( I ) = AA( I )
+   10                      CONTINUE
+                           LDAS = LDA
+                           DO 20 I = 1, LBB
+                              BS( I ) = BB( I )
+   20                      CONTINUE
+                           LDBS = LDB
+                           BLS = BETA
+                           DO 30 I = 1, LCC
+                              CS( I ) = CC( I )
+   30                      CONTINUE
+                           LDCS = LDC
+*
+*                          Call the subroutine.
+*
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                        TRANSA, TRANSB, M, N, K, ALPHA, LDA, LDB,
+     $                        BETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL DGEMM( TRANSA, TRANSB, M, N, K, ALPHA,
+     $                                 AA, LDA, BB, LDB, BETA, CC, LDC )
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9994 )
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = TRANSA.EQ.TRANAS
+                           ISAME( 2 ) = TRANSB.EQ.TRANBS
+                           ISAME( 3 ) = MS.EQ.M
+                           ISAME( 4 ) = NS.EQ.N
+                           ISAME( 5 ) = KS.EQ.K
+                           ISAME( 6 ) = ALS.EQ.ALPHA
+                           ISAME( 7 ) = LDE( AS, AA, LAA )
+                           ISAME( 8 ) = LDAS.EQ.LDA
+                           ISAME( 9 ) = LDE( BS, BB, LBB )
+                           ISAME( 10 ) = LDBS.EQ.LDB
+                           ISAME( 11 ) = BLS.EQ.BETA
+                           IF( NULL )THEN
+                              ISAME( 12 ) = LDE( CS, CC, LCC )
+                           ELSE
+                              ISAME( 12 ) = LDERES( 'GE', ' ', M, N, CS,
+     $                                      CC, LDC )
+                           END IF
+                           ISAME( 13 ) = LDCS.EQ.LDC
+*
+*                          If data was incorrectly changed, report
+*                          and return.
+*
+                           SAME = .TRUE.
+                           DO 40 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   40                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+*
+*                             Check the result.
+*
+                              CALL DMMCH( TRANSA, TRANSB, M, N, K,
+     $                                    ALPHA, A, NMAX, B, NMAX, BETA,
+     $                                    C, NMAX, CT, G, CC, LDC, EPS,
+     $                                    ERR, FATAL, NOUT, .TRUE. )
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 120
+                           END IF
+*
+   50                   CONTINUE
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, M, N, K,
+     $   ALPHA, LDA, LDB, BETA, LDC
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',',
+     $      3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
+     $      'C,', I3, ').' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK1.
+*
+      END
+      SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests DSYMM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, ALS, BETA, BLS, ERR, ERRMAX
+      INTEGER            I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC,
+     $                   LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA,
+     $                   NARGS, NC, NS
+      LOGICAL            LEFT, NULL, RESET, SAME
+      CHARACTER*1        SIDE, SIDES, UPLO, UPLOS
+      CHARACTER*2        ICHS, ICHU
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DMAKE, DMMCH, DSYMM
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHS/'LR'/, ICHU/'UL'/
+*     .. Executable Statements ..
+*
+      NARGS = 12
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 100 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 90 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDC to 1 more than minimum value if room.
+            LDC = M
+            IF( LDC.LT.NMAX )
+     $         LDC = LDC + 1
+*           Skip tests if not enough room.
+            IF( LDC.GT.NMAX )
+     $         GO TO 90
+            LCC = LDC*N
+            NULL = N.LE.0.OR.M.LE.0
+*
+*           Set LDB to 1 more than minimum value if room.
+            LDB = M
+            IF( LDB.LT.NMAX )
+     $         LDB = LDB + 1
+*           Skip tests if not enough room.
+            IF( LDB.GT.NMAX )
+     $         GO TO 90
+            LBB = LDB*N
+*
+*           Generate the matrix B.
+*
+            CALL DMAKE( 'GE', ' ', ' ', M, N, B, NMAX, BB, LDB, RESET,
+     $                  ZERO )
+*
+            DO 80 ICS = 1, 2
+               SIDE = ICHS( ICS: ICS )
+               LEFT = SIDE.EQ.'L'
+*
+               IF( LEFT )THEN
+                  NA = M
+               ELSE
+                  NA = N
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = NA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 80
+               LAA = LDA*NA
+*
+               DO 70 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+*
+*                 Generate the symmetric matrix A.
+*
+                  CALL DMAKE( 'SY', UPLO, ' ', NA, NA, A, NMAX, AA, LDA,
+     $                        RESET, ZERO )
+*
+                  DO 60 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 50 IB = 1, NBET
+                        BETA = BET( IB )
+*
+*                       Generate the matrix C.
+*
+                        CALL DMAKE( 'GE', ' ', ' ', M, N, C, NMAX, CC,
+     $                              LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the
+*                       subroutine.
+*
+                        SIDES = SIDE
+                        UPLOS = UPLO
+                        MS = M
+                        NS = N
+                        ALS = ALPHA
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        DO 20 I = 1, LBB
+                           BS( I ) = BB( I )
+   20                   CONTINUE
+                        LDBS = LDB
+                        BLS = BETA
+                        DO 30 I = 1, LCC
+                           CS( I ) = CC( I )
+   30                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9995 )NC, SNAME, SIDE,
+     $                     UPLO, M, N, ALPHA, LDA, LDB, BETA, LDC
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL DSYMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
+     $                              BB, LDB, BETA, CC, LDC )
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9994 )
+                           FATAL = .TRUE.
+                           GO TO 110
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = SIDES.EQ.SIDE
+                        ISAME( 2 ) = UPLOS.EQ.UPLO
+                        ISAME( 3 ) = MS.EQ.M
+                        ISAME( 4 ) = NS.EQ.N
+                        ISAME( 5 ) = ALS.EQ.ALPHA
+                        ISAME( 6 ) = LDE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        ISAME( 8 ) = LDE( BS, BB, LBB )
+                        ISAME( 9 ) = LDBS.EQ.LDB
+                        ISAME( 10 ) = BLS.EQ.BETA
+                        IF( NULL )THEN
+                           ISAME( 11 ) = LDE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 11 ) = LDERES( 'GE', ' ', M, N, CS,
+     $                                   CC, LDC )
+                        END IF
+                        ISAME( 12 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 110
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result.
+*
+                           IF( LEFT )THEN
+                              CALL DMMCH( 'N', 'N', M, N, M, ALPHA, A,
+     $                                    NMAX, B, NMAX, BETA, C, NMAX,
+     $                                    CT, G, CC, LDC, EPS, ERR,
+     $                                    FATAL, NOUT, .TRUE. )
+                           ELSE
+                              CALL DMMCH( 'N', 'N', M, N, N, ALPHA, B,
+     $                                    NMAX, A, NMAX, BETA, C, NMAX,
+     $                                    CT, G, CC, LDC, EPS, ERR,
+     $                                    FATAL, NOUT, .TRUE. )
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and
+*                          return.
+                           IF( FATAL )
+     $                        GO TO 110
+                        END IF
+*
+   50                CONTINUE
+*
+   60             CONTINUE
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 120
+*
+  110 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, M, N, ALPHA, LDA,
+     $   LDB, BETA, LDC
+*
+  120 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ')   ',
+     $      ' .' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK2.
+*
+      END
+      SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS,
+     $                  B, BB, BS, CT, G, C )
+*
+*  Tests DTRMM and DTRSM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            NALF, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CT( NMAX ), G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, ALS, ERR, ERRMAX
+      INTEGER            I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB,
+     $                   LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC,
+     $                   NS
+      LOGICAL            LEFT, NULL, RESET, SAME
+      CHARACTER*1        DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO,
+     $                   UPLOS
+      CHARACTER*2        ICHD, ICHS, ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DMAKE, DMMCH, DTRMM, DTRSM
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/
+*     .. Executable Statements ..
+*
+      NARGS = 11
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*     Set up zero matrix for DMMCH.
+      DO 20 J = 1, NMAX
+         DO 10 I = 1, NMAX
+            C( I, J ) = ZERO
+   10    CONTINUE
+   20 CONTINUE
+*
+      DO 140 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 130 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDB to 1 more than minimum value if room.
+            LDB = M
+            IF( LDB.LT.NMAX )
+     $         LDB = LDB + 1
+*           Skip tests if not enough room.
+            IF( LDB.GT.NMAX )
+     $         GO TO 130
+            LBB = LDB*N
+            NULL = M.LE.0.OR.N.LE.0
+*
+            DO 120 ICS = 1, 2
+               SIDE = ICHS( ICS: ICS )
+               LEFT = SIDE.EQ.'L'
+               IF( LEFT )THEN
+                  NA = M
+               ELSE
+                  NA = N
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = NA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 130
+               LAA = LDA*NA
+*
+               DO 110 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+*
+                  DO 100 ICT = 1, 3
+                     TRANSA = ICHT( ICT: ICT )
+*
+                     DO 90 ICD = 1, 2
+                        DIAG = ICHD( ICD: ICD )
+*
+                        DO 80 IA = 1, NALF
+                           ALPHA = ALF( IA )
+*
+*                          Generate the matrix A.
+*
+                           CALL DMAKE( 'TR', UPLO, DIAG, NA, NA, A,
+     $                                 NMAX, AA, LDA, RESET, ZERO )
+*
+*                          Generate the matrix B.
+*
+                           CALL DMAKE( 'GE', ' ', ' ', M, N, B, NMAX,
+     $                                 BB, LDB, RESET, ZERO )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           SIDES = SIDE
+                           UPLOS = UPLO
+                           TRANAS = TRANSA
+                           DIAGS = DIAG
+                           MS = M
+                           NS = N
+                           ALS = ALPHA
+                           DO 30 I = 1, LAA
+                              AS( I ) = AA( I )
+   30                      CONTINUE
+                           LDAS = LDA
+                           DO 40 I = 1, LBB
+                              BS( I ) = BB( I )
+   40                      CONTINUE
+                           LDBS = LDB
+*
+*                          Call the subroutine.
+*
+                           IF( SNAME( 4: 5 ).EQ.'MM' )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
+     $                           LDA, LDB
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DTRMM( SIDE, UPLO, TRANSA, DIAG, M,
+     $                                    N, ALPHA, AA, LDA, BB, LDB )
+                           ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
+     $                           LDA, LDB
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL DTRSM( SIDE, UPLO, TRANSA, DIAG, M,
+     $                                    N, ALPHA, AA, LDA, BB, LDB )
+                           END IF
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9994 )
+                              FATAL = .TRUE.
+                              GO TO 150
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = SIDES.EQ.SIDE
+                           ISAME( 2 ) = UPLOS.EQ.UPLO
+                           ISAME( 3 ) = TRANAS.EQ.TRANSA
+                           ISAME( 4 ) = DIAGS.EQ.DIAG
+                           ISAME( 5 ) = MS.EQ.M
+                           ISAME( 6 ) = NS.EQ.N
+                           ISAME( 7 ) = ALS.EQ.ALPHA
+                           ISAME( 8 ) = LDE( AS, AA, LAA )
+                           ISAME( 9 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 10 ) = LDE( BS, BB, LBB )
+                           ELSE
+                              ISAME( 10 ) = LDERES( 'GE', ' ', M, N, BS,
+     $                                      BB, LDB )
+                           END IF
+                           ISAME( 11 ) = LDBS.EQ.LDB
+*
+*                          If data was incorrectly changed, report and
+*                          return.
+*
+                           SAME = .TRUE.
+                           DO 50 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   50                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 150
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+                              IF( SNAME( 4: 5 ).EQ.'MM' )THEN
+*
+*                                Check the result.
+*
+                                 IF( LEFT )THEN
+                                    CALL DMMCH( TRANSA, 'N', M, N, M,
+     $                                          ALPHA, A, NMAX, B, NMAX,
+     $                                          ZERO, C, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .TRUE. )
+                                 ELSE
+                                    CALL DMMCH( 'N', TRANSA, M, N, N,
+     $                                          ALPHA, B, NMAX, A, NMAX,
+     $                                          ZERO, C, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .TRUE. )
+                                 END IF
+                              ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
+*
+*                                Compute approximation to original
+*                                matrix.
+*
+                                 DO 70 J = 1, N
+                                    DO 60 I = 1, M
+                                       C( I, J ) = BB( I + ( J - 1 )*
+     $                                             LDB )
+                                       BB( I + ( J - 1 )*LDB ) = ALPHA*
+     $                                    B( I, J )
+   60                               CONTINUE
+   70                            CONTINUE
+*
+                                 IF( LEFT )THEN
+                                    CALL DMMCH( TRANSA, 'N', M, N, M,
+     $                                          ONE, A, NMAX, C, NMAX,
+     $                                          ZERO, B, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .FALSE. )
+                                 ELSE
+                                    CALL DMMCH( 'N', TRANSA, M, N, N,
+     $                                          ONE, C, NMAX, A, NMAX,
+     $                                          ZERO, B, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .FALSE. )
+                                 END IF
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 150
+                           END IF
+*
+   80                   CONTINUE
+*
+   90                CONTINUE
+*
+  100             CONTINUE
+*
+  110          CONTINUE
+*
+  120       CONTINUE
+*
+  130    CONTINUE
+*
+  140 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 160
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, TRANSA, DIAG, M,
+     $   N, ALPHA, LDA, LDB
+*
+  160 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ', B,', I3, ')        .' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK3.
+*
+      END
+      SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests DSYRK.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, ALS, BETA, BETS, ERR, ERRMAX
+      INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
+     $                   LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA,
+     $                   NARGS, NC, NS
+      LOGICAL            NULL, RESET, SAME, TRAN, UPPER
+      CHARACTER*1        TRANS, TRANSS, UPLO, UPLOS
+      CHARACTER*2        ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DMAKE, DMMCH, DSYRK
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHT/'NTC'/, ICHU/'UL'/
+*     .. Executable Statements ..
+*
+      NARGS = 10
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 100 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDC to 1 more than minimum value if room.
+         LDC = N
+         IF( LDC.LT.NMAX )
+     $      LDC = LDC + 1
+*        Skip tests if not enough room.
+         IF( LDC.GT.NMAX )
+     $      GO TO 100
+         LCC = LDC*N
+         NULL = N.LE.0
+*
+         DO 90 IK = 1, NIDIM
+            K = IDIM( IK )
+*
+            DO 80 ICT = 1, 3
+               TRANS = ICHT( ICT: ICT )
+               TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C'
+               IF( TRAN )THEN
+                  MA = K
+                  NA = N
+               ELSE
+                  MA = N
+                  NA = K
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = MA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 80
+               LAA = LDA*NA
+*
+*              Generate the matrix A.
+*
+               CALL DMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
+     $                     RESET, ZERO )
+*
+               DO 70 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+                  UPPER = UPLO.EQ.'U'
+*
+                  DO 60 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 50 IB = 1, NBET
+                        BETA = BET( IB )
+*
+*                       Generate the matrix C.
+*
+                        CALL DMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, CC,
+     $                              LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        NS = N
+                        KS = K
+                        ALS = ALPHA
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        BETS = BETA
+                        DO 20 I = 1, LCC
+                           CS( I ) = CC( I )
+   20                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
+     $                     TRANS, N, K, ALPHA, LDA, BETA, LDC
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL DSYRK( UPLO, TRANS, N, K, ALPHA, AA, LDA,
+     $                              BETA, CC, LDC )
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9993 )
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLOS.EQ.UPLO
+                        ISAME( 2 ) = TRANSS.EQ.TRANS
+                        ISAME( 3 ) = NS.EQ.N
+                        ISAME( 4 ) = KS.EQ.K
+                        ISAME( 5 ) = ALS.EQ.ALPHA
+                        ISAME( 6 ) = LDE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        ISAME( 8 ) = BETS.EQ.BETA
+                        IF( NULL )THEN
+                           ISAME( 9 ) = LDE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 9 ) = LDERES( 'SY', UPLO, N, N, CS,
+     $                                  CC, LDC )
+                        END IF
+                        ISAME( 10 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 30 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   30                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result column by column.
+*
+                           JC = 1
+                           DO 40 J = 1, N
+                              IF( UPPER )THEN
+                                 JJ = 1
+                                 LJ = J
+                              ELSE
+                                 JJ = J
+                                 LJ = N - J + 1
+                              END IF
+                              IF( TRAN )THEN
+                                 CALL DMMCH( 'T', 'N', LJ, 1, K, ALPHA,
+     $                                       A( 1, JJ ), NMAX,
+     $                                       A( 1, J ), NMAX, BETA,
+     $                                       C( JJ, J ), NMAX, CT, G,
+     $                                       CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              ELSE
+                                 CALL DMMCH( 'N', 'T', LJ, 1, K, ALPHA,
+     $                                       A( JJ, 1 ), NMAX,
+     $                                       A( J, 1 ), NMAX, BETA,
+     $                                       C( JJ, J ), NMAX, CT, G,
+     $                                       CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              END IF
+                              IF( UPPER )THEN
+                                 JC = JC + LDC
+                              ELSE
+                                 JC = JC + LDC + 1
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 110
+   40                      CONTINUE
+                        END IF
+*
+   50                CONTINUE
+*
+   60             CONTINUE
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  110 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9995 )J
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
+     $   LDA, BETA, LDC
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')           .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK4.
+*
+      END
+      SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
+*
+*  Tests DSYR2K.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      DOUBLE PRECISION   AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
+     $                   ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
+     $                   BET( NBET ), BS( NMAX*NMAX ), C( NMAX, NMAX ),
+     $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
+     $                   G( NMAX ), W( 2*NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, ALS, BETA, BETS, ERR, ERRMAX
+      INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB,
+     $                   K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS,
+     $                   LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS
+      LOGICAL            NULL, RESET, SAME, TRAN, UPPER
+      CHARACTER*1        TRANS, TRANSS, UPLO, UPLOS
+      CHARACTER*2        ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LDE, LDERES
+      EXTERNAL           LDE, LDERES
+*     .. External Subroutines ..
+      EXTERNAL           DMAKE, DMMCH, DSYR2K
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHT/'NTC'/, ICHU/'UL'/
+*     .. Executable Statements ..
+*
+      NARGS = 12
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 130 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDC to 1 more than minimum value if room.
+         LDC = N
+         IF( LDC.LT.NMAX )
+     $      LDC = LDC + 1
+*        Skip tests if not enough room.
+         IF( LDC.GT.NMAX )
+     $      GO TO 130
+         LCC = LDC*N
+         NULL = N.LE.0
+*
+         DO 120 IK = 1, NIDIM
+            K = IDIM( IK )
+*
+            DO 110 ICT = 1, 3
+               TRANS = ICHT( ICT: ICT )
+               TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C'
+               IF( TRAN )THEN
+                  MA = K
+                  NA = N
+               ELSE
+                  MA = N
+                  NA = K
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = MA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 110
+               LAA = LDA*NA
+*
+*              Generate the matrix A.
+*
+               IF( TRAN )THEN
+                  CALL DMAKE( 'GE', ' ', ' ', MA, NA, AB, 2*NMAX, AA,
+     $                        LDA, RESET, ZERO )
+               ELSE
+                  CALL DMAKE( 'GE', ' ', ' ', MA, NA, AB, NMAX, AA, LDA,
+     $                        RESET, ZERO )
+               END IF
+*
+*              Generate the matrix B.
+*
+               LDB = LDA
+               LBB = LAA
+               IF( TRAN )THEN
+                  CALL DMAKE( 'GE', ' ', ' ', MA, NA, AB( K + 1 ),
+     $                        2*NMAX, BB, LDB, RESET, ZERO )
+               ELSE
+                  CALL DMAKE( 'GE', ' ', ' ', MA, NA, AB( K*NMAX + 1 ),
+     $                        NMAX, BB, LDB, RESET, ZERO )
+               END IF
+*
+               DO 100 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+                  UPPER = UPLO.EQ.'U'
+*
+                  DO 90 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 80 IB = 1, NBET
+                        BETA = BET( IB )
+*
+*                       Generate the matrix C.
+*
+                        CALL DMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, CC,
+     $                              LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        NS = N
+                        KS = K
+                        ALS = ALPHA
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        DO 20 I = 1, LBB
+                           BS( I ) = BB( I )
+   20                   CONTINUE
+                        LDBS = LDB
+                        BETS = BETA
+                        DO 30 I = 1, LCC
+                           CS( I ) = CC( I )
+   30                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
+     $                     TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL DSYR2K( UPLO, TRANS, N, K, ALPHA, AA, LDA,
+     $                               BB, LDB, BETA, CC, LDC )
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9993 )
+                           FATAL = .TRUE.
+                           GO TO 150
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLOS.EQ.UPLO
+                        ISAME( 2 ) = TRANSS.EQ.TRANS
+                        ISAME( 3 ) = NS.EQ.N
+                        ISAME( 4 ) = KS.EQ.K
+                        ISAME( 5 ) = ALS.EQ.ALPHA
+                        ISAME( 6 ) = LDE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        ISAME( 8 ) = LDE( BS, BB, LBB )
+                        ISAME( 9 ) = LDBS.EQ.LDB
+                        ISAME( 10 ) = BETS.EQ.BETA
+                        IF( NULL )THEN
+                           ISAME( 11 ) = LDE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 11 ) = LDERES( 'SY', UPLO, N, N, CS,
+     $                                   CC, LDC )
+                        END IF
+                        ISAME( 12 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 150
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result column by column.
+*
+                           JJAB = 1
+                           JC = 1
+                           DO 70 J = 1, N
+                              IF( UPPER )THEN
+                                 JJ = 1
+                                 LJ = J
+                              ELSE
+                                 JJ = J
+                                 LJ = N - J + 1
+                              END IF
+                              IF( TRAN )THEN
+                                 DO 50 I = 1, K
+                                    W( I ) = AB( ( J - 1 )*2*NMAX + K +
+     $                                       I )
+                                    W( K + I ) = AB( ( J - 1 )*2*NMAX +
+     $                                           I )
+   50                            CONTINUE
+                                 CALL DMMCH( 'T', 'N', LJ, 1, 2*K,
+     $                                       ALPHA, AB( JJAB ), 2*NMAX,
+     $                                       W, 2*NMAX, BETA,
+     $                                       C( JJ, J ), NMAX, CT, G,
+     $                                       CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              ELSE
+                                 DO 60 I = 1, K
+                                    W( I ) = AB( ( K + I - 1 )*NMAX +
+     $                                       J )
+                                    W( K + I ) = AB( ( I - 1 )*NMAX +
+     $                                           J )
+   60                            CONTINUE
+                                 CALL DMMCH( 'N', 'N', LJ, 1, 2*K,
+     $                                       ALPHA, AB( JJ ), NMAX, W,
+     $                                       2*NMAX, BETA, C( JJ, J ),
+     $                                       NMAX, CT, G, CC( JC ), LDC,
+     $                                       EPS, ERR, FATAL, NOUT,
+     $                                       .TRUE. )
+                              END IF
+                              IF( UPPER )THEN
+                                 JC = JC + LDC
+                              ELSE
+                                 JC = JC + LDC + 1
+                                 IF( TRAN )
+     $                              JJAB = JJAB + 2*NMAX
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 140
+   70                      CONTINUE
+                        END IF
+*
+   80                CONTINUE
+*
+   90             CONTINUE
+*
+  100          CONTINUE
+*
+  110       CONTINUE
+*
+  120    CONTINUE
+*
+  130 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 160
+*
+  140 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9995 )J
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
+     $   LDA, LDB, BETA, LDC
+*
+  160 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ')   ',
+     $      ' .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of DCHK5.
+*
+      END
+      SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT )
+*
+*  Tests the error exits from the Level 3 Blas.
+*  Requires a special version of the error-handling routine XERBLA.
+*  ALPHA, BETA, A, B and C should not need to be defined.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            ISNUM, NOUT
+      CHARACTER*6        SRNAMT
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA, BETA
+*     .. Local Arrays ..
+      DOUBLE PRECISION   A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
+*     .. External Subroutines ..
+      EXTERNAL           CHKXER, DGEMM, DSYMM, DSYR2K, DSYRK, DTRMM,
+     $                   DTRSM
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+*     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
+*     if anything is wrong.
+      OK = .TRUE.
+*     LERR is set to .TRUE. by the special version of XERBLA each time
+*     it is called, and is then tested and re-set by CHKXER.
+      LERR = .FALSE.
+      GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM
+   10 INFOT = 1
+      CALL DGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 1
+      CALL DGEMM( '/', 'T', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DGEMM( 'N', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DGEMM( 'T', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DGEMM( 'N', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DGEMM( 'N', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DGEMM( 'T', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DGEMM( 'T', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DGEMM( 'N', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DGEMM( 'N', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DGEMM( 'T', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DGEMM( 'T', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DGEMM( 'N', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DGEMM( 'N', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DGEMM( 'T', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DGEMM( 'T', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL DGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL DGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL DGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL DGEMM( 'T', 'T', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL DGEMM( 'N', 'N', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL DGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL DGEMM( 'N', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL DGEMM( 'T', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL DGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL DGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL DGEMM( 'T', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL DGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 70
+   20 INFOT = 1
+      CALL DSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DSYMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL DSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL DSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL DSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL DSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 70
+   30 INFOT = 1
+      CALL DTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DTRMM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DTRMM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DTRMM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRMM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRMM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRMM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRMM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRMM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRMM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRMM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRMM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRMM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRMM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRMM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRMM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRMM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRMM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRMM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRMM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRMM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRMM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRMM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRMM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRMM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRMM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRMM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 70
+   40 INFOT = 1
+      CALL DTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DTRSM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DTRSM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DTRSM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRSM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRSM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRSM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRSM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRSM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRSM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRSM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL DTRSM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRSM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRSM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRSM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRSM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRSM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRSM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRSM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL DTRSM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRSM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRSM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRSM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DTRSM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRSM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRSM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRSM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL DTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 70
+   50 INFOT = 1
+      CALL DSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DSYRK( 'U', '/', 0, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYRK( 'U', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYRK( 'U', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYRK( 'L', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYRK( 'L', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYRK( 'U', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYRK( 'U', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYRK( 'L', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYRK( 'L', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYRK( 'U', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYRK( 'U', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYRK( 'L', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYRK( 'L', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL DSYRK( 'U', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL DSYRK( 'U', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL DSYRK( 'L', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL DSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 70
+   60 INFOT = 1
+      CALL DSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL DSYR2K( 'U', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYR2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYR2K( 'U', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYR2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL DSYR2K( 'L', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYR2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYR2K( 'U', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYR2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL DSYR2K( 'L', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYR2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYR2K( 'U', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYR2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL DSYR2K( 'L', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DSYR2K( 'U', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL DSYR2K( 'L', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL DSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL DSYR2K( 'U', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL DSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL DSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+   70 IF( OK )THEN
+         WRITE( NOUT, FMT = 9999 )SRNAMT
+      ELSE
+         WRITE( NOUT, FMT = 9998 )SRNAMT
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+     $      '**' )
+*
+*     End of DCHKE.
+*
+      END
+      SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
+     $                  TRANSL )
+*
+*  Generates values for an M by N matrix A.
+*  Stores the values in the array AA in the data structure required
+*  by the routine, with unwanted elements set to rogue value.
+*
+*  TYPE is 'GE', 'SY' or 'TR'.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+      DOUBLE PRECISION   ROGUE
+      PARAMETER          ( ROGUE = -1.0D10 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   TRANSL
+      INTEGER            LDA, M, N, NMAX
+      LOGICAL            RESET
+      CHARACTER*1        DIAG, UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( NMAX, * ), AA( * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J
+      LOGICAL            GEN, LOWER, SYM, TRI, UNIT, UPPER
+*     .. External Functions ..
+      DOUBLE PRECISION   DBEG
+      EXTERNAL           DBEG
+*     .. Executable Statements ..
+      GEN = TYPE.EQ.'GE'
+      SYM = TYPE.EQ.'SY'
+      TRI = TYPE.EQ.'TR'
+      UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U'
+      LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L'
+      UNIT = TRI.AND.DIAG.EQ.'U'
+*
+*     Generate data in array A.
+*
+      DO 20 J = 1, N
+         DO 10 I = 1, M
+            IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
+     $          THEN
+               A( I, J ) = DBEG( RESET ) + TRANSL
+               IF( I.NE.J )THEN
+*                 Set some elements to zero
+                  IF( N.GT.3.AND.J.EQ.N/2 )
+     $               A( I, J ) = ZERO
+                  IF( SYM )THEN
+                     A( J, I ) = A( I, J )
+                  ELSE IF( TRI )THEN
+                     A( J, I ) = ZERO
+                  END IF
+               END IF
+            END IF
+   10    CONTINUE
+         IF( TRI )
+     $      A( J, J ) = A( J, J ) + ONE
+         IF( UNIT )
+     $      A( J, J ) = ONE
+   20 CONTINUE
+*
+*     Store elements in array AS in data structure required by routine.
+*
+      IF( TYPE.EQ.'GE' )THEN
+         DO 50 J = 1, N
+            DO 30 I = 1, M
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   30       CONTINUE
+            DO 40 I = M + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   40       CONTINUE
+   50    CONTINUE
+      ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN
+         DO 90 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IF( UNIT )THEN
+                  IEND = J - 1
+               ELSE
+                  IEND = J
+               END IF
+            ELSE
+               IF( UNIT )THEN
+                  IBEG = J + 1
+               ELSE
+                  IBEG = J
+               END IF
+               IEND = N
+            END IF
+            DO 60 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   60       CONTINUE
+            DO 70 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   70       CONTINUE
+            DO 80 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   80       CONTINUE
+   90    CONTINUE
+      END IF
+      RETURN
+*
+*     End of DMAKE.
+*
+      END
+      SUBROUTINE DMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
+     $                  BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
+     $                  NOUT, MV )
+*
+*  Checks the results of the computational tests.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   ALPHA, BETA, EPS, ERR
+      INTEGER            KK, LDA, LDB, LDC, LDCC, M, N, NOUT
+      LOGICAL            FATAL, MV
+      CHARACTER*1        TRANSA, TRANSB
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * ),
+     $                   CC( LDCC, * ), CT( * ), G( * )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ERRI
+      INTEGER            I, J, K
+      LOGICAL            TRANA, TRANB
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, SQRT
+*     .. Executable Statements ..
+      TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
+      TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
+*
+*     Compute expected result, one column at a time, in CT using data
+*     in A, B and C.
+*     Compute gauges in G.
+*
+      DO 120 J = 1, N
+*
+         DO 10 I = 1, M
+            CT( I ) = ZERO
+            G( I ) = ZERO
+   10    CONTINUE
+         IF( .NOT.TRANA.AND..NOT.TRANB )THEN
+            DO 30 K = 1, KK
+               DO 20 I = 1, M
+                  CT( I ) = CT( I ) + A( I, K )*B( K, J )
+                  G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) )
+   20          CONTINUE
+   30       CONTINUE
+         ELSE IF( TRANA.AND..NOT.TRANB )THEN
+            DO 50 K = 1, KK
+               DO 40 I = 1, M
+                  CT( I ) = CT( I ) + A( K, I )*B( K, J )
+                  G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) )
+   40          CONTINUE
+   50       CONTINUE
+         ELSE IF( .NOT.TRANA.AND.TRANB )THEN
+            DO 70 K = 1, KK
+               DO 60 I = 1, M
+                  CT( I ) = CT( I ) + A( I, K )*B( J, K )
+                  G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) )
+   60          CONTINUE
+   70       CONTINUE
+         ELSE IF( TRANA.AND.TRANB )THEN
+            DO 90 K = 1, KK
+               DO 80 I = 1, M
+                  CT( I ) = CT( I ) + A( K, I )*B( J, K )
+                  G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) )
+   80          CONTINUE
+   90       CONTINUE
+         END IF
+         DO 100 I = 1, M
+            CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
+            G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) )
+  100    CONTINUE
+*
+*        Compute the error ratio for this result.
+*
+         ERR = ZERO
+         DO 110 I = 1, M
+            ERRI = ABS( CT( I ) - CC( I, J ) )/EPS
+            IF( G( I ).NE.ZERO )
+     $         ERRI = ERRI/G( I )
+            ERR = MAX( ERR, ERRI )
+            IF( ERR*SQRT( EPS ).GE.ONE )
+     $         GO TO 130
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     If the loop completes, all results are at least half accurate.
+      GO TO 150
+*
+*     Report fatal error.
+*
+  130 FATAL = .TRUE.
+      WRITE( NOUT, FMT = 9999 )
+      DO 140 I = 1, M
+         IF( MV )THEN
+            WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
+         ELSE
+            WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
+         END IF
+  140 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9997 )J
+*
+  150 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
+     $      'F ACCURATE *******', /'           EXPECTED RESULT   COMPU',
+     $      'TED RESULT' )
+ 9998 FORMAT( 1X, I7, 2G18.6 )
+ 9997 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+*
+*     End of DMMCH.
+*
+      END
+      LOGICAL FUNCTION LDE( RI, RJ, LR )
+*
+*  Tests if two arrays are identical.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LR
+*     .. Array Arguments ..
+      DOUBLE PRECISION   RI( * ), RJ( * )
+*     .. Local Scalars ..
+      INTEGER            I
+*     .. Executable Statements ..
+      DO 10 I = 1, LR
+         IF( RI( I ).NE.RJ( I ) )
+     $      GO TO 20
+   10 CONTINUE
+      LDE = .TRUE.
+      GO TO 30
+   20 CONTINUE
+      LDE = .FALSE.
+   30 RETURN
+*
+*     End of LDE.
+*
+      END
+      LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA )
+*
+*  Tests if selected elements in two arrays are equal.
+*
+*  TYPE is 'GE' or 'SY'.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDA, M, N
+      CHARACTER*1        UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      DOUBLE PRECISION   AA( LDA, * ), AS( LDA, * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J
+      LOGICAL            UPPER
+*     .. Executable Statements ..
+      UPPER = UPLO.EQ.'U'
+      IF( TYPE.EQ.'GE' )THEN
+         DO 20 J = 1, N
+            DO 10 I = M + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   10       CONTINUE
+   20    CONTINUE
+      ELSE IF( TYPE.EQ.'SY' )THEN
+         DO 50 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 30 I = 1, IBEG - 1
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   30       CONTINUE
+            DO 40 I = IEND + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   40       CONTINUE
+   50    CONTINUE
+      END IF
+*
+   60 CONTINUE
+      LDERES = .TRUE.
+      GO TO 80
+   70 CONTINUE
+      LDERES = .FALSE.
+   80 RETURN
+*
+*     End of LDERES.
+*
+      END
+      DOUBLE PRECISION FUNCTION DBEG( RESET )
+*
+*  Generates random numbers uniformly distributed between -0.5 and 0.5.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      LOGICAL            RESET
+*     .. Local Scalars ..
+      INTEGER            I, IC, MI
+*     .. Save statement ..
+      SAVE               I, IC, MI
+*     .. Executable Statements ..
+      IF( RESET )THEN
+*        Initialize local variables.
+         MI = 891
+         I = 7
+         IC = 0
+         RESET = .FALSE.
+      END IF
+*
+*     The sequence of values of I is bounded between 1 and 999.
+*     If initial I = 1,2,3,6,7 or 9, the period will be 50.
+*     If initial I = 4 or 8, the period will be 25.
+*     If initial I = 5, the period will be 10.
+*     IC is used to break up the period by skipping 1 value of I in 6.
+*
+      IC = IC + 1
+   10 I = I*MI
+      I = I - 1000*( I/1000 )
+      IF( IC.GE.5 )THEN
+         IC = 0
+         GO TO 10
+      END IF
+      DBEG = ( I - 500 )/1001.0D0
+      RETURN
+*
+*     End of DBEG.
+*
+      END
+      DOUBLE PRECISION FUNCTION DDIFF( X, Y )
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   X, Y
+*     .. Executable Statements ..
+      DDIFF = X - Y
+      RETURN
+*
+*     End of DDIFF.
+*
+      END
+      SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+*  Tests whether XERBLA has detected an error when it should.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Executable Statements ..
+      IF( .NOT.LERR )THEN
+         WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
+         OK = .FALSE.
+      END IF
+      LERR = .FALSE.
+      RETURN
+*
+ 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
+     $      'ETECTED BY ', A6, ' *****' )
+*
+*     End of CHKXER.
+*
+      END
+      SUBROUTINE XERBLA( SRNAME, INFO )
+*
+*  This is a special version of XERBLA to be used only as part of
+*  the test program for testing error exits from the Level 3 BLAS
+*  routines.
+*
+*  XERBLA  is an error handler for the Level 3 BLAS routines.
+*
+*  It is called by the Level 3 BLAS routines if an input parameter is
+*  invalid.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO
+      CHARACTER*6        SRNAME
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUT, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Executable Statements ..
+      LERR = .TRUE.
+      IF( INFO.NE.INFOT )THEN
+         IF( INFOT.NE.0 )THEN
+            WRITE( NOUT, FMT = 9999 )INFO, INFOT
+         ELSE
+            WRITE( NOUT, FMT = 9997 )INFO
+         END IF
+         OK = .FALSE.
+      END IF
+      IF( SRNAME.NE.SRNAMT )THEN
+         WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
+         OK = .FALSE.
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
+     $      ' OF ', I2, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
+     $      'AD OF ', A6, ' *******' )
+ 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
+     $      ' *******' )
+*
+*     End of XERBLA
+*
+      END
+
diff --git a/eigen/blas/testing/runblastest.sh b/eigen/blas/testing/runblastest.sh
new file mode 100644
index 0000000..4ffaf01
--- /dev/null
+++ b/eigen/blas/testing/runblastest.sh
@@ -0,0 +1,45 @@
+#!/bin/bash
+
+black='\E[30m'
+red='\E[31m'
+green='\E[32m'
+yellow='\E[33m'
+blue='\E[34m'
+magenta='\E[35m'
+cyan='\E[36m'
+white='\E[37m'
+
+if [ -f $2 ]; then
+  data=$2
+  if [ -f $1.summ ]; then rm $1.summ; fi
+  if [ -f $1.snap ]; then rm $1.snap; fi
+else
+  data=$1
+fi
+
+if ! ./$1 < $data > /dev/null 2> .runtest.log ; then
+  echo -e  $red Test $1 failed: $black
+  echo -e $blue
+  cat .runtest.log
+  echo -e $black
+  exit 1
+else
+  if [ -f $1.summ ]; then
+    if [ `grep "FATAL ERROR" $1.summ | wc -l` -gt 0 ]; then
+      echo -e  $red "Test $1 failed (FATAL ERROR, read the file $1.summ for details)" $black
+      echo -e $blue
+      cat .runtest.log
+      echo -e $black
+      exit 1;
+    fi
+
+    if [ `grep "FAILED THE TESTS OF ERROR-EXITS" $1.summ | wc -l` -gt 0 ]; then
+      echo -e  $red "Test $1 failed (FAILED THE TESTS OF ERROR-EXITS, read the file $1.summ for details)" $black
+      echo -e $blue
+      cat .runtest.log
+      echo -e $black
+      exit 1;
+    fi      
+  fi
+  echo -e $green Test $1 passed$black
+fi
diff --git a/eigen/blas/testing/sblat1.f b/eigen/blas/testing/sblat1.f
new file mode 100644
index 0000000..6657c26
--- /dev/null
+++ b/eigen/blas/testing/sblat1.f
@@ -0,0 +1,1021 @@
+*> \brief \b SBLAT1
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       PROGRAM SBLAT1
+* 
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    Test program for the REAL Level 1 BLAS.
+*>
+*>    Based upon the original BLAS test routine together with:
+*>    F06EAF Example Program Text
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date April 2012
+*
+*> \ingroup single_blas_testing
+*
+*  =====================================================================
+      PROGRAM SBLAT1
+*
+*  -- Reference BLAS test routine (version 3.4.1) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     April 2012
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      INTEGER          NOUT
+      PARAMETER        (NOUT=6)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, N
+      LOGICAL          PASS
+*     .. Local Scalars ..
+      REAL             SFAC
+      INTEGER          IC
+*     .. External Subroutines ..
+      EXTERNAL         CHECK0, CHECK1, CHECK2, CHECK3, HEADER
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      DATA             SFAC/9.765625E-4/
+*     .. Executable Statements ..
+      WRITE (NOUT,99999)
+      DO 20 IC = 1, 13
+         ICASE = IC
+         CALL HEADER
+*
+*        .. Initialize  PASS,  INCX,  and INCY for a new case. ..
+*        .. the value 9999 for INCX or INCY will appear in the ..
+*        .. detailed  output, if any, for cases  that do not involve ..
+*        .. these parameters ..
+*
+         PASS = .TRUE.
+         INCX = 9999
+         INCY = 9999
+         IF (ICASE.EQ.3 .OR. ICASE.EQ.11) THEN
+            CALL CHECK0(SFAC)
+         ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR.
+     +            ICASE.EQ.10) THEN
+            CALL CHECK1(SFAC)
+         ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR.
+     +            ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13) THEN
+            CALL CHECK2(SFAC)
+         ELSE IF (ICASE.EQ.4) THEN
+            CALL CHECK3(SFAC)
+         END IF
+*        -- Print
+         IF (PASS) WRITE (NOUT,99998)
+   20 CONTINUE
+      STOP
+*
+99999 FORMAT (' Real BLAS Test Program Results',/1X)
+99998 FORMAT ('                                    ----- PASS -----')
+      END
+      SUBROUTINE HEADER
+*     .. Parameters ..
+      INTEGER          NOUT
+      PARAMETER        (NOUT=6)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, N
+      LOGICAL          PASS
+*     .. Local Arrays ..
+      CHARACTER*6      L(13)
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      DATA             L(1)/' SDOT '/
+      DATA             L(2)/'SAXPY '/
+      DATA             L(3)/'SROTG '/
+      DATA             L(4)/' SROT '/
+      DATA             L(5)/'SCOPY '/
+      DATA             L(6)/'SSWAP '/
+      DATA             L(7)/'SNRM2 '/
+      DATA             L(8)/'SASUM '/
+      DATA             L(9)/'SSCAL '/
+      DATA             L(10)/'ISAMAX'/
+      DATA             L(11)/'SROTMG'/
+      DATA             L(12)/'SROTM '/
+      DATA             L(13)/'SDSDOT'/
+*     .. Executable Statements ..
+      WRITE (NOUT,99999) ICASE, L(ICASE)
+      RETURN
+*
+99999 FORMAT (/' Test of subprogram number',I3,12X,A6)
+      END
+      SUBROUTINE CHECK0(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      REAL              SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      REAL              D12, SA, SB, SC, SS
+      INTEGER           I, K
+*     .. Local Arrays ..
+      REAL              DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
+     +                  DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
+*     .. External Subroutines ..
+      EXTERNAL          SROTG, SROTMG, STEST1
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      DATA              DA1/0.3E0, 0.4E0, -0.3E0, -0.4E0, -0.3E0, 0.0E0,
+     +                  0.0E0, 1.0E0/
+      DATA              DB1/0.4E0, 0.3E0, 0.4E0, 0.3E0, -0.4E0, 0.0E0,
+     +                  1.0E0, 0.0E0/
+      DATA              DC1/0.6E0, 0.8E0, -0.6E0, 0.8E0, 0.6E0, 1.0E0,
+     +                  0.0E0, 1.0E0/
+      DATA              DS1/0.8E0, 0.6E0, 0.8E0, -0.6E0, 0.8E0, 0.0E0,
+     +                  1.0E0, 0.0E0/
+      DATA              DATRUE/0.5E0, 0.5E0, 0.5E0, -0.5E0, -0.5E0,
+     +                  0.0E0, 1.0E0, 1.0E0/
+      DATA              DBTRUE/0.0E0, 0.6E0, 0.0E0, -0.6E0, 0.0E0,
+     +                  0.0E0, 1.0E0, 0.0E0/
+*     INPUT FOR MODIFIED GIVENS
+      DATA DAB/ .1E0,.3E0,1.2E0,.2E0,
+     A          .7E0, .2E0, .6E0, 4.2E0,
+     B          0.E0,0.E0,0.E0,0.E0,
+     C          4.E0, -1.E0, 2.E0, 4.E0,
+     D          6.E-10, 2.E-2, 1.E5, 10.E0,
+     E          4.E10, 2.E-2, 1.E-5, 10.E0,
+     F          2.E-10, 4.E-2, 1.E5, 10.E0,
+     G          2.E10, 4.E-2, 1.E-5, 10.E0,
+     H          4.E0, -2.E0, 8.E0, 4.E0    /
+*    TRUE RESULTS FOR MODIFIED GIVENS
+      DATA DTRUE/0.E0,0.E0, 1.3E0, .2E0, 0.E0,0.E0,0.E0, .5E0, 0.E0,
+     A           0.E0,0.E0, 4.5E0, 4.2E0, 1.E0, .5E0, 0.E0,0.E0,0.E0,
+     B           0.E0,0.E0,0.E0,0.E0, -2.E0, 0.E0,0.E0,0.E0,0.E0,
+     C           0.E0,0.E0,0.E0, 4.E0, -1.E0, 0.E0,0.E0,0.E0,0.E0,
+     D           0.E0, 15.E-3, 0.E0, 10.E0, -1.E0, 0.E0, -1.E-4,
+     E           0.E0, 1.E0,
+     F           0.E0,0.E0, 6144.E-5, 10.E0, -1.E0, 4096.E0, -1.E6,
+     G           0.E0, 1.E0,
+     H           0.E0,0.E0,15.E0,10.E0,-1.E0, 5.E-5, 0.E0,1.E0,0.E0,
+     I           0.E0,0.E0, 15.E0, 10.E0, -1. E0, 5.E5, -4096.E0,
+     J           1.E0, 4096.E-6,
+     K           0.E0,0.E0, 7.E0, 4.E0, 0.E0,0.E0, -.5E0, -.25E0, 0.E0/
+*                   4096 = 2 ** 12
+      DATA D12  /4096.E0/
+      DTRUE(1,1) = 12.E0 / 130.E0
+      DTRUE(2,1) = 36.E0 / 130.E0
+      DTRUE(7,1) = -1.E0 / 6.E0
+      DTRUE(1,2) = 14.E0 / 75.E0
+      DTRUE(2,2) = 49.E0 / 75.E0
+      DTRUE(9,2) = 1.E0 / 7.E0
+      DTRUE(1,5) = 45.E-11 * (D12 * D12)
+      DTRUE(3,5) = 4.E5 / (3.E0 * D12)
+      DTRUE(6,5) = 1.E0 / D12
+      DTRUE(8,5) = 1.E4 / (3.E0 * D12)
+      DTRUE(1,6) = 4.E10 / (1.5E0 * D12 * D12)
+      DTRUE(2,6) = 2.E-2 / 1.5E0
+      DTRUE(8,6) = 5.E-7 * D12
+      DTRUE(1,7) = 4.E0 / 150.E0
+      DTRUE(2,7) = (2.E-10 / 1.5E0) * (D12 * D12)
+      DTRUE(7,7) = -DTRUE(6,5)
+      DTRUE(9,7) = 1.E4 / D12
+      DTRUE(1,8) = DTRUE(1,7)
+      DTRUE(2,8) = 2.E10 / (1.5E0 * D12 * D12)
+      DTRUE(1,9) = 32.E0 / 7.E0
+      DTRUE(2,9) = -16.E0 / 7.E0
+*     .. Executable Statements ..
+*
+*     Compute true values which cannot be prestored
+*     in decimal notation
+*
+      DBTRUE(1) = 1.0E0/0.6E0
+      DBTRUE(3) = -1.0E0/0.6E0
+      DBTRUE(5) = 1.0E0/0.6E0
+*
+      DO 20 K = 1, 8
+*        .. Set N=K for identification in output if any ..
+         N = K
+         IF (ICASE.EQ.3) THEN
+*           .. SROTG ..
+            IF (K.GT.8) GO TO 40
+            SA = DA1(K)
+            SB = DB1(K)
+            CALL SROTG(SA,SB,SC,SS)
+            CALL STEST1(SA,DATRUE(K),DATRUE(K),SFAC)
+            CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC)
+            CALL STEST1(SC,DC1(K),DC1(K),SFAC)
+            CALL STEST1(SS,DS1(K),DS1(K),SFAC)
+         ELSEIF (ICASE.EQ.11) THEN
+*           .. SROTMG ..
+            DO I=1,4
+               DTEMP(I)= DAB(I,K)
+               DTEMP(I+4) = 0.0
+            END DO
+            DTEMP(9) = 0.0
+            CALL SROTMG(DTEMP(1),DTEMP(2),DTEMP(3),DTEMP(4),DTEMP(5))
+            CALL STEST(9,DTEMP,DTRUE(1,K),DTRUE(1,K),SFAC)
+         ELSE
+            WRITE (NOUT,*) ' Shouldn''t be here in CHECK0'
+            STOP
+         END IF
+   20 CONTINUE
+   40 RETURN
+      END
+      SUBROUTINE CHECK1(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      REAL              SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      INTEGER           I, LEN, NP1
+*     .. Local Arrays ..
+      REAL              DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
+     +                  SA(10), STEMP(1), STRUE(8), SX(8)
+      INTEGER           ITRUE2(5)
+*     .. External Functions ..
+      REAL              SASUM, SNRM2
+      INTEGER           ISAMAX
+      EXTERNAL          SASUM, SNRM2, ISAMAX
+*     .. External Subroutines ..
+      EXTERNAL          ITEST1, SSCAL, STEST, STEST1
+*     .. Intrinsic Functions ..
+      INTRINSIC         MAX
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      DATA              SA/0.3E0, -1.0E0, 0.0E0, 1.0E0, 0.3E0, 0.3E0,
+     +                  0.3E0, 0.3E0, 0.3E0, 0.3E0/
+      DATA              DV/0.1E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
+     +                  2.0E0, 2.0E0, 0.3E0, 3.0E0, 3.0E0, 3.0E0, 3.0E0,
+     +                  3.0E0, 3.0E0, 3.0E0, 0.3E0, -0.4E0, 4.0E0,
+     +                  4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0, 0.2E0,
+     +                  -0.6E0, 0.3E0, 5.0E0, 5.0E0, 5.0E0, 5.0E0,
+     +                  5.0E0, 0.1E0, -0.3E0, 0.5E0, -0.1E0, 6.0E0,
+     +                  6.0E0, 6.0E0, 6.0E0, 0.1E0, 8.0E0, 8.0E0, 8.0E0,
+     +                  8.0E0, 8.0E0, 8.0E0, 8.0E0, 0.3E0, 9.0E0, 9.0E0,
+     +                  9.0E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0, 0.3E0, 2.0E0,
+     +                  -0.4E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
+     +                  0.2E0, 3.0E0, -0.6E0, 5.0E0, 0.3E0, 2.0E0,
+     +                  2.0E0, 2.0E0, 0.1E0, 4.0E0, -0.3E0, 6.0E0,
+     +                  -0.5E0, 7.0E0, -0.1E0, 3.0E0/
+      DATA              DTRUE1/0.0E0, 0.3E0, 0.5E0, 0.7E0, 0.6E0/
+      DATA              DTRUE3/0.0E0, 0.3E0, 0.7E0, 1.1E0, 1.0E0/
+      DATA              DTRUE5/0.10E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
+     +                  2.0E0, 2.0E0, 2.0E0, -0.3E0, 3.0E0, 3.0E0,
+     +                  3.0E0, 3.0E0, 3.0E0, 3.0E0, 3.0E0, 0.0E0, 0.0E0,
+     +                  4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0,
+     +                  0.20E0, -0.60E0, 0.30E0, 5.0E0, 5.0E0, 5.0E0,
+     +                  5.0E0, 5.0E0, 0.03E0, -0.09E0, 0.15E0, -0.03E0,
+     +                  6.0E0, 6.0E0, 6.0E0, 6.0E0, 0.10E0, 8.0E0,
+     +                  8.0E0, 8.0E0, 8.0E0, 8.0E0, 8.0E0, 8.0E0,
+     +                  0.09E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0,
+     +                  9.0E0, 9.0E0, 0.09E0, 2.0E0, -0.12E0, 2.0E0,
+     +                  2.0E0, 2.0E0, 2.0E0, 2.0E0, 0.06E0, 3.0E0,
+     +                  -0.18E0, 5.0E0, 0.09E0, 2.0E0, 2.0E0, 2.0E0,
+     +                  0.03E0, 4.0E0, -0.09E0, 6.0E0, -0.15E0, 7.0E0,
+     +                  -0.03E0, 3.0E0/
+      DATA              ITRUE2/0, 1, 2, 2, 3/
+*     .. Executable Statements ..
+      DO 80 INCX = 1, 2
+         DO 60 NP1 = 1, 5
+            N = NP1 - 1
+            LEN = 2*MAX(N,1)
+*           .. Set vector arguments ..
+            DO 20 I = 1, LEN
+               SX(I) = DV(I,NP1,INCX)
+   20       CONTINUE
+*
+            IF (ICASE.EQ.7) THEN
+*              .. SNRM2 ..
+               STEMP(1) = DTRUE1(NP1)
+               CALL STEST1(SNRM2(N,SX,INCX),STEMP(1),STEMP,SFAC)
+            ELSE IF (ICASE.EQ.8) THEN
+*              .. SASUM ..
+               STEMP(1) = DTRUE3(NP1)
+               CALL STEST1(SASUM(N,SX,INCX),STEMP(1),STEMP,SFAC)
+            ELSE IF (ICASE.EQ.9) THEN
+*              .. SSCAL ..
+               CALL SSCAL(N,SA((INCX-1)*5+NP1),SX,INCX)
+               DO 40 I = 1, LEN
+                  STRUE(I) = DTRUE5(I,NP1,INCX)
+   40          CONTINUE
+               CALL STEST(LEN,SX,STRUE,STRUE,SFAC)
+            ELSE IF (ICASE.EQ.10) THEN
+*              .. ISAMAX ..
+               CALL ITEST1(ISAMAX(N,SX,INCX),ITRUE2(NP1))
+            ELSE
+               WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
+               STOP
+            END IF
+   60    CONTINUE
+   80 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CHECK2(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      REAL              SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      REAL              SA
+      INTEGER           I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
+     $                  MX, MY 
+*     .. Local Arrays ..
+      REAL              DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
+     $                  DT8(7,4,4), DX1(7),
+     $                  DY1(7), SSIZE1(4), SSIZE2(14,2), SSIZE3(4),
+     $                  SSIZE(7), STX(7), STY(7), SX(7), SY(7),
+     $                  DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4),
+     $                  DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4),
+     $                  DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4),
+     $                  DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5),
+     $                  ST7B(4,4)
+      INTEGER           INCXS(4), INCYS(4), LENS(4,2), NS(4)
+*     .. External Functions ..
+      REAL              SDOT, SDSDOT
+      EXTERNAL          SDOT, SDSDOT
+*     .. External Subroutines ..
+      EXTERNAL          SAXPY, SCOPY, SROTM, SSWAP, STEST, STEST1
+*     .. Intrinsic Functions ..
+      INTRINSIC         ABS, MIN
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      EQUIVALENCE (DT19X(1,1,1),DT19XA(1,1,1)),(DT19X(1,1,5),
+     A   DT19XB(1,1,1)),(DT19X(1,1,9),DT19XC(1,1,1)),
+     B   (DT19X(1,1,13),DT19XD(1,1,1))
+      EQUIVALENCE (DT19Y(1,1,1),DT19YA(1,1,1)),(DT19Y(1,1,5),
+     A   DT19YB(1,1,1)),(DT19Y(1,1,9),DT19YC(1,1,1)),
+     B   (DT19Y(1,1,13),DT19YD(1,1,1))
+
+      DATA              SA/0.3E0/
+      DATA              INCXS/1, 2, -2, -1/
+      DATA              INCYS/1, -2, 1, -2/
+      DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
+      DATA              NS/0, 1, 2, 4/
+      DATA              DX1/0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
+     +                  -0.4E0/
+      DATA              DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
+     +                  0.8E0/
+      DATA              DT7/0.0E0, 0.30E0, 0.21E0, 0.62E0, 0.0E0,
+     +                  0.30E0, -0.07E0, 0.85E0, 0.0E0, 0.30E0, -0.79E0,
+     +                  -0.74E0, 0.0E0, 0.30E0, 0.33E0, 1.27E0/
+      DATA              ST7B/ .1, .4, .31, .72,     .1, .4, .03, .95,
+     +                  .1, .4, -.69, -.64,   .1, .4, .43, 1.37/
+      DATA              DT8/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.68E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.68E0, -0.87E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.68E0, -0.87E0, 0.15E0,
+     +                  0.94E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.68E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.35E0, -0.9E0, 0.48E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.38E0, -0.9E0, 0.57E0, 0.7E0, -0.75E0,
+     +                  0.2E0, 0.98E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.68E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.35E0, -0.72E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.38E0,
+     +                  -0.63E0, 0.15E0, 0.88E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.68E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.7E0,
+     +                  -0.75E0, 0.2E0, 1.04E0/
+      DATA              DT10X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.5E0, -0.9E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.5E0, -0.9E0, 0.3E0, 0.7E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.3E0, 0.1E0, 0.5E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.8E0, 0.1E0, -0.6E0,
+     +                  0.8E0, 0.3E0, -0.3E0, 0.5E0, 0.6E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.9E0,
+     +                  0.1E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.7E0,
+     +                  0.1E0, 0.3E0, 0.8E0, -0.9E0, -0.3E0, 0.5E0,
+     +                  0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.5E0, 0.3E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.5E0, 0.3E0, -0.6E0, 0.8E0, 0.0E0, 0.0E0,
+     +                  0.0E0/
+      DATA              DT10Y/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.6E0, 0.1E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, -0.5E0, -0.9E0, 0.6E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, -0.4E0, -0.9E0, 0.9E0,
+     +                  0.7E0, -0.5E0, 0.2E0, 0.6E0, 0.5E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.5E0,
+     +                  0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  -0.4E0, 0.9E0, -0.5E0, 0.6E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.6E0, -0.9E0, 0.1E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.6E0, -0.9E0, 0.1E0, 0.7E0,
+     +                  -0.5E0, 0.2E0, 0.8E0/
+      DATA              SSIZE1/0.0E0, 0.3E0, 1.6E0, 3.2E0/
+      DATA              SSIZE2/0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
+     +                  1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
+     +                  1.17E0, 1.17E0, 1.17E0/
+      DATA              SSIZE3/ .1, .4, 1.7, 3.3 /
+*
+*                         FOR DROTM
+*
+      DATA DPAR/-2.E0,  0.E0,0.E0,0.E0,0.E0,
+     A          -1.E0,  2.E0, -3.E0, -4.E0,  5.E0,
+     B           0.E0,  0.E0,  2.E0, -3.E0,  0.E0,
+     C           1.E0,  5.E0,  2.E0,  0.E0, -4.E0/
+*                        TRUE X RESULTS F0R ROTATIONS DROTM
+      DATA DT19XA/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     H            .6E0,   .1E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     I           -.8E0,  3.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     J           -.9E0,  2.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     K           3.5E0,  -.4E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     L            .6E0,   .1E0,  -.5E0,   .8E0,          0.E0,0.E0,0.E0,
+     M           -.8E0,  3.8E0, -2.2E0, -1.2E0,          0.E0,0.E0,0.E0,
+     N           -.9E0,  2.8E0, -1.4E0, -1.3E0,          0.E0,0.E0,0.E0,
+     O           3.5E0,  -.4E0, -2.2E0,  4.7E0,          0.E0,0.E0,0.E0/
+*
+      DATA DT19XB/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     H            .6E0,   .1E0,  -.5E0,             0.E0,0.E0,0.E0,0.E0,
+     I           0.E0,    .1E0, -3.0E0,             0.E0,0.E0,0.E0,0.E0,
+     J           -.3E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
+     K           3.3E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
+     L            .6E0,   .1E0,  -.5E0,   .8E0,   .9E0,  -.3E0,  -.4E0,
+     M          -2.0E0,   .1E0,  1.4E0,   .8E0,   .6E0,  -.3E0, -2.8E0,
+     N          -1.8E0,   .1E0,  1.3E0,   .8E0,  0.E0,   -.3E0, -1.9E0,
+     O           3.8E0,   .1E0, -3.1E0,   .8E0,  4.8E0,  -.3E0, -1.5E0 /
+*
+      DATA DT19XC/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     H            .6E0,   .1E0,  -.5E0,             0.E0,0.E0,0.E0,0.E0,
+     I           4.8E0,   .1E0, -3.0E0,             0.E0,0.E0,0.E0,0.E0,
+     J           3.3E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
+     K           2.1E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
+     L            .6E0,   .1E0,  -.5E0,   .8E0,   .9E0,  -.3E0,  -.4E0,
+     M          -1.6E0,   .1E0, -2.2E0,   .8E0,  5.4E0,  -.3E0, -2.8E0,
+     N          -1.5E0,   .1E0, -1.4E0,   .8E0,  3.6E0,  -.3E0, -1.9E0,
+     O           3.7E0,   .1E0, -2.2E0,   .8E0,  3.6E0,  -.3E0, -1.5E0 /
+*
+      DATA DT19XD/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     H            .6E0,   .1E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     I           -.8E0, -1.0E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     J           -.9E0,  -.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     K           3.5E0,   .8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     L            .6E0,   .1E0,  -.5E0,   .8E0,          0.E0,0.E0,0.E0,
+     M           -.8E0, -1.0E0,  1.4E0, -1.6E0,          0.E0,0.E0,0.E0,
+     N           -.9E0,  -.8E0,  1.3E0, -1.6E0,          0.E0,0.E0,0.E0,
+     O           3.5E0,   .8E0, -3.1E0,  4.8E0,          0.E0,0.E0,0.E0/
+*                        TRUE Y RESULTS FOR ROTATIONS DROTM
+      DATA DT19YA/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     H            .5E0,  -.9E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     I            .7E0, -4.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     J           1.7E0,  -.7E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     K          -2.6E0,  3.5E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     L            .5E0,  -.9E0,   .3E0,   .7E0,          0.E0,0.E0,0.E0,
+     M            .7E0, -4.8E0,  3.0E0,  1.1E0,          0.E0,0.E0,0.E0,
+     N           1.7E0,  -.7E0,  -.7E0,  2.3E0,          0.E0,0.E0,0.E0,
+     O          -2.6E0,  3.5E0,  -.7E0, -3.6E0,          0.E0,0.E0,0.E0/
+*
+      DATA DT19YB/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     H            .5E0,  -.9E0,   .3E0,             0.E0,0.E0,0.E0,0.E0,
+     I           4.0E0,  -.9E0,  -.3E0,             0.E0,0.E0,0.E0,0.E0,
+     J           -.5E0,  -.9E0,  1.5E0,             0.E0,0.E0,0.E0,0.E0,
+     K          -1.5E0,  -.9E0, -1.8E0,             0.E0,0.E0,0.E0,0.E0,
+     L            .5E0,  -.9E0,   .3E0,   .7E0,  -.6E0,   .2E0,   .8E0,
+     M           3.7E0,  -.9E0, -1.2E0,   .7E0, -1.5E0,   .2E0,  2.2E0,
+     N           -.3E0,  -.9E0,  2.1E0,   .7E0, -1.6E0,   .2E0,  2.0E0,
+     O          -1.6E0,  -.9E0, -2.1E0,   .7E0,  2.9E0,   .2E0, -3.8E0 /
+*
+      DATA DT19YC/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     H            .5E0,  -.9E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     I           4.0E0, -6.3E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     J           -.5E0,   .3E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     K          -1.5E0,  3.0E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
+     L            .5E0,  -.9E0,   .3E0,   .7E0,          0.E0,0.E0,0.E0,
+     M           3.7E0, -7.2E0,  3.0E0,  1.7E0,          0.E0,0.E0,0.E0,
+     N           -.3E0,   .9E0,  -.7E0,  1.9E0,          0.E0,0.E0,0.E0,
+     O          -1.6E0,  2.7E0,  -.7E0, -3.4E0,          0.E0,0.E0,0.E0/
+*
+      DATA DT19YD/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
+     H            .5E0,  -.9E0,   .3E0,             0.E0,0.E0,0.E0,0.E0,
+     I            .7E0,  -.9E0,  1.2E0,             0.E0,0.E0,0.E0,0.E0,
+     J           1.7E0,  -.9E0,   .5E0,             0.E0,0.E0,0.E0,0.E0,
+     K          -2.6E0,  -.9E0, -1.3E0,             0.E0,0.E0,0.E0,0.E0,
+     L            .5E0,  -.9E0,   .3E0,   .7E0,  -.6E0,   .2E0,   .8E0,
+     M            .7E0,  -.9E0,  1.2E0,   .7E0, -1.5E0,   .2E0,  1.6E0,
+     N           1.7E0,  -.9E0,   .5E0,   .7E0, -1.6E0,   .2E0,  2.4E0,
+     O          -2.6E0,  -.9E0, -1.3E0,   .7E0,  2.9E0,   .2E0, -4.0E0 /
+*
+*     .. Executable Statements ..
+*
+      DO 120 KI = 1, 4
+         INCX = INCXS(KI)
+         INCY = INCYS(KI)
+         MX = ABS(INCX)
+         MY = ABS(INCY)
+*
+         DO 100 KN = 1, 4
+            N = NS(KN)
+            KSIZE = MIN(2,KN)
+            LENX = LENS(KN,MX)
+            LENY = LENS(KN,MY)
+*           .. Initialize all argument arrays ..
+            DO 20 I = 1, 7
+               SX(I) = DX1(I)
+               SY(I) = DY1(I)
+   20       CONTINUE
+*
+            IF (ICASE.EQ.1) THEN
+*              .. SDOT ..
+               CALL STEST1(SDOT(N,SX,INCX,SY,INCY),DT7(KN,KI),SSIZE1(KN)
+     +                     ,SFAC)
+            ELSE IF (ICASE.EQ.2) THEN
+*              .. SAXPY ..
+               CALL SAXPY(N,SA,SX,INCX,SY,INCY)
+               DO 40 J = 1, LENY
+                  STY(J) = DT8(J,KN,KI)
+   40          CONTINUE
+               CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
+            ELSE IF (ICASE.EQ.5) THEN
+*              .. SCOPY ..
+               DO 60 I = 1, 7
+                  STY(I) = DT10Y(I,KN,KI)
+   60          CONTINUE
+               CALL SCOPY(N,SX,INCX,SY,INCY)
+               CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0)
+            ELSE IF (ICASE.EQ.6) THEN
+*              .. SSWAP ..
+               CALL SSWAP(N,SX,INCX,SY,INCY)
+               DO 80 I = 1, 7
+                  STX(I) = DT10X(I,KN,KI)
+                  STY(I) = DT10Y(I,KN,KI)
+   80          CONTINUE
+               CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0E0)
+               CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0)
+            ELSEIF (ICASE.EQ.12) THEN
+*              .. SROTM ..
+               KNI=KN+4*(KI-1)
+               DO KPAR=1,4
+                  DO I=1,7
+                     SX(I) = DX1(I)
+                     SY(I) = DY1(I)
+                     STX(I)= DT19X(I,KPAR,KNI)
+                     STY(I)= DT19Y(I,KPAR,KNI)
+                  END DO
+*
+                  DO I=1,5
+                     DTEMP(I) = DPAR(I,KPAR)
+                  END DO
+*
+                  DO  I=1,LENX
+                     SSIZE(I)=STX(I)
+                  END DO
+*                   SEE REMARK ABOVE ABOUT DT11X(1,2,7)
+*                       AND DT11X(5,3,8).
+                  IF ((KPAR .EQ. 2) .AND. (KNI .EQ. 7))
+     $               SSIZE(1) = 2.4E0
+                  IF ((KPAR .EQ. 3) .AND. (KNI .EQ. 8))
+     $               SSIZE(5) = 1.8E0
+*
+                  CALL   SROTM(N,SX,INCX,SY,INCY,DTEMP)
+                  CALL   STEST(LENX,SX,STX,SSIZE,SFAC)
+                  CALL   STEST(LENY,SY,STY,STY,SFAC)
+               END DO
+            ELSEIF (ICASE.EQ.13) THEN
+*              .. SDSROT ..
+               CALL STEST1 (SDSDOT(N,.1,SX,INCX,SY,INCY),
+     $                 ST7B(KN,KI),SSIZE3(KN),SFAC)
+            ELSE
+               WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
+               STOP
+            END IF
+  100    CONTINUE
+  120 CONTINUE
+      RETURN
+      END
+      SUBROUTINE CHECK3(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      REAL              SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      REAL              SC, SS
+      INTEGER           I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
+*     .. Local Arrays ..
+      REAL              COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
+     +                  DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5),
+     +                  MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5),
+     +                  MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7),
+     +                  SY(7)
+      INTEGER           INCXS(4), INCYS(4), LENS(4,2), MWPINX(11),
+     +                  MWPINY(11), MWPN(11), NS(4)
+*     .. External Subroutines ..
+      EXTERNAL          SROT, STEST
+*     .. Intrinsic Functions ..
+      INTRINSIC         ABS, MIN
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Data statements ..
+      DATA              INCXS/1, 2, -2, -1/
+      DATA              INCYS/1, -2, 1, -2/
+      DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
+      DATA              NS/0, 1, 2, 4/
+      DATA              DX1/0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
+     +                  -0.4E0/
+      DATA              DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
+     +                  0.8E0/
+      DATA              SC, SS/0.8E0, 0.6E0/
+      DATA              DT9X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.78E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.78E0, -0.46E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.78E0, -0.46E0, -0.22E0,
+     +                  1.06E0, 0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.78E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.66E0, 0.1E0, -0.1E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.96E0, 0.1E0, -0.76E0, 0.8E0, 0.90E0,
+     +                  -0.3E0, -0.02E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.78E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.06E0, 0.1E0,
+     +                  -0.1E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.90E0,
+     +                  0.1E0, -0.22E0, 0.8E0, 0.18E0, -0.3E0, -0.02E0,
+     +                  0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.78E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.78E0, 0.26E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.78E0, 0.26E0, -0.76E0, 1.12E0,
+     +                  0.0E0, 0.0E0, 0.0E0/
+      DATA              DT9Y/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.04E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.04E0, -0.78E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.04E0, -0.78E0, 0.54E0,
+     +                  0.08E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.04E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.7E0,
+     +                  -0.9E0, -0.12E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.64E0, -0.9E0, -0.30E0, 0.7E0, -0.18E0, 0.2E0,
+     +                  0.28E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.04E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.7E0, -1.08E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.64E0, -1.26E0,
+     +                  0.54E0, 0.20E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.04E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.04E0, -0.9E0, 0.18E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.04E0, -0.9E0, 0.18E0, 0.7E0,
+     +                  -0.18E0, 0.2E0, 0.16E0/
+      DATA              SSIZE2/0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+     +                  0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
+     +                  1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
+     +                  1.17E0, 1.17E0, 1.17E0/
+*     .. Executable Statements ..
+*
+      DO 60 KI = 1, 4
+         INCX = INCXS(KI)
+         INCY = INCYS(KI)
+         MX = ABS(INCX)
+         MY = ABS(INCY)
+*
+         DO 40 KN = 1, 4
+            N = NS(KN)
+            KSIZE = MIN(2,KN)
+            LENX = LENS(KN,MX)
+            LENY = LENS(KN,MY)
+*
+            IF (ICASE.EQ.4) THEN
+*              .. SROT ..
+               DO 20 I = 1, 7
+                  SX(I) = DX1(I)
+                  SY(I) = DY1(I)
+                  STX(I) = DT9X(I,KN,KI)
+                  STY(I) = DT9Y(I,KN,KI)
+   20          CONTINUE
+               CALL SROT(N,SX,INCX,SY,INCY,SC,SS)
+               CALL STEST(LENX,SX,STX,SSIZE2(1,KSIZE),SFAC)
+               CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
+            ELSE
+               WRITE (NOUT,*) ' Shouldn''t be here in CHECK3'
+               STOP
+            END IF
+   40    CONTINUE
+   60 CONTINUE
+*
+      MWPC(1) = 1
+      DO 80 I = 2, 11
+         MWPC(I) = 0
+   80 CONTINUE
+      MWPS(1) = 0
+      DO 100 I = 2, 6
+         MWPS(I) = 1
+  100 CONTINUE
+      DO 120 I = 7, 11
+         MWPS(I) = -1
+  120 CONTINUE
+      MWPINX(1) = 1
+      MWPINX(2) = 1
+      MWPINX(3) = 1
+      MWPINX(4) = -1
+      MWPINX(5) = 1
+      MWPINX(6) = -1
+      MWPINX(7) = 1
+      MWPINX(8) = 1
+      MWPINX(9) = -1
+      MWPINX(10) = 1
+      MWPINX(11) = -1
+      MWPINY(1) = 1
+      MWPINY(2) = 1
+      MWPINY(3) = -1
+      MWPINY(4) = -1
+      MWPINY(5) = 2
+      MWPINY(6) = 1
+      MWPINY(7) = 1
+      MWPINY(8) = -1
+      MWPINY(9) = -1
+      MWPINY(10) = 2
+      MWPINY(11) = 1
+      DO 140 I = 1, 11
+         MWPN(I) = 5
+  140 CONTINUE
+      MWPN(5) = 3
+      MWPN(10) = 3
+      DO 160 I = 1, 5
+         MWPX(I) = I
+         MWPY(I) = I
+         MWPTX(1,I) = I
+         MWPTY(1,I) = I
+         MWPTX(2,I) = I
+         MWPTY(2,I) = -I
+         MWPTX(3,I) = 6 - I
+         MWPTY(3,I) = I - 6
+         MWPTX(4,I) = I
+         MWPTY(4,I) = -I
+         MWPTX(6,I) = 6 - I
+         MWPTY(6,I) = I - 6
+         MWPTX(7,I) = -I
+         MWPTY(7,I) = I
+         MWPTX(8,I) = I - 6
+         MWPTY(8,I) = 6 - I
+         MWPTX(9,I) = -I
+         MWPTY(9,I) = I
+         MWPTX(11,I) = I - 6
+         MWPTY(11,I) = 6 - I
+  160 CONTINUE
+      MWPTX(5,1) = 1
+      MWPTX(5,2) = 3
+      MWPTX(5,3) = 5
+      MWPTX(5,4) = 4
+      MWPTX(5,5) = 5
+      MWPTY(5,1) = -1
+      MWPTY(5,2) = 2
+      MWPTY(5,3) = -2
+      MWPTY(5,4) = 4
+      MWPTY(5,5) = -3
+      MWPTX(10,1) = -1
+      MWPTX(10,2) = -3
+      MWPTX(10,3) = -5
+      MWPTX(10,4) = 4
+      MWPTX(10,5) = 5
+      MWPTY(10,1) = 1
+      MWPTY(10,2) = 2
+      MWPTY(10,3) = 2
+      MWPTY(10,4) = 4
+      MWPTY(10,5) = 3
+      DO 200 I = 1, 11
+         INCX = MWPINX(I)
+         INCY = MWPINY(I)
+         DO 180 K = 1, 5
+            COPYX(K) = MWPX(K)
+            COPYY(K) = MWPY(K)
+            MWPSTX(K) = MWPTX(I,K)
+            MWPSTY(K) = MWPTY(I,K)
+  180    CONTINUE
+         CALL SROT(MWPN(I),COPYX,INCX,COPYY,INCY,MWPC(I),MWPS(I))
+         CALL STEST(5,COPYX,MWPSTX,MWPSTX,SFAC)
+         CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC)
+  200 CONTINUE
+      RETURN
+      END
+      SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
+*     ********************************* STEST **************************
+*
+*     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
+*     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
+*     NEGLIGIBLE.
+*
+*     C. L. LAWSON, JPL, 1974 DEC 10
+*
+*     .. Parameters ..
+      INTEGER          NOUT
+      REAL             ZERO
+      PARAMETER        (NOUT=6, ZERO=0.0E0)
+*     .. Scalar Arguments ..
+      REAL             SFAC
+      INTEGER          LEN
+*     .. Array Arguments ..
+      REAL             SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, N
+      LOGICAL          PASS
+*     .. Local Scalars ..
+      REAL             SD
+      INTEGER          I
+*     .. External Functions ..
+      REAL             SDIFF
+      EXTERNAL         SDIFF
+*     .. Intrinsic Functions ..
+      INTRINSIC        ABS
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Executable Statements ..
+*
+      DO 40 I = 1, LEN
+         SD = SCOMP(I) - STRUE(I)
+         IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
+     +       GO TO 40
+*
+*                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
+*
+         IF ( .NOT. PASS) GO TO 20
+*                             PRINT FAIL MESSAGE AND HEADER.
+         PASS = .FALSE.
+         WRITE (NOUT,99999)
+         WRITE (NOUT,99998)
+   20    WRITE (NOUT,99997) ICASE, N, INCX, INCY, I, SCOMP(I),
+     +     STRUE(I), SD, SSIZE(I)
+   40 CONTINUE
+      RETURN
+*
+99999 FORMAT ('                                       FAIL')
+99998 FORMAT (/' CASE  N INCX INCY  I                            ',
+     +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
+     +       '     SIZE(I)',/1X)
+99997 FORMAT (1X,I4,I3,2I5,I3,2E36.8,2E12.4)
+      END
+      SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
+*     ************************* STEST1 *****************************
+*
+*     THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
+*     REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
+*     ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
+*
+*     C.L. LAWSON, JPL, 1978 DEC 6
+*
+*     .. Scalar Arguments ..
+      REAL              SCOMP1, SFAC, STRUE1
+*     .. Array Arguments ..
+      REAL              SSIZE(*)
+*     .. Local Arrays ..
+      REAL              SCOMP(1), STRUE(1)
+*     .. External Subroutines ..
+      EXTERNAL          STEST
+*     .. Executable Statements ..
+*
+      SCOMP(1) = SCOMP1
+      STRUE(1) = STRUE1
+      CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
+*
+      RETURN
+      END
+      REAL             FUNCTION SDIFF(SA,SB)
+*     ********************************* SDIFF **************************
+*     COMPUTES DIFFERENCE OF TWO NUMBERS.  C. L. LAWSON, JPL 1974 FEB 15
+*
+*     .. Scalar Arguments ..
+      REAL                            SA, SB
+*     .. Executable Statements ..
+      SDIFF = SA - SB
+      RETURN
+      END
+      SUBROUTINE ITEST1(ICOMP,ITRUE)
+*     ********************************* ITEST1 *************************
+*
+*     THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
+*     EQUALITY.
+*     C. L. LAWSON, JPL, 1974 DEC 10
+*
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      INTEGER           ICOMP, ITRUE
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      INTEGER           ID
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
+*     .. Executable Statements ..
+*
+      IF (ICOMP.EQ.ITRUE) GO TO 40
+*
+*                            HERE ICOMP IS NOT EQUAL TO ITRUE.
+*
+      IF ( .NOT. PASS) GO TO 20
+*                             PRINT FAIL MESSAGE AND HEADER.
+      PASS = .FALSE.
+      WRITE (NOUT,99999)
+      WRITE (NOUT,99998)
+   20 ID = ICOMP - ITRUE
+      WRITE (NOUT,99997) ICASE, N, INCX, INCY, ICOMP, ITRUE, ID
+   40 CONTINUE
+      RETURN
+*
+99999 FORMAT ('                                       FAIL')
+99998 FORMAT (/' CASE  N INCX INCY                               ',
+     +       ' COMP                                TRUE     DIFFERENCE',
+     +       /1X)
+99997 FORMAT (1X,I4,I3,2I5,2I36,I12)
+      END
diff --git a/eigen/blas/testing/sblat2.dat b/eigen/blas/testing/sblat2.dat
new file mode 100644
index 0000000..f537d30
--- /dev/null
+++ b/eigen/blas/testing/sblat2.dat
@@ -0,0 +1,34 @@
+'sblat2.summ'     NAME OF SUMMARY OUTPUT FILE
+6                 UNIT NUMBER OF SUMMARY FILE
+'sblat2.snap'     NAME OF SNAPSHOT OUTPUT FILE
+-1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
+T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+16.0     THRESHOLD VALUE OF TEST RATIO
+6                 NUMBER OF VALUES OF N
+0 1 2 3 5 9       VALUES OF N
+4                 NUMBER OF VALUES OF K
+0 1 2 4           VALUES OF K
+4                 NUMBER OF VALUES OF INCX AND INCY
+1 2 -1 -2         VALUES OF INCX AND INCY
+3                 NUMBER OF VALUES OF ALPHA
+0.0 1.0 0.7       VALUES OF ALPHA
+3                 NUMBER OF VALUES OF BETA
+0.0 1.0 0.9       VALUES OF BETA
+SGEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+SGBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+SSYMV  T PUT F FOR NO TEST. SAME COLUMNS.
+SSBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+SSPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+STRMV  T PUT F FOR NO TEST. SAME COLUMNS.
+STBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+STPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+STRSV  T PUT F FOR NO TEST. SAME COLUMNS.
+STBSV  T PUT F FOR NO TEST. SAME COLUMNS.
+STPSV  T PUT F FOR NO TEST. SAME COLUMNS.
+SGER   T PUT F FOR NO TEST. SAME COLUMNS.
+SSYR   T PUT F FOR NO TEST. SAME COLUMNS.
+SSPR   T PUT F FOR NO TEST. SAME COLUMNS.
+SSYR2  T PUT F FOR NO TEST. SAME COLUMNS.
+SSPR2  T PUT F FOR NO TEST. SAME COLUMNS.
diff --git a/eigen/blas/testing/sblat2.f b/eigen/blas/testing/sblat2.f
new file mode 100644
index 0000000..057a854
--- /dev/null
+++ b/eigen/blas/testing/sblat2.f
@@ -0,0 +1,3138 @@
+      PROGRAM SBLAT2
+*
+*  Test program for the REAL             Level 2 Blas.
+*
+*  The program must be driven by a short data file. The first 18 records
+*  of the file are read using list-directed input, the last 16 records
+*  are read using the format ( A6, L2 ). An annotated example of a data
+*  file can be obtained by deleting the first 3 characters from the
+*  following 34 lines:
+*  'SBLAT2.SUMM'     NAME OF SUMMARY OUTPUT FILE
+*  6                 UNIT NUMBER OF SUMMARY FILE
+*  'SBLAT2.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
+*  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+*  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+*  F        LOGICAL FLAG, T TO STOP ON FAILURES.
+*  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+*  16.0     THRESHOLD VALUE OF TEST RATIO
+*  6                 NUMBER OF VALUES OF N
+*  0 1 2 3 5 9       VALUES OF N
+*  4                 NUMBER OF VALUES OF K
+*  0 1 2 4           VALUES OF K
+*  4                 NUMBER OF VALUES OF INCX AND INCY
+*  1 2 -1 -2         VALUES OF INCX AND INCY
+*  3                 NUMBER OF VALUES OF ALPHA
+*  0.0 1.0 0.7       VALUES OF ALPHA
+*  3                 NUMBER OF VALUES OF BETA
+*  0.0 1.0 0.9       VALUES OF BETA
+*  SGEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  SGBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  SSYMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  SSBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  SSPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  STRMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  STBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  STPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  STRSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  STBSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  STPSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  SGER   T PUT F FOR NO TEST. SAME COLUMNS.
+*  SSYR   T PUT F FOR NO TEST. SAME COLUMNS.
+*  SSPR   T PUT F FOR NO TEST. SAME COLUMNS.
+*  SSYR2  T PUT F FOR NO TEST. SAME COLUMNS.
+*  SSPR2  T PUT F FOR NO TEST. SAME COLUMNS.
+*
+*     See:
+*
+*        Dongarra J. J., Du Croz J. J., Hammarling S.  and Hanson R. J..
+*        An  extended  set of Fortran  Basic Linear Algebra Subprograms.
+*
+*        Technical  Memoranda  Nos. 41 (revision 3) and 81,  Mathematics
+*        and  Computer Science  Division,  Argonne  National Laboratory,
+*        9700 South Cass Avenue, Argonne, Illinois 60439, US.
+*
+*        Or
+*
+*        NAG  Technical Reports TR3/87 and TR4/87,  Numerical Algorithms
+*        Group  Ltd.,  NAG  Central  Office,  256  Banbury  Road, Oxford
+*        OX2 7DE, UK,  and  Numerical Algorithms Group Inc.,  1101  31st
+*        Street,  Suite 100,  Downers Grove,  Illinois 60515-1263,  USA.
+*
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      INTEGER            NIN
+      PARAMETER          ( NIN = 5 )
+      INTEGER            NSUBS
+      PARAMETER          ( NSUBS = 16 )
+      REAL               ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 )
+      INTEGER            NMAX, INCMAX
+      PARAMETER          ( NMAX = 65, INCMAX = 2 )
+      INTEGER            NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX
+      PARAMETER          ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7,
+     $                   NALMAX = 7, NBEMAX = 7 )
+*     .. Local Scalars ..
+      REAL               EPS, ERR, THRESH
+      INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
+     $                   TSTERR
+      CHARACTER*1        TRANS
+      CHARACTER*6        SNAMET
+      CHARACTER*32       SNAPS, SUMMRY
+*     .. Local Arrays ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ),
+     $                   ALF( NALMAX ), AS( NMAX*NMAX ), BET( NBEMAX ),
+     $                   G( NMAX ), X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( 2*NMAX )
+      INTEGER            IDIM( NIDMAX ), INC( NINMAX ), KB( NKBMAX )
+      LOGICAL            LTEST( NSUBS )
+      CHARACTER*6        SNAMES( NSUBS )
+*     .. External Functions ..
+      REAL               SDIFF
+      LOGICAL            LSE
+      EXTERNAL           SDIFF, LSE
+*     .. External Subroutines ..
+      EXTERNAL           SCHK1, SCHK2, SCHK3, SCHK4, SCHK5, SCHK6,
+     $                   SCHKE, SMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Data statements ..
+      DATA               SNAMES/'SGEMV ', 'SGBMV ', 'SSYMV ', 'SSBMV ',
+     $                   'SSPMV ', 'STRMV ', 'STBMV ', 'STPMV ',
+     $                   'STRSV ', 'STBSV ', 'STPSV ', 'SGER  ',
+     $                   'SSYR  ', 'SSPR  ', 'SSYR2 ', 'SSPR2 '/
+*     .. Executable Statements ..
+*
+*     Read name and unit number for summary output file and open file.
+*
+      READ( NIN, FMT = * )SUMMRY
+      READ( NIN, FMT = * )NOUT
+      OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+      NOUTC = NOUT
+*
+*     Read name and unit number for snapshot output file and open file.
+*
+      READ( NIN, FMT = * )SNAPS
+      READ( NIN, FMT = * )NTRA
+      TRACE = NTRA.GE.0
+      IF( TRACE )THEN
+         OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+      END IF
+*     Read the flag that directs rewinding of the snapshot file.
+      READ( NIN, FMT = * )REWI
+      REWI = REWI.AND.TRACE
+*     Read the flag that directs stopping on any failure.
+      READ( NIN, FMT = * )SFATAL
+*     Read the flag that indicates whether error exits are to be tested.
+      READ( NIN, FMT = * )TSTERR
+*     Read the threshold value of the test ratio
+      READ( NIN, FMT = * )THRESH
+*
+*     Read and check the parameter values for the tests.
+*
+*     Values of N
+      READ( NIN, FMT = * )NIDIM
+      IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'N', NIDMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
+      DO 10 I = 1, NIDIM
+         IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
+            WRITE( NOUT, FMT = 9996 )NMAX
+            GO TO 230
+         END IF
+   10 CONTINUE
+*     Values of K
+      READ( NIN, FMT = * )NKB
+      IF( NKB.LT.1.OR.NKB.GT.NKBMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'K', NKBMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( KB( I ), I = 1, NKB )
+      DO 20 I = 1, NKB
+         IF( KB( I ).LT.0 )THEN
+            WRITE( NOUT, FMT = 9995 )
+            GO TO 230
+         END IF
+   20 CONTINUE
+*     Values of INCX and INCY
+      READ( NIN, FMT = * )NINC
+      IF( NINC.LT.1.OR.NINC.GT.NINMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'INCX AND INCY', NINMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( INC( I ), I = 1, NINC )
+      DO 30 I = 1, NINC
+         IF( INC( I ).EQ.0.OR.ABS( INC( I ) ).GT.INCMAX )THEN
+            WRITE( NOUT, FMT = 9994 )INCMAX
+            GO TO 230
+         END IF
+   30 CONTINUE
+*     Values of ALPHA
+      READ( NIN, FMT = * )NALF
+      IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
+*     Values of BETA
+      READ( NIN, FMT = * )NBET
+      IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
+*
+*     Report values of parameters.
+*
+      WRITE( NOUT, FMT = 9993 )
+      WRITE( NOUT, FMT = 9992 )( IDIM( I ), I = 1, NIDIM )
+      WRITE( NOUT, FMT = 9991 )( KB( I ), I = 1, NKB )
+      WRITE( NOUT, FMT = 9990 )( INC( I ), I = 1, NINC )
+      WRITE( NOUT, FMT = 9989 )( ALF( I ), I = 1, NALF )
+      WRITE( NOUT, FMT = 9988 )( BET( I ), I = 1, NBET )
+      IF( .NOT.TSTERR )THEN
+         WRITE( NOUT, FMT = * )
+         WRITE( NOUT, FMT = 9980 )
+      END IF
+      WRITE( NOUT, FMT = * )
+      WRITE( NOUT, FMT = 9999 )THRESH
+      WRITE( NOUT, FMT = * )
+*
+*     Read names of subroutines and flags which indicate
+*     whether they are to be tested.
+*
+      DO 40 I = 1, NSUBS
+         LTEST( I ) = .FALSE.
+   40 CONTINUE
+   50 READ( NIN, FMT = 9984, END = 80 )SNAMET, LTESTT
+      DO 60 I = 1, NSUBS
+         IF( SNAMET.EQ.SNAMES( I ) )
+     $      GO TO 70
+   60 CONTINUE
+      WRITE( NOUT, FMT = 9986 )SNAMET
+      STOP
+   70 LTEST( I ) = LTESTT
+      GO TO 50
+*
+   80 CONTINUE
+      CLOSE ( NIN )
+*
+*     Compute EPS (the machine precision).
+*
+      EPS = ONE
+   90 CONTINUE
+      IF( SDIFF( ONE + EPS, ONE ).EQ.ZERO )
+     $   GO TO 100
+      EPS = HALF*EPS
+      GO TO 90
+  100 CONTINUE
+      EPS = EPS + EPS
+      WRITE( NOUT, FMT = 9998 )EPS
+*
+*     Check the reliability of SMVCH using exact data.
+*
+      N = MIN( 32, NMAX )
+      DO 120 J = 1, N
+         DO 110 I = 1, N
+            A( I, J ) = MAX( I - J + 1, 0 )
+  110    CONTINUE
+         X( J ) = J
+         Y( J ) = ZERO
+  120 CONTINUE
+      DO 130 J = 1, N
+         YY( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3
+  130 CONTINUE
+*     YY holds the exact result. On exit from SMVCH YT holds
+*     the result computed by SMVCH.
+      TRANS = 'N'
+      CALL SMVCH( TRANS, N, N, ONE, A, NMAX, X, 1, ZERO, Y, 1, YT, G,
+     $            YY, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LSE( YY, YT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9985 )TRANS, SAME, ERR
+         STOP
+      END IF
+      TRANS = 'T'
+      CALL SMVCH( TRANS, N, N, ONE, A, NMAX, X, -1, ZERO, Y, -1, YT, G,
+     $            YY, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LSE( YY, YT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9985 )TRANS, SAME, ERR
+         STOP
+      END IF
+*
+*     Test each subroutine in turn.
+*
+      DO 210 ISNUM = 1, NSUBS
+         WRITE( NOUT, FMT = * )
+         IF( .NOT.LTEST( ISNUM ) )THEN
+*           Subprogram is not to be tested.
+            WRITE( NOUT, FMT = 9983 )SNAMES( ISNUM )
+         ELSE
+            SRNAMT = SNAMES( ISNUM )
+*           Test error exits.
+            IF( TSTERR )THEN
+               CALL SCHKE( ISNUM, SNAMES( ISNUM ), NOUT )
+               WRITE( NOUT, FMT = * )
+            END IF
+*           Test computations.
+            INFOT = 0
+            OK = .TRUE.
+            FATAL = .FALSE.
+            GO TO ( 140, 140, 150, 150, 150, 160, 160,
+     $              160, 160, 160, 160, 170, 180, 180,
+     $              190, 190 )ISNUM
+*           Test SGEMV, 01, and SGBMV, 02.
+  140       CALL SCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF,
+     $                  NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS,
+     $                  X, XX, XS, Y, YY, YS, YT, G )
+            GO TO 200
+*           Test SSYMV, 03, SSBMV, 04, and SSPMV, 05.
+  150       CALL SCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF,
+     $                  NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS,
+     $                  X, XX, XS, Y, YY, YS, YT, G )
+            GO TO 200
+*           Test STRMV, 06, STBMV, 07, STPMV, 08,
+*           STRSV, 09, STBSV, 10, and STPSV, 11.
+  160       CALL SCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z )
+            GO TO 200
+*           Test SGER, 12.
+  170       CALL SCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+            GO TO 200
+*           Test SSYR, 13, and SSPR, 14.
+  180       CALL SCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+            GO TO 200
+*           Test SSYR2, 15, and SSPR2, 16.
+  190       CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+*
+  200       IF( FATAL.AND.SFATAL )
+     $         GO TO 220
+         END IF
+  210 CONTINUE
+      WRITE( NOUT, FMT = 9982 )
+      GO TO 240
+*
+  220 CONTINUE
+      WRITE( NOUT, FMT = 9981 )
+      GO TO 240
+*
+  230 CONTINUE
+      WRITE( NOUT, FMT = 9987 )
+*
+  240 CONTINUE
+      IF( TRACE )
+     $   CLOSE ( NTRA )
+      CLOSE ( NOUT )
+      STOP
+*
+ 9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
+     $      'S THAN', F8.2 )
+ 9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, E9.1 )
+ 9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
+     $      'THAN ', I2 )
+ 9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 )
+ 9995 FORMAT( ' VALUE OF K IS LESS THAN 0' )
+ 9994 FORMAT( ' ABSOLUTE VALUE OF INCX OR INCY IS 0 OR GREATER THAN ',
+     $      I2 )
+ 9993 FORMAT( ' TESTS OF THE REAL             LEVEL 2 BLAS', //' THE F',
+     $      'OLLOWING PARAMETER VALUES WILL BE USED:' )
+ 9992 FORMAT( '   FOR N              ', 9I6 )
+ 9991 FORMAT( '   FOR K              ', 7I6 )
+ 9990 FORMAT( '   FOR INCX AND INCY  ', 7I6 )
+ 9989 FORMAT( '   FOR ALPHA          ', 7F6.1 )
+ 9988 FORMAT( '   FOR BETA           ', 7F6.1 )
+ 9987 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
+     $      /' ******* TESTS ABANDONED *******' )
+ 9986 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+     $      'ESTS ABANDONED *******' )
+ 9985 FORMAT( ' ERROR IN SMVCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
+     $      'ATED WRONGLY.', /' SMVCH WAS CALLED WITH TRANS = ', A1,
+     $      ' AND RETURNED SAME = ', L1, ' AND ERR = ', F12.3, '.', /
+     $   ' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.'
+     $      , /' ******* TESTS ABANDONED *******' )
+ 9984 FORMAT( A6, L2 )
+ 9983 FORMAT( 1X, A6, ' WAS NOT TESTED' )
+ 9982 FORMAT( /' END OF TESTS' )
+ 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
+ 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
+*
+*     End of SBLAT2.
+*
+      END
+      SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET,
+     $                  BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX,
+     $                  XS, Y, YY, YS, YT, G )
+*
+*  Tests SGEMV and SGBMV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      REAL               ZERO, HALF
+      PARAMETER          ( ZERO = 0.0, HALF = 0.5 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), BET( NBET ), G( NMAX ),
+     $                   X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL
+      INTEGER            I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY,
+     $                   INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA,
+     $                   LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK,
+     $                   NL, NS
+      LOGICAL            BANDED, FULL, NULL, RESET, SAME, TRAN
+      CHARACTER*1        TRANS, TRANSS
+      CHARACTER*3        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SGBMV, SGEMV, SMAKE, SMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'NTC'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'E'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 11
+      ELSE IF( BANDED )THEN
+         NARGS = 13
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 120 IN = 1, NIDIM
+         N = IDIM( IN )
+         ND = N/2 + 1
+*
+         DO 110 IM = 1, 2
+            IF( IM.EQ.1 )
+     $         M = MAX( N - ND, 0 )
+            IF( IM.EQ.2 )
+     $         M = MIN( N + ND, NMAX )
+*
+            IF( BANDED )THEN
+               NK = NKB
+            ELSE
+               NK = 1
+            END IF
+            DO 100 IKU = 1, NK
+               IF( BANDED )THEN
+                  KU = KB( IKU )
+                  KL = MAX( KU - 1, 0 )
+               ELSE
+                  KU = N - 1
+                  KL = M - 1
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               IF( BANDED )THEN
+                  LDA = KL + KU + 1
+               ELSE
+                  LDA = M
+               END IF
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 100
+               LAA = LDA*N
+               NULL = N.LE.0.OR.M.LE.0
+*
+*              Generate the matrix A.
+*
+               TRANSL = ZERO
+               CALL SMAKE( SNAME( 2: 3 ), ' ', ' ', M, N, A, NMAX, AA,
+     $                     LDA, KL, KU, RESET, TRANSL )
+*
+               DO 90 IC = 1, 3
+                  TRANS = ICH( IC: IC )
+                  TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C'
+*
+                  IF( TRAN )THEN
+                     ML = N
+                     NL = M
+                  ELSE
+                     ML = M
+                     NL = N
+                  END IF
+*
+                  DO 80 IX = 1, NINC
+                     INCX = INC( IX )
+                     LX = ABS( INCX )*NL
+*
+*                    Generate the vector X.
+*
+                     TRANSL = HALF
+                     CALL SMAKE( 'GE', ' ', ' ', 1, NL, X, 1, XX,
+     $                           ABS( INCX ), 0, NL - 1, RESET, TRANSL )
+                     IF( NL.GT.1 )THEN
+                        X( NL/2 ) = ZERO
+                        XX( 1 + ABS( INCX )*( NL/2 - 1 ) ) = ZERO
+                     END IF
+*
+                     DO 70 IY = 1, NINC
+                        INCY = INC( IY )
+                        LY = ABS( INCY )*ML
+*
+                        DO 60 IA = 1, NALF
+                           ALPHA = ALF( IA )
+*
+                           DO 50 IB = 1, NBET
+                              BETA = BET( IB )
+*
+*                             Generate the vector Y.
+*
+                              TRANSL = ZERO
+                              CALL SMAKE( 'GE', ' ', ' ', 1, ML, Y, 1,
+     $                                    YY, ABS( INCY ), 0, ML - 1,
+     $                                    RESET, TRANSL )
+*
+                              NC = NC + 1
+*
+*                             Save every datum before calling the
+*                             subroutine.
+*
+                              TRANSS = TRANS
+                              MS = M
+                              NS = N
+                              KLS = KL
+                              KUS = KU
+                              ALS = ALPHA
+                              DO 10 I = 1, LAA
+                                 AS( I ) = AA( I )
+   10                         CONTINUE
+                              LDAS = LDA
+                              DO 20 I = 1, LX
+                                 XS( I ) = XX( I )
+   20                         CONTINUE
+                              INCXS = INCX
+                              BLS = BETA
+                              DO 30 I = 1, LY
+                                 YS( I ) = YY( I )
+   30                         CONTINUE
+                              INCYS = INCY
+*
+*                             Call the subroutine.
+*
+                              IF( FULL )THEN
+                                 IF( TRACE )
+     $                              WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                              TRANS, M, N, ALPHA, LDA, INCX, BETA,
+     $                              INCY
+                                 IF( REWI )
+     $                              REWIND NTRA
+                                 CALL SGEMV( TRANS, M, N, ALPHA, AA,
+     $                                       LDA, XX, INCX, BETA, YY,
+     $                                       INCY )
+                              ELSE IF( BANDED )THEN
+                                 IF( TRACE )
+     $                              WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                              TRANS, M, N, KL, KU, ALPHA, LDA,
+     $                              INCX, BETA, INCY
+                                 IF( REWI )
+     $                              REWIND NTRA
+                                 CALL SGBMV( TRANS, M, N, KL, KU, ALPHA,
+     $                                       AA, LDA, XX, INCX, BETA,
+     $                                       YY, INCY )
+                              END IF
+*
+*                             Check if error-exit was taken incorrectly.
+*
+                              IF( .NOT.OK )THEN
+                                 WRITE( NOUT, FMT = 9993 )
+                                 FATAL = .TRUE.
+                                 GO TO 130
+                              END IF
+*
+*                             See what data changed inside subroutines.
+*
+                              ISAME( 1 ) = TRANS.EQ.TRANSS
+                              ISAME( 2 ) = MS.EQ.M
+                              ISAME( 3 ) = NS.EQ.N
+                              IF( FULL )THEN
+                                 ISAME( 4 ) = ALS.EQ.ALPHA
+                                 ISAME( 5 ) = LSE( AS, AA, LAA )
+                                 ISAME( 6 ) = LDAS.EQ.LDA
+                                 ISAME( 7 ) = LSE( XS, XX, LX )
+                                 ISAME( 8 ) = INCXS.EQ.INCX
+                                 ISAME( 9 ) = BLS.EQ.BETA
+                                 IF( NULL )THEN
+                                    ISAME( 10 ) = LSE( YS, YY, LY )
+                                 ELSE
+                                    ISAME( 10 ) = LSERES( 'GE', ' ', 1,
+     $                                            ML, YS, YY,
+     $                                            ABS( INCY ) )
+                                 END IF
+                                 ISAME( 11 ) = INCYS.EQ.INCY
+                              ELSE IF( BANDED )THEN
+                                 ISAME( 4 ) = KLS.EQ.KL
+                                 ISAME( 5 ) = KUS.EQ.KU
+                                 ISAME( 6 ) = ALS.EQ.ALPHA
+                                 ISAME( 7 ) = LSE( AS, AA, LAA )
+                                 ISAME( 8 ) = LDAS.EQ.LDA
+                                 ISAME( 9 ) = LSE( XS, XX, LX )
+                                 ISAME( 10 ) = INCXS.EQ.INCX
+                                 ISAME( 11 ) = BLS.EQ.BETA
+                                 IF( NULL )THEN
+                                    ISAME( 12 ) = LSE( YS, YY, LY )
+                                 ELSE
+                                    ISAME( 12 ) = LSERES( 'GE', ' ', 1,
+     $                                            ML, YS, YY,
+     $                                            ABS( INCY ) )
+                                 END IF
+                                 ISAME( 13 ) = INCYS.EQ.INCY
+                              END IF
+*
+*                             If data was incorrectly changed, report
+*                             and return.
+*
+                              SAME = .TRUE.
+                              DO 40 I = 1, NARGS
+                                 SAME = SAME.AND.ISAME( I )
+                                 IF( .NOT.ISAME( I ) )
+     $                              WRITE( NOUT, FMT = 9998 )I
+   40                         CONTINUE
+                              IF( .NOT.SAME )THEN
+                                 FATAL = .TRUE.
+                                 GO TO 130
+                              END IF
+*
+                              IF( .NOT.NULL )THEN
+*
+*                                Check the result.
+*
+                                 CALL SMVCH( TRANS, M, N, ALPHA, A,
+     $                                       NMAX, X, INCX, BETA, Y,
+     $                                       INCY, YT, G, YY, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                                 ERRMAX = MAX( ERRMAX, ERR )
+*                                If got really bad answer, report and
+*                                return.
+                                 IF( FATAL )
+     $                              GO TO 130
+                              ELSE
+*                                Avoid repeating tests with M.le.0 or
+*                                N.le.0.
+                                 GO TO 110
+                              END IF
+*
+   50                      CONTINUE
+*
+   60                   CONTINUE
+*
+   70                CONTINUE
+*
+   80             CONTINUE
+*
+   90          CONTINUE
+*
+  100       CONTINUE
+*
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 140
+*
+  130 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA,
+     $      INCX, BETA, INCY
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU,
+     $      ALPHA, LDA, INCX, BETA, INCY
+      END IF
+*
+  140 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 4( I3, ',' ), F4.1,
+     $      ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2, ') .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), F4.1,
+     $      ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2,
+     $      ')         .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK1.
+*
+      END
+      SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET,
+     $                  BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX,
+     $                  XS, Y, YY, YS, YT, G )
+*
+*  Tests SSYMV, SSBMV and SSPMV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      REAL               ZERO, HALF
+      PARAMETER          ( ZERO = 0.0, HALF = 0.5 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), BET( NBET ), G( NMAX ),
+     $                   X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, BETA, BLS, ERR, ERRMAX, TRANSL
+      INTEGER            I, IA, IB, IC, IK, IN, INCX, INCXS, INCY,
+     $                   INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY,
+     $                   N, NARGS, NC, NK, NS
+      LOGICAL            BANDED, FULL, NULL, PACKED, RESET, SAME
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SMAKE, SMVCH, SSBMV, SSPMV, SSYMV
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'Y'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 10
+      ELSE IF( BANDED )THEN
+         NARGS = 11
+      ELSE IF( PACKED )THEN
+         NARGS = 9
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 110 IN = 1, NIDIM
+         N = IDIM( IN )
+*
+         IF( BANDED )THEN
+            NK = NKB
+         ELSE
+            NK = 1
+         END IF
+         DO 100 IK = 1, NK
+            IF( BANDED )THEN
+               K = KB( IK )
+            ELSE
+               K = N - 1
+            END IF
+*           Set LDA to 1 more than minimum value if room.
+            IF( BANDED )THEN
+               LDA = K + 1
+            ELSE
+               LDA = N
+            END IF
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 100
+            IF( PACKED )THEN
+               LAA = ( N*( N + 1 ) )/2
+            ELSE
+               LAA = LDA*N
+            END IF
+            NULL = N.LE.0
+*
+            DO 90 IC = 1, 2
+               UPLO = ICH( IC: IC )
+*
+*              Generate the matrix A.
+*
+               TRANSL = ZERO
+               CALL SMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A, NMAX, AA,
+     $                     LDA, K, K, RESET, TRANSL )
+*
+               DO 80 IX = 1, NINC
+                  INCX = INC( IX )
+                  LX = ABS( INCX )*N
+*
+*                 Generate the vector X.
+*
+                  TRANSL = HALF
+                  CALL SMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX,
+     $                        ABS( INCX ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     X( N/2 ) = ZERO
+                     XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 70 IY = 1, NINC
+                     INCY = INC( IY )
+                     LY = ABS( INCY )*N
+*
+                     DO 60 IA = 1, NALF
+                        ALPHA = ALF( IA )
+*
+                        DO 50 IB = 1, NBET
+                           BETA = BET( IB )
+*
+*                          Generate the vector Y.
+*
+                           TRANSL = ZERO
+                           CALL SMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                                 ABS( INCY ), 0, N - 1, RESET,
+     $                                 TRANSL )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           UPLOS = UPLO
+                           NS = N
+                           KS = K
+                           ALS = ALPHA
+                           DO 10 I = 1, LAA
+                              AS( I ) = AA( I )
+   10                      CONTINUE
+                           LDAS = LDA
+                           DO 20 I = 1, LX
+                              XS( I ) = XX( I )
+   20                      CONTINUE
+                           INCXS = INCX
+                           BLS = BETA
+                           DO 30 I = 1, LY
+                              YS( I ) = YY( I )
+   30                      CONTINUE
+                           INCYS = INCY
+*
+*                          Call the subroutine.
+*
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, N, ALPHA, LDA, INCX, BETA, INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL SSYMV( UPLO, N, ALPHA, AA, LDA, XX,
+     $                                    INCX, BETA, YY, INCY )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, N, K, ALPHA, LDA, INCX, BETA,
+     $                           INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL SSBMV( UPLO, N, K, ALPHA, AA, LDA,
+     $                                    XX, INCX, BETA, YY, INCY )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, N, ALPHA, INCX, BETA, INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL SSPMV( UPLO, N, ALPHA, AA, XX, INCX,
+     $                                    BETA, YY, INCY )
+                           END IF
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9992 )
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = UPLO.EQ.UPLOS
+                           ISAME( 2 ) = NS.EQ.N
+                           IF( FULL )THEN
+                              ISAME( 3 ) = ALS.EQ.ALPHA
+                              ISAME( 4 ) = LSE( AS, AA, LAA )
+                              ISAME( 5 ) = LDAS.EQ.LDA
+                              ISAME( 6 ) = LSE( XS, XX, LX )
+                              ISAME( 7 ) = INCXS.EQ.INCX
+                              ISAME( 8 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 9 ) = LSE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 9 ) = LSERES( 'GE', ' ', 1, N,
+     $                                        YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 10 ) = INCYS.EQ.INCY
+                           ELSE IF( BANDED )THEN
+                              ISAME( 3 ) = KS.EQ.K
+                              ISAME( 4 ) = ALS.EQ.ALPHA
+                              ISAME( 5 ) = LSE( AS, AA, LAA )
+                              ISAME( 6 ) = LDAS.EQ.LDA
+                              ISAME( 7 ) = LSE( XS, XX, LX )
+                              ISAME( 8 ) = INCXS.EQ.INCX
+                              ISAME( 9 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 10 ) = LSE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 10 ) = LSERES( 'GE', ' ', 1, N,
+     $                                         YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 11 ) = INCYS.EQ.INCY
+                           ELSE IF( PACKED )THEN
+                              ISAME( 3 ) = ALS.EQ.ALPHA
+                              ISAME( 4 ) = LSE( AS, AA, LAA )
+                              ISAME( 5 ) = LSE( XS, XX, LX )
+                              ISAME( 6 ) = INCXS.EQ.INCX
+                              ISAME( 7 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 8 ) = LSE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 8 ) = LSERES( 'GE', ' ', 1, N,
+     $                                        YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 9 ) = INCYS.EQ.INCY
+                           END IF
+*
+*                          If data was incorrectly changed, report and
+*                          return.
+*
+                           SAME = .TRUE.
+                           DO 40 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   40                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+*
+*                             Check the result.
+*
+                              CALL SMVCH( 'N', N, N, ALPHA, A, NMAX, X,
+     $                                    INCX, BETA, Y, INCY, YT, G,
+     $                                    YY, EPS, ERR, FATAL, NOUT,
+     $                                    .TRUE. )
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 120
+                           ELSE
+*                             Avoid repeating tests with N.le.0
+                              GO TO 110
+                           END IF
+*
+   50                   CONTINUE
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, LDA, INCX,
+     $      BETA, INCY
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, K, ALPHA, LDA,
+     $      INCX, BETA, INCY
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, N, ALPHA, INCX,
+     $      BETA, INCY
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', AP',
+     $      ', X,', I2, ',', F4.1, ', Y,', I2, ')                .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), F4.1,
+     $      ', A,', I3, ', X,', I2, ',', F4.1, ', Y,', I2,
+     $      ')         .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', A,',
+     $      I3, ', X,', I2, ',', F4.1, ', Y,', I2, ')             .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK2.
+*
+      END
+      SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, XT, G, Z )
+*
+*  Tests STRMV, STBMV, STPMV, STRSV, STBSV and STPSV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      REAL               ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NIDIM, NINC, NKB, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ),
+     $                   AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XT( NMAX ),
+     $                   XX( NMAX*INCMAX ), Z( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      REAL               ERR, ERRMAX, TRANSL
+      INTEGER            I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K,
+     $                   KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS
+      LOGICAL            BANDED, FULL, NULL, PACKED, RESET, SAME
+      CHARACTER*1        DIAG, DIAGS, TRANS, TRANSS, UPLO, UPLOS
+      CHARACTER*2        ICHD, ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SMAKE, SMVCH, STBMV, STBSV, STPMV, STPSV,
+     $                   STRMV, STRSV
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'R'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 8
+      ELSE IF( BANDED )THEN
+         NARGS = 9
+      ELSE IF( PACKED )THEN
+         NARGS = 7
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*     Set up zero vector for SMVCH.
+      DO 10 I = 1, NMAX
+         Z( I ) = ZERO
+   10 CONTINUE
+*
+      DO 110 IN = 1, NIDIM
+         N = IDIM( IN )
+*
+         IF( BANDED )THEN
+            NK = NKB
+         ELSE
+            NK = 1
+         END IF
+         DO 100 IK = 1, NK
+            IF( BANDED )THEN
+               K = KB( IK )
+            ELSE
+               K = N - 1
+            END IF
+*           Set LDA to 1 more than minimum value if room.
+            IF( BANDED )THEN
+               LDA = K + 1
+            ELSE
+               LDA = N
+            END IF
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 100
+            IF( PACKED )THEN
+               LAA = ( N*( N + 1 ) )/2
+            ELSE
+               LAA = LDA*N
+            END IF
+            NULL = N.LE.0
+*
+            DO 90 ICU = 1, 2
+               UPLO = ICHU( ICU: ICU )
+*
+               DO 80 ICT = 1, 3
+                  TRANS = ICHT( ICT: ICT )
+*
+                  DO 70 ICD = 1, 2
+                     DIAG = ICHD( ICD: ICD )
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL SMAKE( SNAME( 2: 3 ), UPLO, DIAG, N, N, A,
+     $                           NMAX, AA, LDA, K, K, RESET, TRANSL )
+*
+                     DO 60 IX = 1, NINC
+                        INCX = INC( IX )
+                        LX = ABS( INCX )*N
+*
+*                       Generate the vector X.
+*
+                        TRANSL = HALF
+                        CALL SMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX,
+     $                              ABS( INCX ), 0, N - 1, RESET,
+     $                              TRANSL )
+                        IF( N.GT.1 )THEN
+                           X( N/2 ) = ZERO
+                           XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+                        END IF
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        DIAGS = DIAG
+                        NS = N
+                        KS = K
+                        DO 20 I = 1, LAA
+                           AS( I ) = AA( I )
+   20                   CONTINUE
+                        LDAS = LDA
+                        DO 30 I = 1, LX
+                           XS( I ) = XX( I )
+   30                   CONTINUE
+                        INCXS = INCX
+*
+*                       Call the subroutine.
+*
+                        IF( SNAME( 4: 5 ).EQ.'MV' )THEN
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL STRMV( UPLO, TRANS, DIAG, N, AA, LDA,
+     $                                    XX, INCX )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, K, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL STBMV( UPLO, TRANS, DIAG, N, K, AA,
+     $                                    LDA, XX, INCX )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL STPMV( UPLO, TRANS, DIAG, N, AA, XX,
+     $                                    INCX )
+                           END IF
+                        ELSE IF( SNAME( 4: 5 ).EQ.'SV' )THEN
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL STRSV( UPLO, TRANS, DIAG, N, AA, LDA,
+     $                                    XX, INCX )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, K, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL STBSV( UPLO, TRANS, DIAG, N, K, AA,
+     $                                    LDA, XX, INCX )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL STPSV( UPLO, TRANS, DIAG, N, AA, XX,
+     $                                    INCX )
+                           END IF
+                        END IF
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9992 )
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLO.EQ.UPLOS
+                        ISAME( 2 ) = TRANS.EQ.TRANSS
+                        ISAME( 3 ) = DIAG.EQ.DIAGS
+                        ISAME( 4 ) = NS.EQ.N
+                        IF( FULL )THEN
+                           ISAME( 5 ) = LSE( AS, AA, LAA )
+                           ISAME( 6 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 7 ) = LSE( XS, XX, LX )
+                           ELSE
+                              ISAME( 7 ) = LSERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 8 ) = INCXS.EQ.INCX
+                        ELSE IF( BANDED )THEN
+                           ISAME( 5 ) = KS.EQ.K
+                           ISAME( 6 ) = LSE( AS, AA, LAA )
+                           ISAME( 7 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 8 ) = LSE( XS, XX, LX )
+                           ELSE
+                              ISAME( 8 ) = LSERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 9 ) = INCXS.EQ.INCX
+                        ELSE IF( PACKED )THEN
+                           ISAME( 5 ) = LSE( AS, AA, LAA )
+                           IF( NULL )THEN
+                              ISAME( 6 ) = LSE( XS, XX, LX )
+                           ELSE
+                              ISAME( 6 ) = LSERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 7 ) = INCXS.EQ.INCX
+                        END IF
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+                           IF( SNAME( 4: 5 ).EQ.'MV' )THEN
+*
+*                             Check the result.
+*
+                              CALL SMVCH( TRANS, N, N, ONE, A, NMAX, X,
+     $                                    INCX, ZERO, Z, INCX, XT, G,
+     $                                    XX, EPS, ERR, FATAL, NOUT,
+     $                                    .TRUE. )
+                           ELSE IF( SNAME( 4: 5 ).EQ.'SV' )THEN
+*
+*                             Compute approximation to original vector.
+*
+                              DO 50 I = 1, N
+                                 Z( I ) = XX( 1 + ( I - 1 )*
+     $                                    ABS( INCX ) )
+                                 XX( 1 + ( I - 1 )*ABS( INCX ) )
+     $                              = X( I )
+   50                         CONTINUE
+                              CALL SMVCH( TRANS, N, N, ONE, A, NMAX, Z,
+     $                                    INCX, ZERO, X, INCX, XT, G,
+     $                                    XX, EPS, ERR, FATAL, NOUT,
+     $                                    .FALSE. )
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 120
+                        ELSE
+*                          Avoid repeating tests with N.le.0.
+                           GO TO 110
+                        END IF
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, DIAG, N, LDA,
+     $      INCX
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, DIAG, N, K,
+     $      LDA, INCX
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANS, DIAG, N, INCX
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', AP, ',
+     $      'X,', I2, ')                        .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), 2( I3, ',' ),
+     $      ' A,', I3, ', X,', I2, ')                 .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', A,',
+     $      I3, ', X,', I2, ')                     .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK3.
+*
+      END
+      SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests SGER.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      REAL               ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
+     $                   Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, ERR, ERRMAX, TRANSL
+      INTEGER            I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX,
+     $                   IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS,
+     $                   NC, ND, NS
+      LOGICAL            NULL, RESET, SAME
+*     .. Local Arrays ..
+      REAL               W( 1 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SGER, SMAKE, SMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+*     Define the number of arguments.
+      NARGS = 9
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 120 IN = 1, NIDIM
+         N = IDIM( IN )
+         ND = N/2 + 1
+*
+         DO 110 IM = 1, 2
+            IF( IM.EQ.1 )
+     $         M = MAX( N - ND, 0 )
+            IF( IM.EQ.2 )
+     $         M = MIN( N + ND, NMAX )
+*
+*           Set LDA to 1 more than minimum value if room.
+            LDA = M
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 110
+            LAA = LDA*N
+            NULL = N.LE.0.OR.M.LE.0
+*
+            DO 100 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*M
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL SMAKE( 'GE', ' ', ' ', 1, M, X, 1, XX, ABS( INCX ),
+     $                     0, M - 1, RESET, TRANSL )
+               IF( M.GT.1 )THEN
+                  X( M/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( M/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 90 IY = 1, NINC
+                  INCY = INC( IY )
+                  LY = ABS( INCY )*N
+*
+*                 Generate the vector Y.
+*
+                  TRANSL = ZERO
+                  CALL SMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                        ABS( INCY ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     Y( N/2 ) = ZERO
+                     YY( 1 + ABS( INCY )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 80 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL SMAKE( SNAME( 2: 3 ), ' ', ' ', M, N, A, NMAX,
+     $                           AA, LDA, M - 1, N - 1, RESET, TRANSL )
+*
+                     NC = NC + 1
+*
+*                    Save every datum before calling the subroutine.
+*
+                     MS = M
+                     NS = N
+                     ALS = ALPHA
+                     DO 10 I = 1, LAA
+                        AS( I ) = AA( I )
+   10                CONTINUE
+                     LDAS = LDA
+                     DO 20 I = 1, LX
+                        XS( I ) = XX( I )
+   20                CONTINUE
+                     INCXS = INCX
+                     DO 30 I = 1, LY
+                        YS( I ) = YY( I )
+   30                CONTINUE
+                     INCYS = INCY
+*
+*                    Call the subroutine.
+*
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9994 )NC, SNAME, M, N,
+     $                  ALPHA, INCX, INCY, LDA
+                     IF( REWI )
+     $                  REWIND NTRA
+                     CALL SGER( M, N, ALPHA, XX, INCX, YY, INCY, AA,
+     $                          LDA )
+*
+*                    Check if error-exit was taken incorrectly.
+*
+                     IF( .NOT.OK )THEN
+                        WRITE( NOUT, FMT = 9993 )
+                        FATAL = .TRUE.
+                        GO TO 140
+                     END IF
+*
+*                    See what data changed inside subroutine.
+*
+                     ISAME( 1 ) = MS.EQ.M
+                     ISAME( 2 ) = NS.EQ.N
+                     ISAME( 3 ) = ALS.EQ.ALPHA
+                     ISAME( 4 ) = LSE( XS, XX, LX )
+                     ISAME( 5 ) = INCXS.EQ.INCX
+                     ISAME( 6 ) = LSE( YS, YY, LY )
+                     ISAME( 7 ) = INCYS.EQ.INCY
+                     IF( NULL )THEN
+                        ISAME( 8 ) = LSE( AS, AA, LAA )
+                     ELSE
+                        ISAME( 8 ) = LSERES( 'GE', ' ', M, N, AS, AA,
+     $                               LDA )
+                     END IF
+                     ISAME( 9 ) = LDAS.EQ.LDA
+*
+*                    If data was incorrectly changed, report and return.
+*
+                     SAME = .TRUE.
+                     DO 40 I = 1, NARGS
+                        SAME = SAME.AND.ISAME( I )
+                        IF( .NOT.ISAME( I ) )
+     $                     WRITE( NOUT, FMT = 9998 )I
+   40                CONTINUE
+                     IF( .NOT.SAME )THEN
+                        FATAL = .TRUE.
+                        GO TO 140
+                     END IF
+*
+                     IF( .NOT.NULL )THEN
+*
+*                       Check the result column by column.
+*
+                        IF( INCX.GT.0 )THEN
+                           DO 50 I = 1, M
+                              Z( I ) = X( I )
+   50                      CONTINUE
+                        ELSE
+                           DO 60 I = 1, M
+                              Z( I ) = X( M - I + 1 )
+   60                      CONTINUE
+                        END IF
+                        DO 70 J = 1, N
+                           IF( INCY.GT.0 )THEN
+                              W( 1 ) = Y( J )
+                           ELSE
+                              W( 1 ) = Y( N - J + 1 )
+                           END IF
+                           CALL SMVCH( 'N', M, 1, ALPHA, Z, NMAX, W, 1,
+     $                                 ONE, A( 1, J ), 1, YT, G,
+     $                                 AA( 1 + ( J - 1 )*LDA ), EPS,
+     $                                 ERR, FATAL, NOUT, .TRUE. )
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 130
+   70                   CONTINUE
+                     ELSE
+*                       Avoid repeating tests with M.le.0 or N.le.0.
+                        GO TO 110
+                     END IF
+*
+   80             CONTINUE
+*
+   90          CONTINUE
+*
+  100       CONTINUE
+*
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 150
+*
+  130 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  140 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA
+*
+  150 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( I3, ',' ), F4.1, ', X,', I2,
+     $      ', Y,', I2, ', A,', I3, ')                  .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK4.
+*
+      END
+      SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests SSYR and SSPR.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      REAL               ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
+     $                   Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, ERR, ERRMAX, TRANSL
+      INTEGER            I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA,
+     $                   LDA, LDAS, LJ, LX, N, NARGS, NC, NS
+      LOGICAL            FULL, NULL, PACKED, RESET, SAME, UPPER
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      REAL               W( 1 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SMAKE, SMVCH, SSPR, SSYR
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'Y'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 7
+      ELSE IF( PACKED )THEN
+         NARGS = 6
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 100 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDA to 1 more than minimum value if room.
+         LDA = N
+         IF( LDA.LT.NMAX )
+     $      LDA = LDA + 1
+*        Skip tests if not enough room.
+         IF( LDA.GT.NMAX )
+     $      GO TO 100
+         IF( PACKED )THEN
+            LAA = ( N*( N + 1 ) )/2
+         ELSE
+            LAA = LDA*N
+         END IF
+*
+         DO 90 IC = 1, 2
+            UPLO = ICH( IC: IC )
+            UPPER = UPLO.EQ.'U'
+*
+            DO 80 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*N
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL SMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX, ABS( INCX ),
+     $                     0, N - 1, RESET, TRANSL )
+               IF( N.GT.1 )THEN
+                  X( N/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 70 IA = 1, NALF
+                  ALPHA = ALF( IA )
+                  NULL = N.LE.0.OR.ALPHA.EQ.ZERO
+*
+*                 Generate the matrix A.
+*
+                  TRANSL = ZERO
+                  CALL SMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A, NMAX,
+     $                        AA, LDA, N - 1, N - 1, RESET, TRANSL )
+*
+                  NC = NC + 1
+*
+*                 Save every datum before calling the subroutine.
+*
+                  UPLOS = UPLO
+                  NS = N
+                  ALS = ALPHA
+                  DO 10 I = 1, LAA
+                     AS( I ) = AA( I )
+   10             CONTINUE
+                  LDAS = LDA
+                  DO 20 I = 1, LX
+                     XS( I ) = XX( I )
+   20             CONTINUE
+                  INCXS = INCX
+*
+*                 Call the subroutine.
+*
+                  IF( FULL )THEN
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO, N,
+     $                  ALPHA, INCX, LDA
+                     IF( REWI )
+     $                  REWIND NTRA
+                     CALL SSYR( UPLO, N, ALPHA, XX, INCX, AA, LDA )
+                  ELSE IF( PACKED )THEN
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO, N,
+     $                  ALPHA, INCX
+                     IF( REWI )
+     $                  REWIND NTRA
+                     CALL SSPR( UPLO, N, ALPHA, XX, INCX, AA )
+                  END IF
+*
+*                 Check if error-exit was taken incorrectly.
+*
+                  IF( .NOT.OK )THEN
+                     WRITE( NOUT, FMT = 9992 )
+                     FATAL = .TRUE.
+                     GO TO 120
+                  END IF
+*
+*                 See what data changed inside subroutines.
+*
+                  ISAME( 1 ) = UPLO.EQ.UPLOS
+                  ISAME( 2 ) = NS.EQ.N
+                  ISAME( 3 ) = ALS.EQ.ALPHA
+                  ISAME( 4 ) = LSE( XS, XX, LX )
+                  ISAME( 5 ) = INCXS.EQ.INCX
+                  IF( NULL )THEN
+                     ISAME( 6 ) = LSE( AS, AA, LAA )
+                  ELSE
+                     ISAME( 6 ) = LSERES( SNAME( 2: 3 ), UPLO, N, N, AS,
+     $                            AA, LDA )
+                  END IF
+                  IF( .NOT.PACKED )THEN
+                     ISAME( 7 ) = LDAS.EQ.LDA
+                  END IF
+*
+*                 If data was incorrectly changed, report and return.
+*
+                  SAME = .TRUE.
+                  DO 30 I = 1, NARGS
+                     SAME = SAME.AND.ISAME( I )
+                     IF( .NOT.ISAME( I ) )
+     $                  WRITE( NOUT, FMT = 9998 )I
+   30             CONTINUE
+                  IF( .NOT.SAME )THEN
+                     FATAL = .TRUE.
+                     GO TO 120
+                  END IF
+*
+                  IF( .NOT.NULL )THEN
+*
+*                    Check the result column by column.
+*
+                     IF( INCX.GT.0 )THEN
+                        DO 40 I = 1, N
+                           Z( I ) = X( I )
+   40                   CONTINUE
+                     ELSE
+                        DO 50 I = 1, N
+                           Z( I ) = X( N - I + 1 )
+   50                   CONTINUE
+                     END IF
+                     JA = 1
+                     DO 60 J = 1, N
+                        W( 1 ) = Z( J )
+                        IF( UPPER )THEN
+                           JJ = 1
+                           LJ = J
+                        ELSE
+                           JJ = J
+                           LJ = N - J + 1
+                        END IF
+                        CALL SMVCH( 'N', LJ, 1, ALPHA, Z( JJ ), LJ, W,
+     $                              1, ONE, A( JJ, J ), 1, YT, G,
+     $                              AA( JA ), EPS, ERR, FATAL, NOUT,
+     $                              .TRUE. )
+                        IF( FULL )THEN
+                           IF( UPPER )THEN
+                              JA = JA + LDA
+                           ELSE
+                              JA = JA + LDA + 1
+                           END IF
+                        ELSE
+                           JA = JA + LJ
+                        END IF
+                        ERRMAX = MAX( ERRMAX, ERR )
+*                       If got really bad answer, report and return.
+                        IF( FATAL )
+     $                     GO TO 110
+   60                CONTINUE
+                  ELSE
+*                    Avoid repeating tests if N.le.0.
+                     IF( N.LE.0 )
+     $                  GO TO 100
+                  END IF
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  110 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, INCX, LDA
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, ALPHA, INCX
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', AP)                           .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', A,', I3, ')                        .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK5.
+*
+      END
+      SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests SSYR2 and SSPR2.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      REAL               ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), G( NMAX ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
+     $                   Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX, 2 )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, ERR, ERRMAX, TRANSL
+      INTEGER            I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX,
+     $                   IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N,
+     $                   NARGS, NC, NS
+      LOGICAL            FULL, NULL, PACKED, RESET, SAME, UPPER
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      REAL               W( 2 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SMAKE, SMVCH, SSPR2, SSYR2
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'Y'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 9
+      ELSE IF( PACKED )THEN
+         NARGS = 8
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 140 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDA to 1 more than minimum value if room.
+         LDA = N
+         IF( LDA.LT.NMAX )
+     $      LDA = LDA + 1
+*        Skip tests if not enough room.
+         IF( LDA.GT.NMAX )
+     $      GO TO 140
+         IF( PACKED )THEN
+            LAA = ( N*( N + 1 ) )/2
+         ELSE
+            LAA = LDA*N
+         END IF
+*
+         DO 130 IC = 1, 2
+            UPLO = ICH( IC: IC )
+            UPPER = UPLO.EQ.'U'
+*
+            DO 120 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*N
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL SMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX, ABS( INCX ),
+     $                     0, N - 1, RESET, TRANSL )
+               IF( N.GT.1 )THEN
+                  X( N/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 110 IY = 1, NINC
+                  INCY = INC( IY )
+                  LY = ABS( INCY )*N
+*
+*                 Generate the vector Y.
+*
+                  TRANSL = ZERO
+                  CALL SMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                        ABS( INCY ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     Y( N/2 ) = ZERO
+                     YY( 1 + ABS( INCY )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 100 IA = 1, NALF
+                     ALPHA = ALF( IA )
+                     NULL = N.LE.0.OR.ALPHA.EQ.ZERO
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL SMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A,
+     $                           NMAX, AA, LDA, N - 1, N - 1, RESET,
+     $                           TRANSL )
+*
+                     NC = NC + 1
+*
+*                    Save every datum before calling the subroutine.
+*
+                     UPLOS = UPLO
+                     NS = N
+                     ALS = ALPHA
+                     DO 10 I = 1, LAA
+                        AS( I ) = AA( I )
+   10                CONTINUE
+                     LDAS = LDA
+                     DO 20 I = 1, LX
+                        XS( I ) = XX( I )
+   20                CONTINUE
+                     INCXS = INCX
+                     DO 30 I = 1, LY
+                        YS( I ) = YY( I )
+   30                CONTINUE
+                     INCYS = INCY
+*
+*                    Call the subroutine.
+*
+                     IF( FULL )THEN
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO, N,
+     $                     ALPHA, INCX, INCY, LDA
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL SSYR2( UPLO, N, ALPHA, XX, INCX, YY, INCY,
+     $                              AA, LDA )
+                     ELSE IF( PACKED )THEN
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO, N,
+     $                     ALPHA, INCX, INCY
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL SSPR2( UPLO, N, ALPHA, XX, INCX, YY, INCY,
+     $                              AA )
+                     END IF
+*
+*                    Check if error-exit was taken incorrectly.
+*
+                     IF( .NOT.OK )THEN
+                        WRITE( NOUT, FMT = 9992 )
+                        FATAL = .TRUE.
+                        GO TO 160
+                     END IF
+*
+*                    See what data changed inside subroutines.
+*
+                     ISAME( 1 ) = UPLO.EQ.UPLOS
+                     ISAME( 2 ) = NS.EQ.N
+                     ISAME( 3 ) = ALS.EQ.ALPHA
+                     ISAME( 4 ) = LSE( XS, XX, LX )
+                     ISAME( 5 ) = INCXS.EQ.INCX
+                     ISAME( 6 ) = LSE( YS, YY, LY )
+                     ISAME( 7 ) = INCYS.EQ.INCY
+                     IF( NULL )THEN
+                        ISAME( 8 ) = LSE( AS, AA, LAA )
+                     ELSE
+                        ISAME( 8 ) = LSERES( SNAME( 2: 3 ), UPLO, N, N,
+     $                               AS, AA, LDA )
+                     END IF
+                     IF( .NOT.PACKED )THEN
+                        ISAME( 9 ) = LDAS.EQ.LDA
+                     END IF
+*
+*                    If data was incorrectly changed, report and return.
+*
+                     SAME = .TRUE.
+                     DO 40 I = 1, NARGS
+                        SAME = SAME.AND.ISAME( I )
+                        IF( .NOT.ISAME( I ) )
+     $                     WRITE( NOUT, FMT = 9998 )I
+   40                CONTINUE
+                     IF( .NOT.SAME )THEN
+                        FATAL = .TRUE.
+                        GO TO 160
+                     END IF
+*
+                     IF( .NOT.NULL )THEN
+*
+*                       Check the result column by column.
+*
+                        IF( INCX.GT.0 )THEN
+                           DO 50 I = 1, N
+                              Z( I, 1 ) = X( I )
+   50                      CONTINUE
+                        ELSE
+                           DO 60 I = 1, N
+                              Z( I, 1 ) = X( N - I + 1 )
+   60                      CONTINUE
+                        END IF
+                        IF( INCY.GT.0 )THEN
+                           DO 70 I = 1, N
+                              Z( I, 2 ) = Y( I )
+   70                      CONTINUE
+                        ELSE
+                           DO 80 I = 1, N
+                              Z( I, 2 ) = Y( N - I + 1 )
+   80                      CONTINUE
+                        END IF
+                        JA = 1
+                        DO 90 J = 1, N
+                           W( 1 ) = Z( J, 2 )
+                           W( 2 ) = Z( J, 1 )
+                           IF( UPPER )THEN
+                              JJ = 1
+                              LJ = J
+                           ELSE
+                              JJ = J
+                              LJ = N - J + 1
+                           END IF
+                           CALL SMVCH( 'N', LJ, 2, ALPHA, Z( JJ, 1 ),
+     $                                 NMAX, W, 1, ONE, A( JJ, J ), 1,
+     $                                 YT, G, AA( JA ), EPS, ERR, FATAL,
+     $                                 NOUT, .TRUE. )
+                           IF( FULL )THEN
+                              IF( UPPER )THEN
+                                 JA = JA + LDA
+                              ELSE
+                                 JA = JA + LDA + 1
+                              END IF
+                           ELSE
+                              JA = JA + LJ
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 150
+   90                   CONTINUE
+                     ELSE
+*                       Avoid repeating tests with N.le.0.
+                        IF( N.LE.0 )
+     $                     GO TO 140
+                     END IF
+*
+  100             CONTINUE
+*
+  110          CONTINUE
+*
+  120       CONTINUE
+*
+  130    CONTINUE
+*
+  140 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 170
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  160 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, INCX,
+     $      INCY, LDA
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, ALPHA, INCX, INCY
+      END IF
+*
+  170 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', Y,', I2, ', AP)                     .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', Y,', I2, ', A,', I3, ')                  .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK6.
+*
+      END
+      SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT )
+*
+*  Tests the error exits from the Level 2 Blas.
+*  Requires a special version of the error-handling routine XERBLA.
+*  ALPHA, BETA, A, X and Y should not need to be defined.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            ISNUM, NOUT
+      CHARACTER*6        SRNAMT
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Local Scalars ..
+      REAL               ALPHA, BETA
+*     .. Local Arrays ..
+      REAL               A( 1, 1 ), X( 1 ), Y( 1 )
+*     .. External Subroutines ..
+      EXTERNAL           CHKXER, SGBMV, SGEMV, SGER, SSBMV, SSPMV, SSPR,
+     $                   SSPR2, SSYMV, SSYR, SSYR2, STBMV, STBSV, STPMV,
+     $                   STPSV, STRMV, STRSV
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+*     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
+*     if anything is wrong.
+      OK = .TRUE.
+*     LERR is set to .TRUE. by the special version of XERBLA each time
+*     it is called, and is then tested and re-set by CHKXER.
+      LERR = .FALSE.
+      GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
+     $        90, 100, 110, 120, 130, 140, 150,
+     $        160 )ISNUM
+   10 INFOT = 1
+      CALL SGEMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SGEMV( 'N', -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SGEMV( 'N', 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL SGEMV( 'N', 2, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL SGEMV( 'N', 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL SGEMV( 'N', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   20 INFOT = 1
+      CALL SGBMV( '/', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SGBMV( 'N', -1, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SGBMV( 'N', 0, -1, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SGBMV( 'N', 0, 0, -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SGBMV( 'N', 2, 0, 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL SGBMV( 'N', 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL SGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL SGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   30 INFOT = 1
+      CALL SSYMV( '/', 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SSYMV( 'U', -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SSYMV( 'U', 2, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYMV( 'U', 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL SSYMV( 'U', 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   40 INFOT = 1
+      CALL SSBMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SSBMV( 'U', -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSBMV( 'U', 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL SSBMV( 'U', 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL SSBMV( 'U', 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL SSBMV( 'U', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   50 INFOT = 1
+      CALL SSPMV( '/', 0, ALPHA, A, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SSPMV( 'U', -1, ALPHA, A, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL SSPMV( 'U', 0, ALPHA, A, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SSPMV( 'U', 0, ALPHA, A, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   60 INFOT = 1
+      CALL STRMV( '/', 'N', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL STRMV( 'U', '/', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL STRMV( 'U', 'N', '/', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL STRMV( 'U', 'N', 'N', -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRMV( 'U', 'N', 'N', 2, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL STRMV( 'U', 'N', 'N', 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   70 INFOT = 1
+      CALL STBMV( '/', 'N', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL STBMV( 'U', '/', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL STBMV( 'U', 'N', '/', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL STBMV( 'U', 'N', 'N', -1, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STBMV( 'U', 'N', 'N', 0, -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL STBMV( 'U', 'N', 'N', 0, 1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STBMV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   80 INFOT = 1
+      CALL STPMV( '/', 'N', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL STPMV( 'U', '/', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL STPMV( 'U', 'N', '/', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL STPMV( 'U', 'N', 'N', -1, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL STPMV( 'U', 'N', 'N', 0, A, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+   90 INFOT = 1
+      CALL STRSV( '/', 'N', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL STRSV( 'U', '/', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL STRSV( 'U', 'N', '/', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL STRSV( 'U', 'N', 'N', -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRSV( 'U', 'N', 'N', 2, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL STRSV( 'U', 'N', 'N', 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  100 INFOT = 1
+      CALL STBSV( '/', 'N', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL STBSV( 'U', '/', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL STBSV( 'U', 'N', '/', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL STBSV( 'U', 'N', 'N', -1, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STBSV( 'U', 'N', 'N', 0, -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL STBSV( 'U', 'N', 'N', 0, 1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STBSV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  110 INFOT = 1
+      CALL STPSV( '/', 'N', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL STPSV( 'U', '/', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL STPSV( 'U', 'N', '/', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL STPSV( 'U', 'N', 'N', -1, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL STPSV( 'U', 'N', 'N', 0, A, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  120 INFOT = 1
+      CALL SGER( -1, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SGER( 0, -1, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SGER( 0, 0, ALPHA, X, 0, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SGER( 0, 0, ALPHA, X, 1, Y, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SGER( 2, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  130 INFOT = 1
+      CALL SSYR( '/', 0, ALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SSYR( 'U', -1, ALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SSYR( 'U', 0, ALPHA, X, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYR( 'U', 2, ALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  140 INFOT = 1
+      CALL SSPR( '/', 0, ALPHA, X, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SSPR( 'U', -1, ALPHA, X, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SSPR( 'U', 0, ALPHA, X, 0, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  150 INFOT = 1
+      CALL SSYR2( '/', 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SSYR2( 'U', -1, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SSYR2( 'U', 0, ALPHA, X, 0, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYR2( 'U', 0, ALPHA, X, 1, Y, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SSYR2( 'U', 2, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 170
+  160 INFOT = 1
+      CALL SSPR2( '/', 0, ALPHA, X, 1, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SSPR2( 'U', -1, ALPHA, X, 1, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SSPR2( 'U', 0, ALPHA, X, 0, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSPR2( 'U', 0, ALPHA, X, 1, Y, 0, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+  170 IF( OK )THEN
+         WRITE( NOUT, FMT = 9999 )SRNAMT
+      ELSE
+         WRITE( NOUT, FMT = 9998 )SRNAMT
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+     $      '**' )
+*
+*     End of SCHKE.
+*
+      END
+      SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL,
+     $                  KU, RESET, TRANSL )
+*
+*  Generates values for an M by N matrix A within the bandwidth
+*  defined by KL and KU.
+*  Stores the values in the array AA in the data structure required
+*  by the routine, with unwanted elements set to rogue value.
+*
+*  TYPE is 'GE', 'GB', 'SY', 'SB', 'SP', 'TR', 'TB' OR 'TP'.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0, ONE = 1.0 )
+      REAL               ROGUE
+      PARAMETER          ( ROGUE = -1.0E10 )
+*     .. Scalar Arguments ..
+      REAL               TRANSL
+      INTEGER            KL, KU, LDA, M, N, NMAX
+      LOGICAL            RESET
+      CHARACTER*1        DIAG, UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      REAL               A( NMAX, * ), AA( * )
+*     .. Local Scalars ..
+      INTEGER            I, I1, I2, I3, IBEG, IEND, IOFF, J, KK
+      LOGICAL            GEN, LOWER, SYM, TRI, UNIT, UPPER
+*     .. External Functions ..
+      REAL               SBEG
+      EXTERNAL           SBEG
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     .. Executable Statements ..
+      GEN = TYPE( 1: 1 ).EQ.'G'
+      SYM = TYPE( 1: 1 ).EQ.'S'
+      TRI = TYPE( 1: 1 ).EQ.'T'
+      UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U'
+      LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L'
+      UNIT = TRI.AND.DIAG.EQ.'U'
+*
+*     Generate data in array A.
+*
+      DO 20 J = 1, N
+         DO 10 I = 1, M
+            IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
+     $          THEN
+               IF( ( I.LE.J.AND.J - I.LE.KU ).OR.
+     $             ( I.GE.J.AND.I - J.LE.KL ) )THEN
+                  A( I, J ) = SBEG( RESET ) + TRANSL
+               ELSE
+                  A( I, J ) = ZERO
+               END IF
+               IF( I.NE.J )THEN
+                  IF( SYM )THEN
+                     A( J, I ) = A( I, J )
+                  ELSE IF( TRI )THEN
+                     A( J, I ) = ZERO
+                  END IF
+               END IF
+            END IF
+   10    CONTINUE
+         IF( TRI )
+     $      A( J, J ) = A( J, J ) + ONE
+         IF( UNIT )
+     $      A( J, J ) = ONE
+   20 CONTINUE
+*
+*     Store elements in array AS in data structure required by routine.
+*
+      IF( TYPE.EQ.'GE' )THEN
+         DO 50 J = 1, N
+            DO 30 I = 1, M
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   30       CONTINUE
+            DO 40 I = M + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   40       CONTINUE
+   50    CONTINUE
+      ELSE IF( TYPE.EQ.'GB' )THEN
+         DO 90 J = 1, N
+            DO 60 I1 = 1, KU + 1 - J
+               AA( I1 + ( J - 1 )*LDA ) = ROGUE
+   60       CONTINUE
+            DO 70 I2 = I1, MIN( KL + KU + 1, KU + 1 + M - J )
+               AA( I2 + ( J - 1 )*LDA ) = A( I2 + J - KU - 1, J )
+   70       CONTINUE
+            DO 80 I3 = I2, LDA
+               AA( I3 + ( J - 1 )*LDA ) = ROGUE
+   80       CONTINUE
+   90    CONTINUE
+      ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN
+         DO 130 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IF( UNIT )THEN
+                  IEND = J - 1
+               ELSE
+                  IEND = J
+               END IF
+            ELSE
+               IF( UNIT )THEN
+                  IBEG = J + 1
+               ELSE
+                  IBEG = J
+               END IF
+               IEND = N
+            END IF
+            DO 100 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  100       CONTINUE
+            DO 110 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+  110       CONTINUE
+            DO 120 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  120       CONTINUE
+  130    CONTINUE
+      ELSE IF( TYPE.EQ.'SB'.OR.TYPE.EQ.'TB' )THEN
+         DO 170 J = 1, N
+            IF( UPPER )THEN
+               KK = KL + 1
+               IBEG = MAX( 1, KL + 2 - J )
+               IF( UNIT )THEN
+                  IEND = KL
+               ELSE
+                  IEND = KL + 1
+               END IF
+            ELSE
+               KK = 1
+               IF( UNIT )THEN
+                  IBEG = 2
+               ELSE
+                  IBEG = 1
+               END IF
+               IEND = MIN( KL + 1, 1 + M - J )
+            END IF
+            DO 140 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  140       CONTINUE
+            DO 150 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I + J - KK, J )
+  150       CONTINUE
+            DO 160 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  160       CONTINUE
+  170    CONTINUE
+      ELSE IF( TYPE.EQ.'SP'.OR.TYPE.EQ.'TP' )THEN
+         IOFF = 0
+         DO 190 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 180 I = IBEG, IEND
+               IOFF = IOFF + 1
+               AA( IOFF ) = A( I, J )
+               IF( I.EQ.J )THEN
+                  IF( UNIT )
+     $               AA( IOFF ) = ROGUE
+               END IF
+  180       CONTINUE
+  190    CONTINUE
+      END IF
+      RETURN
+*
+*     End of SMAKE.
+*
+      END
+      SUBROUTINE SMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y,
+     $                  INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV )
+*
+*  Checks the results of the computational tests.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0, ONE = 1.0 )
+*     .. Scalar Arguments ..
+      REAL               ALPHA, BETA, EPS, ERR
+      INTEGER            INCX, INCY, M, N, NMAX, NOUT
+      LOGICAL            FATAL, MV
+      CHARACTER*1        TRANS
+*     .. Array Arguments ..
+      REAL               A( NMAX, * ), G( * ), X( * ), Y( * ), YT( * ),
+     $                   YY( * )
+*     .. Local Scalars ..
+      REAL               ERRI
+      INTEGER            I, INCXL, INCYL, IY, J, JX, KX, KY, ML, NL
+      LOGICAL            TRAN
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, SQRT
+*     .. Executable Statements ..
+      TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C'
+      IF( TRAN )THEN
+         ML = N
+         NL = M
+      ELSE
+         ML = M
+         NL = N
+      END IF
+      IF( INCX.LT.0 )THEN
+         KX = NL
+         INCXL = -1
+      ELSE
+         KX = 1
+         INCXL = 1
+      END IF
+      IF( INCY.LT.0 )THEN
+         KY = ML
+         INCYL = -1
+      ELSE
+         KY = 1
+         INCYL = 1
+      END IF
+*
+*     Compute expected result in YT using data in A, X and Y.
+*     Compute gauges in G.
+*
+      IY = KY
+      DO 30 I = 1, ML
+         YT( IY ) = ZERO
+         G( IY ) = ZERO
+         JX = KX
+         IF( TRAN )THEN
+            DO 10 J = 1, NL
+               YT( IY ) = YT( IY ) + A( J, I )*X( JX )
+               G( IY ) = G( IY ) + ABS( A( J, I )*X( JX ) )
+               JX = JX + INCXL
+   10       CONTINUE
+         ELSE
+            DO 20 J = 1, NL
+               YT( IY ) = YT( IY ) + A( I, J )*X( JX )
+               G( IY ) = G( IY ) + ABS( A( I, J )*X( JX ) )
+               JX = JX + INCXL
+   20       CONTINUE
+         END IF
+         YT( IY ) = ALPHA*YT( IY ) + BETA*Y( IY )
+         G( IY ) = ABS( ALPHA )*G( IY ) + ABS( BETA*Y( IY ) )
+         IY = IY + INCYL
+   30 CONTINUE
+*
+*     Compute the error ratio for this result.
+*
+      ERR = ZERO
+      DO 40 I = 1, ML
+         ERRI = ABS( YT( I ) - YY( 1 + ( I - 1 )*ABS( INCY ) ) )/EPS
+         IF( G( I ).NE.ZERO )
+     $      ERRI = ERRI/G( I )
+         ERR = MAX( ERR, ERRI )
+         IF( ERR*SQRT( EPS ).GE.ONE )
+     $      GO TO 50
+   40 CONTINUE
+*     If the loop completes, all results are at least half accurate.
+      GO TO 70
+*
+*     Report fatal error.
+*
+   50 FATAL = .TRUE.
+      WRITE( NOUT, FMT = 9999 )
+      DO 60 I = 1, ML
+         IF( MV )THEN
+            WRITE( NOUT, FMT = 9998 )I, YT( I ),
+     $         YY( 1 + ( I - 1 )*ABS( INCY ) )
+         ELSE
+            WRITE( NOUT, FMT = 9998 )I, 
+     $         YY( 1 + ( I - 1 )*ABS( INCY ) ), YT(I)
+         END IF
+   60 CONTINUE
+*
+   70 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
+     $      'F ACCURATE *******', /'           EXPECTED RESULT   COMPU',
+     $      'TED RESULT' )
+ 9998 FORMAT( 1X, I7, 2G18.6 )
+*
+*     End of SMVCH.
+*
+      END
+      LOGICAL FUNCTION LSE( RI, RJ, LR )
+*
+*  Tests if two arrays are identical.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LR
+*     .. Array Arguments ..
+      REAL               RI( * ), RJ( * )
+*     .. Local Scalars ..
+      INTEGER            I
+*     .. Executable Statements ..
+      DO 10 I = 1, LR
+         IF( RI( I ).NE.RJ( I ) )
+     $      GO TO 20
+   10 CONTINUE
+      LSE = .TRUE.
+      GO TO 30
+   20 CONTINUE
+      LSE = .FALSE.
+   30 RETURN
+*
+*     End of LSE.
+*
+      END
+      LOGICAL FUNCTION LSERES( TYPE, UPLO, M, N, AA, AS, LDA )
+*
+*  Tests if selected elements in two arrays are equal.
+*
+*  TYPE is 'GE', 'SY' or 'SP'.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDA, M, N
+      CHARACTER*1        UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      REAL               AA( LDA, * ), AS( LDA, * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J
+      LOGICAL            UPPER
+*     .. Executable Statements ..
+      UPPER = UPLO.EQ.'U'
+      IF( TYPE.EQ.'GE' )THEN
+         DO 20 J = 1, N
+            DO 10 I = M + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   10       CONTINUE
+   20    CONTINUE
+      ELSE IF( TYPE.EQ.'SY' )THEN
+         DO 50 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 30 I = 1, IBEG - 1
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   30       CONTINUE
+            DO 40 I = IEND + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   40       CONTINUE
+   50    CONTINUE
+      END IF
+*
+   60 CONTINUE
+      LSERES = .TRUE.
+      GO TO 80
+   70 CONTINUE
+      LSERES = .FALSE.
+   80 RETURN
+*
+*     End of LSERES.
+*
+      END
+      REAL FUNCTION SBEG( RESET )
+*
+*  Generates random numbers uniformly distributed between -0.5 and 0.5.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      LOGICAL            RESET
+*     .. Local Scalars ..
+      INTEGER            I, IC, MI
+*     .. Save statement ..
+      SAVE               I, IC, MI
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL
+*     .. Executable Statements ..
+      IF( RESET )THEN
+*        Initialize local variables.
+         MI = 891
+         I = 7
+         IC = 0
+         RESET = .FALSE.
+      END IF
+*
+*     The sequence of values of I is bounded between 1 and 999.
+*     If initial I = 1,2,3,6,7 or 9, the period will be 50.
+*     If initial I = 4 or 8, the period will be 25.
+*     If initial I = 5, the period will be 10.
+*     IC is used to break up the period by skipping 1 value of I in 6.
+*
+      IC = IC + 1
+   10 I = I*MI
+      I = I - 1000*( I/1000 )
+      IF( IC.GE.5 )THEN
+         IC = 0
+         GO TO 10
+      END IF
+      SBEG = REAL( I - 500 )/1001.0
+      RETURN
+*
+*     End of SBEG.
+*
+      END
+      REAL FUNCTION SDIFF( X, Y )
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*
+*     .. Scalar Arguments ..
+      REAL               X, Y
+*     .. Executable Statements ..
+      SDIFF = X - Y
+      RETURN
+*
+*     End of SDIFF.
+*
+      END
+      SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+*  Tests whether XERBLA has detected an error when it should.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Executable Statements ..
+      IF( .NOT.LERR )THEN
+         WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
+         OK = .FALSE.
+      END IF
+      LERR = .FALSE.
+      RETURN
+*
+ 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
+     $      'ETECTED BY ', A6, ' *****' )
+*
+*     End of CHKXER.
+*
+      END
+      SUBROUTINE XERBLA( SRNAME, INFO )
+*
+*  This is a special version of XERBLA to be used only as part of
+*  the test program for testing error exits from the Level 2 BLAS
+*  routines.
+*
+*  XERBLA  is an error handler for the Level 2 BLAS routines.
+*
+*  It is called by the Level 2 BLAS routines if an input parameter is
+*  invalid.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO
+      CHARACTER*6        SRNAME
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUT, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Executable Statements ..
+      LERR = .TRUE.
+      IF( INFO.NE.INFOT )THEN
+         IF( INFOT.NE.0 )THEN
+            WRITE( NOUT, FMT = 9999 )INFO, INFOT
+         ELSE
+            WRITE( NOUT, FMT = 9997 )INFO
+         END IF
+         OK = .FALSE.
+      END IF
+      IF( SRNAME.NE.SRNAMT )THEN
+         WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
+         OK = .FALSE.
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
+     $      ' OF ', I2, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
+     $      'AD OF ', A6, ' *******' )
+ 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
+     $      ' *******' )
+*
+*     End of XERBLA
+*
+      END
+
diff --git a/eigen/blas/testing/sblat3.dat b/eigen/blas/testing/sblat3.dat
new file mode 100644
index 0000000..680e736
--- /dev/null
+++ b/eigen/blas/testing/sblat3.dat
@@ -0,0 +1,20 @@
+'sblat3.summ'     NAME OF SUMMARY OUTPUT FILE
+6                 UNIT NUMBER OF SUMMARY FILE
+'sblat3.snap'     NAME OF SNAPSHOT OUTPUT FILE
+-1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
+T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+16.0     THRESHOLD VALUE OF TEST RATIO
+6                 NUMBER OF VALUES OF N
+0 1 2 3 5 9       VALUES OF N
+3                 NUMBER OF VALUES OF ALPHA
+0.0 1.0 0.7       VALUES OF ALPHA
+3                 NUMBER OF VALUES OF BETA
+0.0 1.0 1.3       VALUES OF BETA
+SGEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+SSYMM  T PUT F FOR NO TEST. SAME COLUMNS.
+STRMM  T PUT F FOR NO TEST. SAME COLUMNS.
+STRSM  T PUT F FOR NO TEST. SAME COLUMNS.
+SSYRK  T PUT F FOR NO TEST. SAME COLUMNS.
+SSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
diff --git a/eigen/blas/testing/sblat3.f b/eigen/blas/testing/sblat3.f
new file mode 100644
index 0000000..325a9eb
--- /dev/null
+++ b/eigen/blas/testing/sblat3.f
@@ -0,0 +1,2823 @@
+      PROGRAM SBLAT3
+*
+*  Test program for the REAL             Level 3 Blas.
+*
+*  The program must be driven by a short data file. The first 14 records
+*  of the file are read using list-directed input, the last 6 records
+*  are read using the format ( A6, L2 ). An annotated example of a data
+*  file can be obtained by deleting the first 3 characters from the
+*  following 20 lines:
+*  'SBLAT3.SUMM'     NAME OF SUMMARY OUTPUT FILE
+*  6                 UNIT NUMBER OF SUMMARY FILE
+*  'SBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
+*  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+*  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+*  F        LOGICAL FLAG, T TO STOP ON FAILURES.
+*  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+*  16.0     THRESHOLD VALUE OF TEST RATIO
+*  6                 NUMBER OF VALUES OF N
+*  0 1 2 3 5 9       VALUES OF N
+*  3                 NUMBER OF VALUES OF ALPHA
+*  0.0 1.0 0.7       VALUES OF ALPHA
+*  3                 NUMBER OF VALUES OF BETA
+*  0.0 1.0 1.3       VALUES OF BETA
+*  SGEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  SSYMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  STRMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  STRSM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  SSYRK  T PUT F FOR NO TEST. SAME COLUMNS.
+*  SSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
+*
+*  See:
+*
+*     Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
+*     A Set of Level 3 Basic Linear Algebra Subprograms.
+*
+*     Technical Memorandum No.88 (Revision 1), Mathematics and
+*     Computer Science Division, Argonne National Laboratory, 9700
+*     South Cass Avenue, Argonne, Illinois 60439, US.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      INTEGER            NIN
+      PARAMETER          ( NIN = 5 )
+      INTEGER            NSUBS
+      PARAMETER          ( NSUBS = 6 )
+      REAL               ZERO, HALF, ONE
+      PARAMETER          ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 )
+      INTEGER            NMAX
+      PARAMETER          ( NMAX = 65 )
+      INTEGER            NIDMAX, NALMAX, NBEMAX
+      PARAMETER          ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 )
+*     .. Local Scalars ..
+      REAL               EPS, ERR, THRESH
+      INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA
+      LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
+     $                   TSTERR
+      CHARACTER*1        TRANSA, TRANSB
+      CHARACTER*6        SNAMET
+      CHARACTER*32       SNAPS, SUMMRY
+*     .. Local Arrays ..
+      REAL               AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
+     $                   ALF( NALMAX ), AS( NMAX*NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBEMAX ),
+     $                   BS( NMAX*NMAX ), C( NMAX, NMAX ),
+     $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
+     $                   G( NMAX ), W( 2*NMAX )
+      INTEGER            IDIM( NIDMAX )
+      LOGICAL            LTEST( NSUBS )
+      CHARACTER*6        SNAMES( NSUBS )
+*     .. External Functions ..
+      REAL               SDIFF
+      LOGICAL            LSE
+      EXTERNAL           SDIFF, LSE
+*     .. External Subroutines ..
+      EXTERNAL           SCHK1, SCHK2, SCHK3, SCHK4, SCHK5, SCHKE, SMMCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Data statements ..
+      DATA               SNAMES/'SGEMM ', 'SSYMM ', 'STRMM ', 'STRSM ',
+     $                   'SSYRK ', 'SSYR2K'/
+*     .. Executable Statements ..
+*
+*     Read name and unit number for summary output file and open file.
+*
+      READ( NIN, FMT = * )SUMMRY
+      READ( NIN, FMT = * )NOUT
+      OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+      NOUTC = NOUT
+*
+*     Read name and unit number for snapshot output file and open file.
+*
+      READ( NIN, FMT = * )SNAPS
+      READ( NIN, FMT = * )NTRA
+      TRACE = NTRA.GE.0
+      IF( TRACE )THEN
+         OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+      END IF
+*     Read the flag that directs rewinding of the snapshot file.
+      READ( NIN, FMT = * )REWI
+      REWI = REWI.AND.TRACE
+*     Read the flag that directs stopping on any failure.
+      READ( NIN, FMT = * )SFATAL
+*     Read the flag that indicates whether error exits are to be tested.
+      READ( NIN, FMT = * )TSTERR
+*     Read the threshold value of the test ratio
+      READ( NIN, FMT = * )THRESH
+*
+*     Read and check the parameter values for the tests.
+*
+*     Values of N
+      READ( NIN, FMT = * )NIDIM
+      IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'N', NIDMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
+      DO 10 I = 1, NIDIM
+         IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
+            WRITE( NOUT, FMT = 9996 )NMAX
+            GO TO 220
+         END IF
+   10 CONTINUE
+*     Values of ALPHA
+      READ( NIN, FMT = * )NALF
+      IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
+*     Values of BETA
+      READ( NIN, FMT = * )NBET
+      IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
+*
+*     Report values of parameters.
+*
+      WRITE( NOUT, FMT = 9995 )
+      WRITE( NOUT, FMT = 9994 )( IDIM( I ), I = 1, NIDIM )
+      WRITE( NOUT, FMT = 9993 )( ALF( I ), I = 1, NALF )
+      WRITE( NOUT, FMT = 9992 )( BET( I ), I = 1, NBET )
+      IF( .NOT.TSTERR )THEN
+         WRITE( NOUT, FMT = * )
+         WRITE( NOUT, FMT = 9984 )
+      END IF
+      WRITE( NOUT, FMT = * )
+      WRITE( NOUT, FMT = 9999 )THRESH
+      WRITE( NOUT, FMT = * )
+*
+*     Read names of subroutines and flags which indicate
+*     whether they are to be tested.
+*
+      DO 20 I = 1, NSUBS
+         LTEST( I ) = .FALSE.
+   20 CONTINUE
+   30 READ( NIN, FMT = 9988, END = 60 )SNAMET, LTESTT
+      DO 40 I = 1, NSUBS
+         IF( SNAMET.EQ.SNAMES( I ) )
+     $      GO TO 50
+   40 CONTINUE
+      WRITE( NOUT, FMT = 9990 )SNAMET
+      STOP
+   50 LTEST( I ) = LTESTT
+      GO TO 30
+*
+   60 CONTINUE
+      CLOSE ( NIN )
+*
+*     Compute EPS (the machine precision).
+*
+      EPS = ONE
+   70 CONTINUE
+      IF( SDIFF( ONE + EPS, ONE ).EQ.ZERO )
+     $   GO TO 80
+      EPS = HALF*EPS
+      GO TO 70
+   80 CONTINUE
+      EPS = EPS + EPS
+      WRITE( NOUT, FMT = 9998 )EPS
+*
+*     Check the reliability of SMMCH using exact data.
+*
+      N = MIN( 32, NMAX )
+      DO 100 J = 1, N
+         DO 90 I = 1, N
+            AB( I, J ) = MAX( I - J + 1, 0 )
+   90    CONTINUE
+         AB( J, NMAX + 1 ) = J
+         AB( 1, NMAX + J ) = J
+         C( J, 1 ) = ZERO
+  100 CONTINUE
+      DO 110 J = 1, N
+         CC( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3
+  110 CONTINUE
+*     CC holds the exact result. On exit from SMMCH CT holds
+*     the result computed by SMMCH.
+      TRANSA = 'N'
+      TRANSB = 'N'
+      CALL SMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LSE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      TRANSB = 'T'
+      CALL SMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LSE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      DO 120 J = 1, N
+         AB( J, NMAX + 1 ) = N - J + 1
+         AB( 1, NMAX + J ) = N - J + 1
+  120 CONTINUE
+      DO 130 J = 1, N
+         CC( N - J + 1 ) = J*( ( J + 1 )*J )/2 -
+     $                     ( ( J + 1 )*J*( J - 1 ) )/3
+  130 CONTINUE
+      TRANSA = 'T'
+      TRANSB = 'N'
+      CALL SMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LSE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      TRANSB = 'T'
+      CALL SMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LSE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+*
+*     Test each subroutine in turn.
+*
+      DO 200 ISNUM = 1, NSUBS
+         WRITE( NOUT, FMT = * )
+         IF( .NOT.LTEST( ISNUM ) )THEN
+*           Subprogram is not to be tested.
+            WRITE( NOUT, FMT = 9987 )SNAMES( ISNUM )
+         ELSE
+            SRNAMT = SNAMES( ISNUM )
+*           Test error exits.
+            IF( TSTERR )THEN
+               CALL SCHKE( ISNUM, SNAMES( ISNUM ), NOUT )
+               WRITE( NOUT, FMT = * )
+            END IF
+*           Test computations.
+            INFOT = 0
+            OK = .TRUE.
+            FATAL = .FALSE.
+            GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM
+*           Test SGEMM, 01.
+  140       CALL SCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test SSYMM, 02.
+  150       CALL SCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test STRMM, 03, STRSM, 04.
+  160       CALL SCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
+     $                  AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C )
+            GO TO 190
+*           Test SSYRK, 05.
+  170       CALL SCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test SSYR2K, 06.
+  180       CALL SCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
+            GO TO 190
+*
+  190       IF( FATAL.AND.SFATAL )
+     $         GO TO 210
+         END IF
+  200 CONTINUE
+      WRITE( NOUT, FMT = 9986 )
+      GO TO 230
+*
+  210 CONTINUE
+      WRITE( NOUT, FMT = 9985 )
+      GO TO 230
+*
+  220 CONTINUE
+      WRITE( NOUT, FMT = 9991 )
+*
+  230 CONTINUE
+      IF( TRACE )
+     $   CLOSE ( NTRA )
+      CLOSE ( NOUT )
+      STOP
+*
+ 9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
+     $      'S THAN', F8.2 )
+ 9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, E9.1 )
+ 9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
+     $      'THAN ', I2 )
+ 9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 )
+ 9995 FORMAT( ' TESTS OF THE REAL             LEVEL 3 BLAS', //' THE F',
+     $      'OLLOWING PARAMETER VALUES WILL BE USED:' )
+ 9994 FORMAT( '   FOR N              ', 9I6 )
+ 9993 FORMAT( '   FOR ALPHA          ', 7F6.1 )
+ 9992 FORMAT( '   FOR BETA           ', 7F6.1 )
+ 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
+     $      /' ******* TESTS ABANDONED *******' )
+ 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+     $      'ESTS ABANDONED *******' )
+ 9989 FORMAT( ' ERROR IN SMMCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
+     $      'ATED WRONGLY.', /' SMMCH WAS CALLED WITH TRANSA = ', A1,
+     $      ' AND TRANSB = ', A1, /' AND RETURNED SAME = ', L1, ' AND ',
+     $      'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
+     $      'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
+     $      '*******' )
+ 9988 FORMAT( A6, L2 )
+ 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
+ 9986 FORMAT( /' END OF TESTS' )
+ 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
+ 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
+*
+*     End of SBLAT3.
+*
+      END
+      SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests SGEMM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, BETA, BLS, ERR, ERRMAX
+      INTEGER            I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
+     $                   LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M,
+     $                   MA, MB, MS, N, NA, NARGS, NB, NC, NS
+      LOGICAL            NULL, RESET, SAME, TRANA, TRANB
+      CHARACTER*1        TRANAS, TRANBS, TRANSA, TRANSB
+      CHARACTER*3        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SGEMM, SMAKE, SMMCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'NTC'/
+*     .. Executable Statements ..
+*
+      NARGS = 13
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 110 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 100 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDC to 1 more than minimum value if room.
+            LDC = M
+            IF( LDC.LT.NMAX )
+     $         LDC = LDC + 1
+*           Skip tests if not enough room.
+            IF( LDC.GT.NMAX )
+     $         GO TO 100
+            LCC = LDC*N
+            NULL = N.LE.0.OR.M.LE.0
+*
+            DO 90 IK = 1, NIDIM
+               K = IDIM( IK )
+*
+               DO 80 ICA = 1, 3
+                  TRANSA = ICH( ICA: ICA )
+                  TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
+*
+                  IF( TRANA )THEN
+                     MA = K
+                     NA = M
+                  ELSE
+                     MA = M
+                     NA = K
+                  END IF
+*                 Set LDA to 1 more than minimum value if room.
+                  LDA = MA
+                  IF( LDA.LT.NMAX )
+     $               LDA = LDA + 1
+*                 Skip tests if not enough room.
+                  IF( LDA.GT.NMAX )
+     $               GO TO 80
+                  LAA = LDA*NA
+*
+*                 Generate the matrix A.
+*
+                  CALL SMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
+     $                        RESET, ZERO )
+*
+                  DO 70 ICB = 1, 3
+                     TRANSB = ICH( ICB: ICB )
+                     TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
+*
+                     IF( TRANB )THEN
+                        MB = N
+                        NB = K
+                     ELSE
+                        MB = K
+                        NB = N
+                     END IF
+*                    Set LDB to 1 more than minimum value if room.
+                     LDB = MB
+                     IF( LDB.LT.NMAX )
+     $                  LDB = LDB + 1
+*                    Skip tests if not enough room.
+                     IF( LDB.GT.NMAX )
+     $                  GO TO 70
+                     LBB = LDB*NB
+*
+*                    Generate the matrix B.
+*
+                     CALL SMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
+     $                           LDB, RESET, ZERO )
+*
+                     DO 60 IA = 1, NALF
+                        ALPHA = ALF( IA )
+*
+                        DO 50 IB = 1, NBET
+                           BETA = BET( IB )
+*
+*                          Generate the matrix C.
+*
+                           CALL SMAKE( 'GE', ' ', ' ', M, N, C, NMAX,
+     $                                 CC, LDC, RESET, ZERO )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           TRANAS = TRANSA
+                           TRANBS = TRANSB
+                           MS = M
+                           NS = N
+                           KS = K
+                           ALS = ALPHA
+                           DO 10 I = 1, LAA
+                              AS( I ) = AA( I )
+   10                      CONTINUE
+                           LDAS = LDA
+                           DO 20 I = 1, LBB
+                              BS( I ) = BB( I )
+   20                      CONTINUE
+                           LDBS = LDB
+                           BLS = BETA
+                           DO 30 I = 1, LCC
+                              CS( I ) = CC( I )
+   30                      CONTINUE
+                           LDCS = LDC
+*
+*                          Call the subroutine.
+*
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                        TRANSA, TRANSB, M, N, K, ALPHA, LDA, LDB,
+     $                        BETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL SGEMM( TRANSA, TRANSB, M, N, K, ALPHA,
+     $                                 AA, LDA, BB, LDB, BETA, CC, LDC )
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9994 )
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = TRANSA.EQ.TRANAS
+                           ISAME( 2 ) = TRANSB.EQ.TRANBS
+                           ISAME( 3 ) = MS.EQ.M
+                           ISAME( 4 ) = NS.EQ.N
+                           ISAME( 5 ) = KS.EQ.K
+                           ISAME( 6 ) = ALS.EQ.ALPHA
+                           ISAME( 7 ) = LSE( AS, AA, LAA )
+                           ISAME( 8 ) = LDAS.EQ.LDA
+                           ISAME( 9 ) = LSE( BS, BB, LBB )
+                           ISAME( 10 ) = LDBS.EQ.LDB
+                           ISAME( 11 ) = BLS.EQ.BETA
+                           IF( NULL )THEN
+                              ISAME( 12 ) = LSE( CS, CC, LCC )
+                           ELSE
+                              ISAME( 12 ) = LSERES( 'GE', ' ', M, N, CS,
+     $                                      CC, LDC )
+                           END IF
+                           ISAME( 13 ) = LDCS.EQ.LDC
+*
+*                          If data was incorrectly changed, report
+*                          and return.
+*
+                           SAME = .TRUE.
+                           DO 40 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   40                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+*
+*                             Check the result.
+*
+                              CALL SMMCH( TRANSA, TRANSB, M, N, K,
+     $                                    ALPHA, A, NMAX, B, NMAX, BETA,
+     $                                    C, NMAX, CT, G, CC, LDC, EPS,
+     $                                    ERR, FATAL, NOUT, .TRUE. )
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 120
+                           END IF
+*
+   50                   CONTINUE
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, M, N, K,
+     $   ALPHA, LDA, LDB, BETA, LDC
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',',
+     $      3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
+     $      'C,', I3, ').' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK1.
+*
+      END
+      SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests SSYMM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, BETA, BLS, ERR, ERRMAX
+      INTEGER            I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC,
+     $                   LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA,
+     $                   NARGS, NC, NS
+      LOGICAL            LEFT, NULL, RESET, SAME
+      CHARACTER*1        SIDE, SIDES, UPLO, UPLOS
+      CHARACTER*2        ICHS, ICHU
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SMAKE, SMMCH, SSYMM
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHS/'LR'/, ICHU/'UL'/
+*     .. Executable Statements ..
+*
+      NARGS = 12
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 100 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 90 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDC to 1 more than minimum value if room.
+            LDC = M
+            IF( LDC.LT.NMAX )
+     $         LDC = LDC + 1
+*           Skip tests if not enough room.
+            IF( LDC.GT.NMAX )
+     $         GO TO 90
+            LCC = LDC*N
+            NULL = N.LE.0.OR.M.LE.0
+*
+*           Set LDB to 1 more than minimum value if room.
+            LDB = M
+            IF( LDB.LT.NMAX )
+     $         LDB = LDB + 1
+*           Skip tests if not enough room.
+            IF( LDB.GT.NMAX )
+     $         GO TO 90
+            LBB = LDB*N
+*
+*           Generate the matrix B.
+*
+            CALL SMAKE( 'GE', ' ', ' ', M, N, B, NMAX, BB, LDB, RESET,
+     $                  ZERO )
+*
+            DO 80 ICS = 1, 2
+               SIDE = ICHS( ICS: ICS )
+               LEFT = SIDE.EQ.'L'
+*
+               IF( LEFT )THEN
+                  NA = M
+               ELSE
+                  NA = N
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = NA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 80
+               LAA = LDA*NA
+*
+               DO 70 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+*
+*                 Generate the symmetric matrix A.
+*
+                  CALL SMAKE( 'SY', UPLO, ' ', NA, NA, A, NMAX, AA, LDA,
+     $                        RESET, ZERO )
+*
+                  DO 60 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 50 IB = 1, NBET
+                        BETA = BET( IB )
+*
+*                       Generate the matrix C.
+*
+                        CALL SMAKE( 'GE', ' ', ' ', M, N, C, NMAX, CC,
+     $                              LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the
+*                       subroutine.
+*
+                        SIDES = SIDE
+                        UPLOS = UPLO
+                        MS = M
+                        NS = N
+                        ALS = ALPHA
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        DO 20 I = 1, LBB
+                           BS( I ) = BB( I )
+   20                   CONTINUE
+                        LDBS = LDB
+                        BLS = BETA
+                        DO 30 I = 1, LCC
+                           CS( I ) = CC( I )
+   30                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9995 )NC, SNAME, SIDE,
+     $                     UPLO, M, N, ALPHA, LDA, LDB, BETA, LDC
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL SSYMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
+     $                              BB, LDB, BETA, CC, LDC )
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9994 )
+                           FATAL = .TRUE.
+                           GO TO 110
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = SIDES.EQ.SIDE
+                        ISAME( 2 ) = UPLOS.EQ.UPLO
+                        ISAME( 3 ) = MS.EQ.M
+                        ISAME( 4 ) = NS.EQ.N
+                        ISAME( 5 ) = ALS.EQ.ALPHA
+                        ISAME( 6 ) = LSE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        ISAME( 8 ) = LSE( BS, BB, LBB )
+                        ISAME( 9 ) = LDBS.EQ.LDB
+                        ISAME( 10 ) = BLS.EQ.BETA
+                        IF( NULL )THEN
+                           ISAME( 11 ) = LSE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 11 ) = LSERES( 'GE', ' ', M, N, CS,
+     $                                   CC, LDC )
+                        END IF
+                        ISAME( 12 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 110
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result.
+*
+                           IF( LEFT )THEN
+                              CALL SMMCH( 'N', 'N', M, N, M, ALPHA, A,
+     $                                    NMAX, B, NMAX, BETA, C, NMAX,
+     $                                    CT, G, CC, LDC, EPS, ERR,
+     $                                    FATAL, NOUT, .TRUE. )
+                           ELSE
+                              CALL SMMCH( 'N', 'N', M, N, N, ALPHA, B,
+     $                                    NMAX, A, NMAX, BETA, C, NMAX,
+     $                                    CT, G, CC, LDC, EPS, ERR,
+     $                                    FATAL, NOUT, .TRUE. )
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and
+*                          return.
+                           IF( FATAL )
+     $                        GO TO 110
+                        END IF
+*
+   50                CONTINUE
+*
+   60             CONTINUE
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 120
+*
+  110 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, M, N, ALPHA, LDA,
+     $   LDB, BETA, LDC
+*
+  120 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ')   ',
+     $      ' .' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK2.
+*
+      END
+      SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS,
+     $                  B, BB, BS, CT, G, C )
+*
+*  Tests STRMM and STRSM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0, ONE = 1.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CT( NMAX ), G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, ERR, ERRMAX
+      INTEGER            I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB,
+     $                   LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC,
+     $                   NS
+      LOGICAL            LEFT, NULL, RESET, SAME
+      CHARACTER*1        DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO,
+     $                   UPLOS
+      CHARACTER*2        ICHD, ICHS, ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SMAKE, SMMCH, STRMM, STRSM
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/
+*     .. Executable Statements ..
+*
+      NARGS = 11
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*     Set up zero matrix for SMMCH.
+      DO 20 J = 1, NMAX
+         DO 10 I = 1, NMAX
+            C( I, J ) = ZERO
+   10    CONTINUE
+   20 CONTINUE
+*
+      DO 140 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 130 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDB to 1 more than minimum value if room.
+            LDB = M
+            IF( LDB.LT.NMAX )
+     $         LDB = LDB + 1
+*           Skip tests if not enough room.
+            IF( LDB.GT.NMAX )
+     $         GO TO 130
+            LBB = LDB*N
+            NULL = M.LE.0.OR.N.LE.0
+*
+            DO 120 ICS = 1, 2
+               SIDE = ICHS( ICS: ICS )
+               LEFT = SIDE.EQ.'L'
+               IF( LEFT )THEN
+                  NA = M
+               ELSE
+                  NA = N
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = NA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 130
+               LAA = LDA*NA
+*
+               DO 110 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+*
+                  DO 100 ICT = 1, 3
+                     TRANSA = ICHT( ICT: ICT )
+*
+                     DO 90 ICD = 1, 2
+                        DIAG = ICHD( ICD: ICD )
+*
+                        DO 80 IA = 1, NALF
+                           ALPHA = ALF( IA )
+*
+*                          Generate the matrix A.
+*
+                           CALL SMAKE( 'TR', UPLO, DIAG, NA, NA, A,
+     $                                 NMAX, AA, LDA, RESET, ZERO )
+*
+*                          Generate the matrix B.
+*
+                           CALL SMAKE( 'GE', ' ', ' ', M, N, B, NMAX,
+     $                                 BB, LDB, RESET, ZERO )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           SIDES = SIDE
+                           UPLOS = UPLO
+                           TRANAS = TRANSA
+                           DIAGS = DIAG
+                           MS = M
+                           NS = N
+                           ALS = ALPHA
+                           DO 30 I = 1, LAA
+                              AS( I ) = AA( I )
+   30                      CONTINUE
+                           LDAS = LDA
+                           DO 40 I = 1, LBB
+                              BS( I ) = BB( I )
+   40                      CONTINUE
+                           LDBS = LDB
+*
+*                          Call the subroutine.
+*
+                           IF( SNAME( 4: 5 ).EQ.'MM' )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
+     $                           LDA, LDB
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL STRMM( SIDE, UPLO, TRANSA, DIAG, M,
+     $                                    N, ALPHA, AA, LDA, BB, LDB )
+                           ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
+     $                           LDA, LDB
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL STRSM( SIDE, UPLO, TRANSA, DIAG, M,
+     $                                    N, ALPHA, AA, LDA, BB, LDB )
+                           END IF
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9994 )
+                              FATAL = .TRUE.
+                              GO TO 150
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = SIDES.EQ.SIDE
+                           ISAME( 2 ) = UPLOS.EQ.UPLO
+                           ISAME( 3 ) = TRANAS.EQ.TRANSA
+                           ISAME( 4 ) = DIAGS.EQ.DIAG
+                           ISAME( 5 ) = MS.EQ.M
+                           ISAME( 6 ) = NS.EQ.N
+                           ISAME( 7 ) = ALS.EQ.ALPHA
+                           ISAME( 8 ) = LSE( AS, AA, LAA )
+                           ISAME( 9 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 10 ) = LSE( BS, BB, LBB )
+                           ELSE
+                              ISAME( 10 ) = LSERES( 'GE', ' ', M, N, BS,
+     $                                      BB, LDB )
+                           END IF
+                           ISAME( 11 ) = LDBS.EQ.LDB
+*
+*                          If data was incorrectly changed, report and
+*                          return.
+*
+                           SAME = .TRUE.
+                           DO 50 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   50                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 150
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+                              IF( SNAME( 4: 5 ).EQ.'MM' )THEN
+*
+*                                Check the result.
+*
+                                 IF( LEFT )THEN
+                                    CALL SMMCH( TRANSA, 'N', M, N, M,
+     $                                          ALPHA, A, NMAX, B, NMAX,
+     $                                          ZERO, C, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .TRUE. )
+                                 ELSE
+                                    CALL SMMCH( 'N', TRANSA, M, N, N,
+     $                                          ALPHA, B, NMAX, A, NMAX,
+     $                                          ZERO, C, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .TRUE. )
+                                 END IF
+                              ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
+*
+*                                Compute approximation to original
+*                                matrix.
+*
+                                 DO 70 J = 1, N
+                                    DO 60 I = 1, M
+                                       C( I, J ) = BB( I + ( J - 1 )*
+     $                                             LDB )
+                                       BB( I + ( J - 1 )*LDB ) = ALPHA*
+     $                                    B( I, J )
+   60                               CONTINUE
+   70                            CONTINUE
+*
+                                 IF( LEFT )THEN
+                                    CALL SMMCH( TRANSA, 'N', M, N, M,
+     $                                          ONE, A, NMAX, C, NMAX,
+     $                                          ZERO, B, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .FALSE. )
+                                 ELSE
+                                    CALL SMMCH( 'N', TRANSA, M, N, N,
+     $                                          ONE, C, NMAX, A, NMAX,
+     $                                          ZERO, B, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .FALSE. )
+                                 END IF
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 150
+                           END IF
+*
+   80                   CONTINUE
+*
+   90                CONTINUE
+*
+  100             CONTINUE
+*
+  110          CONTINUE
+*
+  120       CONTINUE
+*
+  130    CONTINUE
+*
+  140 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 160
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, TRANSA, DIAG, M,
+     $   N, ALPHA, LDA, LDB
+*
+  160 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ', B,', I3, ')        .' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK3.
+*
+      END
+      SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests SSYRK.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, BETA, BETS, ERR, ERRMAX
+      INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
+     $                   LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA,
+     $                   NARGS, NC, NS
+      LOGICAL            NULL, RESET, SAME, TRAN, UPPER
+      CHARACTER*1        TRANS, TRANSS, UPLO, UPLOS
+      CHARACTER*2        ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SMAKE, SMMCH, SSYRK
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHT/'NTC'/, ICHU/'UL'/
+*     .. Executable Statements ..
+*
+      NARGS = 10
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 100 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDC to 1 more than minimum value if room.
+         LDC = N
+         IF( LDC.LT.NMAX )
+     $      LDC = LDC + 1
+*        Skip tests if not enough room.
+         IF( LDC.GT.NMAX )
+     $      GO TO 100
+         LCC = LDC*N
+         NULL = N.LE.0
+*
+         DO 90 IK = 1, NIDIM
+            K = IDIM( IK )
+*
+            DO 80 ICT = 1, 3
+               TRANS = ICHT( ICT: ICT )
+               TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C'
+               IF( TRAN )THEN
+                  MA = K
+                  NA = N
+               ELSE
+                  MA = N
+                  NA = K
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = MA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 80
+               LAA = LDA*NA
+*
+*              Generate the matrix A.
+*
+               CALL SMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
+     $                     RESET, ZERO )
+*
+               DO 70 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+                  UPPER = UPLO.EQ.'U'
+*
+                  DO 60 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 50 IB = 1, NBET
+                        BETA = BET( IB )
+*
+*                       Generate the matrix C.
+*
+                        CALL SMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, CC,
+     $                              LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        NS = N
+                        KS = K
+                        ALS = ALPHA
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        BETS = BETA
+                        DO 20 I = 1, LCC
+                           CS( I ) = CC( I )
+   20                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
+     $                     TRANS, N, K, ALPHA, LDA, BETA, LDC
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL SSYRK( UPLO, TRANS, N, K, ALPHA, AA, LDA,
+     $                              BETA, CC, LDC )
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9993 )
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLOS.EQ.UPLO
+                        ISAME( 2 ) = TRANSS.EQ.TRANS
+                        ISAME( 3 ) = NS.EQ.N
+                        ISAME( 4 ) = KS.EQ.K
+                        ISAME( 5 ) = ALS.EQ.ALPHA
+                        ISAME( 6 ) = LSE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        ISAME( 8 ) = BETS.EQ.BETA
+                        IF( NULL )THEN
+                           ISAME( 9 ) = LSE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 9 ) = LSERES( 'SY', UPLO, N, N, CS,
+     $                                  CC, LDC )
+                        END IF
+                        ISAME( 10 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 30 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   30                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result column by column.
+*
+                           JC = 1
+                           DO 40 J = 1, N
+                              IF( UPPER )THEN
+                                 JJ = 1
+                                 LJ = J
+                              ELSE
+                                 JJ = J
+                                 LJ = N - J + 1
+                              END IF
+                              IF( TRAN )THEN
+                                 CALL SMMCH( 'T', 'N', LJ, 1, K, ALPHA,
+     $                                       A( 1, JJ ), NMAX,
+     $                                       A( 1, J ), NMAX, BETA,
+     $                                       C( JJ, J ), NMAX, CT, G,
+     $                                       CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              ELSE
+                                 CALL SMMCH( 'N', 'T', LJ, 1, K, ALPHA,
+     $                                       A( JJ, 1 ), NMAX,
+     $                                       A( J, 1 ), NMAX, BETA,
+     $                                       C( JJ, J ), NMAX, CT, G,
+     $                                       CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              END IF
+                              IF( UPPER )THEN
+                                 JC = JC + LDC
+                              ELSE
+                                 JC = JC + LDC + 1
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 110
+   40                      CONTINUE
+                        END IF
+*
+   50                CONTINUE
+*
+   60             CONTINUE
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  110 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9995 )J
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
+     $   LDA, BETA, LDC
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')           .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK4.
+*
+      END
+      SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
+*
+*  Tests SSYR2K.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      REAL               AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
+     $                   ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
+     $                   BET( NBET ), BS( NMAX*NMAX ), C( NMAX, NMAX ),
+     $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
+     $                   G( NMAX ), W( 2*NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, BETA, BETS, ERR, ERRMAX
+      INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB,
+     $                   K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS,
+     $                   LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS
+      LOGICAL            NULL, RESET, SAME, TRAN, UPPER
+      CHARACTER*1        TRANS, TRANSS, UPLO, UPLOS
+      CHARACTER*2        ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           SMAKE, SMMCH, SSYR2K
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHT/'NTC'/, ICHU/'UL'/
+*     .. Executable Statements ..
+*
+      NARGS = 12
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 130 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDC to 1 more than minimum value if room.
+         LDC = N
+         IF( LDC.LT.NMAX )
+     $      LDC = LDC + 1
+*        Skip tests if not enough room.
+         IF( LDC.GT.NMAX )
+     $      GO TO 130
+         LCC = LDC*N
+         NULL = N.LE.0
+*
+         DO 120 IK = 1, NIDIM
+            K = IDIM( IK )
+*
+            DO 110 ICT = 1, 3
+               TRANS = ICHT( ICT: ICT )
+               TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C'
+               IF( TRAN )THEN
+                  MA = K
+                  NA = N
+               ELSE
+                  MA = N
+                  NA = K
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = MA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 110
+               LAA = LDA*NA
+*
+*              Generate the matrix A.
+*
+               IF( TRAN )THEN
+                  CALL SMAKE( 'GE', ' ', ' ', MA, NA, AB, 2*NMAX, AA,
+     $                        LDA, RESET, ZERO )
+               ELSE
+                  CALL SMAKE( 'GE', ' ', ' ', MA, NA, AB, NMAX, AA, LDA,
+     $                        RESET, ZERO )
+               END IF
+*
+*              Generate the matrix B.
+*
+               LDB = LDA
+               LBB = LAA
+               IF( TRAN )THEN
+                  CALL SMAKE( 'GE', ' ', ' ', MA, NA, AB( K + 1 ),
+     $                        2*NMAX, BB, LDB, RESET, ZERO )
+               ELSE
+                  CALL SMAKE( 'GE', ' ', ' ', MA, NA, AB( K*NMAX + 1 ),
+     $                        NMAX, BB, LDB, RESET, ZERO )
+               END IF
+*
+               DO 100 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+                  UPPER = UPLO.EQ.'U'
+*
+                  DO 90 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 80 IB = 1, NBET
+                        BETA = BET( IB )
+*
+*                       Generate the matrix C.
+*
+                        CALL SMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, CC,
+     $                              LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        NS = N
+                        KS = K
+                        ALS = ALPHA
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        DO 20 I = 1, LBB
+                           BS( I ) = BB( I )
+   20                   CONTINUE
+                        LDBS = LDB
+                        BETS = BETA
+                        DO 30 I = 1, LCC
+                           CS( I ) = CC( I )
+   30                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
+     $                     TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL SSYR2K( UPLO, TRANS, N, K, ALPHA, AA, LDA,
+     $                               BB, LDB, BETA, CC, LDC )
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9993 )
+                           FATAL = .TRUE.
+                           GO TO 150
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLOS.EQ.UPLO
+                        ISAME( 2 ) = TRANSS.EQ.TRANS
+                        ISAME( 3 ) = NS.EQ.N
+                        ISAME( 4 ) = KS.EQ.K
+                        ISAME( 5 ) = ALS.EQ.ALPHA
+                        ISAME( 6 ) = LSE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        ISAME( 8 ) = LSE( BS, BB, LBB )
+                        ISAME( 9 ) = LDBS.EQ.LDB
+                        ISAME( 10 ) = BETS.EQ.BETA
+                        IF( NULL )THEN
+                           ISAME( 11 ) = LSE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 11 ) = LSERES( 'SY', UPLO, N, N, CS,
+     $                                   CC, LDC )
+                        END IF
+                        ISAME( 12 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 150
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result column by column.
+*
+                           JJAB = 1
+                           JC = 1
+                           DO 70 J = 1, N
+                              IF( UPPER )THEN
+                                 JJ = 1
+                                 LJ = J
+                              ELSE
+                                 JJ = J
+                                 LJ = N - J + 1
+                              END IF
+                              IF( TRAN )THEN
+                                 DO 50 I = 1, K
+                                    W( I ) = AB( ( J - 1 )*2*NMAX + K +
+     $                                       I )
+                                    W( K + I ) = AB( ( J - 1 )*2*NMAX +
+     $                                           I )
+   50                            CONTINUE
+                                 CALL SMMCH( 'T', 'N', LJ, 1, 2*K,
+     $                                       ALPHA, AB( JJAB ), 2*NMAX,
+     $                                       W, 2*NMAX, BETA,
+     $                                       C( JJ, J ), NMAX, CT, G,
+     $                                       CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              ELSE
+                                 DO 60 I = 1, K
+                                    W( I ) = AB( ( K + I - 1 )*NMAX +
+     $                                       J )
+                                    W( K + I ) = AB( ( I - 1 )*NMAX +
+     $                                           J )
+   60                            CONTINUE
+                                 CALL SMMCH( 'N', 'N', LJ, 1, 2*K,
+     $                                       ALPHA, AB( JJ ), NMAX, W,
+     $                                       2*NMAX, BETA, C( JJ, J ),
+     $                                       NMAX, CT, G, CC( JC ), LDC,
+     $                                       EPS, ERR, FATAL, NOUT,
+     $                                       .TRUE. )
+                              END IF
+                              IF( UPPER )THEN
+                                 JC = JC + LDC
+                              ELSE
+                                 JC = JC + LDC + 1
+                                 IF( TRAN )
+     $                              JJAB = JJAB + 2*NMAX
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 140
+   70                      CONTINUE
+                        END IF
+*
+   80                CONTINUE
+*
+   90             CONTINUE
+*
+  100          CONTINUE
+*
+  110       CONTINUE
+*
+  120    CONTINUE
+*
+  130 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 160
+*
+  140 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9995 )J
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
+     $   LDA, LDB, BETA, LDC
+*
+  160 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ')   ',
+     $      ' .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK5.
+*
+      END
+      SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT )
+*
+*  Tests the error exits from the Level 3 Blas.
+*  Requires a special version of the error-handling routine XERBLA.
+*  ALPHA, BETA, A, B and C should not need to be defined.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            ISNUM, NOUT
+      CHARACTER*6        SRNAMT
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Local Scalars ..
+      REAL               ALPHA, BETA
+*     .. Local Arrays ..
+      REAL               A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
+*     .. External Subroutines ..
+      EXTERNAL           CHKXER, SGEMM, SSYMM, SSYR2K, SSYRK, STRMM,
+     $                   STRSM
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+*     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
+*     if anything is wrong.
+      OK = .TRUE.
+*     LERR is set to .TRUE. by the special version of XERBLA each time
+*     it is called, and is then tested and re-set by CHKXER.
+      LERR = .FALSE.
+      GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM
+   10 INFOT = 1
+      CALL SGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 1
+      CALL SGEMM( '/', 'T', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SGEMM( 'N', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SGEMM( 'T', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SGEMM( 'N', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SGEMM( 'N', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SGEMM( 'T', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SGEMM( 'T', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SGEMM( 'N', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SGEMM( 'N', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SGEMM( 'T', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SGEMM( 'T', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SGEMM( 'N', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SGEMM( 'N', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SGEMM( 'T', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL SGEMM( 'T', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL SGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL SGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL SGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL SGEMM( 'T', 'T', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL SGEMM( 'N', 'N', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL SGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL SGEMM( 'N', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL SGEMM( 'T', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL SGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL SGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL SGEMM( 'T', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL SGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 70
+   20 INFOT = 1
+      CALL SSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SSYMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL SSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL SSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL SSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL SSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 70
+   30 INFOT = 1
+      CALL STRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL STRMM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL STRMM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL STRMM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRMM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRMM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRMM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRMM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRMM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRMM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRMM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRMM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRMM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRMM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRMM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRMM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRMM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRMM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRMM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRMM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRMM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRMM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRMM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRMM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRMM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRMM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRMM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 70
+   40 INFOT = 1
+      CALL STRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL STRSM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL STRSM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL STRSM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRSM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRSM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRSM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRSM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRSM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRSM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRSM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL STRSM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRSM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRSM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRSM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRSM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRSM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRSM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRSM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL STRSM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRSM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRSM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRSM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL STRSM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRSM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRSM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRSM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL STRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 70
+   50 INFOT = 1
+      CALL SSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SSYRK( 'U', '/', 0, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYRK( 'U', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYRK( 'U', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYRK( 'L', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYRK( 'L', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYRK( 'U', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYRK( 'U', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYRK( 'L', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYRK( 'L', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYRK( 'U', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYRK( 'U', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYRK( 'L', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYRK( 'L', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL SSYRK( 'U', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL SSYRK( 'U', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL SSYRK( 'L', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL SSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 70
+   60 INFOT = 1
+      CALL SSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL SSYR2K( 'U', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYR2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYR2K( 'U', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYR2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL SSYR2K( 'L', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYR2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYR2K( 'U', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYR2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL SSYR2K( 'L', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYR2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYR2K( 'U', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYR2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL SSYR2K( 'L', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SSYR2K( 'U', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL SSYR2K( 'L', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL SSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL SSYR2K( 'U', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL SSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL SSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+   70 IF( OK )THEN
+         WRITE( NOUT, FMT = 9999 )SRNAMT
+      ELSE
+         WRITE( NOUT, FMT = 9998 )SRNAMT
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+     $      '**' )
+*
+*     End of SCHKE.
+*
+      END
+      SUBROUTINE SMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
+     $                  TRANSL )
+*
+*  Generates values for an M by N matrix A.
+*  Stores the values in the array AA in the data structure required
+*  by the routine, with unwanted elements set to rogue value.
+*
+*  TYPE is 'GE', 'SY' or 'TR'.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0, ONE = 1.0 )
+      REAL               ROGUE
+      PARAMETER          ( ROGUE = -1.0E10 )
+*     .. Scalar Arguments ..
+      REAL               TRANSL
+      INTEGER            LDA, M, N, NMAX
+      LOGICAL            RESET
+      CHARACTER*1        DIAG, UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      REAL               A( NMAX, * ), AA( * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J
+      LOGICAL            GEN, LOWER, SYM, TRI, UNIT, UPPER
+*     .. External Functions ..
+      REAL               SBEG
+      EXTERNAL           SBEG
+*     .. Executable Statements ..
+      GEN = TYPE.EQ.'GE'
+      SYM = TYPE.EQ.'SY'
+      TRI = TYPE.EQ.'TR'
+      UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U'
+      LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L'
+      UNIT = TRI.AND.DIAG.EQ.'U'
+*
+*     Generate data in array A.
+*
+      DO 20 J = 1, N
+         DO 10 I = 1, M
+            IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
+     $          THEN
+               A( I, J ) = SBEG( RESET ) + TRANSL
+               IF( I.NE.J )THEN
+*                 Set some elements to zero
+                  IF( N.GT.3.AND.J.EQ.N/2 )
+     $               A( I, J ) = ZERO
+                  IF( SYM )THEN
+                     A( J, I ) = A( I, J )
+                  ELSE IF( TRI )THEN
+                     A( J, I ) = ZERO
+                  END IF
+               END IF
+            END IF
+   10    CONTINUE
+         IF( TRI )
+     $      A( J, J ) = A( J, J ) + ONE
+         IF( UNIT )
+     $      A( J, J ) = ONE
+   20 CONTINUE
+*
+*     Store elements in array AS in data structure required by routine.
+*
+      IF( TYPE.EQ.'GE' )THEN
+         DO 50 J = 1, N
+            DO 30 I = 1, M
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   30       CONTINUE
+            DO 40 I = M + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   40       CONTINUE
+   50    CONTINUE
+      ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN
+         DO 90 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IF( UNIT )THEN
+                  IEND = J - 1
+               ELSE
+                  IEND = J
+               END IF
+            ELSE
+               IF( UNIT )THEN
+                  IBEG = J + 1
+               ELSE
+                  IBEG = J
+               END IF
+               IEND = N
+            END IF
+            DO 60 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   60       CONTINUE
+            DO 70 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   70       CONTINUE
+            DO 80 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   80       CONTINUE
+   90    CONTINUE
+      END IF
+      RETURN
+*
+*     End of SMAKE.
+*
+      END
+      SUBROUTINE SMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
+     $                  BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
+     $                  NOUT, MV )
+*
+*  Checks the results of the computational tests.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0, ONE = 1.0 )
+*     .. Scalar Arguments ..
+      REAL               ALPHA, BETA, EPS, ERR
+      INTEGER            KK, LDA, LDB, LDC, LDCC, M, N, NOUT
+      LOGICAL            FATAL, MV
+      CHARACTER*1        TRANSA, TRANSB
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), B( LDB, * ), C( LDC, * ),
+     $                   CC( LDCC, * ), CT( * ), G( * )
+*     .. Local Scalars ..
+      REAL               ERRI
+      INTEGER            I, J, K
+      LOGICAL            TRANA, TRANB
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, SQRT
+*     .. Executable Statements ..
+      TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
+      TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
+*
+*     Compute expected result, one column at a time, in CT using data
+*     in A, B and C.
+*     Compute gauges in G.
+*
+      DO 120 J = 1, N
+*
+         DO 10 I = 1, M
+            CT( I ) = ZERO
+            G( I ) = ZERO
+   10    CONTINUE
+         IF( .NOT.TRANA.AND..NOT.TRANB )THEN
+            DO 30 K = 1, KK
+               DO 20 I = 1, M
+                  CT( I ) = CT( I ) + A( I, K )*B( K, J )
+                  G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) )
+   20          CONTINUE
+   30       CONTINUE
+         ELSE IF( TRANA.AND..NOT.TRANB )THEN
+            DO 50 K = 1, KK
+               DO 40 I = 1, M
+                  CT( I ) = CT( I ) + A( K, I )*B( K, J )
+                  G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) )
+   40          CONTINUE
+   50       CONTINUE
+         ELSE IF( .NOT.TRANA.AND.TRANB )THEN
+            DO 70 K = 1, KK
+               DO 60 I = 1, M
+                  CT( I ) = CT( I ) + A( I, K )*B( J, K )
+                  G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) )
+   60          CONTINUE
+   70       CONTINUE
+         ELSE IF( TRANA.AND.TRANB )THEN
+            DO 90 K = 1, KK
+               DO 80 I = 1, M
+                  CT( I ) = CT( I ) + A( K, I )*B( J, K )
+                  G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) )
+   80          CONTINUE
+   90       CONTINUE
+         END IF
+         DO 100 I = 1, M
+            CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
+            G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) )
+  100    CONTINUE
+*
+*        Compute the error ratio for this result.
+*
+         ERR = ZERO
+         DO 110 I = 1, M
+            ERRI = ABS( CT( I ) - CC( I, J ) )/EPS
+            IF( G( I ).NE.ZERO )
+     $         ERRI = ERRI/G( I )
+            ERR = MAX( ERR, ERRI )
+            IF( ERR*SQRT( EPS ).GE.ONE )
+     $         GO TO 130
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     If the loop completes, all results are at least half accurate.
+      GO TO 150
+*
+*     Report fatal error.
+*
+  130 FATAL = .TRUE.
+      WRITE( NOUT, FMT = 9999 )
+      DO 140 I = 1, M
+         IF( MV )THEN
+            WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
+         ELSE
+            WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
+         END IF
+  140 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9997 )J
+*
+  150 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
+     $      'F ACCURATE *******', /'           EXPECTED RESULT   COMPU',
+     $      'TED RESULT' )
+ 9998 FORMAT( 1X, I7, 2G18.6 )
+ 9997 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+*
+*     End of SMMCH.
+*
+      END
+      LOGICAL FUNCTION LSE( RI, RJ, LR )
+*
+*  Tests if two arrays are identical.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LR
+*     .. Array Arguments ..
+      REAL               RI( * ), RJ( * )
+*     .. Local Scalars ..
+      INTEGER            I
+*     .. Executable Statements ..
+      DO 10 I = 1, LR
+         IF( RI( I ).NE.RJ( I ) )
+     $      GO TO 20
+   10 CONTINUE
+      LSE = .TRUE.
+      GO TO 30
+   20 CONTINUE
+      LSE = .FALSE.
+   30 RETURN
+*
+*     End of LSE.
+*
+      END
+      LOGICAL FUNCTION LSERES( TYPE, UPLO, M, N, AA, AS, LDA )
+*
+*  Tests if selected elements in two arrays are equal.
+*
+*  TYPE is 'GE' or 'SY'.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDA, M, N
+      CHARACTER*1        UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      REAL               AA( LDA, * ), AS( LDA, * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J
+      LOGICAL            UPPER
+*     .. Executable Statements ..
+      UPPER = UPLO.EQ.'U'
+      IF( TYPE.EQ.'GE' )THEN
+         DO 20 J = 1, N
+            DO 10 I = M + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   10       CONTINUE
+   20    CONTINUE
+      ELSE IF( TYPE.EQ.'SY' )THEN
+         DO 50 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 30 I = 1, IBEG - 1
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   30       CONTINUE
+            DO 40 I = IEND + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   40       CONTINUE
+   50    CONTINUE
+      END IF
+*
+   60 CONTINUE
+      LSERES = .TRUE.
+      GO TO 80
+   70 CONTINUE
+      LSERES = .FALSE.
+   80 RETURN
+*
+*     End of LSERES.
+*
+      END
+      REAL FUNCTION SBEG( RESET )
+*
+*  Generates random numbers uniformly distributed between -0.5 and 0.5.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      LOGICAL            RESET
+*     .. Local Scalars ..
+      INTEGER            I, IC, MI
+*     .. Save statement ..
+      SAVE               I, IC, MI
+*     .. Executable Statements ..
+      IF( RESET )THEN
+*        Initialize local variables.
+         MI = 891
+         I = 7
+         IC = 0
+         RESET = .FALSE.
+      END IF
+*
+*     The sequence of values of I is bounded between 1 and 999.
+*     If initial I = 1,2,3,6,7 or 9, the period will be 50.
+*     If initial I = 4 or 8, the period will be 25.
+*     If initial I = 5, the period will be 10.
+*     IC is used to break up the period by skipping 1 value of I in 6.
+*
+      IC = IC + 1
+   10 I = I*MI
+      I = I - 1000*( I/1000 )
+      IF( IC.GE.5 )THEN
+         IC = 0
+         GO TO 10
+      END IF
+      SBEG = ( I - 500 )/1001.0
+      RETURN
+*
+*     End of SBEG.
+*
+      END
+      REAL FUNCTION SDIFF( X, Y )
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      REAL               X, Y
+*     .. Executable Statements ..
+      SDIFF = X - Y
+      RETURN
+*
+*     End of SDIFF.
+*
+      END
+      SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+*  Tests whether XERBLA has detected an error when it should.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Executable Statements ..
+      IF( .NOT.LERR )THEN
+         WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
+         OK = .FALSE.
+      END IF
+      LERR = .FALSE.
+      RETURN
+*
+ 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
+     $      'ETECTED BY ', A6, ' *****' )
+*
+*     End of CHKXER.
+*
+      END
+      SUBROUTINE XERBLA( SRNAME, INFO )
+*
+*  This is a special version of XERBLA to be used only as part of
+*  the test program for testing error exits from the Level 3 BLAS
+*  routines.
+*
+*  XERBLA  is an error handler for the Level 3 BLAS routines.
+*
+*  It is called by the Level 3 BLAS routines if an input parameter is
+*  invalid.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO
+      CHARACTER*6        SRNAME
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUT, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Executable Statements ..
+      LERR = .TRUE.
+      IF( INFO.NE.INFOT )THEN
+         IF( INFOT.NE.0 )THEN
+            WRITE( NOUT, FMT = 9999 )INFO, INFOT
+         ELSE
+            WRITE( NOUT, FMT = 9997 )INFO
+         END IF
+         OK = .FALSE.
+      END IF
+      IF( SRNAME.NE.SRNAMT )THEN
+         WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
+         OK = .FALSE.
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
+     $      ' OF ', I2, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
+     $      'AD OF ', A6, ' *******' )
+ 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
+     $      ' *******' )
+*
+*     End of XERBLA
+*
+      END
+
diff --git a/eigen/blas/testing/zblat1.f b/eigen/blas/testing/zblat1.f
new file mode 100644
index 0000000..e2415e1
--- /dev/null
+++ b/eigen/blas/testing/zblat1.f
@@ -0,0 +1,681 @@
+      PROGRAM ZBLAT1
+*     Test program for the COMPLEX*16 Level 1 BLAS.
+*     Based upon the original BLAS test routine together with:
+*     F06GAF Example Program Text
+*     .. Parameters ..
+      INTEGER          NOUT
+      PARAMETER        (NOUT=6)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, MODE, N
+      LOGICAL          PASS
+*     .. Local Scalars ..
+      DOUBLE PRECISION SFAC
+      INTEGER          IC
+*     .. External Subroutines ..
+      EXTERNAL         CHECK1, CHECK2, HEADER
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Data statements ..
+      DATA             SFAC/9.765625D-4/
+*     .. Executable Statements ..
+      WRITE (NOUT,99999)
+      DO 20 IC = 1, 10
+         ICASE = IC
+         CALL HEADER
+*
+*        Initialize PASS, INCX, INCY, and MODE for a new case.
+*        The value 9999 for INCX, INCY or MODE will appear in the
+*        detailed  output, if any, for cases that do not involve
+*        these parameters.
+*
+         PASS = .TRUE.
+         INCX = 9999
+         INCY = 9999
+         MODE = 9999
+         IF (ICASE.LE.5) THEN
+            CALL CHECK2(SFAC)
+         ELSE IF (ICASE.GE.6) THEN
+            CALL CHECK1(SFAC)
+         END IF
+*        -- Print
+         IF (PASS) WRITE (NOUT,99998)
+   20 CONTINUE
+      STOP
+*
+99999 FORMAT (' Complex BLAS Test Program Results',/1X)
+99998 FORMAT ('                                    ----- PASS -----')
+      END
+      SUBROUTINE HEADER
+*     .. Parameters ..
+      INTEGER          NOUT
+      PARAMETER        (NOUT=6)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, MODE, N
+      LOGICAL          PASS
+*     .. Local Arrays ..
+      CHARACTER*6      L(10)
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Data statements ..
+      DATA             L(1)/'ZDOTC '/
+      DATA             L(2)/'ZDOTU '/
+      DATA             L(3)/'ZAXPY '/
+      DATA             L(4)/'ZCOPY '/
+      DATA             L(5)/'ZSWAP '/
+      DATA             L(6)/'DZNRM2'/
+      DATA             L(7)/'DZASUM'/
+      DATA             L(8)/'ZSCAL '/
+      DATA             L(9)/'ZDSCAL'/
+      DATA             L(10)/'IZAMAX'/
+*     .. Executable Statements ..
+      WRITE (NOUT,99999) ICASE, L(ICASE)
+      RETURN
+*
+99999 FORMAT (/' Test of subprogram number',I3,12X,A6)
+      END
+      SUBROUTINE CHECK1(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION  SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, MODE, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      COMPLEX*16        CA
+      DOUBLE PRECISION  SA
+      INTEGER           I, J, LEN, NP1
+*     .. Local Arrays ..
+      COMPLEX*16        CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
+     +                  MWPCS(5), MWPCT(5)
+      DOUBLE PRECISION  STRUE2(5), STRUE4(5)
+      INTEGER           ITRUE3(5)
+*     .. External Functions ..
+      DOUBLE PRECISION  DZASUM, DZNRM2
+      INTEGER           IZAMAX
+      EXTERNAL          DZASUM, DZNRM2, IZAMAX
+*     .. External Subroutines ..
+      EXTERNAL          ZSCAL, ZDSCAL, CTEST, ITEST1, STEST1
+*     .. Intrinsic Functions ..
+      INTRINSIC         MAX
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Data statements ..
+      DATA              SA, CA/0.3D0, (0.4D0,-0.7D0)/
+      DATA              ((CV(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
+     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
+     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
+     +                  (1.0D0,2.0D0), (0.3D0,-0.4D0), (3.0D0,4.0D0),
+     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
+     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
+     +                  (0.1D0,-0.3D0), (0.5D0,-0.1D0), (5.0D0,6.0D0),
+     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
+     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (0.1D0,0.1D0),
+     +                  (-0.6D0,0.1D0), (0.1D0,-0.3D0), (7.0D0,8.0D0),
+     +                  (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
+     +                  (7.0D0,8.0D0), (0.3D0,0.1D0), (0.1D0,0.4D0),
+     +                  (0.4D0,0.1D0), (0.1D0,0.2D0), (2.0D0,3.0D0),
+     +                  (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/
+      DATA              ((CV(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
+     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
+     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
+     +                  (4.0D0,5.0D0), (0.3D0,-0.4D0), (6.0D0,7.0D0),
+     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
+     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
+     +                  (0.1D0,-0.3D0), (8.0D0,9.0D0), (0.5D0,-0.1D0),
+     +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
+     +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (0.1D0,0.1D0),
+     +                  (3.0D0,6.0D0), (-0.6D0,0.1D0), (4.0D0,7.0D0),
+     +                  (0.1D0,-0.3D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
+     +                  (7.0D0,2.0D0), (0.3D0,0.1D0), (5.0D0,8.0D0),
+     +                  (0.1D0,0.4D0), (6.0D0,9.0D0), (0.4D0,0.1D0),
+     +                  (8.0D0,3.0D0), (0.1D0,0.2D0), (9.0D0,4.0D0)/
+      DATA              STRUE2/0.0D0, 0.5D0, 0.6D0, 0.7D0, 0.7D0/
+      DATA              STRUE4/0.0D0, 0.7D0, 1.0D0, 1.3D0, 1.7D0/
+      DATA              ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
+     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
+     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
+     +                  (1.0D0,2.0D0), (-0.16D0,-0.37D0), (3.0D0,4.0D0),
+     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
+     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
+     +                  (-0.17D0,-0.19D0), (0.13D0,-0.39D0),
+     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
+     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
+     +                  (0.11D0,-0.03D0), (-0.17D0,0.46D0),
+     +                  (-0.17D0,-0.19D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
+     +                  (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
+     +                  (0.19D0,-0.17D0), (0.32D0,0.09D0),
+     +                  (0.23D0,-0.24D0), (0.18D0,0.01D0),
+     +                  (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0),
+     +                  (2.0D0,3.0D0)/
+      DATA              ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
+     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
+     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
+     +                  (4.0D0,5.0D0), (-0.16D0,-0.37D0), (6.0D0,7.0D0),
+     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
+     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
+     +                  (-0.17D0,-0.19D0), (8.0D0,9.0D0),
+     +                  (0.13D0,-0.39D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
+     +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
+     +                  (0.11D0,-0.03D0), (3.0D0,6.0D0),
+     +                  (-0.17D0,0.46D0), (4.0D0,7.0D0),
+     +                  (-0.17D0,-0.19D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
+     +                  (7.0D0,2.0D0), (0.19D0,-0.17D0), (5.0D0,8.0D0),
+     +                  (0.32D0,0.09D0), (6.0D0,9.0D0),
+     +                  (0.23D0,-0.24D0), (8.0D0,3.0D0),
+     +                  (0.18D0,0.01D0), (9.0D0,4.0D0)/
+      DATA              ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
+     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
+     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
+     +                  (1.0D0,2.0D0), (0.09D0,-0.12D0), (3.0D0,4.0D0),
+     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
+     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
+     +                  (0.03D0,-0.09D0), (0.15D0,-0.03D0),
+     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
+     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
+     +                  (0.03D0,0.03D0), (-0.18D0,0.03D0),
+     +                  (0.03D0,-0.09D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
+     +                  (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
+     +                  (0.09D0,0.03D0), (0.03D0,0.12D0),
+     +                  (0.12D0,0.03D0), (0.03D0,0.06D0), (2.0D0,3.0D0),
+     +                  (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/
+      DATA              ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
+     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
+     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
+     +                  (4.0D0,5.0D0), (0.09D0,-0.12D0), (6.0D0,7.0D0),
+     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
+     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
+     +                  (0.03D0,-0.09D0), (8.0D0,9.0D0),
+     +                  (0.15D0,-0.03D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
+     +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
+     +                  (0.03D0,0.03D0), (3.0D0,6.0D0),
+     +                  (-0.18D0,0.03D0), (4.0D0,7.0D0),
+     +                  (0.03D0,-0.09D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
+     +                  (7.0D0,2.0D0), (0.09D0,0.03D0), (5.0D0,8.0D0),
+     +                  (0.03D0,0.12D0), (6.0D0,9.0D0), (0.12D0,0.03D0),
+     +                  (8.0D0,3.0D0), (0.03D0,0.06D0), (9.0D0,4.0D0)/
+      DATA              ITRUE3/0, 1, 2, 2, 2/
+*     .. Executable Statements ..
+      DO 60 INCX = 1, 2
+         DO 40 NP1 = 1, 5
+            N = NP1 - 1
+            LEN = 2*MAX(N,1)
+*           .. Set vector arguments ..
+            DO 20 I = 1, LEN
+               CX(I) = CV(I,NP1,INCX)
+   20       CONTINUE
+            IF (ICASE.EQ.6) THEN
+*              .. DZNRM2 ..
+               CALL STEST1(DZNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1),
+     +                     SFAC)
+            ELSE IF (ICASE.EQ.7) THEN
+*              .. DZASUM ..
+               CALL STEST1(DZASUM(N,CX,INCX),STRUE4(NP1),STRUE4(NP1),
+     +                     SFAC)
+            ELSE IF (ICASE.EQ.8) THEN
+*              .. ZSCAL ..
+               CALL ZSCAL(N,CA,CX,INCX)
+               CALL CTEST(LEN,CX,CTRUE5(1,NP1,INCX),CTRUE5(1,NP1,INCX),
+     +                    SFAC)
+            ELSE IF (ICASE.EQ.9) THEN
+*              .. ZDSCAL ..
+               CALL ZDSCAL(N,SA,CX,INCX)
+               CALL CTEST(LEN,CX,CTRUE6(1,NP1,INCX),CTRUE6(1,NP1,INCX),
+     +                    SFAC)
+            ELSE IF (ICASE.EQ.10) THEN
+*              .. IZAMAX ..
+               CALL ITEST1(IZAMAX(N,CX,INCX),ITRUE3(NP1))
+            ELSE
+               WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
+               STOP
+            END IF
+*
+   40    CONTINUE
+   60 CONTINUE
+*
+      INCX = 1
+      IF (ICASE.EQ.8) THEN
+*        ZSCAL
+*        Add a test for alpha equal to zero.
+         CA = (0.0D0,0.0D0)
+         DO 80 I = 1, 5
+            MWPCT(I) = (0.0D0,0.0D0)
+            MWPCS(I) = (1.0D0,1.0D0)
+   80    CONTINUE
+         CALL ZSCAL(5,CA,CX,INCX)
+         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
+      ELSE IF (ICASE.EQ.9) THEN
+*        ZDSCAL
+*        Add a test for alpha equal to zero.
+         SA = 0.0D0
+         DO 100 I = 1, 5
+            MWPCT(I) = (0.0D0,0.0D0)
+            MWPCS(I) = (1.0D0,1.0D0)
+  100    CONTINUE
+         CALL ZDSCAL(5,SA,CX,INCX)
+         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
+*        Add a test for alpha equal to one.
+         SA = 1.0D0
+         DO 120 I = 1, 5
+            MWPCT(I) = CX(I)
+            MWPCS(I) = CX(I)
+  120    CONTINUE
+         CALL ZDSCAL(5,SA,CX,INCX)
+         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
+*        Add a test for alpha equal to minus one.
+         SA = -1.0D0
+         DO 140 I = 1, 5
+            MWPCT(I) = -CX(I)
+            MWPCS(I) = -CX(I)
+  140    CONTINUE
+         CALL ZDSCAL(5,SA,CX,INCX)
+         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
+      END IF
+      RETURN
+      END
+      SUBROUTINE CHECK2(SFAC)
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION  SFAC
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, MODE, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      COMPLEX*16        CA
+      INTEGER           I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
+*     .. Local Arrays ..
+      COMPLEX*16        CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
+     +                  CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
+     +                  CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
+      INTEGER           INCXS(4), INCYS(4), LENS(4,2), NS(4)
+*     .. External Functions ..
+      COMPLEX*16        ZDOTC, ZDOTU
+      EXTERNAL          ZDOTC, ZDOTU
+*     .. External Subroutines ..
+      EXTERNAL          ZAXPY, ZCOPY, ZSWAP, CTEST
+*     .. Intrinsic Functions ..
+      INTRINSIC         ABS, MIN
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Data statements ..
+      DATA              CA/(0.4D0,-0.7D0)/
+      DATA              INCXS/1, 2, -2, -1/
+      DATA              INCYS/1, -2, 1, -2/
+      DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
+      DATA              NS/0, 1, 2, 4/
+      DATA              CX1/(0.7D0,-0.8D0), (-0.4D0,-0.7D0),
+     +                  (-0.1D0,-0.9D0), (0.2D0,-0.8D0),
+     +                  (-0.9D0,-0.4D0), (0.1D0,0.4D0), (-0.6D0,0.6D0)/
+      DATA              CY1/(0.6D0,-0.6D0), (-0.9D0,0.5D0),
+     +                  (0.7D0,-0.6D0), (0.1D0,-0.5D0), (-0.1D0,-0.2D0),
+     +                  (-0.5D0,-0.3D0), (0.8D0,-0.7D0)/
+      DATA              ((CT8(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.32D0,-1.41D0),
+     +                  (-1.55D0,0.5D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.32D0,-1.41D0), (-1.55D0,0.5D0),
+     +                  (0.03D0,-0.89D0), (-0.38D0,-0.96D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
+      DATA              ((CT8(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (-0.07D0,-0.89D0),
+     +                  (-0.9D0,0.5D0), (0.42D0,-1.41D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.78D0,0.06D0), (-0.9D0,0.5D0),
+     +                  (0.06D0,-0.13D0), (0.1D0,-0.5D0),
+     +                  (-0.77D0,-0.49D0), (-0.5D0,-0.3D0),
+     +                  (0.52D0,-1.51D0)/
+      DATA              ((CT8(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (-0.07D0,-0.89D0),
+     +                  (-1.18D0,-0.31D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.78D0,0.06D0), (-1.54D0,0.97D0),
+     +                  (0.03D0,-0.89D0), (-0.18D0,-1.31D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
+      DATA              ((CT8(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.32D0,-1.41D0), (-0.9D0,0.5D0),
+     +                  (0.05D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.32D0,-1.41D0),
+     +                  (-0.9D0,0.5D0), (0.05D0,-0.6D0), (0.1D0,-0.5D0),
+     +                  (-0.77D0,-0.49D0), (-0.5D0,-0.3D0),
+     +                  (0.32D0,-1.16D0)/
+      DATA              CT7/(0.0D0,0.0D0), (-0.06D0,-0.90D0),
+     +                  (0.65D0,-0.47D0), (-0.34D0,-1.22D0),
+     +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
+     +                  (-0.59D0,-1.46D0), (-1.04D0,-0.04D0),
+     +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
+     +                  (-0.83D0,0.59D0), (0.07D0,-0.37D0),
+     +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
+     +                  (-0.76D0,-1.15D0), (-1.33D0,-1.82D0)/
+      DATA              CT6/(0.0D0,0.0D0), (0.90D0,0.06D0),
+     +                  (0.91D0,-0.77D0), (1.80D0,-0.10D0),
+     +                  (0.0D0,0.0D0), (0.90D0,0.06D0), (1.45D0,0.74D0),
+     +                  (0.20D0,0.90D0), (0.0D0,0.0D0), (0.90D0,0.06D0),
+     +                  (-0.55D0,0.23D0), (0.83D0,-0.39D0),
+     +                  (0.0D0,0.0D0), (0.90D0,0.06D0), (1.04D0,0.79D0),
+     +                  (1.95D0,1.22D0)/
+      DATA              ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7D0,-0.8D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.6D0,-0.6D0), (-0.9D0,0.5D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0),
+     +                  (-0.9D0,0.5D0), (0.7D0,-0.6D0), (0.1D0,-0.5D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
+      DATA              ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7D0,-0.8D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.7D0,-0.6D0), (-0.4D0,-0.7D0),
+     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.8D0,-0.7D0),
+     +                  (-0.4D0,-0.7D0), (-0.1D0,-0.2D0),
+     +                  (0.2D0,-0.8D0), (0.7D0,-0.6D0), (0.1D0,0.4D0),
+     +                  (0.6D0,-0.6D0)/
+      DATA              ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7D0,-0.8D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (-0.9D0,0.5D0), (-0.4D0,-0.7D0),
+     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.1D0,-0.5D0),
+     +                  (-0.4D0,-0.7D0), (0.7D0,-0.6D0), (0.2D0,-0.8D0),
+     +                  (-0.9D0,0.5D0), (0.1D0,0.4D0), (0.6D0,-0.6D0)/
+      DATA              ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7D0,-0.8D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.6D0,-0.6D0), (0.7D0,-0.6D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0),
+     +                  (0.7D0,-0.6D0), (-0.1D0,-0.2D0), (0.8D0,-0.7D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
+      DATA              ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.4D0,-0.7D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0),
+     +                  (-0.4D0,-0.7D0), (-0.1D0,-0.9D0),
+     +                  (0.2D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0)/
+      DATA              ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (-0.1D0,-0.9D0), (-0.9D0,0.5D0),
+     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0),
+     +                  (-0.9D0,0.5D0), (-0.9D0,-0.4D0), (0.1D0,-0.5D0),
+     +                  (-0.1D0,-0.9D0), (-0.5D0,-0.3D0),
+     +                  (0.7D0,-0.8D0)/
+      DATA              ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (-0.1D0,-0.9D0), (0.7D0,-0.8D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0),
+     +                  (-0.9D0,-0.4D0), (-0.1D0,-0.9D0),
+     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0)/
+      DATA              ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.9D0,0.5D0),
+     +                  (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0),
+     +                  (-0.9D0,0.5D0), (-0.4D0,-0.7D0), (0.1D0,-0.5D0),
+     +                  (-0.1D0,-0.9D0), (-0.5D0,-0.3D0),
+     +                  (0.2D0,-0.8D0)/
+      DATA              CSIZE1/(0.0D0,0.0D0), (0.9D0,0.9D0),
+     +                  (1.63D0,1.73D0), (2.90D0,2.78D0)/
+      DATA              CSIZE3/(0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (1.17D0,1.17D0),
+     +                  (1.17D0,1.17D0), (1.17D0,1.17D0),
+     +                  (1.17D0,1.17D0), (1.17D0,1.17D0),
+     +                  (1.17D0,1.17D0), (1.17D0,1.17D0)/
+      DATA              CSIZE2/(0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
+     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (1.54D0,1.54D0),
+     +                  (1.54D0,1.54D0), (1.54D0,1.54D0),
+     +                  (1.54D0,1.54D0), (1.54D0,1.54D0),
+     +                  (1.54D0,1.54D0), (1.54D0,1.54D0)/
+*     .. Executable Statements ..
+      DO 60 KI = 1, 4
+         INCX = INCXS(KI)
+         INCY = INCYS(KI)
+         MX = ABS(INCX)
+         MY = ABS(INCY)
+*
+         DO 40 KN = 1, 4
+            N = NS(KN)
+            KSIZE = MIN(2,KN)
+            LENX = LENS(KN,MX)
+            LENY = LENS(KN,MY)
+*           .. initialize all argument arrays ..
+            DO 20 I = 1, 7
+               CX(I) = CX1(I)
+               CY(I) = CY1(I)
+   20       CONTINUE
+            IF (ICASE.EQ.1) THEN
+*              .. ZDOTC ..
+               CDOT(1) = ZDOTC(N,CX,INCX,CY,INCY)
+               CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC)
+            ELSE IF (ICASE.EQ.2) THEN
+*              .. ZDOTU ..
+               CDOT(1) = ZDOTU(N,CX,INCX,CY,INCY)
+               CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC)
+            ELSE IF (ICASE.EQ.3) THEN
+*              .. ZAXPY ..
+               CALL ZAXPY(N,CA,CX,INCX,CY,INCY)
+               CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC)
+            ELSE IF (ICASE.EQ.4) THEN
+*              .. ZCOPY ..
+               CALL ZCOPY(N,CX,INCX,CY,INCY)
+               CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0)
+            ELSE IF (ICASE.EQ.5) THEN
+*              .. ZSWAP ..
+               CALL ZSWAP(N,CX,INCX,CY,INCY)
+               CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0D0)
+               CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0)
+            ELSE
+               WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
+               STOP
+            END IF
+*
+   40    CONTINUE
+   60 CONTINUE
+      RETURN
+      END
+      SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
+*     ********************************* STEST **************************
+*
+*     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
+*     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
+*     NEGLIGIBLE.
+*
+*     C. L. LAWSON, JPL, 1974 DEC 10
+*
+*     .. Parameters ..
+      INTEGER          NOUT
+      PARAMETER        (NOUT=6)
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION SFAC
+      INTEGER          LEN
+*     .. Array Arguments ..
+      DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
+*     .. Scalars in Common ..
+      INTEGER          ICASE, INCX, INCY, MODE, N
+      LOGICAL          PASS
+*     .. Local Scalars ..
+      DOUBLE PRECISION SD
+      INTEGER          I
+*     .. External Functions ..
+      DOUBLE PRECISION SDIFF
+      EXTERNAL         SDIFF
+*     .. Intrinsic Functions ..
+      INTRINSIC        ABS
+*     .. Common blocks ..
+      COMMON           /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Executable Statements ..
+*
+      DO 40 I = 1, LEN
+         SD = SCOMP(I) - STRUE(I)
+         IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0)
+     +       GO TO 40
+*
+*                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
+*
+         IF ( .NOT. PASS) GO TO 20
+*                             PRINT FAIL MESSAGE AND HEADER.
+         PASS = .FALSE.
+         WRITE (NOUT,99999)
+         WRITE (NOUT,99998)
+   20    WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I),
+     +     STRUE(I), SD, SSIZE(I)
+   40 CONTINUE
+      RETURN
+*
+99999 FORMAT ('                                       FAIL')
+99998 FORMAT (/' CASE  N INCX INCY MODE  I                            ',
+     +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
+     +       '     SIZE(I)',/1X)
+99997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4)
+      END
+      SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
+*     ************************* STEST1 *****************************
+*
+*     THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
+*     REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
+*     ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
+*
+*     C.L. LAWSON, JPL, 1978 DEC 6
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION  SCOMP1, SFAC, STRUE1
+*     .. Array Arguments ..
+      DOUBLE PRECISION  SSIZE(*)
+*     .. Local Arrays ..
+      DOUBLE PRECISION  SCOMP(1), STRUE(1)
+*     .. External Subroutines ..
+      EXTERNAL          STEST
+*     .. Executable Statements ..
+*
+      SCOMP(1) = SCOMP1
+      STRUE(1) = STRUE1
+      CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
+*
+      RETURN
+      END
+      DOUBLE PRECISION FUNCTION SDIFF(SA,SB)
+*     ********************************* SDIFF **************************
+*     COMPUTES DIFFERENCE OF TWO NUMBERS.  C. L. LAWSON, JPL 1974 FEB 15
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION                SA, SB
+*     .. Executable Statements ..
+      SDIFF = SA - SB
+      RETURN
+      END
+      SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC)
+*     **************************** CTEST *****************************
+*
+*     C.L. LAWSON, JPL, 1978 DEC 6
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION SFAC
+      INTEGER          LEN
+*     .. Array Arguments ..
+      COMPLEX*16       CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
+*     .. Local Scalars ..
+      INTEGER          I
+*     .. Local Arrays ..
+      DOUBLE PRECISION SCOMP(20), SSIZE(20), STRUE(20)
+*     .. External Subroutines ..
+      EXTERNAL         STEST
+*     .. Intrinsic Functions ..
+      INTRINSIC        DIMAG, DBLE
+*     .. Executable Statements ..
+      DO 20 I = 1, LEN
+         SCOMP(2*I-1) = DBLE(CCOMP(I))
+         SCOMP(2*I) = DIMAG(CCOMP(I))
+         STRUE(2*I-1) = DBLE(CTRUE(I))
+         STRUE(2*I) = DIMAG(CTRUE(I))
+         SSIZE(2*I-1) = DBLE(CSIZE(I))
+         SSIZE(2*I) = DIMAG(CSIZE(I))
+   20 CONTINUE
+*
+      CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC)
+      RETURN
+      END
+      SUBROUTINE ITEST1(ICOMP,ITRUE)
+*     ********************************* ITEST1 *************************
+*
+*     THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
+*     EQUALITY.
+*     C. L. LAWSON, JPL, 1974 DEC 10
+*
+*     .. Parameters ..
+      INTEGER           NOUT
+      PARAMETER         (NOUT=6)
+*     .. Scalar Arguments ..
+      INTEGER           ICOMP, ITRUE
+*     .. Scalars in Common ..
+      INTEGER           ICASE, INCX, INCY, MODE, N
+      LOGICAL           PASS
+*     .. Local Scalars ..
+      INTEGER           ID
+*     .. Common blocks ..
+      COMMON            /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
+*     .. Executable Statements ..
+      IF (ICOMP.EQ.ITRUE) GO TO 40
+*
+*                            HERE ICOMP IS NOT EQUAL TO ITRUE.
+*
+      IF ( .NOT. PASS) GO TO 20
+*                             PRINT FAIL MESSAGE AND HEADER.
+      PASS = .FALSE.
+      WRITE (NOUT,99999)
+      WRITE (NOUT,99998)
+   20 ID = ICOMP - ITRUE
+      WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID
+   40 CONTINUE
+      RETURN
+*
+99999 FORMAT ('                                       FAIL')
+99998 FORMAT (/' CASE  N INCX INCY MODE                               ',
+     +       ' COMP                                TRUE     DIFFERENCE',
+     +       /1X)
+99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
+      END
diff --git a/eigen/blas/testing/zblat2.dat b/eigen/blas/testing/zblat2.dat
new file mode 100644
index 0000000..c922440
--- /dev/null
+++ b/eigen/blas/testing/zblat2.dat
@@ -0,0 +1,35 @@
+'zblat2.summ'     NAME OF SUMMARY OUTPUT FILE
+6                 UNIT NUMBER OF SUMMARY FILE
+'cbla2t.snap'     NAME OF SNAPSHOT OUTPUT FILE
+-1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
+T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+16.0     THRESHOLD VALUE OF TEST RATIO
+6                 NUMBER OF VALUES OF N
+0 1 2 3 5 9       VALUES OF N
+4                 NUMBER OF VALUES OF K
+0 1 2 4           VALUES OF K
+4                 NUMBER OF VALUES OF INCX AND INCY
+1 2 -1 -2         VALUES OF INCX AND INCY
+3                 NUMBER OF VALUES OF ALPHA
+(0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
+3                 NUMBER OF VALUES OF BETA
+(0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
+ZGEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZGBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZHEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZHBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZHPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZTRMV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZTBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZTPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZTRSV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZTBSV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZTPSV  T PUT F FOR NO TEST. SAME COLUMNS.
+ZGERC  T PUT F FOR NO TEST. SAME COLUMNS.
+ZGERU  T PUT F FOR NO TEST. SAME COLUMNS.
+ZHER   T PUT F FOR NO TEST. SAME COLUMNS.
+ZHPR   T PUT F FOR NO TEST. SAME COLUMNS.
+ZHER2  T PUT F FOR NO TEST. SAME COLUMNS.
+ZHPR2  T PUT F FOR NO TEST. SAME COLUMNS.
diff --git a/eigen/blas/testing/zblat2.f b/eigen/blas/testing/zblat2.f
new file mode 100644
index 0000000..e65cdcc
--- /dev/null
+++ b/eigen/blas/testing/zblat2.f
@@ -0,0 +1,3249 @@
+      PROGRAM ZBLAT2
+*
+*  Test program for the COMPLEX*16       Level 2 Blas.
+*
+*  The program must be driven by a short data file. The first 18 records
+*  of the file are read using list-directed input, the last 17 records
+*  are read using the format ( A6, L2 ). An annotated example of a data
+*  file can be obtained by deleting the first 3 characters from the
+*  following 35 lines:
+*  'ZBLAT2.SUMM'     NAME OF SUMMARY OUTPUT FILE
+*  6                 UNIT NUMBER OF SUMMARY FILE
+*  'CBLA2T.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
+*  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+*  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+*  F        LOGICAL FLAG, T TO STOP ON FAILURES.
+*  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+*  16.0     THRESHOLD VALUE OF TEST RATIO
+*  6                 NUMBER OF VALUES OF N
+*  0 1 2 3 5 9       VALUES OF N
+*  4                 NUMBER OF VALUES OF K
+*  0 1 2 4           VALUES OF K
+*  4                 NUMBER OF VALUES OF INCX AND INCY
+*  1 2 -1 -2         VALUES OF INCX AND INCY
+*  3                 NUMBER OF VALUES OF ALPHA
+*  (0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
+*  3                 NUMBER OF VALUES OF BETA
+*  (0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
+*  ZGEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZGBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZHEMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZHBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZHPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZTRMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZTBMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZTPMV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZTRSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZTBSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZTPSV  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZGERC  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZGERU  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZHER   T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZHPR   T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZHER2  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZHPR2  T PUT F FOR NO TEST. SAME COLUMNS.
+*
+*     See:
+*
+*        Dongarra J. J., Du Croz J. J., Hammarling S.  and Hanson R. J..
+*        An  extended  set of Fortran  Basic Linear Algebra Subprograms.
+*
+*        Technical  Memoranda  Nos. 41 (revision 3) and 81,  Mathematics
+*        and  Computer Science  Division,  Argonne  National Laboratory,
+*        9700 South Cass Avenue, Argonne, Illinois 60439, US.
+*
+*        Or
+*
+*        NAG  Technical Reports TR3/87 and TR4/87,  Numerical Algorithms
+*        Group  Ltd.,  NAG  Central  Office,  256  Banbury  Road, Oxford
+*        OX2 7DE, UK,  and  Numerical Algorithms Group Inc.,  1101  31st
+*        Street,  Suite 100,  Downers Grove,  Illinois 60515-1263,  USA.
+*
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      INTEGER            NIN
+      PARAMETER          ( NIN = 5 )
+      INTEGER            NSUBS
+      PARAMETER          ( NSUBS = 17 )
+      COMPLEX*16         ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   ONE = ( 1.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO, RHALF, RONE
+      PARAMETER          ( RZERO = 0.0D0, RHALF = 0.5D0, RONE = 1.0D0 )
+      INTEGER            NMAX, INCMAX
+      PARAMETER          ( NMAX = 65, INCMAX = 2 )
+      INTEGER            NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX
+      PARAMETER          ( NINMAX = 7, NIDMAX = 9, NKBMAX = 7,
+     $                   NALMAX = 7, NBEMAX = 7 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   EPS, ERR, THRESH
+      INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NINC, NKB,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
+     $                   TSTERR
+      CHARACTER*1        TRANS
+      CHARACTER*6        SNAMET
+      CHARACTER*32       SNAPS, SUMMRY
+*     .. Local Arrays ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ),
+     $                   ALF( NALMAX ), AS( NMAX*NMAX ), BET( NBEMAX ),
+     $                   X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( 2*NMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDMAX ), INC( NINMAX ), KB( NKBMAX )
+      LOGICAL            LTEST( NSUBS )
+      CHARACTER*6        SNAMES( NSUBS )
+*     .. External Functions ..
+      DOUBLE PRECISION   DDIFF
+      LOGICAL            LZE
+      EXTERNAL           DDIFF, LZE
+*     .. External Subroutines ..
+      EXTERNAL           ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHK6,
+     $                   ZCHKE, ZMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Data statements ..
+      DATA               SNAMES/'ZGEMV ', 'ZGBMV ', 'ZHEMV ', 'ZHBMV ',
+     $                   'ZHPMV ', 'ZTRMV ', 'ZTBMV ', 'ZTPMV ',
+     $                   'ZTRSV ', 'ZTBSV ', 'ZTPSV ', 'ZGERC ',
+     $                   'ZGERU ', 'ZHER  ', 'ZHPR  ', 'ZHER2 ',
+     $                   'ZHPR2 '/
+*     .. Executable Statements ..
+*
+*     Read name and unit number for summary output file and open file.
+*
+      READ( NIN, FMT = * )SUMMRY
+      READ( NIN, FMT = * )NOUT
+      OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+      NOUTC = NOUT
+*
+*     Read name and unit number for snapshot output file and open file.
+*
+      READ( NIN, FMT = * )SNAPS
+      READ( NIN, FMT = * )NTRA
+      TRACE = NTRA.GE.0
+      IF( TRACE )THEN
+         OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+      END IF
+*     Read the flag that directs rewinding of the snapshot file.
+      READ( NIN, FMT = * )REWI
+      REWI = REWI.AND.TRACE
+*     Read the flag that directs stopping on any failure.
+      READ( NIN, FMT = * )SFATAL
+*     Read the flag that indicates whether error exits are to be tested.
+      READ( NIN, FMT = * )TSTERR
+*     Read the threshold value of the test ratio
+      READ( NIN, FMT = * )THRESH
+*
+*     Read and check the parameter values for the tests.
+*
+*     Values of N
+      READ( NIN, FMT = * )NIDIM
+      IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'N', NIDMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
+      DO 10 I = 1, NIDIM
+         IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
+            WRITE( NOUT, FMT = 9996 )NMAX
+            GO TO 230
+         END IF
+   10 CONTINUE
+*     Values of K
+      READ( NIN, FMT = * )NKB
+      IF( NKB.LT.1.OR.NKB.GT.NKBMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'K', NKBMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( KB( I ), I = 1, NKB )
+      DO 20 I = 1, NKB
+         IF( KB( I ).LT.0 )THEN
+            WRITE( NOUT, FMT = 9995 )
+            GO TO 230
+         END IF
+   20 CONTINUE
+*     Values of INCX and INCY
+      READ( NIN, FMT = * )NINC
+      IF( NINC.LT.1.OR.NINC.GT.NINMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'INCX AND INCY', NINMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( INC( I ), I = 1, NINC )
+      DO 30 I = 1, NINC
+         IF( INC( I ).EQ.0.OR.ABS( INC( I ) ).GT.INCMAX )THEN
+            WRITE( NOUT, FMT = 9994 )INCMAX
+            GO TO 230
+         END IF
+   30 CONTINUE
+*     Values of ALPHA
+      READ( NIN, FMT = * )NALF
+      IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
+*     Values of BETA
+      READ( NIN, FMT = * )NBET
+      IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
+         GO TO 230
+      END IF
+      READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
+*
+*     Report values of parameters.
+*
+      WRITE( NOUT, FMT = 9993 )
+      WRITE( NOUT, FMT = 9992 )( IDIM( I ), I = 1, NIDIM )
+      WRITE( NOUT, FMT = 9991 )( KB( I ), I = 1, NKB )
+      WRITE( NOUT, FMT = 9990 )( INC( I ), I = 1, NINC )
+      WRITE( NOUT, FMT = 9989 )( ALF( I ), I = 1, NALF )
+      WRITE( NOUT, FMT = 9988 )( BET( I ), I = 1, NBET )
+      IF( .NOT.TSTERR )THEN
+         WRITE( NOUT, FMT = * )
+         WRITE( NOUT, FMT = 9980 )
+      END IF
+      WRITE( NOUT, FMT = * )
+      WRITE( NOUT, FMT = 9999 )THRESH
+      WRITE( NOUT, FMT = * )
+*
+*     Read names of subroutines and flags which indicate
+*     whether they are to be tested.
+*
+      DO 40 I = 1, NSUBS
+         LTEST( I ) = .FALSE.
+   40 CONTINUE
+   50 READ( NIN, FMT = 9984, END = 80 )SNAMET, LTESTT
+      DO 60 I = 1, NSUBS
+         IF( SNAMET.EQ.SNAMES( I ) )
+     $      GO TO 70
+   60 CONTINUE
+      WRITE( NOUT, FMT = 9986 )SNAMET
+      STOP
+   70 LTEST( I ) = LTESTT
+      GO TO 50
+*
+   80 CONTINUE
+      CLOSE ( NIN )
+*
+*     Compute EPS (the machine precision).
+*
+      EPS = RONE
+   90 CONTINUE
+      IF( DDIFF( RONE + EPS, RONE ).EQ.RZERO )
+     $   GO TO 100
+      EPS = RHALF*EPS
+      GO TO 90
+  100 CONTINUE
+      EPS = EPS + EPS
+      WRITE( NOUT, FMT = 9998 )EPS
+*
+*     Check the reliability of ZMVCH using exact data.
+*
+      N = MIN( 32, NMAX )
+      DO 120 J = 1, N
+         DO 110 I = 1, N
+            A( I, J ) = MAX( I - J + 1, 0 )
+  110    CONTINUE
+         X( J ) = J
+         Y( J ) = ZERO
+  120 CONTINUE
+      DO 130 J = 1, N
+         YY( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3
+  130 CONTINUE
+*     YY holds the exact result. On exit from ZMVCH YT holds
+*     the result computed by ZMVCH.
+      TRANS = 'N'
+      CALL ZMVCH( TRANS, N, N, ONE, A, NMAX, X, 1, ZERO, Y, 1, YT, G,
+     $            YY, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LZE( YY, YT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9985 )TRANS, SAME, ERR
+         STOP
+      END IF
+      TRANS = 'T'
+      CALL ZMVCH( TRANS, N, N, ONE, A, NMAX, X, -1, ZERO, Y, -1, YT, G,
+     $            YY, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LZE( YY, YT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9985 )TRANS, SAME, ERR
+         STOP
+      END IF
+*
+*     Test each subroutine in turn.
+*
+      DO 210 ISNUM = 1, NSUBS
+         WRITE( NOUT, FMT = * )
+         IF( .NOT.LTEST( ISNUM ) )THEN
+*           Subprogram is not to be tested.
+            WRITE( NOUT, FMT = 9983 )SNAMES( ISNUM )
+         ELSE
+            SRNAMT = SNAMES( ISNUM )
+*           Test error exits.
+            IF( TSTERR )THEN
+               CALL ZCHKE( ISNUM, SNAMES( ISNUM ), NOUT )
+               WRITE( NOUT, FMT = * )
+            END IF
+*           Test computations.
+            INFOT = 0
+            OK = .TRUE.
+            FATAL = .FALSE.
+            GO TO ( 140, 140, 150, 150, 150, 160, 160,
+     $              160, 160, 160, 160, 170, 170, 180,
+     $              180, 190, 190 )ISNUM
+*           Test ZGEMV, 01, and ZGBMV, 02.
+  140       CALL ZCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF,
+     $                  NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS,
+     $                  X, XX, XS, Y, YY, YS, YT, G )
+            GO TO 200
+*           Test ZHEMV, 03, ZHBMV, 04, and ZHPMV, 05.
+  150       CALL ZCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF,
+     $                  NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS,
+     $                  X, XX, XS, Y, YY, YS, YT, G )
+            GO TO 200
+*           Test ZTRMV, 06, ZTBMV, 07, ZTPMV, 08,
+*           ZTRSV, 09, ZTBSV, 10, and ZTPSV, 11.
+  160       CALL ZCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z )
+            GO TO 200
+*           Test ZGERC, 12, ZGERU, 13.
+  170       CALL ZCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+            GO TO 200
+*           Test ZHER, 14, and ZHPR, 15.
+  180       CALL ZCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+            GO TO 200
+*           Test ZHER2, 16, and ZHPR2, 17.
+  190       CALL ZCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC,
+     $                  NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS,
+     $                  YT, G, Z )
+*
+  200       IF( FATAL.AND.SFATAL )
+     $         GO TO 220
+         END IF
+  210 CONTINUE
+      WRITE( NOUT, FMT = 9982 )
+      GO TO 240
+*
+  220 CONTINUE
+      WRITE( NOUT, FMT = 9981 )
+      GO TO 240
+*
+  230 CONTINUE
+      WRITE( NOUT, FMT = 9987 )
+*
+  240 CONTINUE
+      IF( TRACE )
+     $   CLOSE ( NTRA )
+      CLOSE ( NOUT )
+      STOP
+*
+ 9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
+     $      'S THAN', F8.2 )
+ 9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, D9.1 )
+ 9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
+     $      'THAN ', I2 )
+ 9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 )
+ 9995 FORMAT( ' VALUE OF K IS LESS THAN 0' )
+ 9994 FORMAT( ' ABSOLUTE VALUE OF INCX OR INCY IS 0 OR GREATER THAN ',
+     $      I2 )
+ 9993 FORMAT( ' TESTS OF THE COMPLEX*16       LEVEL 2 BLAS', //' THE F',
+     $      'OLLOWING PARAMETER VALUES WILL BE USED:' )
+ 9992 FORMAT( '   FOR N              ', 9I6 )
+ 9991 FORMAT( '   FOR K              ', 7I6 )
+ 9990 FORMAT( '   FOR INCX AND INCY  ', 7I6 )
+ 9989 FORMAT( '   FOR ALPHA          ',
+     $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
+ 9988 FORMAT( '   FOR BETA           ',
+     $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
+ 9987 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
+     $      /' ******* TESTS ABANDONED *******' )
+ 9986 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+     $      'ESTS ABANDONED *******' )
+ 9985 FORMAT( ' ERROR IN ZMVCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
+     $      'ATED WRONGLY.', /' ZMVCH WAS CALLED WITH TRANS = ', A1,
+     $      ' AND RETURNED SAME = ', L1, ' AND ERR = ', F12.3, '.', /
+     $   ' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.'
+     $      , /' ******* TESTS ABANDONED *******' )
+ 9984 FORMAT( A6, L2 )
+ 9983 FORMAT( 1X, A6, ' WAS NOT TESTED' )
+ 9982 FORMAT( /' END OF TESTS' )
+ 9981 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
+ 9980 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
+*
+*     End of ZBLAT2.
+*
+      END
+      SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET,
+     $                  BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX,
+     $                  XS, Y, YY, YS, YT, G )
+*
+*  Tests ZGEMV and ZGBMV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, HALF
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   HALF = ( 0.5D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), BET( NBET ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
+     $                   Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, ALS, BETA, BLS, TRANSL
+      DOUBLE PRECISION   ERR, ERRMAX
+      INTEGER            I, IA, IB, IC, IKU, IM, IN, INCX, INCXS, INCY,
+     $                   INCYS, IX, IY, KL, KLS, KU, KUS, LAA, LDA,
+     $                   LDAS, LX, LY, M, ML, MS, N, NARGS, NC, ND, NK,
+     $                   NL, NS
+      LOGICAL            BANDED, FULL, NULL, RESET, SAME, TRAN
+      CHARACTER*1        TRANS, TRANSS
+      CHARACTER*3        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZGBMV, ZGEMV, ZMAKE, ZMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'NTC'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'E'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 11
+      ELSE IF( BANDED )THEN
+         NARGS = 13
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 120 IN = 1, NIDIM
+         N = IDIM( IN )
+         ND = N/2 + 1
+*
+         DO 110 IM = 1, 2
+            IF( IM.EQ.1 )
+     $         M = MAX( N - ND, 0 )
+            IF( IM.EQ.2 )
+     $         M = MIN( N + ND, NMAX )
+*
+            IF( BANDED )THEN
+               NK = NKB
+            ELSE
+               NK = 1
+            END IF
+            DO 100 IKU = 1, NK
+               IF( BANDED )THEN
+                  KU = KB( IKU )
+                  KL = MAX( KU - 1, 0 )
+               ELSE
+                  KU = N - 1
+                  KL = M - 1
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               IF( BANDED )THEN
+                  LDA = KL + KU + 1
+               ELSE
+                  LDA = M
+               END IF
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 100
+               LAA = LDA*N
+               NULL = N.LE.0.OR.M.LE.0
+*
+*              Generate the matrix A.
+*
+               TRANSL = ZERO
+               CALL ZMAKE( SNAME( 2: 3 ), ' ', ' ', M, N, A, NMAX, AA,
+     $                     LDA, KL, KU, RESET, TRANSL )
+*
+               DO 90 IC = 1, 3
+                  TRANS = ICH( IC: IC )
+                  TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C'
+*
+                  IF( TRAN )THEN
+                     ML = N
+                     NL = M
+                  ELSE
+                     ML = M
+                     NL = N
+                  END IF
+*
+                  DO 80 IX = 1, NINC
+                     INCX = INC( IX )
+                     LX = ABS( INCX )*NL
+*
+*                    Generate the vector X.
+*
+                     TRANSL = HALF
+                     CALL ZMAKE( 'GE', ' ', ' ', 1, NL, X, 1, XX,
+     $                           ABS( INCX ), 0, NL - 1, RESET, TRANSL )
+                     IF( NL.GT.1 )THEN
+                        X( NL/2 ) = ZERO
+                        XX( 1 + ABS( INCX )*( NL/2 - 1 ) ) = ZERO
+                     END IF
+*
+                     DO 70 IY = 1, NINC
+                        INCY = INC( IY )
+                        LY = ABS( INCY )*ML
+*
+                        DO 60 IA = 1, NALF
+                           ALPHA = ALF( IA )
+*
+                           DO 50 IB = 1, NBET
+                              BETA = BET( IB )
+*
+*                             Generate the vector Y.
+*
+                              TRANSL = ZERO
+                              CALL ZMAKE( 'GE', ' ', ' ', 1, ML, Y, 1,
+     $                                    YY, ABS( INCY ), 0, ML - 1,
+     $                                    RESET, TRANSL )
+*
+                              NC = NC + 1
+*
+*                             Save every datum before calling the
+*                             subroutine.
+*
+                              TRANSS = TRANS
+                              MS = M
+                              NS = N
+                              KLS = KL
+                              KUS = KU
+                              ALS = ALPHA
+                              DO 10 I = 1, LAA
+                                 AS( I ) = AA( I )
+   10                         CONTINUE
+                              LDAS = LDA
+                              DO 20 I = 1, LX
+                                 XS( I ) = XX( I )
+   20                         CONTINUE
+                              INCXS = INCX
+                              BLS = BETA
+                              DO 30 I = 1, LY
+                                 YS( I ) = YY( I )
+   30                         CONTINUE
+                              INCYS = INCY
+*
+*                             Call the subroutine.
+*
+                              IF( FULL )THEN
+                                 IF( TRACE )
+     $                              WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                              TRANS, M, N, ALPHA, LDA, INCX, BETA,
+     $                              INCY
+                                 IF( REWI )
+     $                              REWIND NTRA
+                                 CALL ZGEMV( TRANS, M, N, ALPHA, AA,
+     $                                       LDA, XX, INCX, BETA, YY,
+     $                                       INCY )
+                              ELSE IF( BANDED )THEN
+                                 IF( TRACE )
+     $                              WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                              TRANS, M, N, KL, KU, ALPHA, LDA,
+     $                              INCX, BETA, INCY
+                                 IF( REWI )
+     $                              REWIND NTRA
+                                 CALL ZGBMV( TRANS, M, N, KL, KU, ALPHA,
+     $                                       AA, LDA, XX, INCX, BETA,
+     $                                       YY, INCY )
+                              END IF
+*
+*                             Check if error-exit was taken incorrectly.
+*
+                              IF( .NOT.OK )THEN
+                                 WRITE( NOUT, FMT = 9993 )
+                                 FATAL = .TRUE.
+                                 GO TO 130
+                              END IF
+*
+*                             See what data changed inside subroutines.
+*
+                              ISAME( 1 ) = TRANS.EQ.TRANSS
+                              ISAME( 2 ) = MS.EQ.M
+                              ISAME( 3 ) = NS.EQ.N
+                              IF( FULL )THEN
+                                 ISAME( 4 ) = ALS.EQ.ALPHA
+                                 ISAME( 5 ) = LZE( AS, AA, LAA )
+                                 ISAME( 6 ) = LDAS.EQ.LDA
+                                 ISAME( 7 ) = LZE( XS, XX, LX )
+                                 ISAME( 8 ) = INCXS.EQ.INCX
+                                 ISAME( 9 ) = BLS.EQ.BETA
+                                 IF( NULL )THEN
+                                    ISAME( 10 ) = LZE( YS, YY, LY )
+                                 ELSE
+                                    ISAME( 10 ) = LZERES( 'GE', ' ', 1,
+     $                                            ML, YS, YY,
+     $                                            ABS( INCY ) )
+                                 END IF
+                                 ISAME( 11 ) = INCYS.EQ.INCY
+                              ELSE IF( BANDED )THEN
+                                 ISAME( 4 ) = KLS.EQ.KL
+                                 ISAME( 5 ) = KUS.EQ.KU
+                                 ISAME( 6 ) = ALS.EQ.ALPHA
+                                 ISAME( 7 ) = LZE( AS, AA, LAA )
+                                 ISAME( 8 ) = LDAS.EQ.LDA
+                                 ISAME( 9 ) = LZE( XS, XX, LX )
+                                 ISAME( 10 ) = INCXS.EQ.INCX
+                                 ISAME( 11 ) = BLS.EQ.BETA
+                                 IF( NULL )THEN
+                                    ISAME( 12 ) = LZE( YS, YY, LY )
+                                 ELSE
+                                    ISAME( 12 ) = LZERES( 'GE', ' ', 1,
+     $                                            ML, YS, YY,
+     $                                            ABS( INCY ) )
+                                 END IF
+                                 ISAME( 13 ) = INCYS.EQ.INCY
+                              END IF
+*
+*                             If data was incorrectly changed, report
+*                             and return.
+*
+                              SAME = .TRUE.
+                              DO 40 I = 1, NARGS
+                                 SAME = SAME.AND.ISAME( I )
+                                 IF( .NOT.ISAME( I ) )
+     $                              WRITE( NOUT, FMT = 9998 )I
+   40                         CONTINUE
+                              IF( .NOT.SAME )THEN
+                                 FATAL = .TRUE.
+                                 GO TO 130
+                              END IF
+*
+                              IF( .NOT.NULL )THEN
+*
+*                                Check the result.
+*
+                                 CALL ZMVCH( TRANS, M, N, ALPHA, A,
+     $                                       NMAX, X, INCX, BETA, Y,
+     $                                       INCY, YT, G, YY, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                                 ERRMAX = MAX( ERRMAX, ERR )
+*                                If got really bad answer, report and
+*                                return.
+                                 IF( FATAL )
+     $                              GO TO 130
+                              ELSE
+*                                Avoid repeating tests with M.le.0 or
+*                                N.le.0.
+                                 GO TO 110
+                              END IF
+*
+   50                      CONTINUE
+*
+   60                   CONTINUE
+*
+   70                CONTINUE
+*
+   80             CONTINUE
+*
+   90          CONTINUE
+*
+  100       CONTINUE
+*
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 140
+*
+  130 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA,
+     $      INCX, BETA, INCY
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU,
+     $      ALPHA, LDA, INCX, BETA, INCY
+      END IF
+*
+  140 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 4( I3, ',' ), '(',
+     $      F4.1, ',', F4.1, '), A,', I3, ', X,', I2, ',(', F4.1, ',',
+     $      F4.1, '), Y,', I2, ') .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), '(',
+     $      F4.1, ',', F4.1, '), A,', I3, ', X,', I2, ',(', F4.1, ',',
+     $      F4.1, '), Y,', I2, ')         .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK1.
+*
+      END
+      SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET,
+     $                  BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX,
+     $                  XS, Y, YY, YS, YT, G )
+*
+*  Tests ZHEMV, ZHBMV and ZHPMV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, HALF
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   HALF = ( 0.5D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NALF, NBET, NIDIM, NINC, NKB, NMAX,
+     $                   NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), BET( NBET ), X( NMAX ),
+     $                   XS( NMAX*INCMAX ), XX( NMAX*INCMAX ),
+     $                   Y( NMAX ), YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, ALS, BETA, BLS, TRANSL
+      DOUBLE PRECISION   ERR, ERRMAX
+      INTEGER            I, IA, IB, IC, IK, IN, INCX, INCXS, INCY,
+     $                   INCYS, IX, IY, K, KS, LAA, LDA, LDAS, LX, LY,
+     $                   N, NARGS, NC, NK, NS
+      LOGICAL            BANDED, FULL, NULL, PACKED, RESET, SAME
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZHBMV, ZHEMV, ZHPMV, ZMAKE, ZMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'E'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 10
+      ELSE IF( BANDED )THEN
+         NARGS = 11
+      ELSE IF( PACKED )THEN
+         NARGS = 9
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 110 IN = 1, NIDIM
+         N = IDIM( IN )
+*
+         IF( BANDED )THEN
+            NK = NKB
+         ELSE
+            NK = 1
+         END IF
+         DO 100 IK = 1, NK
+            IF( BANDED )THEN
+               K = KB( IK )
+            ELSE
+               K = N - 1
+            END IF
+*           Set LDA to 1 more than minimum value if room.
+            IF( BANDED )THEN
+               LDA = K + 1
+            ELSE
+               LDA = N
+            END IF
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 100
+            IF( PACKED )THEN
+               LAA = ( N*( N + 1 ) )/2
+            ELSE
+               LAA = LDA*N
+            END IF
+            NULL = N.LE.0
+*
+            DO 90 IC = 1, 2
+               UPLO = ICH( IC: IC )
+*
+*              Generate the matrix A.
+*
+               TRANSL = ZERO
+               CALL ZMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A, NMAX, AA,
+     $                     LDA, K, K, RESET, TRANSL )
+*
+               DO 80 IX = 1, NINC
+                  INCX = INC( IX )
+                  LX = ABS( INCX )*N
+*
+*                 Generate the vector X.
+*
+                  TRANSL = HALF
+                  CALL ZMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX,
+     $                        ABS( INCX ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     X( N/2 ) = ZERO
+                     XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 70 IY = 1, NINC
+                     INCY = INC( IY )
+                     LY = ABS( INCY )*N
+*
+                     DO 60 IA = 1, NALF
+                        ALPHA = ALF( IA )
+*
+                        DO 50 IB = 1, NBET
+                           BETA = BET( IB )
+*
+*                          Generate the vector Y.
+*
+                           TRANSL = ZERO
+                           CALL ZMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                                 ABS( INCY ), 0, N - 1, RESET,
+     $                                 TRANSL )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           UPLOS = UPLO
+                           NS = N
+                           KS = K
+                           ALS = ALPHA
+                           DO 10 I = 1, LAA
+                              AS( I ) = AA( I )
+   10                      CONTINUE
+                           LDAS = LDA
+                           DO 20 I = 1, LX
+                              XS( I ) = XX( I )
+   20                      CONTINUE
+                           INCXS = INCX
+                           BLS = BETA
+                           DO 30 I = 1, LY
+                              YS( I ) = YY( I )
+   30                      CONTINUE
+                           INCYS = INCY
+*
+*                          Call the subroutine.
+*
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, N, ALPHA, LDA, INCX, BETA, INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZHEMV( UPLO, N, ALPHA, AA, LDA, XX,
+     $                                    INCX, BETA, YY, INCY )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, N, K, ALPHA, LDA, INCX, BETA,
+     $                           INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZHBMV( UPLO, N, K, ALPHA, AA, LDA,
+     $                                    XX, INCX, BETA, YY, INCY )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, N, ALPHA, INCX, BETA, INCY
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZHPMV( UPLO, N, ALPHA, AA, XX, INCX,
+     $                                    BETA, YY, INCY )
+                           END IF
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9992 )
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = UPLO.EQ.UPLOS
+                           ISAME( 2 ) = NS.EQ.N
+                           IF( FULL )THEN
+                              ISAME( 3 ) = ALS.EQ.ALPHA
+                              ISAME( 4 ) = LZE( AS, AA, LAA )
+                              ISAME( 5 ) = LDAS.EQ.LDA
+                              ISAME( 6 ) = LZE( XS, XX, LX )
+                              ISAME( 7 ) = INCXS.EQ.INCX
+                              ISAME( 8 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 9 ) = LZE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 9 ) = LZERES( 'GE', ' ', 1, N,
+     $                                        YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 10 ) = INCYS.EQ.INCY
+                           ELSE IF( BANDED )THEN
+                              ISAME( 3 ) = KS.EQ.K
+                              ISAME( 4 ) = ALS.EQ.ALPHA
+                              ISAME( 5 ) = LZE( AS, AA, LAA )
+                              ISAME( 6 ) = LDAS.EQ.LDA
+                              ISAME( 7 ) = LZE( XS, XX, LX )
+                              ISAME( 8 ) = INCXS.EQ.INCX
+                              ISAME( 9 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 10 ) = LZE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 10 ) = LZERES( 'GE', ' ', 1, N,
+     $                                         YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 11 ) = INCYS.EQ.INCY
+                           ELSE IF( PACKED )THEN
+                              ISAME( 3 ) = ALS.EQ.ALPHA
+                              ISAME( 4 ) = LZE( AS, AA, LAA )
+                              ISAME( 5 ) = LZE( XS, XX, LX )
+                              ISAME( 6 ) = INCXS.EQ.INCX
+                              ISAME( 7 ) = BLS.EQ.BETA
+                              IF( NULL )THEN
+                                 ISAME( 8 ) = LZE( YS, YY, LY )
+                              ELSE
+                                 ISAME( 8 ) = LZERES( 'GE', ' ', 1, N,
+     $                                        YS, YY, ABS( INCY ) )
+                              END IF
+                              ISAME( 9 ) = INCYS.EQ.INCY
+                           END IF
+*
+*                          If data was incorrectly changed, report and
+*                          return.
+*
+                           SAME = .TRUE.
+                           DO 40 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   40                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+*
+*                             Check the result.
+*
+                              CALL ZMVCH( 'N', N, N, ALPHA, A, NMAX, X,
+     $                                    INCX, BETA, Y, INCY, YT, G,
+     $                                    YY, EPS, ERR, FATAL, NOUT,
+     $                                    .TRUE. )
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 120
+                           ELSE
+*                             Avoid repeating tests with N.le.0
+                              GO TO 110
+                           END IF
+*
+   50                   CONTINUE
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, LDA, INCX,
+     $      BETA, INCY
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, K, ALPHA, LDA,
+     $      INCX, BETA, INCY
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, N, ALPHA, INCX,
+     $      BETA, INCY
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',(', F4.1, ',',
+     $      F4.1, '), AP, X,', I2, ',(', F4.1, ',', F4.1, '), Y,', I2,
+     $      ')                .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', 2( I3, ',' ), '(',
+     $      F4.1, ',', F4.1, '), A,', I3, ', X,', I2, ',(', F4.1, ',',
+     $      F4.1, '), Y,', I2, ')         .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',(', F4.1, ',',
+     $      F4.1, '), A,', I3, ', X,', I2, ',(', F4.1, ',', F4.1, '), ',
+     $      'Y,', I2, ')             .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK2.
+*
+      END
+      SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, XT, G, Z )
+*
+*  Tests ZTRMV, ZTBMV, ZTPMV, ZTRSV, ZTBSV and ZTPSV.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, HALF, ONE
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   HALF = ( 0.5D0, 0.0D0 ),
+     $                   ONE = ( 1.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NIDIM, NINC, NKB, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ),
+     $                   AS( NMAX*NMAX ), X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XT( NMAX ), XX( NMAX*INCMAX ), Z( NMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC ), KB( NKB )
+*     .. Local Scalars ..
+      COMPLEX*16         TRANSL
+      DOUBLE PRECISION   ERR, ERRMAX
+      INTEGER            I, ICD, ICT, ICU, IK, IN, INCX, INCXS, IX, K,
+     $                   KS, LAA, LDA, LDAS, LX, N, NARGS, NC, NK, NS
+      LOGICAL            BANDED, FULL, NULL, PACKED, RESET, SAME
+      CHARACTER*1        DIAG, DIAGS, TRANS, TRANSS, UPLO, UPLOS
+      CHARACTER*2        ICHD, ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZMAKE, ZMVCH, ZTBMV, ZTBSV, ZTPMV, ZTPSV,
+     $                   ZTRMV, ZTRSV
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'R'
+      BANDED = SNAME( 3: 3 ).EQ.'B'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 8
+      ELSE IF( BANDED )THEN
+         NARGS = 9
+      ELSE IF( PACKED )THEN
+         NARGS = 7
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*     Set up zero vector for ZMVCH.
+      DO 10 I = 1, NMAX
+         Z( I ) = ZERO
+   10 CONTINUE
+*
+      DO 110 IN = 1, NIDIM
+         N = IDIM( IN )
+*
+         IF( BANDED )THEN
+            NK = NKB
+         ELSE
+            NK = 1
+         END IF
+         DO 100 IK = 1, NK
+            IF( BANDED )THEN
+               K = KB( IK )
+            ELSE
+               K = N - 1
+            END IF
+*           Set LDA to 1 more than minimum value if room.
+            IF( BANDED )THEN
+               LDA = K + 1
+            ELSE
+               LDA = N
+            END IF
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 100
+            IF( PACKED )THEN
+               LAA = ( N*( N + 1 ) )/2
+            ELSE
+               LAA = LDA*N
+            END IF
+            NULL = N.LE.0
+*
+            DO 90 ICU = 1, 2
+               UPLO = ICHU( ICU: ICU )
+*
+               DO 80 ICT = 1, 3
+                  TRANS = ICHT( ICT: ICT )
+*
+                  DO 70 ICD = 1, 2
+                     DIAG = ICHD( ICD: ICD )
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL ZMAKE( SNAME( 2: 3 ), UPLO, DIAG, N, N, A,
+     $                           NMAX, AA, LDA, K, K, RESET, TRANSL )
+*
+                     DO 60 IX = 1, NINC
+                        INCX = INC( IX )
+                        LX = ABS( INCX )*N
+*
+*                       Generate the vector X.
+*
+                        TRANSL = HALF
+                        CALL ZMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX,
+     $                              ABS( INCX ), 0, N - 1, RESET,
+     $                              TRANSL )
+                        IF( N.GT.1 )THEN
+                           X( N/2 ) = ZERO
+                           XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+                        END IF
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        DIAGS = DIAG
+                        NS = N
+                        KS = K
+                        DO 20 I = 1, LAA
+                           AS( I ) = AA( I )
+   20                   CONTINUE
+                        LDAS = LDA
+                        DO 30 I = 1, LX
+                           XS( I ) = XX( I )
+   30                   CONTINUE
+                        INCXS = INCX
+*
+*                       Call the subroutine.
+*
+                        IF( SNAME( 4: 5 ).EQ.'MV' )THEN
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZTRMV( UPLO, TRANS, DIAG, N, AA, LDA,
+     $                                    XX, INCX )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, K, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZTBMV( UPLO, TRANS, DIAG, N, K, AA,
+     $                                    LDA, XX, INCX )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZTPMV( UPLO, TRANS, DIAG, N, AA, XX,
+     $                                    INCX )
+                           END IF
+                        ELSE IF( SNAME( 4: 5 ).EQ.'SV' )THEN
+                           IF( FULL )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9993 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZTRSV( UPLO, TRANS, DIAG, N, AA, LDA,
+     $                                    XX, INCX )
+                           ELSE IF( BANDED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9994 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, K, LDA, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZTBSV( UPLO, TRANS, DIAG, N, K, AA,
+     $                                    LDA, XX, INCX )
+                           ELSE IF( PACKED )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           UPLO, TRANS, DIAG, N, INCX
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZTPSV( UPLO, TRANS, DIAG, N, AA, XX,
+     $                                    INCX )
+                           END IF
+                        END IF
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9992 )
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLO.EQ.UPLOS
+                        ISAME( 2 ) = TRANS.EQ.TRANSS
+                        ISAME( 3 ) = DIAG.EQ.DIAGS
+                        ISAME( 4 ) = NS.EQ.N
+                        IF( FULL )THEN
+                           ISAME( 5 ) = LZE( AS, AA, LAA )
+                           ISAME( 6 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 7 ) = LZE( XS, XX, LX )
+                           ELSE
+                              ISAME( 7 ) = LZERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 8 ) = INCXS.EQ.INCX
+                        ELSE IF( BANDED )THEN
+                           ISAME( 5 ) = KS.EQ.K
+                           ISAME( 6 ) = LZE( AS, AA, LAA )
+                           ISAME( 7 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 8 ) = LZE( XS, XX, LX )
+                           ELSE
+                              ISAME( 8 ) = LZERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 9 ) = INCXS.EQ.INCX
+                        ELSE IF( PACKED )THEN
+                           ISAME( 5 ) = LZE( AS, AA, LAA )
+                           IF( NULL )THEN
+                              ISAME( 6 ) = LZE( XS, XX, LX )
+                           ELSE
+                              ISAME( 6 ) = LZERES( 'GE', ' ', 1, N, XS,
+     $                                     XX, ABS( INCX ) )
+                           END IF
+                           ISAME( 7 ) = INCXS.EQ.INCX
+                        END IF
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+                           IF( SNAME( 4: 5 ).EQ.'MV' )THEN
+*
+*                             Check the result.
+*
+                              CALL ZMVCH( TRANS, N, N, ONE, A, NMAX, X,
+     $                                    INCX, ZERO, Z, INCX, XT, G,
+     $                                    XX, EPS, ERR, FATAL, NOUT,
+     $                                    .TRUE. )
+                           ELSE IF( SNAME( 4: 5 ).EQ.'SV' )THEN
+*
+*                             Compute approximation to original vector.
+*
+                              DO 50 I = 1, N
+                                 Z( I ) = XX( 1 + ( I - 1 )*
+     $                                    ABS( INCX ) )
+                                 XX( 1 + ( I - 1 )*ABS( INCX ) )
+     $                              = X( I )
+   50                         CONTINUE
+                              CALL ZMVCH( TRANS, N, N, ONE, A, NMAX, Z,
+     $                                    INCX, ZERO, X, INCX, XT, G,
+     $                                    XX, EPS, ERR, FATAL, NOUT,
+     $                                    .FALSE. )
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 120
+                        ELSE
+*                          Avoid repeating tests with N.le.0.
+                           GO TO 110
+                        END IF
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, DIAG, N, LDA,
+     $      INCX
+      ELSE IF( BANDED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, DIAG, N, K,
+     $      LDA, INCX
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANS, DIAG, N, INCX
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', AP, ',
+     $      'X,', I2, ')                                      .' )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), 2( I3, ',' ),
+     $      ' A,', I3, ', X,', I2, ')                               .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(', 3( '''', A1, ''',' ), I3, ', A,',
+     $      I3, ', X,', I2, ')                                   .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK3.
+*
+      END
+      SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests ZGERC and ZGERU.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, HALF, ONE
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   HALF = ( 0.5D0, 0.0D0 ),
+     $                   ONE = ( 1.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, ALS, TRANSL
+      DOUBLE PRECISION   ERR, ERRMAX
+      INTEGER            I, IA, IM, IN, INCX, INCXS, INCY, INCYS, IX,
+     $                   IY, J, LAA, LDA, LDAS, LX, LY, M, MS, N, NARGS,
+     $                   NC, ND, NS
+      LOGICAL            CONJ, NULL, RESET, SAME
+*     .. Local Arrays ..
+      COMPLEX*16         W( 1 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZGERC, ZGERU, ZMAKE, ZMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DCONJG, MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+      CONJ = SNAME( 5: 5 ).EQ.'C'
+*     Define the number of arguments.
+      NARGS = 9
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 120 IN = 1, NIDIM
+         N = IDIM( IN )
+         ND = N/2 + 1
+*
+         DO 110 IM = 1, 2
+            IF( IM.EQ.1 )
+     $         M = MAX( N - ND, 0 )
+            IF( IM.EQ.2 )
+     $         M = MIN( N + ND, NMAX )
+*
+*           Set LDA to 1 more than minimum value if room.
+            LDA = M
+            IF( LDA.LT.NMAX )
+     $         LDA = LDA + 1
+*           Skip tests if not enough room.
+            IF( LDA.GT.NMAX )
+     $         GO TO 110
+            LAA = LDA*N
+            NULL = N.LE.0.OR.M.LE.0
+*
+            DO 100 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*M
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL ZMAKE( 'GE', ' ', ' ', 1, M, X, 1, XX, ABS( INCX ),
+     $                     0, M - 1, RESET, TRANSL )
+               IF( M.GT.1 )THEN
+                  X( M/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( M/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 90 IY = 1, NINC
+                  INCY = INC( IY )
+                  LY = ABS( INCY )*N
+*
+*                 Generate the vector Y.
+*
+                  TRANSL = ZERO
+                  CALL ZMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                        ABS( INCY ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     Y( N/2 ) = ZERO
+                     YY( 1 + ABS( INCY )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 80 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL ZMAKE( SNAME( 2: 3 ), ' ', ' ', M, N, A, NMAX,
+     $                           AA, LDA, M - 1, N - 1, RESET, TRANSL )
+*
+                     NC = NC + 1
+*
+*                    Save every datum before calling the subroutine.
+*
+                     MS = M
+                     NS = N
+                     ALS = ALPHA
+                     DO 10 I = 1, LAA
+                        AS( I ) = AA( I )
+   10                CONTINUE
+                     LDAS = LDA
+                     DO 20 I = 1, LX
+                        XS( I ) = XX( I )
+   20                CONTINUE
+                     INCXS = INCX
+                     DO 30 I = 1, LY
+                        YS( I ) = YY( I )
+   30                CONTINUE
+                     INCYS = INCY
+*
+*                    Call the subroutine.
+*
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9994 )NC, SNAME, M, N,
+     $                  ALPHA, INCX, INCY, LDA
+                     IF( CONJ )THEN
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL ZGERC( M, N, ALPHA, XX, INCX, YY, INCY, AA,
+     $                              LDA )
+                     ELSE
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL ZGERU( M, N, ALPHA, XX, INCX, YY, INCY, AA,
+     $                              LDA )
+                     END IF
+*
+*                    Check if error-exit was taken incorrectly.
+*
+                     IF( .NOT.OK )THEN
+                        WRITE( NOUT, FMT = 9993 )
+                        FATAL = .TRUE.
+                        GO TO 140
+                     END IF
+*
+*                    See what data changed inside subroutine.
+*
+                     ISAME( 1 ) = MS.EQ.M
+                     ISAME( 2 ) = NS.EQ.N
+                     ISAME( 3 ) = ALS.EQ.ALPHA
+                     ISAME( 4 ) = LZE( XS, XX, LX )
+                     ISAME( 5 ) = INCXS.EQ.INCX
+                     ISAME( 6 ) = LZE( YS, YY, LY )
+                     ISAME( 7 ) = INCYS.EQ.INCY
+                     IF( NULL )THEN
+                        ISAME( 8 ) = LZE( AS, AA, LAA )
+                     ELSE
+                        ISAME( 8 ) = LZERES( 'GE', ' ', M, N, AS, AA,
+     $                               LDA )
+                     END IF
+                     ISAME( 9 ) = LDAS.EQ.LDA
+*
+*                    If data was incorrectly changed, report and return.
+*
+                     SAME = .TRUE.
+                     DO 40 I = 1, NARGS
+                        SAME = SAME.AND.ISAME( I )
+                        IF( .NOT.ISAME( I ) )
+     $                     WRITE( NOUT, FMT = 9998 )I
+   40                CONTINUE
+                     IF( .NOT.SAME )THEN
+                        FATAL = .TRUE.
+                        GO TO 140
+                     END IF
+*
+                     IF( .NOT.NULL )THEN
+*
+*                       Check the result column by column.
+*
+                        IF( INCX.GT.0 )THEN
+                           DO 50 I = 1, M
+                              Z( I ) = X( I )
+   50                      CONTINUE
+                        ELSE
+                           DO 60 I = 1, M
+                              Z( I ) = X( M - I + 1 )
+   60                      CONTINUE
+                        END IF
+                        DO 70 J = 1, N
+                           IF( INCY.GT.0 )THEN
+                              W( 1 ) = Y( J )
+                           ELSE
+                              W( 1 ) = Y( N - J + 1 )
+                           END IF
+                           IF( CONJ )
+     $                        W( 1 ) = DCONJG( W( 1 ) )
+                           CALL ZMVCH( 'N', M, 1, ALPHA, Z, NMAX, W, 1,
+     $                                 ONE, A( 1, J ), 1, YT, G,
+     $                                 AA( 1 + ( J - 1 )*LDA ), EPS,
+     $                                 ERR, FATAL, NOUT, .TRUE. )
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 130
+   70                   CONTINUE
+                     ELSE
+*                       Avoid repeating tests with M.le.0 or N.le.0.
+                        GO TO 110
+                     END IF
+*
+   80             CONTINUE
+*
+   90          CONTINUE
+*
+  100       CONTINUE
+*
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 150
+*
+  130 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  140 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9994 )NC, SNAME, M, N, ALPHA, INCX, INCY, LDA
+*
+  150 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( I3, ',' ), '(', F4.1, ',', F4.1,
+     $      '), X,', I2, ', Y,', I2, ', A,', I3, ')                   ',
+     $      '      .' )
+ 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK4.
+*
+      END
+      SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests ZHER and ZHPR.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, HALF, ONE
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   HALF = ( 0.5D0, 0.0D0 ),
+     $                   ONE = ( 1.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, TRANSL
+      DOUBLE PRECISION   ERR, ERRMAX, RALPHA, RALS
+      INTEGER            I, IA, IC, IN, INCX, INCXS, IX, J, JA, JJ, LAA,
+     $                   LDA, LDAS, LJ, LX, N, NARGS, NC, NS
+      LOGICAL            FULL, NULL, PACKED, RESET, SAME, UPPER
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      COMPLEX*16         W( 1 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZHER, ZHPR, ZMAKE, ZMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'E'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 7
+      ELSE IF( PACKED )THEN
+         NARGS = 6
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 100 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDA to 1 more than minimum value if room.
+         LDA = N
+         IF( LDA.LT.NMAX )
+     $      LDA = LDA + 1
+*        Skip tests if not enough room.
+         IF( LDA.GT.NMAX )
+     $      GO TO 100
+         IF( PACKED )THEN
+            LAA = ( N*( N + 1 ) )/2
+         ELSE
+            LAA = LDA*N
+         END IF
+*
+         DO 90 IC = 1, 2
+            UPLO = ICH( IC: IC )
+            UPPER = UPLO.EQ.'U'
+*
+            DO 80 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*N
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL ZMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX, ABS( INCX ),
+     $                     0, N - 1, RESET, TRANSL )
+               IF( N.GT.1 )THEN
+                  X( N/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 70 IA = 1, NALF
+                  RALPHA = DBLE( ALF( IA ) )
+                  ALPHA = DCMPLX( RALPHA, RZERO )
+                  NULL = N.LE.0.OR.RALPHA.EQ.RZERO
+*
+*                 Generate the matrix A.
+*
+                  TRANSL = ZERO
+                  CALL ZMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A, NMAX,
+     $                        AA, LDA, N - 1, N - 1, RESET, TRANSL )
+*
+                  NC = NC + 1
+*
+*                 Save every datum before calling the subroutine.
+*
+                  UPLOS = UPLO
+                  NS = N
+                  RALS = RALPHA
+                  DO 10 I = 1, LAA
+                     AS( I ) = AA( I )
+   10             CONTINUE
+                  LDAS = LDA
+                  DO 20 I = 1, LX
+                     XS( I ) = XX( I )
+   20             CONTINUE
+                  INCXS = INCX
+*
+*                 Call the subroutine.
+*
+                  IF( FULL )THEN
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO, N,
+     $                  RALPHA, INCX, LDA
+                     IF( REWI )
+     $                  REWIND NTRA
+                     CALL ZHER( UPLO, N, RALPHA, XX, INCX, AA, LDA )
+                  ELSE IF( PACKED )THEN
+                     IF( TRACE )
+     $                  WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO, N,
+     $                  RALPHA, INCX
+                     IF( REWI )
+     $                  REWIND NTRA
+                     CALL ZHPR( UPLO, N, RALPHA, XX, INCX, AA )
+                  END IF
+*
+*                 Check if error-exit was taken incorrectly.
+*
+                  IF( .NOT.OK )THEN
+                     WRITE( NOUT, FMT = 9992 )
+                     FATAL = .TRUE.
+                     GO TO 120
+                  END IF
+*
+*                 See what data changed inside subroutines.
+*
+                  ISAME( 1 ) = UPLO.EQ.UPLOS
+                  ISAME( 2 ) = NS.EQ.N
+                  ISAME( 3 ) = RALS.EQ.RALPHA
+                  ISAME( 4 ) = LZE( XS, XX, LX )
+                  ISAME( 5 ) = INCXS.EQ.INCX
+                  IF( NULL )THEN
+                     ISAME( 6 ) = LZE( AS, AA, LAA )
+                  ELSE
+                     ISAME( 6 ) = LZERES( SNAME( 2: 3 ), UPLO, N, N, AS,
+     $                            AA, LDA )
+                  END IF
+                  IF( .NOT.PACKED )THEN
+                     ISAME( 7 ) = LDAS.EQ.LDA
+                  END IF
+*
+*                 If data was incorrectly changed, report and return.
+*
+                  SAME = .TRUE.
+                  DO 30 I = 1, NARGS
+                     SAME = SAME.AND.ISAME( I )
+                     IF( .NOT.ISAME( I ) )
+     $                  WRITE( NOUT, FMT = 9998 )I
+   30             CONTINUE
+                  IF( .NOT.SAME )THEN
+                     FATAL = .TRUE.
+                     GO TO 120
+                  END IF
+*
+                  IF( .NOT.NULL )THEN
+*
+*                    Check the result column by column.
+*
+                     IF( INCX.GT.0 )THEN
+                        DO 40 I = 1, N
+                           Z( I ) = X( I )
+   40                   CONTINUE
+                     ELSE
+                        DO 50 I = 1, N
+                           Z( I ) = X( N - I + 1 )
+   50                   CONTINUE
+                     END IF
+                     JA = 1
+                     DO 60 J = 1, N
+                        W( 1 ) = DCONJG( Z( J ) )
+                        IF( UPPER )THEN
+                           JJ = 1
+                           LJ = J
+                        ELSE
+                           JJ = J
+                           LJ = N - J + 1
+                        END IF
+                        CALL ZMVCH( 'N', LJ, 1, ALPHA, Z( JJ ), LJ, W,
+     $                              1, ONE, A( JJ, J ), 1, YT, G,
+     $                              AA( JA ), EPS, ERR, FATAL, NOUT,
+     $                              .TRUE. )
+                        IF( FULL )THEN
+                           IF( UPPER )THEN
+                              JA = JA + LDA
+                           ELSE
+                              JA = JA + LDA + 1
+                           END IF
+                        ELSE
+                           JA = JA + LJ
+                        END IF
+                        ERRMAX = MAX( ERRMAX, ERR )
+*                       If got really bad answer, report and return.
+                        IF( FATAL )
+     $                     GO TO 110
+   60                CONTINUE
+                  ELSE
+*                    Avoid repeating tests if N.le.0.
+                     IF( N.LE.0 )
+     $                  GO TO 100
+                  END IF
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  110 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, RALPHA, INCX, LDA
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, RALPHA, INCX
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', AP)                                         .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',', F4.1, ', X,',
+     $      I2, ', A,', I3, ')                                      .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK5.
+*
+      END
+      SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX,
+     $                  INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G,
+     $                  Z )
+*
+*  Tests ZHER2 and ZHPR2.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, HALF, ONE
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   HALF = ( 0.5D0, 0.0D0 ),
+     $                   ONE = ( 1.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            INCMAX, NALF, NIDIM, NINC, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), X( NMAX ), XS( NMAX*INCMAX ),
+     $                   XX( NMAX*INCMAX ), Y( NMAX ),
+     $                   YS( NMAX*INCMAX ), YT( NMAX ),
+     $                   YY( NMAX*INCMAX ), Z( NMAX, 2 )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM ), INC( NINC )
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, ALS, TRANSL
+      DOUBLE PRECISION   ERR, ERRMAX
+      INTEGER            I, IA, IC, IN, INCX, INCXS, INCY, INCYS, IX,
+     $                   IY, J, JA, JJ, LAA, LDA, LDAS, LJ, LX, LY, N,
+     $                   NARGS, NC, NS
+      LOGICAL            FULL, NULL, PACKED, RESET, SAME, UPPER
+      CHARACTER*1        UPLO, UPLOS
+      CHARACTER*2        ICH
+*     .. Local Arrays ..
+      COMPLEX*16         W( 2 )
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZHER2, ZHPR2, ZMAKE, ZMVCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DCONJG, MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'UL'/
+*     .. Executable Statements ..
+      FULL = SNAME( 3: 3 ).EQ.'E'
+      PACKED = SNAME( 3: 3 ).EQ.'P'
+*     Define the number of arguments.
+      IF( FULL )THEN
+         NARGS = 9
+      ELSE IF( PACKED )THEN
+         NARGS = 8
+      END IF
+*
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 140 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDA to 1 more than minimum value if room.
+         LDA = N
+         IF( LDA.LT.NMAX )
+     $      LDA = LDA + 1
+*        Skip tests if not enough room.
+         IF( LDA.GT.NMAX )
+     $      GO TO 140
+         IF( PACKED )THEN
+            LAA = ( N*( N + 1 ) )/2
+         ELSE
+            LAA = LDA*N
+         END IF
+*
+         DO 130 IC = 1, 2
+            UPLO = ICH( IC: IC )
+            UPPER = UPLO.EQ.'U'
+*
+            DO 120 IX = 1, NINC
+               INCX = INC( IX )
+               LX = ABS( INCX )*N
+*
+*              Generate the vector X.
+*
+               TRANSL = HALF
+               CALL ZMAKE( 'GE', ' ', ' ', 1, N, X, 1, XX, ABS( INCX ),
+     $                     0, N - 1, RESET, TRANSL )
+               IF( N.GT.1 )THEN
+                  X( N/2 ) = ZERO
+                  XX( 1 + ABS( INCX )*( N/2 - 1 ) ) = ZERO
+               END IF
+*
+               DO 110 IY = 1, NINC
+                  INCY = INC( IY )
+                  LY = ABS( INCY )*N
+*
+*                 Generate the vector Y.
+*
+                  TRANSL = ZERO
+                  CALL ZMAKE( 'GE', ' ', ' ', 1, N, Y, 1, YY,
+     $                        ABS( INCY ), 0, N - 1, RESET, TRANSL )
+                  IF( N.GT.1 )THEN
+                     Y( N/2 ) = ZERO
+                     YY( 1 + ABS( INCY )*( N/2 - 1 ) ) = ZERO
+                  END IF
+*
+                  DO 100 IA = 1, NALF
+                     ALPHA = ALF( IA )
+                     NULL = N.LE.0.OR.ALPHA.EQ.ZERO
+*
+*                    Generate the matrix A.
+*
+                     TRANSL = ZERO
+                     CALL ZMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, A,
+     $                           NMAX, AA, LDA, N - 1, N - 1, RESET,
+     $                           TRANSL )
+*
+                     NC = NC + 1
+*
+*                    Save every datum before calling the subroutine.
+*
+                     UPLOS = UPLO
+                     NS = N
+                     ALS = ALPHA
+                     DO 10 I = 1, LAA
+                        AS( I ) = AA( I )
+   10                CONTINUE
+                     LDAS = LDA
+                     DO 20 I = 1, LX
+                        XS( I ) = XX( I )
+   20                CONTINUE
+                     INCXS = INCX
+                     DO 30 I = 1, LY
+                        YS( I ) = YY( I )
+   30                CONTINUE
+                     INCYS = INCY
+*
+*                    Call the subroutine.
+*
+                     IF( FULL )THEN
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO, N,
+     $                     ALPHA, INCX, INCY, LDA
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL ZHER2( UPLO, N, ALPHA, XX, INCX, YY, INCY,
+     $                              AA, LDA )
+                     ELSE IF( PACKED )THEN
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO, N,
+     $                     ALPHA, INCX, INCY
+                        IF( REWI )
+     $                     REWIND NTRA
+                        CALL ZHPR2( UPLO, N, ALPHA, XX, INCX, YY, INCY,
+     $                              AA )
+                     END IF
+*
+*                    Check if error-exit was taken incorrectly.
+*
+                     IF( .NOT.OK )THEN
+                        WRITE( NOUT, FMT = 9992 )
+                        FATAL = .TRUE.
+                        GO TO 160
+                     END IF
+*
+*                    See what data changed inside subroutines.
+*
+                     ISAME( 1 ) = UPLO.EQ.UPLOS
+                     ISAME( 2 ) = NS.EQ.N
+                     ISAME( 3 ) = ALS.EQ.ALPHA
+                     ISAME( 4 ) = LZE( XS, XX, LX )
+                     ISAME( 5 ) = INCXS.EQ.INCX
+                     ISAME( 6 ) = LZE( YS, YY, LY )
+                     ISAME( 7 ) = INCYS.EQ.INCY
+                     IF( NULL )THEN
+                        ISAME( 8 ) = LZE( AS, AA, LAA )
+                     ELSE
+                        ISAME( 8 ) = LZERES( SNAME( 2: 3 ), UPLO, N, N,
+     $                               AS, AA, LDA )
+                     END IF
+                     IF( .NOT.PACKED )THEN
+                        ISAME( 9 ) = LDAS.EQ.LDA
+                     END IF
+*
+*                    If data was incorrectly changed, report and return.
+*
+                     SAME = .TRUE.
+                     DO 40 I = 1, NARGS
+                        SAME = SAME.AND.ISAME( I )
+                        IF( .NOT.ISAME( I ) )
+     $                     WRITE( NOUT, FMT = 9998 )I
+   40                CONTINUE
+                     IF( .NOT.SAME )THEN
+                        FATAL = .TRUE.
+                        GO TO 160
+                     END IF
+*
+                     IF( .NOT.NULL )THEN
+*
+*                       Check the result column by column.
+*
+                        IF( INCX.GT.0 )THEN
+                           DO 50 I = 1, N
+                              Z( I, 1 ) = X( I )
+   50                      CONTINUE
+                        ELSE
+                           DO 60 I = 1, N
+                              Z( I, 1 ) = X( N - I + 1 )
+   60                      CONTINUE
+                        END IF
+                        IF( INCY.GT.0 )THEN
+                           DO 70 I = 1, N
+                              Z( I, 2 ) = Y( I )
+   70                      CONTINUE
+                        ELSE
+                           DO 80 I = 1, N
+                              Z( I, 2 ) = Y( N - I + 1 )
+   80                      CONTINUE
+                        END IF
+                        JA = 1
+                        DO 90 J = 1, N
+                           W( 1 ) = ALPHA*DCONJG( Z( J, 2 ) )
+                           W( 2 ) = DCONJG( ALPHA )*DCONJG( Z( J, 1 ) )
+                           IF( UPPER )THEN
+                              JJ = 1
+                              LJ = J
+                           ELSE
+                              JJ = J
+                              LJ = N - J + 1
+                           END IF
+                           CALL ZMVCH( 'N', LJ, 2, ONE, Z( JJ, 1 ),
+     $                                 NMAX, W, 1, ONE, A( JJ, J ), 1,
+     $                                 YT, G, AA( JA ), EPS, ERR, FATAL,
+     $                                 NOUT, .TRUE. )
+                           IF( FULL )THEN
+                              IF( UPPER )THEN
+                                 JA = JA + LDA
+                              ELSE
+                                 JA = JA + LDA + 1
+                              END IF
+                           ELSE
+                              JA = JA + LJ
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and return.
+                           IF( FATAL )
+     $                        GO TO 150
+   90                   CONTINUE
+                     ELSE
+*                       Avoid repeating tests with N.le.0.
+                        IF( N.LE.0 )
+     $                     GO TO 140
+                     END IF
+*
+  100             CONTINUE
+*
+  110          CONTINUE
+*
+  120       CONTINUE
+*
+  130    CONTINUE
+*
+  140 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 170
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9995 )J
+*
+  160 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( FULL )THEN
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, N, ALPHA, INCX,
+     $      INCY, LDA
+      ELSE IF( PACKED )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, N, ALPHA, INCX, INCY
+      END IF
+*
+  170 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',(', F4.1, ',',
+     $      F4.1, '), X,', I2, ', Y,', I2, ', AP)                     ',
+     $      '       .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',', I3, ',(', F4.1, ',',
+     $      F4.1, '), X,', I2, ', Y,', I2, ', A,', I3, ')             ',
+     $      '            .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK6.
+*
+      END
+      SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT )
+*
+*  Tests the error exits from the Level 2 Blas.
+*  Requires a special version of the error-handling routine XERBLA.
+*  ALPHA, RALPHA, BETA, A, X and Y should not need to be defined.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            ISNUM, NOUT
+      CHARACTER*6        SRNAMT
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, BETA
+      DOUBLE PRECISION   RALPHA
+*     .. Local Arrays ..
+      COMPLEX*16         A( 1, 1 ), X( 1 ), Y( 1 )
+*     .. External Subroutines ..
+      EXTERNAL           CHKXER, ZGBMV, ZGEMV, ZGERC, ZGERU, ZHBMV,
+     $                   ZHEMV, ZHER, ZHER2, ZHPMV, ZHPR, ZHPR2, ZTBMV,
+     $                   ZTBSV, ZTPMV, ZTPSV, ZTRMV, ZTRSV
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+*     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
+*     if anything is wrong.
+      OK = .TRUE.
+*     LERR is set to .TRUE. by the special version of XERBLA each time
+*     it is called, and is then tested and re-set by CHKXER.
+      LERR = .FALSE.
+      GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
+     $        90, 100, 110, 120, 130, 140, 150, 160,
+     $        170 )ISNUM
+   10 INFOT = 1
+      CALL ZGEMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZGEMV( 'N', -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGEMV( 'N', 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZGEMV( 'N', 2, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGEMV( 'N', 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZGEMV( 'N', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   20 INFOT = 1
+      CALL ZGBMV( '/', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZGBMV( 'N', -1, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGBMV( 'N', 0, -1, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZGBMV( 'N', 0, 0, -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGBMV( 'N', 2, 0, 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGBMV( 'N', 0, 0, 1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL ZGBMV( 'N', 0, 0, 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   30 INFOT = 1
+      CALL ZHEMV( '/', 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZHEMV( 'U', -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZHEMV( 'U', 2, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHEMV( 'U', 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZHEMV( 'U', 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   40 INFOT = 1
+      CALL ZHBMV( '/', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZHBMV( 'U', -1, 0, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHBMV( 'U', 0, -1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZHBMV( 'U', 0, 1, ALPHA, A, 1, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZHBMV( 'U', 0, 0, ALPHA, A, 1, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZHBMV( 'U', 0, 0, ALPHA, A, 1, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   50 INFOT = 1
+      CALL ZHPMV( '/', 0, ALPHA, A, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZHPMV( 'U', -1, ALPHA, A, X, 1, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZHPMV( 'U', 0, ALPHA, A, X, 0, BETA, Y, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZHPMV( 'U', 0, ALPHA, A, X, 1, BETA, Y, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   60 INFOT = 1
+      CALL ZTRMV( '/', 'N', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZTRMV( 'U', '/', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZTRMV( 'U', 'N', '/', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZTRMV( 'U', 'N', 'N', -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMV( 'U', 'N', 'N', 2, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZTRMV( 'U', 'N', 'N', 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   70 INFOT = 1
+      CALL ZTBMV( '/', 'N', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZTBMV( 'U', '/', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZTBMV( 'U', 'N', '/', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZTBMV( 'U', 'N', 'N', -1, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTBMV( 'U', 'N', 'N', 0, -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZTBMV( 'U', 'N', 'N', 0, 1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTBMV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   80 INFOT = 1
+      CALL ZTPMV( '/', 'N', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZTPMV( 'U', '/', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZTPMV( 'U', 'N', '/', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZTPMV( 'U', 'N', 'N', -1, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZTPMV( 'U', 'N', 'N', 0, A, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+   90 INFOT = 1
+      CALL ZTRSV( '/', 'N', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZTRSV( 'U', '/', 'N', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZTRSV( 'U', 'N', '/', 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZTRSV( 'U', 'N', 'N', -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSV( 'U', 'N', 'N', 2, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZTRSV( 'U', 'N', 'N', 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  100 INFOT = 1
+      CALL ZTBSV( '/', 'N', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZTBSV( 'U', '/', 'N', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZTBSV( 'U', 'N', '/', 0, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZTBSV( 'U', 'N', 'N', -1, 0, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTBSV( 'U', 'N', 'N', 0, -1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZTBSV( 'U', 'N', 'N', 0, 1, A, 1, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTBSV( 'U', 'N', 'N', 0, 0, A, 1, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  110 INFOT = 1
+      CALL ZTPSV( '/', 'N', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZTPSV( 'U', '/', 'N', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZTPSV( 'U', 'N', '/', 0, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZTPSV( 'U', 'N', 'N', -1, A, X, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZTPSV( 'U', 'N', 'N', 0, A, X, 0 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  120 INFOT = 1
+      CALL ZGERC( -1, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZGERC( 0, -1, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGERC( 0, 0, ALPHA, X, 0, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZGERC( 0, 0, ALPHA, X, 1, Y, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZGERC( 2, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  130 INFOT = 1
+      CALL ZGERU( -1, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZGERU( 0, -1, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGERU( 0, 0, ALPHA, X, 0, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZGERU( 0, 0, ALPHA, X, 1, Y, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZGERU( 2, 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  140 INFOT = 1
+      CALL ZHER( '/', 0, RALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZHER( 'U', -1, RALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZHER( 'U', 0, RALPHA, X, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHER( 'U', 2, RALPHA, X, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  150 INFOT = 1
+      CALL ZHPR( '/', 0, RALPHA, X, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZHPR( 'U', -1, RALPHA, X, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZHPR( 'U', 0, RALPHA, X, 0, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  160 INFOT = 1
+      CALL ZHER2( '/', 0, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZHER2( 'U', -1, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZHER2( 'U', 0, ALPHA, X, 0, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHER2( 'U', 0, ALPHA, X, 1, Y, 0, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZHER2( 'U', 2, ALPHA, X, 1, Y, 1, A, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 180
+  170 INFOT = 1
+      CALL ZHPR2( '/', 0, ALPHA, X, 1, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZHPR2( 'U', -1, ALPHA, X, 1, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZHPR2( 'U', 0, ALPHA, X, 0, Y, 1, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHPR2( 'U', 0, ALPHA, X, 1, Y, 0, A )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+  180 IF( OK )THEN
+         WRITE( NOUT, FMT = 9999 )SRNAMT
+      ELSE
+         WRITE( NOUT, FMT = 9998 )SRNAMT
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+     $      '**' )
+*
+*     End of ZCHKE.
+*
+      END
+      SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL,
+     $                  KU, RESET, TRANSL )
+*
+*  Generates values for an M by N matrix A within the bandwidth
+*  defined by KL and KU.
+*  Stores the values in the array AA in the data structure required
+*  by the routine, with unwanted elements set to rogue value.
+*
+*  TYPE is 'GE', 'GB', 'HE', 'HB', 'HP', 'TR', 'TB' OR 'TP'.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   ONE = ( 1.0D0, 0.0D0 ) )
+      COMPLEX*16         ROGUE
+      PARAMETER          ( ROGUE = ( -1.0D10, 1.0D10 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+      DOUBLE PRECISION   RROGUE
+      PARAMETER          ( RROGUE = -1.0D10 )
+*     .. Scalar Arguments ..
+      COMPLEX*16         TRANSL
+      INTEGER            KL, KU, LDA, M, N, NMAX
+      LOGICAL            RESET
+      CHARACTER*1        DIAG, UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, * ), AA( * )
+*     .. Local Scalars ..
+      INTEGER            I, I1, I2, I3, IBEG, IEND, IOFF, J, JJ, KK
+      LOGICAL            GEN, LOWER, SYM, TRI, UNIT, UPPER
+*     .. External Functions ..
+      COMPLEX*16         ZBEG
+      EXTERNAL           ZBEG
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, DCMPLX, DCONJG, MAX, MIN
+*     .. Executable Statements ..
+      GEN = TYPE( 1: 1 ).EQ.'G'
+      SYM = TYPE( 1: 1 ).EQ.'H'
+      TRI = TYPE( 1: 1 ).EQ.'T'
+      UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U'
+      LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L'
+      UNIT = TRI.AND.DIAG.EQ.'U'
+*
+*     Generate data in array A.
+*
+      DO 20 J = 1, N
+         DO 10 I = 1, M
+            IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
+     $          THEN
+               IF( ( I.LE.J.AND.J - I.LE.KU ).OR.
+     $             ( I.GE.J.AND.I - J.LE.KL ) )THEN
+                  A( I, J ) = ZBEG( RESET ) + TRANSL
+               ELSE
+                  A( I, J ) = ZERO
+               END IF
+               IF( I.NE.J )THEN
+                  IF( SYM )THEN
+                     A( J, I ) = DCONJG( A( I, J ) )
+                  ELSE IF( TRI )THEN
+                     A( J, I ) = ZERO
+                  END IF
+               END IF
+            END IF
+   10    CONTINUE
+         IF( SYM )
+     $      A( J, J ) = DCMPLX( DBLE( A( J, J ) ), RZERO )
+         IF( TRI )
+     $      A( J, J ) = A( J, J ) + ONE
+         IF( UNIT )
+     $      A( J, J ) = ONE
+   20 CONTINUE
+*
+*     Store elements in array AS in data structure required by routine.
+*
+      IF( TYPE.EQ.'GE' )THEN
+         DO 50 J = 1, N
+            DO 30 I = 1, M
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   30       CONTINUE
+            DO 40 I = M + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   40       CONTINUE
+   50    CONTINUE
+      ELSE IF( TYPE.EQ.'GB' )THEN
+         DO 90 J = 1, N
+            DO 60 I1 = 1, KU + 1 - J
+               AA( I1 + ( J - 1 )*LDA ) = ROGUE
+   60       CONTINUE
+            DO 70 I2 = I1, MIN( KL + KU + 1, KU + 1 + M - J )
+               AA( I2 + ( J - 1 )*LDA ) = A( I2 + J - KU - 1, J )
+   70       CONTINUE
+            DO 80 I3 = I2, LDA
+               AA( I3 + ( J - 1 )*LDA ) = ROGUE
+   80       CONTINUE
+   90    CONTINUE
+      ELSE IF( TYPE.EQ.'HE'.OR.TYPE.EQ.'TR' )THEN
+         DO 130 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IF( UNIT )THEN
+                  IEND = J - 1
+               ELSE
+                  IEND = J
+               END IF
+            ELSE
+               IF( UNIT )THEN
+                  IBEG = J + 1
+               ELSE
+                  IBEG = J
+               END IF
+               IEND = N
+            END IF
+            DO 100 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  100       CONTINUE
+            DO 110 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+  110       CONTINUE
+            DO 120 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  120       CONTINUE
+            IF( SYM )THEN
+               JJ = J + ( J - 1 )*LDA
+               AA( JJ ) = DCMPLX( DBLE( AA( JJ ) ), RROGUE )
+            END IF
+  130    CONTINUE
+      ELSE IF( TYPE.EQ.'HB'.OR.TYPE.EQ.'TB' )THEN
+         DO 170 J = 1, N
+            IF( UPPER )THEN
+               KK = KL + 1
+               IBEG = MAX( 1, KL + 2 - J )
+               IF( UNIT )THEN
+                  IEND = KL
+               ELSE
+                  IEND = KL + 1
+               END IF
+            ELSE
+               KK = 1
+               IF( UNIT )THEN
+                  IBEG = 2
+               ELSE
+                  IBEG = 1
+               END IF
+               IEND = MIN( KL + 1, 1 + M - J )
+            END IF
+            DO 140 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  140       CONTINUE
+            DO 150 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I + J - KK, J )
+  150       CONTINUE
+            DO 160 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+  160       CONTINUE
+            IF( SYM )THEN
+               JJ = KK + ( J - 1 )*LDA
+               AA( JJ ) = DCMPLX( DBLE( AA( JJ ) ), RROGUE )
+            END IF
+  170    CONTINUE
+      ELSE IF( TYPE.EQ.'HP'.OR.TYPE.EQ.'TP' )THEN
+         IOFF = 0
+         DO 190 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 180 I = IBEG, IEND
+               IOFF = IOFF + 1
+               AA( IOFF ) = A( I, J )
+               IF( I.EQ.J )THEN
+                  IF( UNIT )
+     $               AA( IOFF ) = ROGUE
+                  IF( SYM )
+     $               AA( IOFF ) = DCMPLX( DBLE( AA( IOFF ) ), RROGUE )
+               END IF
+  180       CONTINUE
+  190    CONTINUE
+      END IF
+      RETURN
+*
+*     End of ZMAKE.
+*
+      END
+      SUBROUTINE ZMVCH( TRANS, M, N, ALPHA, A, NMAX, X, INCX, BETA, Y,
+     $                  INCY, YT, G, YY, EPS, ERR, FATAL, NOUT, MV )
+*
+*  Checks the results of the computational tests.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO, RONE
+      PARAMETER          ( RZERO = 0.0D0, RONE = 1.0D0 )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA, BETA
+      DOUBLE PRECISION   EPS, ERR
+      INTEGER            INCX, INCY, M, N, NMAX, NOUT
+      LOGICAL            FATAL, MV
+      CHARACTER*1        TRANS
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, * ), X( * ), Y( * ), YT( * ), YY( * )
+      DOUBLE PRECISION   G( * )
+*     .. Local Scalars ..
+      COMPLEX*16         C
+      DOUBLE PRECISION   ERRI
+      INTEGER            I, INCXL, INCYL, IY, J, JX, KX, KY, ML, NL
+      LOGICAL            CTRAN, TRAN
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, DCONJG, DIMAG, MAX, SQRT
+*     .. Statement Functions ..
+      DOUBLE PRECISION   ABS1
+*     .. Statement Function definitions ..
+      ABS1( C ) = ABS( DBLE( C ) ) + ABS( DIMAG( C ) )
+*     .. Executable Statements ..
+      TRAN = TRANS.EQ.'T'
+      CTRAN = TRANS.EQ.'C'
+      IF( TRAN.OR.CTRAN )THEN
+         ML = N
+         NL = M
+      ELSE
+         ML = M
+         NL = N
+      END IF
+      IF( INCX.LT.0 )THEN
+         KX = NL
+         INCXL = -1
+      ELSE
+         KX = 1
+         INCXL = 1
+      END IF
+      IF( INCY.LT.0 )THEN
+         KY = ML
+         INCYL = -1
+      ELSE
+         KY = 1
+         INCYL = 1
+      END IF
+*
+*     Compute expected result in YT using data in A, X and Y.
+*     Compute gauges in G.
+*
+      IY = KY
+      DO 40 I = 1, ML
+         YT( IY ) = ZERO
+         G( IY ) = RZERO
+         JX = KX
+         IF( TRAN )THEN
+            DO 10 J = 1, NL
+               YT( IY ) = YT( IY ) + A( J, I )*X( JX )
+               G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) )
+               JX = JX + INCXL
+   10       CONTINUE
+         ELSE IF( CTRAN )THEN
+            DO 20 J = 1, NL
+               YT( IY ) = YT( IY ) + DCONJG( A( J, I ) )*X( JX )
+               G( IY ) = G( IY ) + ABS1( A( J, I ) )*ABS1( X( JX ) )
+               JX = JX + INCXL
+   20       CONTINUE
+         ELSE
+            DO 30 J = 1, NL
+               YT( IY ) = YT( IY ) + A( I, J )*X( JX )
+               G( IY ) = G( IY ) + ABS1( A( I, J ) )*ABS1( X( JX ) )
+               JX = JX + INCXL
+   30       CONTINUE
+         END IF
+         YT( IY ) = ALPHA*YT( IY ) + BETA*Y( IY )
+         G( IY ) = ABS1( ALPHA )*G( IY ) + ABS1( BETA )*ABS1( Y( IY ) )
+         IY = IY + INCYL
+   40 CONTINUE
+*
+*     Compute the error ratio for this result.
+*
+      ERR = ZERO
+      DO 50 I = 1, ML
+         ERRI = ABS( YT( I ) - YY( 1 + ( I - 1 )*ABS( INCY ) ) )/EPS
+         IF( G( I ).NE.RZERO )
+     $      ERRI = ERRI/G( I )
+         ERR = MAX( ERR, ERRI )
+         IF( ERR*SQRT( EPS ).GE.RONE )
+     $      GO TO 60
+   50 CONTINUE
+*     If the loop completes, all results are at least half accurate.
+      GO TO 80
+*
+*     Report fatal error.
+*
+   60 FATAL = .TRUE.
+      WRITE( NOUT, FMT = 9999 )
+      DO 70 I = 1, ML
+         IF( MV )THEN
+            WRITE( NOUT, FMT = 9998 )I, YT( I ),
+     $         YY( 1 + ( I - 1 )*ABS( INCY ) )
+         ELSE
+            WRITE( NOUT, FMT = 9998 )I,
+     $         YY( 1 + ( I - 1 )*ABS( INCY ) ), YT( I )
+         END IF
+   70 CONTINUE
+*
+   80 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
+     $      'F ACCURATE *******', /'                       EXPECTED RE',
+     $      'SULT                    COMPUTED RESULT' )
+ 9998 FORMAT( 1X, I7, 2( '  (', G15.6, ',', G15.6, ')' ) )
+*
+*     End of ZMVCH.
+*
+      END
+      LOGICAL FUNCTION LZE( RI, RJ, LR )
+*
+*  Tests if two arrays are identical.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LR
+*     .. Array Arguments ..
+      COMPLEX*16         RI( * ), RJ( * )
+*     .. Local Scalars ..
+      INTEGER            I
+*     .. Executable Statements ..
+      DO 10 I = 1, LR
+         IF( RI( I ).NE.RJ( I ) )
+     $      GO TO 20
+   10 CONTINUE
+      LZE = .TRUE.
+      GO TO 30
+   20 CONTINUE
+      LZE = .FALSE.
+   30 RETURN
+*
+*     End of LZE.
+*
+      END
+      LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA )
+*
+*  Tests if selected elements in two arrays are equal.
+*
+*  TYPE is 'GE', 'HE' or 'HP'.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDA, M, N
+      CHARACTER*1        UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      COMPLEX*16         AA( LDA, * ), AS( LDA, * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J
+      LOGICAL            UPPER
+*     .. Executable Statements ..
+      UPPER = UPLO.EQ.'U'
+      IF( TYPE.EQ.'GE' )THEN
+         DO 20 J = 1, N
+            DO 10 I = M + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   10       CONTINUE
+   20    CONTINUE
+      ELSE IF( TYPE.EQ.'HE' )THEN
+         DO 50 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 30 I = 1, IBEG - 1
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   30       CONTINUE
+            DO 40 I = IEND + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   40       CONTINUE
+   50    CONTINUE
+      END IF
+*
+   60 CONTINUE
+      LZERES = .TRUE.
+      GO TO 80
+   70 CONTINUE
+      LZERES = .FALSE.
+   80 RETURN
+*
+*     End of LZERES.
+*
+      END
+      COMPLEX*16 FUNCTION ZBEG( RESET )
+*
+*  Generates complex numbers as pairs of random numbers uniformly
+*  distributed between -0.5 and 0.5.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      LOGICAL            RESET
+*     .. Local Scalars ..
+      INTEGER            I, IC, J, MI, MJ
+*     .. Save statement ..
+      SAVE               I, IC, J, MI, MJ
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCMPLX
+*     .. Executable Statements ..
+      IF( RESET )THEN
+*        Initialize local variables.
+         MI = 891
+         MJ = 457
+         I = 7
+         J = 7
+         IC = 0
+         RESET = .FALSE.
+      END IF
+*
+*     The sequence of values of I or J is bounded between 1 and 999.
+*     If initial I or J = 1,2,3,6,7 or 9, the period will be 50.
+*     If initial I or J = 4 or 8, the period will be 25.
+*     If initial I or J = 5, the period will be 10.
+*     IC is used to break up the period by skipping 1 value of I or J
+*     in 6.
+*
+      IC = IC + 1
+   10 I = I*MI
+      J = J*MJ
+      I = I - 1000*( I/1000 )
+      J = J - 1000*( J/1000 )
+      IF( IC.GE.5 )THEN
+         IC = 0
+         GO TO 10
+      END IF
+      ZBEG = DCMPLX( ( I - 500 )/1001.0D0, ( J - 500 )/1001.0D0 )
+      RETURN
+*
+*     End of ZBEG.
+*
+      END
+      DOUBLE PRECISION FUNCTION DDIFF( X, Y )
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   X, Y
+*     .. Executable Statements ..
+      DDIFF = X - Y
+      RETURN
+*
+*     End of DDIFF.
+*
+      END
+      SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+*  Tests whether XERBLA has detected an error when it should.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Executable Statements ..
+      IF( .NOT.LERR )THEN
+         WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
+         OK = .FALSE.
+      END IF
+      LERR = .FALSE.
+      RETURN
+*
+ 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
+     $      'ETECTED BY ', A6, ' *****' )
+*
+*     End of CHKXER.
+*
+      END
+      SUBROUTINE XERBLA( SRNAME, INFO )
+*
+*  This is a special version of XERBLA to be used only as part of
+*  the test program for testing error exits from the Level 2 BLAS
+*  routines.
+*
+*  XERBLA  is an error handler for the Level 2 BLAS routines.
+*
+*  It is called by the Level 2 BLAS routines if an input parameter is
+*  invalid.
+*
+*  Auxiliary routine for test program for Level 2 Blas.
+*
+*  -- Written on 10-August-1987.
+*     Richard Hanson, Sandia National Labs.
+*     Jeremy Du Croz, NAG Central Office.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO
+      CHARACTER*6        SRNAME
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUT, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Executable Statements ..
+      LERR = .TRUE.
+      IF( INFO.NE.INFOT )THEN
+         IF( INFOT.NE.0 )THEN
+            WRITE( NOUT, FMT = 9999 )INFO, INFOT
+         ELSE
+            WRITE( NOUT, FMT = 9997 )INFO
+         END IF
+         OK = .FALSE.
+      END IF
+      IF( SRNAME.NE.SRNAMT )THEN
+         WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
+         OK = .FALSE.
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
+     $      ' OF ', I2, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
+     $      'AD OF ', A6, ' *******' )
+ 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
+     $      ' *******' )
+*
+*     End of XERBLA
+*
+      END
+
diff --git a/eigen/blas/testing/zblat3.dat b/eigen/blas/testing/zblat3.dat
new file mode 100644
index 0000000..ede516f
--- /dev/null
+++ b/eigen/blas/testing/zblat3.dat
@@ -0,0 +1,23 @@
+'zblat3.summ'     NAME OF SUMMARY OUTPUT FILE
+6                 UNIT NUMBER OF SUMMARY FILE
+'zblat3.snap'     NAME OF SNAPSHOT OUTPUT FILE
+-1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
+F        LOGICAL FLAG, T TO TEST ERROR EXITS.
+16.0     THRESHOLD VALUE OF TEST RATIO
+6                 NUMBER OF VALUES OF N
+0 1 2 3 5 9       VALUES OF N
+3                 NUMBER OF VALUES OF ALPHA
+(0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
+3                 NUMBER OF VALUES OF BETA
+(0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
+ZGEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+ZHEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+ZSYMM  T PUT F FOR NO TEST. SAME COLUMNS.
+ZTRMM  T PUT F FOR NO TEST. SAME COLUMNS.
+ZTRSM  T PUT F FOR NO TEST. SAME COLUMNS.
+ZHERK  T PUT F FOR NO TEST. SAME COLUMNS.
+ZSYRK  T PUT F FOR NO TEST. SAME COLUMNS.
+ZHER2K T PUT F FOR NO TEST. SAME COLUMNS.
+ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
diff --git a/eigen/blas/testing/zblat3.f b/eigen/blas/testing/zblat3.f
new file mode 100644
index 0000000..d6a522f
--- /dev/null
+++ b/eigen/blas/testing/zblat3.f
@@ -0,0 +1,3445 @@
+      PROGRAM ZBLAT3
+*
+*  Test program for the COMPLEX*16       Level 3 Blas.
+*
+*  The program must be driven by a short data file. The first 14 records
+*  of the file are read using list-directed input, the last 9 records
+*  are read using the format ( A6, L2 ). An annotated example of a data
+*  file can be obtained by deleting the first 3 characters from the
+*  following 23 lines:
+*  'ZBLAT3.SUMM'     NAME OF SUMMARY OUTPUT FILE
+*  6                 UNIT NUMBER OF SUMMARY FILE
+*  'ZBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
+*  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
+*  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
+*  F        LOGICAL FLAG, T TO STOP ON FAILURES.
+*  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
+*  16.0     THRESHOLD VALUE OF TEST RATIO
+*  6                 NUMBER OF VALUES OF N
+*  0 1 2 3 5 9       VALUES OF N
+*  3                 NUMBER OF VALUES OF ALPHA
+*  (0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
+*  3                 NUMBER OF VALUES OF BETA
+*  (0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
+*  ZGEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZHEMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZSYMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZTRMM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZTRSM  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZHERK  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZSYRK  T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZHER2K T PUT F FOR NO TEST. SAME COLUMNS.
+*  ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
+*
+*  See:
+*
+*     Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
+*     A Set of Level 3 Basic Linear Algebra Subprograms.
+*
+*     Technical Memorandum No.88 (Revision 1), Mathematics and
+*     Computer Science Division, Argonne National Laboratory, 9700
+*     South Cass Avenue, Argonne, Illinois 60439, US.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      INTEGER            NIN
+      PARAMETER          ( NIN = 5 )
+      INTEGER            NSUBS
+      PARAMETER          ( NSUBS = 9 )
+      COMPLEX*16         ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   ONE = ( 1.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO, RHALF, RONE
+      PARAMETER          ( RZERO = 0.0D0, RHALF = 0.5D0, RONE = 1.0D0 )
+      INTEGER            NMAX
+      PARAMETER          ( NMAX = 65 )
+      INTEGER            NIDMAX, NALMAX, NBEMAX
+      PARAMETER          ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 )
+*     .. Local Scalars ..
+      DOUBLE PRECISION   EPS, ERR, THRESH
+      INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA
+      LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
+     $                   TSTERR
+      CHARACTER*1        TRANSA, TRANSB
+      CHARACTER*6        SNAMET
+      CHARACTER*32       SNAPS, SUMMRY
+*     .. Local Arrays ..
+      COMPLEX*16         AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
+     $                   ALF( NALMAX ), AS( NMAX*NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBEMAX ),
+     $                   BS( NMAX*NMAX ), C( NMAX, NMAX ),
+     $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
+     $                   W( 2*NMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDMAX )
+      LOGICAL            LTEST( NSUBS )
+      CHARACTER*6        SNAMES( NSUBS )
+*     .. External Functions ..
+      DOUBLE PRECISION   DDIFF
+      LOGICAL            LZE
+      EXTERNAL           DDIFF, LZE
+*     .. External Subroutines ..
+      EXTERNAL           ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHKE, ZMMCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Data statements ..
+      DATA               SNAMES/'ZGEMM ', 'ZHEMM ', 'ZSYMM ', 'ZTRMM ',
+     $                   'ZTRSM ', 'ZHERK ', 'ZSYRK ', 'ZHER2K',
+     $                   'ZSYR2K'/
+*     .. Executable Statements ..
+*
+*     Read name and unit number for summary output file and open file.
+*
+      READ( NIN, FMT = * )SUMMRY
+      READ( NIN, FMT = * )NOUT
+      OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
+      NOUTC = NOUT
+*
+*     Read name and unit number for snapshot output file and open file.
+*
+      READ( NIN, FMT = * )SNAPS
+      READ( NIN, FMT = * )NTRA
+      TRACE = NTRA.GE.0
+      IF( TRACE )THEN
+         OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
+      END IF
+*     Read the flag that directs rewinding of the snapshot file.
+      READ( NIN, FMT = * )REWI
+      REWI = REWI.AND.TRACE
+*     Read the flag that directs stopping on any failure.
+      READ( NIN, FMT = * )SFATAL
+*     Read the flag that indicates whether error exits are to be tested.
+      READ( NIN, FMT = * )TSTERR
+*     Read the threshold value of the test ratio
+      READ( NIN, FMT = * )THRESH
+*
+*     Read and check the parameter values for the tests.
+*
+*     Values of N
+      READ( NIN, FMT = * )NIDIM
+      IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'N', NIDMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
+      DO 10 I = 1, NIDIM
+         IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
+            WRITE( NOUT, FMT = 9996 )NMAX
+            GO TO 220
+         END IF
+   10 CONTINUE
+*     Values of ALPHA
+      READ( NIN, FMT = * )NALF
+      IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
+*     Values of BETA
+      READ( NIN, FMT = * )NBET
+      IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
+         WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
+         GO TO 220
+      END IF
+      READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
+*
+*     Report values of parameters.
+*
+      WRITE( NOUT, FMT = 9995 )
+      WRITE( NOUT, FMT = 9994 )( IDIM( I ), I = 1, NIDIM )
+      WRITE( NOUT, FMT = 9993 )( ALF( I ), I = 1, NALF )
+      WRITE( NOUT, FMT = 9992 )( BET( I ), I = 1, NBET )
+      IF( .NOT.TSTERR )THEN
+         WRITE( NOUT, FMT = * )
+         WRITE( NOUT, FMT = 9984 )
+      END IF
+      WRITE( NOUT, FMT = * )
+      WRITE( NOUT, FMT = 9999 )THRESH
+      WRITE( NOUT, FMT = * )
+*
+*     Read names of subroutines and flags which indicate
+*     whether they are to be tested.
+*
+      DO 20 I = 1, NSUBS
+         LTEST( I ) = .FALSE.
+   20 CONTINUE
+   30 READ( NIN, FMT = 9988, END = 60 )SNAMET, LTESTT
+      DO 40 I = 1, NSUBS
+         IF( SNAMET.EQ.SNAMES( I ) )
+     $      GO TO 50
+   40 CONTINUE
+      WRITE( NOUT, FMT = 9990 )SNAMET
+      STOP
+   50 LTEST( I ) = LTESTT
+      GO TO 30
+*
+   60 CONTINUE
+      CLOSE ( NIN )
+*
+*     Compute EPS (the machine precision).
+*
+      EPS = RONE
+   70 CONTINUE
+      IF( DDIFF( RONE + EPS, RONE ).EQ.RZERO )
+     $   GO TO 80
+      EPS = RHALF*EPS
+      GO TO 70
+   80 CONTINUE
+      EPS = EPS + EPS
+      WRITE( NOUT, FMT = 9998 )EPS
+*
+*     Check the reliability of ZMMCH using exact data.
+*
+      N = MIN( 32, NMAX )
+      DO 100 J = 1, N
+         DO 90 I = 1, N
+            AB( I, J ) = MAX( I - J + 1, 0 )
+   90    CONTINUE
+         AB( J, NMAX + 1 ) = J
+         AB( 1, NMAX + J ) = J
+         C( J, 1 ) = ZERO
+  100 CONTINUE
+      DO 110 J = 1, N
+         CC( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3
+  110 CONTINUE
+*     CC holds the exact result. On exit from ZMMCH CT holds
+*     the result computed by ZMMCH.
+      TRANSA = 'N'
+      TRANSB = 'N'
+      CALL ZMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LZE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      TRANSB = 'C'
+      CALL ZMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LZE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      DO 120 J = 1, N
+         AB( J, NMAX + 1 ) = N - J + 1
+         AB( 1, NMAX + J ) = N - J + 1
+  120 CONTINUE
+      DO 130 J = 1, N
+         CC( N - J + 1 ) = J*( ( J + 1 )*J )/2 -
+     $                     ( ( J + 1 )*J*( J - 1 ) )/3
+  130 CONTINUE
+      TRANSA = 'C'
+      TRANSB = 'N'
+      CALL ZMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LZE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+      TRANSB = 'C'
+      CALL ZMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
+     $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
+     $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
+      SAME = LZE( CC, CT, N )
+      IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
+         WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
+         STOP
+      END IF
+*
+*     Test each subroutine in turn.
+*
+      DO 200 ISNUM = 1, NSUBS
+         WRITE( NOUT, FMT = * )
+         IF( .NOT.LTEST( ISNUM ) )THEN
+*           Subprogram is not to be tested.
+            WRITE( NOUT, FMT = 9987 )SNAMES( ISNUM )
+         ELSE
+            SRNAMT = SNAMES( ISNUM )
+*           Test error exits.
+            IF( TSTERR )THEN
+               CALL ZCHKE( ISNUM, SNAMES( ISNUM ), NOUT )
+               WRITE( NOUT, FMT = * )
+            END IF
+*           Test computations.
+            INFOT = 0
+            OK = .TRUE.
+            FATAL = .FALSE.
+            GO TO ( 140, 150, 150, 160, 160, 170, 170,
+     $              180, 180 )ISNUM
+*           Test ZGEMM, 01.
+  140       CALL ZCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test ZHEMM, 02, ZSYMM, 03.
+  150       CALL ZCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test ZTRMM, 04, ZTRSM, 05.
+  160       CALL ZCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
+     $                  AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C )
+            GO TO 190
+*           Test ZHERK, 06, ZSYRK, 07.
+  170       CALL ZCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
+     $                  CC, CS, CT, G )
+            GO TO 190
+*           Test ZHER2K, 08, ZSYR2K, 09.
+  180       CALL ZCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
+            GO TO 190
+*
+  190       IF( FATAL.AND.SFATAL )
+     $         GO TO 210
+         END IF
+  200 CONTINUE
+      WRITE( NOUT, FMT = 9986 )
+      GO TO 230
+*
+  210 CONTINUE
+      WRITE( NOUT, FMT = 9985 )
+      GO TO 230
+*
+  220 CONTINUE
+      WRITE( NOUT, FMT = 9991 )
+*
+  230 CONTINUE
+      IF( TRACE )
+     $   CLOSE ( NTRA )
+      CLOSE ( NOUT )
+      STOP
+*
+ 9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
+     $      'S THAN', F8.2 )
+ 9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, D9.1 )
+ 9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
+     $      'THAN ', I2 )
+ 9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 )
+ 9995 FORMAT( ' TESTS OF THE COMPLEX*16       LEVEL 3 BLAS', //' THE F',
+     $      'OLLOWING PARAMETER VALUES WILL BE USED:' )
+ 9994 FORMAT( '   FOR N              ', 9I6 )
+ 9993 FORMAT( '   FOR ALPHA          ',
+     $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
+ 9992 FORMAT( '   FOR BETA           ',
+     $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
+ 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
+     $      /' ******* TESTS ABANDONED *******' )
+ 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+     $      'ESTS ABANDONED *******' )
+ 9989 FORMAT( ' ERROR IN ZMMCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
+     $      'ATED WRONGLY.', /' ZMMCH WAS CALLED WITH TRANSA = ', A1,
+     $      ' AND TRANSB = ', A1, /' AND RETURNED SAME = ', L1, ' AND ',
+     $      'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
+     $      'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
+     $      '*******' )
+ 9988 FORMAT( A6, L2 )
+ 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
+ 9986 FORMAT( /' END OF TESTS' )
+ 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
+ 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
+*
+*     End of ZBLAT3.
+*
+      END
+      SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests ZGEMM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, ALS, BETA, BLS
+      DOUBLE PRECISION   ERR, ERRMAX
+      INTEGER            I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
+     $                   LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M,
+     $                   MA, MB, MS, N, NA, NARGS, NB, NC, NS
+      LOGICAL            NULL, RESET, SAME, TRANA, TRANB
+      CHARACTER*1        TRANAS, TRANBS, TRANSA, TRANSB
+      CHARACTER*3        ICH
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZGEMM, ZMAKE, ZMMCH
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'NTC'/
+*     .. Executable Statements ..
+*
+      NARGS = 13
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 110 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 100 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDC to 1 more than minimum value if room.
+            LDC = M
+            IF( LDC.LT.NMAX )
+     $         LDC = LDC + 1
+*           Skip tests if not enough room.
+            IF( LDC.GT.NMAX )
+     $         GO TO 100
+            LCC = LDC*N
+            NULL = N.LE.0.OR.M.LE.0
+*
+            DO 90 IK = 1, NIDIM
+               K = IDIM( IK )
+*
+               DO 80 ICA = 1, 3
+                  TRANSA = ICH( ICA: ICA )
+                  TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
+*
+                  IF( TRANA )THEN
+                     MA = K
+                     NA = M
+                  ELSE
+                     MA = M
+                     NA = K
+                  END IF
+*                 Set LDA to 1 more than minimum value if room.
+                  LDA = MA
+                  IF( LDA.LT.NMAX )
+     $               LDA = LDA + 1
+*                 Skip tests if not enough room.
+                  IF( LDA.GT.NMAX )
+     $               GO TO 80
+                  LAA = LDA*NA
+*
+*                 Generate the matrix A.
+*
+                  CALL ZMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
+     $                        RESET, ZERO )
+*
+                  DO 70 ICB = 1, 3
+                     TRANSB = ICH( ICB: ICB )
+                     TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
+*
+                     IF( TRANB )THEN
+                        MB = N
+                        NB = K
+                     ELSE
+                        MB = K
+                        NB = N
+                     END IF
+*                    Set LDB to 1 more than minimum value if room.
+                     LDB = MB
+                     IF( LDB.LT.NMAX )
+     $                  LDB = LDB + 1
+*                    Skip tests if not enough room.
+                     IF( LDB.GT.NMAX )
+     $                  GO TO 70
+                     LBB = LDB*NB
+*
+*                    Generate the matrix B.
+*
+                     CALL ZMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
+     $                           LDB, RESET, ZERO )
+*
+                     DO 60 IA = 1, NALF
+                        ALPHA = ALF( IA )
+*
+                        DO 50 IB = 1, NBET
+                           BETA = BET( IB )
+*
+*                          Generate the matrix C.
+*
+                           CALL ZMAKE( 'GE', ' ', ' ', M, N, C, NMAX,
+     $                                 CC, LDC, RESET, ZERO )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           TRANAS = TRANSA
+                           TRANBS = TRANSB
+                           MS = M
+                           NS = N
+                           KS = K
+                           ALS = ALPHA
+                           DO 10 I = 1, LAA
+                              AS( I ) = AA( I )
+   10                      CONTINUE
+                           LDAS = LDA
+                           DO 20 I = 1, LBB
+                              BS( I ) = BB( I )
+   20                      CONTINUE
+                           LDBS = LDB
+                           BLS = BETA
+                           DO 30 I = 1, LCC
+                              CS( I ) = CC( I )
+   30                      CONTINUE
+                           LDCS = LDC
+*
+*                          Call the subroutine.
+*
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                        TRANSA, TRANSB, M, N, K, ALPHA, LDA, LDB,
+     $                        BETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL ZGEMM( TRANSA, TRANSB, M, N, K, ALPHA,
+     $                                 AA, LDA, BB, LDB, BETA, CC, LDC )
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9994 )
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = TRANSA.EQ.TRANAS
+                           ISAME( 2 ) = TRANSB.EQ.TRANBS
+                           ISAME( 3 ) = MS.EQ.M
+                           ISAME( 4 ) = NS.EQ.N
+                           ISAME( 5 ) = KS.EQ.K
+                           ISAME( 6 ) = ALS.EQ.ALPHA
+                           ISAME( 7 ) = LZE( AS, AA, LAA )
+                           ISAME( 8 ) = LDAS.EQ.LDA
+                           ISAME( 9 ) = LZE( BS, BB, LBB )
+                           ISAME( 10 ) = LDBS.EQ.LDB
+                           ISAME( 11 ) = BLS.EQ.BETA
+                           IF( NULL )THEN
+                              ISAME( 12 ) = LZE( CS, CC, LCC )
+                           ELSE
+                              ISAME( 12 ) = LZERES( 'GE', ' ', M, N, CS,
+     $                                      CC, LDC )
+                           END IF
+                           ISAME( 13 ) = LDCS.EQ.LDC
+*
+*                          If data was incorrectly changed, report
+*                          and return.
+*
+                           SAME = .TRUE.
+                           DO 40 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   40                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+*
+*                             Check the result.
+*
+                              CALL ZMMCH( TRANSA, TRANSB, M, N, K,
+     $                                    ALPHA, A, NMAX, B, NMAX, BETA,
+     $                                    C, NMAX, CT, G, CC, LDC, EPS,
+     $                                    ERR, FATAL, NOUT, .TRUE. )
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 120
+                           END IF
+*
+   50                   CONTINUE
+*
+   60                CONTINUE
+*
+   70             CONTINUE
+*
+   80          CONTINUE
+*
+   90       CONTINUE
+*
+  100    CONTINUE
+*
+  110 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, M, N, K,
+     $   ALPHA, LDA, LDB, BETA, LDC
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',',
+     $      3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
+     $      ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK1.
+*
+      END
+      SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests ZHEMM and ZSYMM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, ALS, BETA, BLS
+      DOUBLE PRECISION   ERR, ERRMAX
+      INTEGER            I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC,
+     $                   LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA,
+     $                   NARGS, NC, NS
+      LOGICAL            CONJ, LEFT, NULL, RESET, SAME
+      CHARACTER*1        SIDE, SIDES, UPLO, UPLOS
+      CHARACTER*2        ICHS, ICHU
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZHEMM, ZMAKE, ZMMCH, ZSYMM
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHS/'LR'/, ICHU/'UL'/
+*     .. Executable Statements ..
+      CONJ = SNAME( 2: 3 ).EQ.'HE'
+*
+      NARGS = 12
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 100 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 90 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDC to 1 more than minimum value if room.
+            LDC = M
+            IF( LDC.LT.NMAX )
+     $         LDC = LDC + 1
+*           Skip tests if not enough room.
+            IF( LDC.GT.NMAX )
+     $         GO TO 90
+            LCC = LDC*N
+            NULL = N.LE.0.OR.M.LE.0
+*           Set LDB to 1 more than minimum value if room.
+            LDB = M
+            IF( LDB.LT.NMAX )
+     $         LDB = LDB + 1
+*           Skip tests if not enough room.
+            IF( LDB.GT.NMAX )
+     $         GO TO 90
+            LBB = LDB*N
+*
+*           Generate the matrix B.
+*
+            CALL ZMAKE( 'GE', ' ', ' ', M, N, B, NMAX, BB, LDB, RESET,
+     $                  ZERO )
+*
+            DO 80 ICS = 1, 2
+               SIDE = ICHS( ICS: ICS )
+               LEFT = SIDE.EQ.'L'
+*
+               IF( LEFT )THEN
+                  NA = M
+               ELSE
+                  NA = N
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = NA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 80
+               LAA = LDA*NA
+*
+               DO 70 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+*
+*                 Generate the hermitian or symmetric matrix A.
+*
+                  CALL ZMAKE( SNAME( 2: 3 ), UPLO, ' ', NA, NA, A, NMAX,
+     $                        AA, LDA, RESET, ZERO )
+*
+                  DO 60 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 50 IB = 1, NBET
+                        BETA = BET( IB )
+*
+*                       Generate the matrix C.
+*
+                        CALL ZMAKE( 'GE', ' ', ' ', M, N, C, NMAX, CC,
+     $                              LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the
+*                       subroutine.
+*
+                        SIDES = SIDE
+                        UPLOS = UPLO
+                        MS = M
+                        NS = N
+                        ALS = ALPHA
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        DO 20 I = 1, LBB
+                           BS( I ) = BB( I )
+   20                   CONTINUE
+                        LDBS = LDB
+                        BLS = BETA
+                        DO 30 I = 1, LCC
+                           CS( I ) = CC( I )
+   30                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( TRACE )
+     $                     WRITE( NTRA, FMT = 9995 )NC, SNAME, SIDE,
+     $                     UPLO, M, N, ALPHA, LDA, LDB, BETA, LDC
+                        IF( REWI )
+     $                     REWIND NTRA
+                        IF( CONJ )THEN
+                           CALL ZHEMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
+     $                                 BB, LDB, BETA, CC, LDC )
+                        ELSE
+                           CALL ZSYMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
+     $                                 BB, LDB, BETA, CC, LDC )
+                        END IF
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9994 )
+                           FATAL = .TRUE.
+                           GO TO 110
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = SIDES.EQ.SIDE
+                        ISAME( 2 ) = UPLOS.EQ.UPLO
+                        ISAME( 3 ) = MS.EQ.M
+                        ISAME( 4 ) = NS.EQ.N
+                        ISAME( 5 ) = ALS.EQ.ALPHA
+                        ISAME( 6 ) = LZE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        ISAME( 8 ) = LZE( BS, BB, LBB )
+                        ISAME( 9 ) = LDBS.EQ.LDB
+                        ISAME( 10 ) = BLS.EQ.BETA
+                        IF( NULL )THEN
+                           ISAME( 11 ) = LZE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 11 ) = LZERES( 'GE', ' ', M, N, CS,
+     $                                   CC, LDC )
+                        END IF
+                        ISAME( 12 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 110
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result.
+*
+                           IF( LEFT )THEN
+                              CALL ZMMCH( 'N', 'N', M, N, M, ALPHA, A,
+     $                                    NMAX, B, NMAX, BETA, C, NMAX,
+     $                                    CT, G, CC, LDC, EPS, ERR,
+     $                                    FATAL, NOUT, .TRUE. )
+                           ELSE
+                              CALL ZMMCH( 'N', 'N', M, N, N, ALPHA, B,
+     $                                    NMAX, A, NMAX, BETA, C, NMAX,
+     $                                    CT, G, CC, LDC, EPS, ERR,
+     $                                    FATAL, NOUT, .TRUE. )
+                           END IF
+                           ERRMAX = MAX( ERRMAX, ERR )
+*                          If got really bad answer, report and
+*                          return.
+                           IF( FATAL )
+     $                        GO TO 110
+                        END IF
+*
+   50                CONTINUE
+*
+   60             CONTINUE
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 120
+*
+  110 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, M, N, ALPHA, LDA,
+     $   LDB, BETA, LDC
+*
+  120 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
+     $      ',', F4.1, '), C,', I3, ')    .' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK2.
+*
+      END
+      SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS,
+     $                  B, BB, BS, CT, G, C )
+*
+*  Tests ZTRMM and ZTRSM.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   ONE = ( 1.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            NALF, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CT( NMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, ALS
+      DOUBLE PRECISION   ERR, ERRMAX
+      INTEGER            I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB,
+     $                   LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC,
+     $                   NS
+      LOGICAL            LEFT, NULL, RESET, SAME
+      CHARACTER*1        DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO,
+     $                   UPLOS
+      CHARACTER*2        ICHD, ICHS, ICHU
+      CHARACTER*3        ICHT
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZMAKE, ZMMCH, ZTRMM, ZTRSM
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/
+*     .. Executable Statements ..
+*
+      NARGS = 11
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*     Set up zero matrix for ZMMCH.
+      DO 20 J = 1, NMAX
+         DO 10 I = 1, NMAX
+            C( I, J ) = ZERO
+   10    CONTINUE
+   20 CONTINUE
+*
+      DO 140 IM = 1, NIDIM
+         M = IDIM( IM )
+*
+         DO 130 IN = 1, NIDIM
+            N = IDIM( IN )
+*           Set LDB to 1 more than minimum value if room.
+            LDB = M
+            IF( LDB.LT.NMAX )
+     $         LDB = LDB + 1
+*           Skip tests if not enough room.
+            IF( LDB.GT.NMAX )
+     $         GO TO 130
+            LBB = LDB*N
+            NULL = M.LE.0.OR.N.LE.0
+*
+            DO 120 ICS = 1, 2
+               SIDE = ICHS( ICS: ICS )
+               LEFT = SIDE.EQ.'L'
+               IF( LEFT )THEN
+                  NA = M
+               ELSE
+                  NA = N
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = NA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 130
+               LAA = LDA*NA
+*
+               DO 110 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+*
+                  DO 100 ICT = 1, 3
+                     TRANSA = ICHT( ICT: ICT )
+*
+                     DO 90 ICD = 1, 2
+                        DIAG = ICHD( ICD: ICD )
+*
+                        DO 80 IA = 1, NALF
+                           ALPHA = ALF( IA )
+*
+*                          Generate the matrix A.
+*
+                           CALL ZMAKE( 'TR', UPLO, DIAG, NA, NA, A,
+     $                                 NMAX, AA, LDA, RESET, ZERO )
+*
+*                          Generate the matrix B.
+*
+                           CALL ZMAKE( 'GE', ' ', ' ', M, N, B, NMAX,
+     $                                 BB, LDB, RESET, ZERO )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           SIDES = SIDE
+                           UPLOS = UPLO
+                           TRANAS = TRANSA
+                           DIAGS = DIAG
+                           MS = M
+                           NS = N
+                           ALS = ALPHA
+                           DO 30 I = 1, LAA
+                              AS( I ) = AA( I )
+   30                      CONTINUE
+                           LDAS = LDA
+                           DO 40 I = 1, LBB
+                              BS( I ) = BB( I )
+   40                      CONTINUE
+                           LDBS = LDB
+*
+*                          Call the subroutine.
+*
+                           IF( SNAME( 4: 5 ).EQ.'MM' )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
+     $                           LDA, LDB
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZTRMM( SIDE, UPLO, TRANSA, DIAG, M,
+     $                                    N, ALPHA, AA, LDA, BB, LDB )
+                           ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
+                              IF( TRACE )
+     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
+     $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
+     $                           LDA, LDB
+                              IF( REWI )
+     $                           REWIND NTRA
+                              CALL ZTRSM( SIDE, UPLO, TRANSA, DIAG, M,
+     $                                    N, ALPHA, AA, LDA, BB, LDB )
+                           END IF
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9994 )
+                              FATAL = .TRUE.
+                              GO TO 150
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = SIDES.EQ.SIDE
+                           ISAME( 2 ) = UPLOS.EQ.UPLO
+                           ISAME( 3 ) = TRANAS.EQ.TRANSA
+                           ISAME( 4 ) = DIAGS.EQ.DIAG
+                           ISAME( 5 ) = MS.EQ.M
+                           ISAME( 6 ) = NS.EQ.N
+                           ISAME( 7 ) = ALS.EQ.ALPHA
+                           ISAME( 8 ) = LZE( AS, AA, LAA )
+                           ISAME( 9 ) = LDAS.EQ.LDA
+                           IF( NULL )THEN
+                              ISAME( 10 ) = LZE( BS, BB, LBB )
+                           ELSE
+                              ISAME( 10 ) = LZERES( 'GE', ' ', M, N, BS,
+     $                                      BB, LDB )
+                           END IF
+                           ISAME( 11 ) = LDBS.EQ.LDB
+*
+*                          If data was incorrectly changed, report and
+*                          return.
+*
+                           SAME = .TRUE.
+                           DO 50 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   50                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 150
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+                              IF( SNAME( 4: 5 ).EQ.'MM' )THEN
+*
+*                                Check the result.
+*
+                                 IF( LEFT )THEN
+                                    CALL ZMMCH( TRANSA, 'N', M, N, M,
+     $                                          ALPHA, A, NMAX, B, NMAX,
+     $                                          ZERO, C, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .TRUE. )
+                                 ELSE
+                                    CALL ZMMCH( 'N', TRANSA, M, N, N,
+     $                                          ALPHA, B, NMAX, A, NMAX,
+     $                                          ZERO, C, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .TRUE. )
+                                 END IF
+                              ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
+*
+*                                Compute approximation to original
+*                                matrix.
+*
+                                 DO 70 J = 1, N
+                                    DO 60 I = 1, M
+                                       C( I, J ) = BB( I + ( J - 1 )*
+     $                                             LDB )
+                                       BB( I + ( J - 1 )*LDB ) = ALPHA*
+     $                                    B( I, J )
+   60                               CONTINUE
+   70                            CONTINUE
+*
+                                 IF( LEFT )THEN
+                                    CALL ZMMCH( TRANSA, 'N', M, N, M,
+     $                                          ONE, A, NMAX, C, NMAX,
+     $                                          ZERO, B, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .FALSE. )
+                                 ELSE
+                                    CALL ZMMCH( 'N', TRANSA, M, N, N,
+     $                                          ONE, C, NMAX, A, NMAX,
+     $                                          ZERO, B, NMAX, CT, G,
+     $                                          BB, LDB, EPS, ERR,
+     $                                          FATAL, NOUT, .FALSE. )
+                                 END IF
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 150
+                           END IF
+*
+   80                   CONTINUE
+*
+   90                CONTINUE
+*
+  100             CONTINUE
+*
+  110          CONTINUE
+*
+  120       CONTINUE
+*
+  130    CONTINUE
+*
+  140 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 160
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, TRANSA, DIAG, M,
+     $   N, ALPHA, LDA, LDB
+*
+  160 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
+     $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ')         ',
+     $      '      .' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK3.
+*
+      END
+      SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
+*
+*  Tests ZHERK and ZSYRK.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RONE, RZERO
+      PARAMETER          ( RONE = 1.0D0, RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, ALS, BETA, BETS
+      DOUBLE PRECISION   ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS
+      INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
+     $                   LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA,
+     $                   NARGS, NC, NS
+      LOGICAL            CONJ, NULL, RESET, SAME, TRAN, UPPER
+      CHARACTER*1        TRANS, TRANSS, TRANST, UPLO, UPLOS
+      CHARACTER*2        ICHT, ICHU
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZHERK, ZMAKE, ZMMCH, ZSYRK
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCMPLX, MAX, DBLE
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHT/'NC'/, ICHU/'UL'/
+*     .. Executable Statements ..
+      CONJ = SNAME( 2: 3 ).EQ.'HE'
+*
+      NARGS = 10
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 100 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDC to 1 more than minimum value if room.
+         LDC = N
+         IF( LDC.LT.NMAX )
+     $      LDC = LDC + 1
+*        Skip tests if not enough room.
+         IF( LDC.GT.NMAX )
+     $      GO TO 100
+         LCC = LDC*N
+*
+         DO 90 IK = 1, NIDIM
+            K = IDIM( IK )
+*
+            DO 80 ICT = 1, 2
+               TRANS = ICHT( ICT: ICT )
+               TRAN = TRANS.EQ.'C'
+               IF( TRAN.AND..NOT.CONJ )
+     $            TRANS = 'T'
+               IF( TRAN )THEN
+                  MA = K
+                  NA = N
+               ELSE
+                  MA = N
+                  NA = K
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = MA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 80
+               LAA = LDA*NA
+*
+*              Generate the matrix A.
+*
+               CALL ZMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
+     $                     RESET, ZERO )
+*
+               DO 70 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+                  UPPER = UPLO.EQ.'U'
+*
+                  DO 60 IA = 1, NALF
+                     ALPHA = ALF( IA )
+                     IF( CONJ )THEN
+                        RALPHA = DBLE( ALPHA )
+                        ALPHA = DCMPLX( RALPHA, RZERO )
+                     END IF
+*
+                     DO 50 IB = 1, NBET
+                        BETA = BET( IB )
+                        IF( CONJ )THEN
+                           RBETA = DBLE( BETA )
+                           BETA = DCMPLX( RBETA, RZERO )
+                        END IF
+                        NULL = N.LE.0
+                        IF( CONJ )
+     $                     NULL = NULL.OR.( ( K.LE.0.OR.RALPHA.EQ.
+     $                            RZERO ).AND.RBETA.EQ.RONE )
+*
+*                       Generate the matrix C.
+*
+                        CALL ZMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, C,
+     $                              NMAX, CC, LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        NS = N
+                        KS = K
+                        IF( CONJ )THEN
+                           RALS = RALPHA
+                        ELSE
+                           ALS = ALPHA
+                        END IF
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        IF( CONJ )THEN
+                           RBETS = RBETA
+                        ELSE
+                           BETS = BETA
+                        END IF
+                        DO 20 I = 1, LCC
+                           CS( I ) = CC( I )
+   20                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( CONJ )THEN
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
+     $                        TRANS, N, K, RALPHA, LDA, RBETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL ZHERK( UPLO, TRANS, N, K, RALPHA, AA,
+     $                                 LDA, RBETA, CC, LDC )
+                        ELSE
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO,
+     $                        TRANS, N, K, ALPHA, LDA, BETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL ZSYRK( UPLO, TRANS, N, K, ALPHA, AA,
+     $                                 LDA, BETA, CC, LDC )
+                        END IF
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9992 )
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLOS.EQ.UPLO
+                        ISAME( 2 ) = TRANSS.EQ.TRANS
+                        ISAME( 3 ) = NS.EQ.N
+                        ISAME( 4 ) = KS.EQ.K
+                        IF( CONJ )THEN
+                           ISAME( 5 ) = RALS.EQ.RALPHA
+                        ELSE
+                           ISAME( 5 ) = ALS.EQ.ALPHA
+                        END IF
+                        ISAME( 6 ) = LZE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        IF( CONJ )THEN
+                           ISAME( 8 ) = RBETS.EQ.RBETA
+                        ELSE
+                           ISAME( 8 ) = BETS.EQ.BETA
+                        END IF
+                        IF( NULL )THEN
+                           ISAME( 9 ) = LZE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 9 ) = LZERES( SNAME( 2: 3 ), UPLO, N,
+     $                                  N, CS, CC, LDC )
+                        END IF
+                        ISAME( 10 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 30 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   30                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 120
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result column by column.
+*
+                           IF( CONJ )THEN
+                              TRANST = 'C'
+                           ELSE
+                              TRANST = 'T'
+                           END IF
+                           JC = 1
+                           DO 40 J = 1, N
+                              IF( UPPER )THEN
+                                 JJ = 1
+                                 LJ = J
+                              ELSE
+                                 JJ = J
+                                 LJ = N - J + 1
+                              END IF
+                              IF( TRAN )THEN
+                                 CALL ZMMCH( TRANST, 'N', LJ, 1, K,
+     $                                       ALPHA, A( 1, JJ ), NMAX,
+     $                                       A( 1, J ), NMAX, BETA,
+     $                                       C( JJ, J ), NMAX, CT, G,
+     $                                       CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              ELSE
+                                 CALL ZMMCH( 'N', TRANST, LJ, 1, K,
+     $                                       ALPHA, A( JJ, 1 ), NMAX,
+     $                                       A( J, 1 ), NMAX, BETA,
+     $                                       C( JJ, J ), NMAX, CT, G,
+     $                                       CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              END IF
+                              IF( UPPER )THEN
+                                 JC = JC + LDC
+                              ELSE
+                                 JC = JC + LDC + 1
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 110
+   40                      CONTINUE
+                        END IF
+*
+   50                CONTINUE
+*
+   60             CONTINUE
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  110 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9995 )J
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( CONJ )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, RALPHA,
+     $      LDA, RBETA, LDC
+      ELSE
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
+     $      LDA, BETA, LDC
+      END IF
+*
+  130 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')               ',
+     $      '          .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1,
+     $      '), C,', I3, ')          .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK4.
+*
+      END
+      SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
+*
+*  Tests ZHER2K and ZSYR2K.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   ONE = ( 1.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RONE, RZERO
+      PARAMETER          ( RONE = 1.0D0, RZERO = 0.0D0 )
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*6        SNAME
+*     .. Array Arguments ..
+      COMPLEX*16         AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
+     $                   ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
+     $                   BET( NBET ), BS( NMAX*NMAX ), C( NMAX, NMAX ),
+     $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
+     $                   W( 2*NMAX )
+      DOUBLE PRECISION   G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, ALS, BETA, BETS
+      DOUBLE PRECISION   ERR, ERRMAX, RBETA, RBETS
+      INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB,
+     $                   K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS,
+     $                   LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS
+      LOGICAL            CONJ, NULL, RESET, SAME, TRAN, UPPER
+      CHARACTER*1        TRANS, TRANSS, TRANST, UPLO, UPLOS
+      CHARACTER*2        ICHT, ICHU
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LZE, LZERES
+      EXTERNAL           LZE, LZERES
+*     .. External Subroutines ..
+      EXTERNAL           ZHER2K, ZMAKE, ZMMCH, ZSYR2K
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCMPLX, DCONJG, MAX, DBLE
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICHT/'NC'/, ICHU/'UL'/
+*     .. Executable Statements ..
+      CONJ = SNAME( 2: 3 ).EQ.'HE'
+*
+      NARGS = 12
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = RZERO
+*
+      DO 130 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDC to 1 more than minimum value if room.
+         LDC = N
+         IF( LDC.LT.NMAX )
+     $      LDC = LDC + 1
+*        Skip tests if not enough room.
+         IF( LDC.GT.NMAX )
+     $      GO TO 130
+         LCC = LDC*N
+*
+         DO 120 IK = 1, NIDIM
+            K = IDIM( IK )
+*
+            DO 110 ICT = 1, 2
+               TRANS = ICHT( ICT: ICT )
+               TRAN = TRANS.EQ.'C'
+               IF( TRAN.AND..NOT.CONJ )
+     $            TRANS = 'T'
+               IF( TRAN )THEN
+                  MA = K
+                  NA = N
+               ELSE
+                  MA = N
+                  NA = K
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = MA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 110
+               LAA = LDA*NA
+*
+*              Generate the matrix A.
+*
+               IF( TRAN )THEN
+                  CALL ZMAKE( 'GE', ' ', ' ', MA, NA, AB, 2*NMAX, AA,
+     $                        LDA, RESET, ZERO )
+               ELSE
+                  CALL ZMAKE( 'GE', ' ', ' ', MA, NA, AB, NMAX, AA, LDA,
+     $                        RESET, ZERO )
+               END IF
+*
+*              Generate the matrix B.
+*
+               LDB = LDA
+               LBB = LAA
+               IF( TRAN )THEN
+                  CALL ZMAKE( 'GE', ' ', ' ', MA, NA, AB( K + 1 ),
+     $                        2*NMAX, BB, LDB, RESET, ZERO )
+               ELSE
+                  CALL ZMAKE( 'GE', ' ', ' ', MA, NA, AB( K*NMAX + 1 ),
+     $                        NMAX, BB, LDB, RESET, ZERO )
+               END IF
+*
+               DO 100 ICU = 1, 2
+                  UPLO = ICHU( ICU: ICU )
+                  UPPER = UPLO.EQ.'U'
+*
+                  DO 90 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 80 IB = 1, NBET
+                        BETA = BET( IB )
+                        IF( CONJ )THEN
+                           RBETA = DBLE( BETA )
+                           BETA = DCMPLX( RBETA, RZERO )
+                        END IF
+                        NULL = N.LE.0
+                        IF( CONJ )
+     $                     NULL = NULL.OR.( ( K.LE.0.OR.ALPHA.EQ.
+     $                            ZERO ).AND.RBETA.EQ.RONE )
+*
+*                       Generate the matrix C.
+*
+                        CALL ZMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, C,
+     $                              NMAX, CC, LDC, RESET, ZERO )
+*
+                        NC = NC + 1
+*
+*                       Save every datum before calling the subroutine.
+*
+                        UPLOS = UPLO
+                        TRANSS = TRANS
+                        NS = N
+                        KS = K
+                        ALS = ALPHA
+                        DO 10 I = 1, LAA
+                           AS( I ) = AA( I )
+   10                   CONTINUE
+                        LDAS = LDA
+                        DO 20 I = 1, LBB
+                           BS( I ) = BB( I )
+   20                   CONTINUE
+                        LDBS = LDB
+                        IF( CONJ )THEN
+                           RBETS = RBETA
+                        ELSE
+                           BETS = BETA
+                        END IF
+                        DO 30 I = 1, LCC
+                           CS( I ) = CC( I )
+   30                   CONTINUE
+                        LDCS = LDC
+*
+*                       Call the subroutine.
+*
+                        IF( CONJ )THEN
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
+     $                        TRANS, N, K, ALPHA, LDA, LDB, RBETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL ZHER2K( UPLO, TRANS, N, K, ALPHA, AA,
+     $                                  LDA, BB, LDB, RBETA, CC, LDC )
+                        ELSE
+                           IF( TRACE )
+     $                        WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO,
+     $                        TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL ZSYR2K( UPLO, TRANS, N, K, ALPHA, AA,
+     $                                  LDA, BB, LDB, BETA, CC, LDC )
+                        END IF
+*
+*                       Check if error-exit was taken incorrectly.
+*
+                        IF( .NOT.OK )THEN
+                           WRITE( NOUT, FMT = 9992 )
+                           FATAL = .TRUE.
+                           GO TO 150
+                        END IF
+*
+*                       See what data changed inside subroutines.
+*
+                        ISAME( 1 ) = UPLOS.EQ.UPLO
+                        ISAME( 2 ) = TRANSS.EQ.TRANS
+                        ISAME( 3 ) = NS.EQ.N
+                        ISAME( 4 ) = KS.EQ.K
+                        ISAME( 5 ) = ALS.EQ.ALPHA
+                        ISAME( 6 ) = LZE( AS, AA, LAA )
+                        ISAME( 7 ) = LDAS.EQ.LDA
+                        ISAME( 8 ) = LZE( BS, BB, LBB )
+                        ISAME( 9 ) = LDBS.EQ.LDB
+                        IF( CONJ )THEN
+                           ISAME( 10 ) = RBETS.EQ.RBETA
+                        ELSE
+                           ISAME( 10 ) = BETS.EQ.BETA
+                        END IF
+                        IF( NULL )THEN
+                           ISAME( 11 ) = LZE( CS, CC, LCC )
+                        ELSE
+                           ISAME( 11 ) = LZERES( 'HE', UPLO, N, N, CS,
+     $                                   CC, LDC )
+                        END IF
+                        ISAME( 12 ) = LDCS.EQ.LDC
+*
+*                       If data was incorrectly changed, report and
+*                       return.
+*
+                        SAME = .TRUE.
+                        DO 40 I = 1, NARGS
+                           SAME = SAME.AND.ISAME( I )
+                           IF( .NOT.ISAME( I ) )
+     $                        WRITE( NOUT, FMT = 9998 )I
+   40                   CONTINUE
+                        IF( .NOT.SAME )THEN
+                           FATAL = .TRUE.
+                           GO TO 150
+                        END IF
+*
+                        IF( .NOT.NULL )THEN
+*
+*                          Check the result column by column.
+*
+                           IF( CONJ )THEN
+                              TRANST = 'C'
+                           ELSE
+                              TRANST = 'T'
+                           END IF
+                           JJAB = 1
+                           JC = 1
+                           DO 70 J = 1, N
+                              IF( UPPER )THEN
+                                 JJ = 1
+                                 LJ = J
+                              ELSE
+                                 JJ = J
+                                 LJ = N - J + 1
+                              END IF
+                              IF( TRAN )THEN
+                                 DO 50 I = 1, K
+                                    W( I ) = ALPHA*AB( ( J - 1 )*2*
+     $                                       NMAX + K + I )
+                                    IF( CONJ )THEN
+                                       W( K + I ) = DCONJG( ALPHA )*
+     $                                              AB( ( J - 1 )*2*
+     $                                              NMAX + I )
+                                    ELSE
+                                       W( K + I ) = ALPHA*
+     $                                              AB( ( J - 1 )*2*
+     $                                              NMAX + I )
+                                    END IF
+   50                            CONTINUE
+                                 CALL ZMMCH( TRANST, 'N', LJ, 1, 2*K,
+     $                                       ONE, AB( JJAB ), 2*NMAX, W,
+     $                                       2*NMAX, BETA, C( JJ, J ),
+     $                                       NMAX, CT, G, CC( JC ), LDC,
+     $                                       EPS, ERR, FATAL, NOUT,
+     $                                       .TRUE. )
+                              ELSE
+                                 DO 60 I = 1, K
+                                    IF( CONJ )THEN
+                                       W( I ) = ALPHA*DCONJG( AB( ( K +
+     $                                          I - 1 )*NMAX + J ) )
+                                       W( K + I ) = DCONJG( ALPHA*
+     $                                              AB( ( I - 1 )*NMAX +
+     $                                              J ) )
+                                    ELSE
+                                       W( I ) = ALPHA*AB( ( K + I - 1 )*
+     $                                          NMAX + J )
+                                       W( K + I ) = ALPHA*
+     $                                              AB( ( I - 1 )*NMAX +
+     $                                              J )
+                                    END IF
+   60                            CONTINUE
+                                 CALL ZMMCH( 'N', 'N', LJ, 1, 2*K, ONE,
+     $                                       AB( JJ ), NMAX, W, 2*NMAX,
+     $                                       BETA, C( JJ, J ), NMAX, CT,
+     $                                       G, CC( JC ), LDC, EPS, ERR,
+     $                                       FATAL, NOUT, .TRUE. )
+                              END IF
+                              IF( UPPER )THEN
+                                 JC = JC + LDC
+                              ELSE
+                                 JC = JC + LDC + 1
+                                 IF( TRAN )
+     $                              JJAB = JJAB + 2*NMAX
+                              END IF
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 140
+   70                      CONTINUE
+                        END IF
+*
+   80                CONTINUE
+*
+   90             CONTINUE
+*
+  100          CONTINUE
+*
+  110       CONTINUE
+*
+  120    CONTINUE
+*
+  130 CONTINUE
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         WRITE( NOUT, FMT = 9999 )SNAME, NC
+      ELSE
+         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 160
+*
+  140 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9995 )J
+*
+  150 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      IF( CONJ )THEN
+         WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
+     $      LDA, LDB, RBETA, LDC
+      ELSE
+         WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
+     $      LDA, LDB, BETA, LDC
+      END IF
+*
+  160 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+     $      'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+ 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1,
+     $      ', C,', I3, ')           .' )
+ 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
+     $      ',', F4.1, '), C,', I3, ')    .' )
+ 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of ZCHK5.
+*
+      END
+      SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT )
+*
+*  Tests the error exits from the Level 3 Blas.
+*  Requires a special version of the error-handling routine XERBLA.
+*  ALPHA, RALPHA, BETA, RBETA, A, B and C should not need to be defined.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            ISNUM, NOUT
+      CHARACTER*6        SRNAMT
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA, BETA
+      DOUBLE PRECISION   RALPHA, RBETA
+*     .. Local Arrays ..
+      COMPLEX*16         A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
+*     .. External Subroutines ..
+      EXTERNAL           ZGEMM, ZHEMM, ZHER2K, ZHERK, CHKXER, ZSYMM,
+     $                   ZSYR2K, ZSYRK, ZTRMM, ZTRSM
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Executable Statements ..
+*     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
+*     if anything is wrong.
+      OK = .TRUE.
+*     LERR is set to .TRUE. by the special version of XERBLA each time
+*     it is called, and is then tested and re-set by CHKXER.
+      LERR = .FALSE.
+      GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
+     $        90 )ISNUM
+   10 INFOT = 1
+      CALL ZGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 1
+      CALL ZGEMM( '/', 'C', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 1
+      CALL ZGEMM( '/', 'T', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZGEMM( 'N', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZGEMM( 'C', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZGEMM( 'T', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGEMM( 'N', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGEMM( 'N', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGEMM( 'N', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGEMM( 'C', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGEMM( 'C', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGEMM( 'C', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGEMM( 'T', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGEMM( 'T', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZGEMM( 'T', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZGEMM( 'N', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZGEMM( 'N', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZGEMM( 'N', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZGEMM( 'C', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZGEMM( 'C', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZGEMM( 'C', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZGEMM( 'T', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZGEMM( 'T', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZGEMM( 'T', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGEMM( 'N', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGEMM( 'N', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGEMM( 'N', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGEMM( 'C', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGEMM( 'C', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGEMM( 'C', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGEMM( 'T', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGEMM( 'T', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZGEMM( 'T', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGEMM( 'N', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGEMM( 'C', 'N', 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGEMM( 'C', 'C', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGEMM( 'C', 'T', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGEMM( 'T', 'C', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 8
+      CALL ZGEMM( 'T', 'T', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZGEMM( 'N', 'N', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZGEMM( 'C', 'N', 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZGEMM( 'N', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZGEMM( 'C', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZGEMM( 'T', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZGEMM( 'N', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZGEMM( 'C', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZGEMM( 'T', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL ZGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL ZGEMM( 'N', 'C', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL ZGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL ZGEMM( 'C', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL ZGEMM( 'C', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL ZGEMM( 'C', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL ZGEMM( 'T', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL ZGEMM( 'T', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 13
+      CALL ZGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   20 INFOT = 1
+      CALL ZHEMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZHEMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHEMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHEMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHEMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHEMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHEMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHEMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHEMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHEMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHEMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHEMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHEMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHEMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   30 INFOT = 1
+      CALL ZSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZSYMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   40 INFOT = 1
+      CALL ZTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZTRMM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZTRMM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZTRMM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'L', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'R', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'L', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'R', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRMM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'L', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'R', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'L', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'R', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRMM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'R', 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'R', 'L', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRMM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'R', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'R', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   50 INFOT = 1
+      CALL ZTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZTRSM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZTRSM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZTRSM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'L', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'R', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'L', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'R', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 5
+      CALL ZTRSM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'L', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'R', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'L', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'R', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 6
+      CALL ZTRSM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'R', 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'R', 'L', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZTRSM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'R', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'R', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 11
+      CALL ZTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   60 INFOT = 1
+      CALL ZHERK( '/', 'N', 0, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZHERK( 'U', 'T', 0, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHERK( 'U', 'N', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHERK( 'U', 'C', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHERK( 'L', 'N', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHERK( 'L', 'C', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHERK( 'U', 'N', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHERK( 'U', 'C', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHERK( 'L', 'N', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHERK( 'L', 'C', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHERK( 'U', 'N', 2, 0, RALPHA, A, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHERK( 'U', 'C', 0, 2, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHERK( 'L', 'N', 2, 0, RALPHA, A, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHERK( 'L', 'C', 0, 2, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZHERK( 'U', 'N', 2, 0, RALPHA, A, 2, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZHERK( 'U', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZHERK( 'L', 'N', 2, 0, RALPHA, A, 2, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZHERK( 'L', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   70 INFOT = 1
+      CALL ZSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZSYRK( 'U', 'C', 0, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYRK( 'U', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYRK( 'U', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYRK( 'L', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYRK( 'L', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYRK( 'U', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYRK( 'U', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYRK( 'L', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYRK( 'L', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYRK( 'U', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYRK( 'U', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYRK( 'L', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYRK( 'L', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZSYRK( 'U', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZSYRK( 'U', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZSYRK( 'L', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 10
+      CALL ZSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   80 INFOT = 1
+      CALL ZHER2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZHER2K( 'U', 'T', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHER2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHER2K( 'U', 'C', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHER2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZHER2K( 'L', 'C', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHER2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHER2K( 'U', 'C', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHER2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZHER2K( 'L', 'C', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHER2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHER2K( 'U', 'C', 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHER2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZHER2K( 'L', 'C', 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZHER2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZHER2K( 'U', 'C', 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZHER2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZHER2K( 'L', 'C', 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZHER2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZHER2K( 'U', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZHER2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZHER2K( 'L', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      GO TO 100
+   90 INFOT = 1
+      CALL ZSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 2
+      CALL ZSYR2K( 'U', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYR2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYR2K( 'U', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYR2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 3
+      CALL ZSYR2K( 'L', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYR2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYR2K( 'U', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYR2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 4
+      CALL ZSYR2K( 'L', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYR2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYR2K( 'U', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYR2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 7
+      CALL ZSYR2K( 'L', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZSYR2K( 'U', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 9
+      CALL ZSYR2K( 'L', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZSYR2K( 'U', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+      INFOT = 12
+      CALL ZSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
+      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+  100 IF( OK )THEN
+         WRITE( NOUT, FMT = 9999 )SRNAMT
+      ELSE
+         WRITE( NOUT, FMT = 9998 )SRNAMT
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+     $      '**' )
+*
+*     End of ZCHKE.
+*
+      END
+      SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
+     $                  TRANSL )
+*
+*  Generates values for an M by N matrix A.
+*  Stores the values in the array AA in the data structure required
+*  by the routine, with unwanted elements set to rogue value.
+*
+*  TYPE is 'GE', 'HE', 'SY' or 'TR'.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
+     $                   ONE = ( 1.0D0, 0.0D0 ) )
+      COMPLEX*16         ROGUE
+      PARAMETER          ( ROGUE = ( -1.0D10, 1.0D10 ) )
+      DOUBLE PRECISION   RZERO
+      PARAMETER          ( RZERO = 0.0D0 )
+      DOUBLE PRECISION   RROGUE
+      PARAMETER          ( RROGUE = -1.0D10 )
+*     .. Scalar Arguments ..
+      COMPLEX*16         TRANSL
+      INTEGER            LDA, M, N, NMAX
+      LOGICAL            RESET
+      CHARACTER*1        DIAG, UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      COMPLEX*16         A( NMAX, * ), AA( * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J, JJ
+      LOGICAL            GEN, HER, LOWER, SYM, TRI, UNIT, UPPER
+*     .. External Functions ..
+      COMPLEX*16         ZBEG
+      EXTERNAL           ZBEG
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCMPLX, DCONJG, DBLE
+*     .. Executable Statements ..
+      GEN = TYPE.EQ.'GE'
+      HER = TYPE.EQ.'HE'
+      SYM = TYPE.EQ.'SY'
+      TRI = TYPE.EQ.'TR'
+      UPPER = ( HER.OR.SYM.OR.TRI ).AND.UPLO.EQ.'U'
+      LOWER = ( HER.OR.SYM.OR.TRI ).AND.UPLO.EQ.'L'
+      UNIT = TRI.AND.DIAG.EQ.'U'
+*
+*     Generate data in array A.
+*
+      DO 20 J = 1, N
+         DO 10 I = 1, M
+            IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
+     $          THEN
+               A( I, J ) = ZBEG( RESET ) + TRANSL
+               IF( I.NE.J )THEN
+*                 Set some elements to zero
+                  IF( N.GT.3.AND.J.EQ.N/2 )
+     $               A( I, J ) = ZERO
+                  IF( HER )THEN
+                     A( J, I ) = DCONJG( A( I, J ) )
+                  ELSE IF( SYM )THEN
+                     A( J, I ) = A( I, J )
+                  ELSE IF( TRI )THEN
+                     A( J, I ) = ZERO
+                  END IF
+               END IF
+            END IF
+   10    CONTINUE
+         IF( HER )
+     $      A( J, J ) = DCMPLX( DBLE( A( J, J ) ), RZERO )
+         IF( TRI )
+     $      A( J, J ) = A( J, J ) + ONE
+         IF( UNIT )
+     $      A( J, J ) = ONE
+   20 CONTINUE
+*
+*     Store elements in array AS in data structure required by routine.
+*
+      IF( TYPE.EQ.'GE' )THEN
+         DO 50 J = 1, N
+            DO 30 I = 1, M
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   30       CONTINUE
+            DO 40 I = M + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   40       CONTINUE
+   50    CONTINUE
+      ELSE IF( TYPE.EQ.'HE'.OR.TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN
+         DO 90 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IF( UNIT )THEN
+                  IEND = J - 1
+               ELSE
+                  IEND = J
+               END IF
+            ELSE
+               IF( UNIT )THEN
+                  IBEG = J + 1
+               ELSE
+                  IBEG = J
+               END IF
+               IEND = N
+            END IF
+            DO 60 I = 1, IBEG - 1
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   60       CONTINUE
+            DO 70 I = IBEG, IEND
+               AA( I + ( J - 1 )*LDA ) = A( I, J )
+   70       CONTINUE
+            DO 80 I = IEND + 1, LDA
+               AA( I + ( J - 1 )*LDA ) = ROGUE
+   80       CONTINUE
+            IF( HER )THEN
+               JJ = J + ( J - 1 )*LDA
+               AA( JJ ) = DCMPLX( DBLE( AA( JJ ) ), RROGUE )
+            END IF
+   90    CONTINUE
+      END IF
+      RETURN
+*
+*     End of ZMAKE.
+*
+      END
+      SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
+     $                  BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
+     $                  NOUT, MV )
+*
+*  Checks the results of the computational tests.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ) )
+      DOUBLE PRECISION   RZERO, RONE
+      PARAMETER          ( RZERO = 0.0D0, RONE = 1.0D0 )
+*     .. Scalar Arguments ..
+      COMPLEX*16         ALPHA, BETA
+      DOUBLE PRECISION   EPS, ERR
+      INTEGER            KK, LDA, LDB, LDC, LDCC, M, N, NOUT
+      LOGICAL            FATAL, MV
+      CHARACTER*1        TRANSA, TRANSB
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * ),
+     $                   CC( LDCC, * ), CT( * )
+      DOUBLE PRECISION   G( * )
+*     .. Local Scalars ..
+      COMPLEX*16         CL
+      DOUBLE PRECISION   ERRI
+      INTEGER            I, J, K
+      LOGICAL            CTRANA, CTRANB, TRANA, TRANB
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DIMAG, DCONJG, MAX, DBLE, SQRT
+*     .. Statement Functions ..
+      DOUBLE PRECISION   ABS1
+*     .. Statement Function definitions ..
+      ABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) )
+*     .. Executable Statements ..
+      TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
+      TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
+      CTRANA = TRANSA.EQ.'C'
+      CTRANB = TRANSB.EQ.'C'
+*
+*     Compute expected result, one column at a time, in CT using data
+*     in A, B and C.
+*     Compute gauges in G.
+*
+      DO 220 J = 1, N
+*
+         DO 10 I = 1, M
+            CT( I ) = ZERO
+            G( I ) = RZERO
+   10    CONTINUE
+         IF( .NOT.TRANA.AND..NOT.TRANB )THEN
+            DO 30 K = 1, KK
+               DO 20 I = 1, M
+                  CT( I ) = CT( I ) + A( I, K )*B( K, J )
+                  G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) )
+   20          CONTINUE
+   30       CONTINUE
+         ELSE IF( TRANA.AND..NOT.TRANB )THEN
+            IF( CTRANA )THEN
+               DO 50 K = 1, KK
+                  DO 40 I = 1, M
+                     CT( I ) = CT( I ) + DCONJG( A( K, I ) )*B( K, J )
+                     G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                        ABS1( B( K, J ) )
+   40             CONTINUE
+   50          CONTINUE
+            ELSE
+               DO 70 K = 1, KK
+                  DO 60 I = 1, M
+                     CT( I ) = CT( I ) + A( K, I )*B( K, J )
+                     G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                        ABS1( B( K, J ) )
+   60             CONTINUE
+   70          CONTINUE
+            END IF
+         ELSE IF( .NOT.TRANA.AND.TRANB )THEN
+            IF( CTRANB )THEN
+               DO 90 K = 1, KK
+                  DO 80 I = 1, M
+                     CT( I ) = CT( I ) + A( I, K )*DCONJG( B( J, K ) )
+                     G( I ) = G( I ) + ABS1( A( I, K ) )*
+     $                        ABS1( B( J, K ) )
+   80             CONTINUE
+   90          CONTINUE
+            ELSE
+               DO 110 K = 1, KK
+                  DO 100 I = 1, M
+                     CT( I ) = CT( I ) + A( I, K )*B( J, K )
+                     G( I ) = G( I ) + ABS1( A( I, K ) )*
+     $                        ABS1( B( J, K ) )
+  100             CONTINUE
+  110          CONTINUE
+            END IF
+         ELSE IF( TRANA.AND.TRANB )THEN
+            IF( CTRANA )THEN
+               IF( CTRANB )THEN
+                  DO 130 K = 1, KK
+                     DO 120 I = 1, M
+                        CT( I ) = CT( I ) + DCONJG( A( K, I ) )*
+     $                            DCONJG( B( J, K ) )
+                        G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                           ABS1( B( J, K ) )
+  120                CONTINUE
+  130             CONTINUE
+               ELSE
+                  DO 150 K = 1, KK
+                     DO 140 I = 1, M
+                        CT( I ) = CT( I ) + DCONJG( A( K, I ) )*
+     $                            B( J, K )
+                        G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                           ABS1( B( J, K ) )
+  140                CONTINUE
+  150             CONTINUE
+               END IF
+            ELSE
+               IF( CTRANB )THEN
+                  DO 170 K = 1, KK
+                     DO 160 I = 1, M
+                        CT( I ) = CT( I ) + A( K, I )*
+     $                            DCONJG( B( J, K ) )
+                        G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                           ABS1( B( J, K ) )
+  160                CONTINUE
+  170             CONTINUE
+               ELSE
+                  DO 190 K = 1, KK
+                     DO 180 I = 1, M
+                        CT( I ) = CT( I ) + A( K, I )*B( J, K )
+                        G( I ) = G( I ) + ABS1( A( K, I ) )*
+     $                           ABS1( B( J, K ) )
+  180                CONTINUE
+  190             CONTINUE
+               END IF
+            END IF
+         END IF
+         DO 200 I = 1, M
+            CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
+            G( I ) = ABS1( ALPHA )*G( I ) +
+     $               ABS1( BETA )*ABS1( C( I, J ) )
+  200    CONTINUE
+*
+*        Compute the error ratio for this result.
+*
+         ERR = ZERO
+         DO 210 I = 1, M
+            ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS
+            IF( G( I ).NE.RZERO )
+     $         ERRI = ERRI/G( I )
+            ERR = MAX( ERR, ERRI )
+            IF( ERR*SQRT( EPS ).GE.RONE )
+     $         GO TO 230
+  210    CONTINUE
+*
+  220 CONTINUE
+*
+*     If the loop completes, all results are at least half accurate.
+      GO TO 250
+*
+*     Report fatal error.
+*
+  230 FATAL = .TRUE.
+      WRITE( NOUT, FMT = 9999 )
+      DO 240 I = 1, M
+         IF( MV )THEN
+            WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
+         ELSE
+            WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
+         END IF
+  240 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9997 )J
+*
+  250 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
+     $      'F ACCURATE *******', /'                       EXPECTED RE',
+     $      'SULT                    COMPUTED RESULT' )
+ 9998 FORMAT( 1X, I7, 2( '  (', G15.6, ',', G15.6, ')' ) )
+ 9997 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+*
+*     End of ZMMCH.
+*
+      END
+      LOGICAL FUNCTION LZE( RI, RJ, LR )
+*
+*  Tests if two arrays are identical.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LR
+*     .. Array Arguments ..
+      COMPLEX*16         RI( * ), RJ( * )
+*     .. Local Scalars ..
+      INTEGER            I
+*     .. Executable Statements ..
+      DO 10 I = 1, LR
+         IF( RI( I ).NE.RJ( I ) )
+     $      GO TO 20
+   10 CONTINUE
+      LZE = .TRUE.
+      GO TO 30
+   20 CONTINUE
+      LZE = .FALSE.
+   30 RETURN
+*
+*     End of LZE.
+*
+      END
+      LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA )
+*
+*  Tests if selected elements in two arrays are equal.
+*
+*  TYPE is 'GE' or 'HE' or 'SY'.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDA, M, N
+      CHARACTER*1        UPLO
+      CHARACTER*2        TYPE
+*     .. Array Arguments ..
+      COMPLEX*16         AA( LDA, * ), AS( LDA, * )
+*     .. Local Scalars ..
+      INTEGER            I, IBEG, IEND, J
+      LOGICAL            UPPER
+*     .. Executable Statements ..
+      UPPER = UPLO.EQ.'U'
+      IF( TYPE.EQ.'GE' )THEN
+         DO 20 J = 1, N
+            DO 10 I = M + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   10       CONTINUE
+   20    CONTINUE
+      ELSE IF( TYPE.EQ.'HE'.OR.TYPE.EQ.'SY' )THEN
+         DO 50 J = 1, N
+            IF( UPPER )THEN
+               IBEG = 1
+               IEND = J
+            ELSE
+               IBEG = J
+               IEND = N
+            END IF
+            DO 30 I = 1, IBEG - 1
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   30       CONTINUE
+            DO 40 I = IEND + 1, LDA
+               IF( AA( I, J ).NE.AS( I, J ) )
+     $            GO TO 70
+   40       CONTINUE
+   50    CONTINUE
+      END IF
+*
+   60 CONTINUE
+      LZERES = .TRUE.
+      GO TO 80
+   70 CONTINUE
+      LZERES = .FALSE.
+   80 RETURN
+*
+*     End of LZERES.
+*
+      END
+      COMPLEX*16     FUNCTION ZBEG( RESET )
+*
+*  Generates complex numbers as pairs of random numbers uniformly
+*  distributed between -0.5 and 0.5.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      LOGICAL            RESET
+*     .. Local Scalars ..
+      INTEGER            I, IC, J, MI, MJ
+*     .. Save statement ..
+      SAVE               I, IC, J, MI, MJ
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCMPLX
+*     .. Executable Statements ..
+      IF( RESET )THEN
+*        Initialize local variables.
+         MI = 891
+         MJ = 457
+         I = 7
+         J = 7
+         IC = 0
+         RESET = .FALSE.
+      END IF
+*
+*     The sequence of values of I or J is bounded between 1 and 999.
+*     If initial I or J = 1,2,3,6,7 or 9, the period will be 50.
+*     If initial I or J = 4 or 8, the period will be 25.
+*     If initial I or J = 5, the period will be 10.
+*     IC is used to break up the period by skipping 1 value of I or J
+*     in 6.
+*
+      IC = IC + 1
+   10 I = I*MI
+      J = J*MJ
+      I = I - 1000*( I/1000 )
+      J = J - 1000*( J/1000 )
+      IF( IC.GE.5 )THEN
+         IC = 0
+         GO TO 10
+      END IF
+      ZBEG = DCMPLX( ( I - 500 )/1001.0D0, ( J - 500 )/1001.0D0 )
+      RETURN
+*
+*     End of ZBEG.
+*
+      END
+      DOUBLE PRECISION FUNCTION DDIFF( X, Y )
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION   X, Y
+*     .. Executable Statements ..
+      DDIFF = X - Y
+      RETURN
+*
+*     End of DDIFF.
+*
+      END
+      SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
+*
+*  Tests whether XERBLA has detected an error when it should.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Executable Statements ..
+      IF( .NOT.LERR )THEN
+         WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
+         OK = .FALSE.
+      END IF
+      LERR = .FALSE.
+      RETURN
+*
+ 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
+     $      'ETECTED BY ', A6, ' *****' )
+*
+*     End of CHKXER.
+*
+      END
+      SUBROUTINE XERBLA( SRNAME, INFO )
+*
+*  This is a special version of XERBLA to be used only as part of
+*  the test program for testing error exits from the Level 3 BLAS
+*  routines.
+*
+*  XERBLA  is an error handler for the Level 3 BLAS routines.
+*
+*  It is called by the Level 3 BLAS routines if an input parameter is
+*  invalid.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- 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.
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO
+      CHARACTER*6        SRNAME
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUT
+      LOGICAL            LERR, OK
+      CHARACTER*6        SRNAMT
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUT, OK, LERR
+      COMMON             /SRNAMC/SRNAMT
+*     .. Executable Statements ..
+      LERR = .TRUE.
+      IF( INFO.NE.INFOT )THEN
+         IF( INFOT.NE.0 )THEN
+            WRITE( NOUT, FMT = 9999 )INFO, INFOT
+         ELSE
+            WRITE( NOUT, FMT = 9997 )INFO
+         END IF
+         OK = .FALSE.
+      END IF
+      IF( SRNAME.NE.SRNAMT )THEN
+         WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
+         OK = .FALSE.
+      END IF
+      RETURN
+*
+ 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
+     $      ' OF ', I2, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
+     $      'AD OF ', A6, ' *******' )
+ 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
+     $      ' *******' )
+*
+*     End of XERBLA
+*
+      END
+
diff --git a/eigen/blas/xerbla.cpp b/eigen/blas/xerbla.cpp
new file mode 100644
index 0000000..dd39a52
--- /dev/null
+++ b/eigen/blas/xerbla.cpp
@@ -0,0 +1,23 @@
+
+#include <iostream>
+
+#if (defined __GNUC__) && (!defined __MINGW32__) && (!defined __CYGWIN__)
+#define EIGEN_WEAK_LINKING __attribute__ ((weak))
+#else
+#define EIGEN_WEAK_LINKING
+#endif
+
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+
+EIGEN_WEAK_LINKING int xerbla_(const char * msg, int *info, int)
+{
+  std::cerr << "Eigen BLAS ERROR #" << *info << ": " << msg << "\n";
+  return 0;
+}
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/eigen/blas/zhbmv.f b/eigen/blas/zhbmv.f
new file mode 100644
index 0000000..bca0da5
--- /dev/null
+++ b/eigen/blas/zhbmv.f
@@ -0,0 +1,310 @@
+      SUBROUTINE ZHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*     .. Scalar Arguments ..
+      DOUBLE COMPLEX ALPHA,BETA
+      INTEGER INCX,INCY,K,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE COMPLEX A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHBMV  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 hermitian band matrix, with k super-diagonals.
+*
+*  Arguments
+*  ==========
+*
+*  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  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  A      - COMPLEX*16       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 hermitian 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 hermitian 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 hermitian 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 hermitian 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 the imaginary parts of the diagonal elements need
+*           not be set and are assumed to be zero.
+*           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      - COMPLEX*16       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   - COMPLEX*16      .
+*           On entry, BETA specifies the scalar beta.
+*           Unchanged on exit.
+*
+*  Y      - COMPLEX*16       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.
+*
+*  Further Details
+*  ===============
+*
+*  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 COMPLEX ONE
+      PARAMETER (ONE= (1.0D+0,0.0D+0))
+      DOUBLE COMPLEX ZERO
+      PARAMETER (ZERO= (0.0D+0,0.0D+0))
+*     ..
+*     .. Local Scalars ..
+      DOUBLE COMPLEX 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 DBLE,DCONJG,MAX,MIN
+*     ..
+*
+*     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('ZHBMV ',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 + DCONJG(A(L+I,J))*X(I)
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*DBLE(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 + DCONJG(A(L+I,J))*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*DBLE(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*DBLE(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 + DCONJG(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*DBLE(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 + DCONJG(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 ZHBMV .
+*
+      END
diff --git a/eigen/blas/zhpmv.f b/eigen/blas/zhpmv.f
new file mode 100644
index 0000000..b686108
--- /dev/null
+++ b/eigen/blas/zhpmv.f
@@ -0,0 +1,272 @@
+      SUBROUTINE ZHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
+*     .. Scalar Arguments ..
+      DOUBLE COMPLEX ALPHA,BETA
+      INTEGER INCX,INCY,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE COMPLEX AP(*),X(*),Y(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZHPMV  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 hermitian matrix, supplied in packed form.
+*
+*  Arguments
+*  ==========
+*
+*  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  - COMPLEX*16      .
+*           On entry, ALPHA specifies the scalar alpha.
+*           Unchanged on exit.
+*
+*  AP     - COMPLEX*16       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 hermitian 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 hermitian 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 the imaginary parts of the diagonal elements need
+*           not be set and are assumed to be zero.
+*           Unchanged on exit.
+*
+*  X      - COMPLEX*16       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   - COMPLEX*16      .
+*           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      - COMPLEX*16       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.
+*
+*  Further Details
+*  ===============
+*
+*  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 COMPLEX ONE
+      PARAMETER (ONE= (1.0D+0,0.0D+0))
+      DOUBLE COMPLEX ZERO
+      PARAMETER (ZERO= (0.0D+0,0.0D+0))
+*     ..
+*     .. Local Scalars ..
+      DOUBLE COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC DBLE,DCONJG
+*     ..
+*
+*     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('ZHPMV ',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 + DCONJG(AP(K))*X(I)
+                      K = K + 1
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*DBLE(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 + DCONJG(AP(K))*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*DBLE(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*DBLE(AP(KK))
+                  K = KK + 1
+                  DO 90 I = J + 1,N
+                      Y(I) = Y(I) + TEMP1*AP(K)
+                      TEMP2 = TEMP2 + DCONJG(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*DBLE(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 + DCONJG(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 ZHPMV .
+*
+      END
diff --git a/eigen/blas/ztbmv.f b/eigen/blas/ztbmv.f
new file mode 100644
index 0000000..7c85c1b
--- /dev/null
+++ b/eigen/blas/ztbmv.f
@@ -0,0 +1,366 @@
+      SUBROUTINE ZTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+*     .. Scalar Arguments ..
+      INTEGER INCX,K,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE COMPLEX A(LDA,*),X(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZTBMV  performs one of the matrix-vector operations
+*
+*     x := A*x,   or   x := A'*x,   or   x := conjg( 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.
+*
+*  Arguments
+*  ==========
+*
+*  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 := conjg( 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      - COMPLEX*16       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      - COMPLEX*16       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.
+*
+*  Further Details
+*  ===============
+*
+*  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 COMPLEX ZERO
+      PARAMETER (ZERO= (0.0D+0,0.0D+0))
+*     ..
+*     .. Local Scalars ..
+      DOUBLE COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
+      LOGICAL NOCONJ,NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC DCONJG,MAX,MIN
+*     ..
+*
+*     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('ZTBMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOCONJ = LSAME(TRANS,'T')
+      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  or  x := conjg( A' )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KPLUS1 = K + 1
+              IF (INCX.EQ.1) THEN
+                  DO 110 J = N,1,-1
+                      TEMP = X(J)
+                      L = KPLUS1 - J
+                      IF (NOCONJ) THEN
+                          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
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*DCONJG(A(KPLUS1,J))
+                          DO 100 I = J - 1,MAX(1,J-K),-1
+                              TEMP = TEMP + DCONJG(A(L+I,J))*X(I)
+  100                     CONTINUE
+                      END IF
+                      X(J) = TEMP
+  110             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 140 J = N,1,-1
+                      TEMP = X(JX)
+                      KX = KX - INCX
+                      IX = KX
+                      L = KPLUS1 - J
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
+                          DO 120 I = J - 1,MAX(1,J-K),-1
+                              TEMP = TEMP + A(L+I,J)*X(IX)
+                              IX = IX - INCX
+  120                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*DCONJG(A(KPLUS1,J))
+                          DO 130 I = J - 1,MAX(1,J-K),-1
+                              TEMP = TEMP + DCONJG(A(L+I,J))*X(IX)
+                              IX = IX - INCX
+  130                     CONTINUE
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX - INCX
+  140             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 170 J = 1,N
+                      TEMP = X(J)
+                      L = 1 - J
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(1,J)
+                          DO 150 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + A(L+I,J)*X(I)
+  150                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*DCONJG(A(1,J))
+                          DO 160 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + DCONJG(A(L+I,J))*X(I)
+  160                     CONTINUE
+                      END IF
+                      X(J) = TEMP
+  170             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 200 J = 1,N
+                      TEMP = X(JX)
+                      KX = KX + INCX
+                      IX = KX
+                      L = 1 - J
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(1,J)
+                          DO 180 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + A(L+I,J)*X(IX)
+                              IX = IX + INCX
+  180                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*DCONJG(A(1,J))
+                          DO 190 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + DCONJG(A(L+I,J))*X(IX)
+                              IX = IX + INCX
+  190                     CONTINUE
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX + INCX
+  200             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZTBMV .
+*
+      END