Merge remote-tracking branch 'refs/remotes/Reference-LAPACK/master'

309 files changed, 105128 insertions, 2618 deletions

diff --git a/BLAS/SRC/CMakeLists.txt b/BLAS/SRC/CMakeLists.txt
index 84e85250..a9306fc4 100644
--- a/BLAS/SRC/CMakeLists.txt
+++ b/BLAS/SRC/CMakeLists.txt
@@ -69,7 +69,7 @@ set(DBLAS1 idamax.f dasum.f daxpy.f dcopy.f ddot.f dnrm2.f
 set(ZBLAS1 dcabs1.f dzasum.f dznrm2.f izamax.f zaxpy.f zcopy.f
 	zdotc.f zdotu.f zdscal.f zrotg.f zscal.f zswap.f zdrot.f)
 
-set(CB1AUX  isamax.f sasum.f saxpy.f scopy.f snrm2.f sscal.f)
+set(CB1AUX isamax.f sasum.f saxpy.f scopy.f snrm2.f sscal.f)
 
 set(ZB1AUX idamax.f dasum.f daxpy.f dcopy.f dnrm2.f dscal.f)
 
@@ -78,7 +78,7 @@ set(ZB1AUX idamax.f dasum.f daxpy.f dcopy.f dnrm2.f dscal.f)
 #  Level 2 and Level 3 BLAS.  Comment it out only if you already have
 #  both the Level 2 and 3 BLAS.
 #---------------------------------------------------------------------
-set(ALLBLAS  lsame.f xerbla.f xerbla_array.f)
+set(ALLBLAS lsame.f xerbla.f xerbla_array.f)
 
 #---------------------------------------------------------
 #  Comment out the next 4 definitions if you already have
@@ -104,7 +104,7 @@ set(ZBLAS2 zgemv.f zgbmv.f zhemv.f zhbmv.f zhpmv.f
 #  Comment out the next 4 definitions if you already have
 #  the Level 3 BLAS.
 #---------------------------------------------------------
-set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f )
+set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f)
 
 set(CBLAS3 cgemm.f csymm.f csyrk.f csyr2k.f ctrmm.f ctrsm.f
 	chemm.f cherk.f cher2k.f)
@@ -127,11 +127,11 @@ if(BLAS_DOUBLE)
 	${DBLAS2} ${DBLAS3})
 endif()
 if(BLAS_COMPLEX)
-  set(ALLOBJ  ${BLASLIB} ${CBLAS1} ${CB1AUX}
+  set(ALLOBJ ${BLASLIB} ${CBLAS1} ${CB1AUX}
 	${ALLBLAS} ${CBLAS2})
 endif()
 if(BLAS_COMPLEX16)
-  set(ALLOBJ  ${BLASLIB} ${ZBLAS1} ${ZB1AUX}
+  set(ALLOBJ ${BLASLIB} ${ZBLAS1} ${ZB1AUX}
 	${ALLBLAS} ${ZBLAS2} ${ZBLAS3})
 endif()
 
diff --git a/BLAS/SRC/Makefile b/BLAS/SRC/Makefile
index f36e8ad9..47a15824 100644
--- a/BLAS/SRC/Makefile
+++ b/BLAS/SRC/Makefile
@@ -88,8 +88,8 @@ $(ZB1AUX): $(FRC)
 #  Level 2 and Level 3 BLAS.  Comment it out only if you already have
 #  both the Level 2 and 3 BLAS.
 #---------------------------------------------------------------------
-ALLBLAS  = lsame.o xerbla.o xerbla_array.o
-$(ALLBLAS) : $(FRC)
+ALLBLAS = lsame.o xerbla.o xerbla_array.o
+$(ALLBLAS): $(FRC)
 
 #---------------------------------------------------------
 #  Comment out the next 4 definitions if you already have
@@ -133,7 +133,7 @@ ZBLAS3 = zgemm.o zsymm.o zsyrk.o zsyr2k.o ztrmm.o ztrsm.o \
 	zhemm.o zherk.o zher2k.o
 $(ZBLAS3): $(FRC)
 
-ALLOBJ=$(SBLAS1) $(SBLAS2) $(SBLAS3) $(DBLAS1) $(DBLAS2) $(DBLAS3)	\
+ALLOBJ = $(SBLAS1) $(SBLAS2) $(SBLAS3) $(DBLAS1) $(DBLAS2) $(DBLAS3) \
 	$(CBLAS1) $(CBLAS2) $(CBLAS3) $(ZBLAS1) \
 	$(ZBLAS2) $(ZBLAS3) $(ALLBLAS)
 
@@ -168,4 +168,4 @@ clean:
 	rm -f *.o
 
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
diff --git a/BLAS/TESTING/CMakeLists.txt b/BLAS/TESTING/CMakeLists.txt
index e0d9a05b..f88c9a8a 100644
--- a/BLAS/TESTING/CMakeLists.txt
+++ b/BLAS/TESTING/CMakeLists.txt
@@ -37,12 +37,12 @@ macro(add_blas_test name src)
       -DINPUT=${TEST_INPUT}
       -DINTDIR=${CMAKE_CFG_INTDIR}
       -P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake")
-    else()
-      add_test(NAME BLAS-${name} COMMAND "${CMAKE_COMMAND}"
-        -DTEST=$<TARGET_FILE:${name}>
-        -DINTDIR=${CMAKE_CFG_INTDIR}
-        -P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake")
-    endif()
+  else()
+    add_test(NAME BLAS-${name} COMMAND "${CMAKE_COMMAND}"
+      -DTEST=$<TARGET_FILE:${name}>
+      -DINTDIR=${CMAKE_CFG_INTDIR}
+      -P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake")
+  endif()
 endmacro()
 
 if(BUILD_SINGLE)
diff --git a/BLAS/TESTING/Makeblat1 b/BLAS/TESTING/Makeblat1
index 573a2891..ccd7e3c6 100644
--- a/BLAS/TESTING/Makeblat1
+++ b/BLAS/TESTING/Makeblat1
@@ -29,14 +29,11 @@ include ../../make.inc
 #######################################################################
 
 SBLAT1 = sblat1.o
-
 CBLAT1 = cblat1.o
-
 DBLAT1 = dblat1.o
-
 ZBLAT1 = zblat1.o
 
-all:  single double complex complex16
+all: single double complex complex16
 
 single: ../xblat1s
 double: ../xblat1d
@@ -44,20 +41,16 @@ complex: ../xblat1c
 complex16: ../xblat1z
 
 ../xblat1s: $(SBLAT1)
-	$(LOADER) $(LOADOPTS) $(SBLAT1) \
-        $(BLASLIB)  -o ../xblat1s
+	$(LOADER) $(LOADOPTS) -o $@ $(SBLAT1) $(BLASLIB)
 
 ../xblat1c: $(CBLAT1)
-	$(LOADER) $(LOADOPTS) $(CBLAT1) \
-        $(BLASLIB)  -o ../xblat1c
+	$(LOADER) $(LOADOPTS) -o $@ $(CBLAT1) $(BLASLIB)
 
 ../xblat1d: $(DBLAT1)
-	$(LOADER) $(LOADOPTS) $(DBLAT1) \
-        $(BLASLIB)  -o ../xblat1d
+	$(LOADER) $(LOADOPTS) -o $@ $(DBLAT1) $(BLASLIB)
 
 ../xblat1z: $(ZBLAT1)
-	$(LOADER) $(LOADOPTS) $(ZBLAT1) \
-        $(BLASLIB)  -o ../xblat1z
+	$(LOADER) $(LOADOPTS) -o $@ $(ZBLAT1) $(BLASLIB)
 
 $(SBLAT1): $(FRC)
 $(CBLAT1): $(FRC)
@@ -71,4 +64,4 @@ clean:
 	rm -f *.o
 
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
diff --git a/BLAS/TESTING/Makeblat2 b/BLAS/TESTING/Makeblat2
index 2c62684c..92060788 100644
--- a/BLAS/TESTING/Makeblat2
+++ b/BLAS/TESTING/Makeblat2
@@ -29,14 +29,11 @@ include ../../make.inc
 #######################################################################
 
 SBLAT2 = sblat2.o
-
 CBLAT2 = cblat2.o
-
 DBLAT2 = dblat2.o
-
 ZBLAT2 = zblat2.o
 
-all:  single double complex complex16
+all: single double complex complex16
 
 single: ../xblat2s
 double: ../xblat2d
@@ -44,20 +41,16 @@ complex: ../xblat2c
 complex16: ../xblat2z
 
 ../xblat2s: $(SBLAT2)
-	$(LOADER) $(LOADOPTS) $(SBLAT2) \
-        $(BLASLIB)  -o ../xblat2s
+	$(LOADER) $(LOADOPTS) -o $@ $(SBLAT2) $(BLASLIB)
 
 ../xblat2c: $(CBLAT2)
-	$(LOADER) $(LOADOPTS) $(CBLAT2) \
-        $(BLASLIB)  -o ../xblat2c
+	$(LOADER) $(LOADOPTS) -o $@ $(CBLAT2) $(BLASLIB)
 
 ../xblat2d: $(DBLAT2)
-	$(LOADER) $(LOADOPTS) $(DBLAT2) \
-        $(BLASLIB)  -o ../xblat2d
+	$(LOADER) $(LOADOPTS) -o $@ $(DBLAT2) $(BLASLIB)
 
 ../xblat2z: $(ZBLAT2)
-	$(LOADER) $(LOADOPTS) $(ZBLAT2) \
-        $(BLASLIB)  -o ../xblat2z
+	$(LOADER) $(LOADOPTS) -o $@ $(ZBLAT2) $(BLASLIB)
 
 $(SBLAT2): $(FRC)
 $(CBLAT2): $(FRC)
@@ -71,4 +64,4 @@ clean:
 	rm -f *.o
 
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
diff --git a/BLAS/TESTING/Makeblat3 b/BLAS/TESTING/Makeblat3
index 8ee1212a..e454b348 100644
--- a/BLAS/TESTING/Makeblat3
+++ b/BLAS/TESTING/Makeblat3
@@ -29,14 +29,11 @@ include ../../make.inc
 #######################################################################
 
 SBLAT3 = sblat3.o
-
 CBLAT3 = cblat3.o
-
 DBLAT3 = dblat3.o
-
 ZBLAT3 = zblat3.o
 
-all:  single double complex complex16
+all: single double complex complex16
 
 single: ../xblat3s
 double: ../xblat3d
@@ -44,20 +41,16 @@ complex: ../xblat3c
 complex16: ../xblat3z
 
 ../xblat3s: $(SBLAT3)
-	$(LOADER) $(LOADOPTS) $(SBLAT3) \
-        $(BLASLIB) -o ../xblat3s
+	$(LOADER) $(LOADOPTS) -o $@ $(SBLAT3) $(BLASLIB)
 
 ../xblat3c: $(CBLAT3)
-	$(LOADER) $(LOADOPTS) $(CBLAT3) \
-        $(BLASLIB) -o ../xblat3c
+	$(LOADER) $(LOADOPTS) -o $@ $(CBLAT3) $(BLASLIB)
 
 ../xblat3d: $(DBLAT3)
-	$(LOADER) $(LOADOPTS) $(DBLAT3) \
-        $(BLASLIB) -o ../xblat3d
+	$(LOADER) $(LOADOPTS) -o $@ $(DBLAT3) $(BLASLIB)
 
 ../xblat3z: $(ZBLAT3)
-	$(LOADER) $(LOADOPTS) $(ZBLAT3) \
-        $(BLASLIB) -o ../xblat3z
+	$(LOADER) $(LOADOPTS) -o $@ $(ZBLAT3) $(BLASLIB)
 
 $(SBLAT3): $(FRC)
 $(CBLAT3): $(FRC)
@@ -71,4 +64,4 @@ clean:
 	rm -f *.o
 
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
diff --git a/CBLAS/CMakeLists.txt b/CBLAS/CMakeLists.txt
index a17a5ba6..580864fb 100644
--- a/CBLAS/CMakeLists.txt
+++ b/CBLAS/CMakeLists.txt
@@ -7,16 +7,16 @@ set(LAPACK_INSTALL_EXPORT_NAME cblas-targets)
 include(FortranCInterface)
 ## Ensure that the fortran compiler and c compiler specified are compatible
 FortranCInterface_VERIFY()
-FortranCInterface_HEADER( ${LAPACK_BINARY_DIR}/include/cblas_mangling.h
-                          MACRO_NAMESPACE "F77_"
-                          SYMBOL_NAMESPACE "F77_" )
-if( NOT FortranCInterface_GLOBAL_FOUND OR NOT FortranCInterface_MODULE_FOUND)
+FortranCInterface_HEADER(${LAPACK_BINARY_DIR}/include/cblas_mangling.h
+                         MACRO_NAMESPACE "F77_"
+                         SYMBOL_NAMESPACE "F77_")
+if(NOT FortranCInterface_GLOBAL_FOUND OR NOT FortranCInterface_MODULE_FOUND)
   message(WARNING "Reverting to pre-defined include/lapacke_mangling.h")
-  configure_file( include/lapacke_mangling_with_flags.h.in
-                  ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h )
-endif ()
+  configure_file(include/lapacke_mangling_with_flags.h.in
+                 ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h)
+endif()
 
-include_directories( include ${LAPACK_BINARY_DIR}/include )
+include_directories(include ${LAPACK_BINARY_DIR}/include)
 add_subdirectory(include)
 add_subdirectory(src)
 
@@ -28,12 +28,12 @@ endforeach()
 endmacro()
 
 append_subdir_files(CBLAS_INCLUDE "include")
-install( FILES ${CBLAS_INCLUDE} ${LAPACK_BINARY_DIR}/include/cblas_mangling.h DESTINATION include )
+install(FILES ${CBLAS_INCLUDE} ${LAPACK_BINARY_DIR}/include/cblas_mangling.h DESTINATION include)
 
 # --------------------------------------------------
 if(BUILD_TESTING)
-   add_subdirectory(testing)
-   add_subdirectory(examples)
+  add_subdirectory(testing)
+  add_subdirectory(examples)
 endif()
 
 if(NOT BLAS_FOUND)
@@ -71,7 +71,7 @@ configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cblas.pc.in ${CMAKE_CURRENT_BINARY_DI
   install(FILES
   ${CMAKE_CURRENT_BINARY_DIR}/cblas.pc
   DESTINATION ${PKG_CONFIG_DIR}
-   )
+  )
 
 configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cmake/cblas-config-install.cmake.in
   ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/cblas-config.cmake @ONLY)
@@ -83,4 +83,3 @@ install(FILES
 
 #install(EXPORT cblas-targets
 #  DESTINATION ${LIBRARY_DIR}/cmake/cblas-${LAPACK_VERSION})
-
diff --git a/CBLAS/Makefile b/CBLAS/Makefile
index c4ab4e87..5a398f80 100644
--- a/CBLAS/Makefile
+++ b/CBLAS/Makefile
@@ -24,4 +24,4 @@ runtst:
 	cd testing && $(MAKE) run
 
 example: all
-	cd examples && make all
+	cd examples && $(MAKE) all
diff --git a/CBLAS/Makefile.in b/CBLAS/Makefile.in
deleted file mode 100644
index 8fb9d139..00000000
--- a/CBLAS/Makefile.in
+++ /dev/null
@@ -1,49 +0,0 @@
-#
-# Makefile.LINUX
-#
-#
-# If you compile, change the name to Makefile.in.
-#
-#
-
-#-----------------------------------------------------------------------------
-# Shell
-#-----------------------------------------------------------------------------
-
-SHELL = /bin/sh
-
-#-----------------------------------------------------------------------------
-# Platform
-#-----------------------------------------------------------------------------
-
-PLAT = LINUX
-
-#-----------------------------------------------------------------------------
-# Libraries and includes
-#-----------------------------------------------------------------------------
-
-BLLIB = $(home)/lib/librefblas.a
-CBLIB = ../lib/libcblas.a
-
-#-----------------------------------------------------------------------------
-# Compilers
-#-----------------------------------------------------------------------------
-
-CC = gcc
-FC = gfortran
-LOADER = $(FC)
-
-#-----------------------------------------------------------------------------
-# Flags for Compilers
-#-----------------------------------------------------------------------------
-
-CFLAGS = -O3 -DADD_
-FFLAGS = -O3
-
-#-----------------------------------------------------------------------------
-# Archive programs and flags
-#-----------------------------------------------------------------------------
-
-ARCH = ar
-ARCHFLAGS = cr
-RANLIB = ranlib
diff --git a/CBLAS/cmake/tmp.jIUCyIMYeG b/CBLAS/cmake/tmp.jIUCyIMYeG
deleted file mode 100644
index e69de29b..00000000
--- a/CBLAS/cmake/tmp.jIUCyIMYeG
+++ /dev/null
diff --git a/CBLAS/examples/CMakeLists.txt b/CBLAS/examples/CMakeLists.txt
index 85d8bbe6..a4bab6be 100644
--- a/CBLAS/examples/CMakeLists.txt
+++ b/CBLAS/examples/CMakeLists.txt
@@ -1,5 +1,5 @@
-add_executable(xexample1_CBLAS cblas_example1.c )
-add_executable(xexample2_CBLAS cblas_example2.c )
+add_executable(xexample1_CBLAS cblas_example1.c)
+add_executable(xexample2_CBLAS cblas_example2.c)
 
 target_link_libraries(xexample1_CBLAS cblas ${BLAS_LIBRARIES})
 target_link_libraries(xexample2_CBLAS cblas ${BLAS_LIBRARIES})
diff --git a/CBLAS/examples/Makefile b/CBLAS/examples/Makefile
index 61a00c97..1d416a88 100644
--- a/CBLAS/examples/Makefile
+++ b/CBLAS/examples/Makefile
@@ -3,12 +3,12 @@ include ../../make.inc
 all: example1 example2
 
 example1:
-	$(CC) -c $(CFLAGS) -I../include cblas_example1.c
-	$(LOADER) -o cblas_ex1 cblas_example1.o $(CBLASLIB) $(BLASLIB)
+	$(CC) $(CFLAGS) -I../include -c cblas_example1.c
+	$(LOADER) $(LOADOPTS) -o cblas_ex1 cblas_example1.o $(CBLASLIB) $(BLASLIB)
 
 example2:
-	$(CC) -c $(CFLAGS) -I../include cblas_example2.c
-	$(LOADER) -o cblas_ex2 cblas_example2.o $(CBLASLIB) $(BLASLIB)
+	$(CC) $(CFLAGS) -I../include -c cblas_example2.c
+	$(LOADER) $(LOADOPTS) -o cblas_ex2 cblas_example2.o $(CBLASLIB) $(BLASLIB)
 
 cleanall:
 	rm -f *.o cblas_ex1 cblas_ex2
diff --git a/CBLAS/include/CMakeLists.txt b/CBLAS/include/CMakeLists.txt
index a333467a..299b45c9 100644
--- a/CBLAS/include/CMakeLists.txt
+++ b/CBLAS/include/CMakeLists.txt
@@ -1,3 +1,3 @@
-set (CBLAS_INCLUDE cblas.h cblas_f77.h cblas_test.h )
+set(CBLAS_INCLUDE cblas.h cblas_f77.h cblas_test.h)
 
 file(COPY ${CBLAS_INCLUDE} DESTINATION ${LAPACK_BINARY_DIR}/include)
diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h
index 3035ab0b..edda4462 100644
--- a/CBLAS/include/cblas_f77.h
+++ b/CBLAS/include/cblas_f77.h
@@ -135,7 +135,7 @@
 #define F77_dgbmv 		F77_GLOBAL(dgbmv,DGBMV)
 #define F77_dtrmv 		F77_GLOBAL(dtrmv,DTRMV)
 #define F77_dtbmv 		F77_GLOBAL(dtbmv,DTBMV)
-#define F77_dtpmv 		F77_GLOBAL(dtpmv,DTRMV)
+#define F77_dtpmv 		F77_GLOBAL(dtpmv,DTPMV)
 #define F77_dtrsv 		F77_GLOBAL(dtrsv,DTRSV)
 #define F77_dtbsv 		F77_GLOBAL(dtbsv,DTBSV)
 #define F77_dtpsv 		F77_GLOBAL(dtpsv,DTPSV)
diff --git a/CBLAS/include/cblas_test.h b/CBLAS/include/cblas_test.h
index 933e13fb..f8174ba4 100644
--- a/CBLAS/include/cblas_test.h
+++ b/CBLAS/include/cblas_test.h
@@ -131,7 +131,7 @@ typedef struct { double real; double imag; } CBLAS_TEST_ZOMPLEX;
 #define F77_cgemv 		F77_GLOBAL(ccgemv,CCGEMV)
 #define F77_cgbmv 		F77_GLOBAL(ccgbmv,CCGBMV)
 #define F77_ctrmv 		F77_GLOBAL(cctrmv,CCTRMV)
-#define F77_ctbmv 		F77_GLOBAL(cctbmv,CCTPMV)
+#define F77_ctbmv 		F77_GLOBAL(cctbmv,CCTBMV)
 #define F77_ctpmv 		F77_GLOBAL(cctpmv,CCTPMV)
 #define F77_ctrsv 		F77_GLOBAL(cctrsv,CCTRSV)
 #define F77_ctbsv 		F77_GLOBAL(cctbsv,CCTBSV)
diff --git a/CBLAS/src/CMakeLists.txt b/CBLAS/src/CMakeLists.txt
index 90496b92..20f8eb4c 100644
--- a/CBLAS/src/CMakeLists.txt
+++ b/CBLAS/src/CMakeLists.txt
@@ -2,7 +2,7 @@
 #
 # Error handling routines for level 2 & 3
 
-set (ERRHAND cblas_globals.c cblas_xerbla.c xerbla.c)
+set(ERRHAND cblas_globals.c cblas_xerbla.c xerbla.c)
 
 #
 #
@@ -15,47 +15,45 @@ set (ERRHAND cblas_globals.c cblas_xerbla.c xerbla.c)
 #
 # All object files for single real precision
 #
-set (SLEV1 cblas_srotg.c cblas_srotmg.c cblas_srot.c cblas_srotm.c
+set(SLEV1 cblas_srotg.c cblas_srotmg.c cblas_srot.c cblas_srotm.c
          cblas_sswap.c cblas_sscal.c  cblas_scopy.c cblas_saxpy.c
          cblas_sdot.c  cblas_sdsdot.c cblas_snrm2.c cblas_sasum.c
-         cblas_isamax.c   sdotsub.f   sdsdotsub.f snrm2sub.f sasumsub.f
+         cblas_isamax.c sdotsub.f sdsdotsub.f snrm2sub.f sasumsub.f
          isamaxsub.f)
+
 #
 # All object files for double real precision
 #
-set (DLEV1 cblas_drotg.c cblas_drotmg.c cblas_drot.c cblas_drotm.c
+set(DLEV1 cblas_drotg.c cblas_drotmg.c cblas_drot.c cblas_drotm.c
          cblas_dswap.c cblas_dscal.c  cblas_dcopy.c cblas_daxpy.c
          cblas_ddot.c  cblas_dsdot.c cblas_dnrm2.c cblas_dasum.c
-         cblas_idamax.c   ddotsub.f   dsdotsub.f       dnrm2sub.f
+         cblas_idamax.c ddotsub.f dsdotsub.f dnrm2sub.f
          dasumsub.f idamaxsub.f)
 
 #
 # All object files for single complex precision
 #
-set (CLEV1 cblas_cswap.c cblas_cscal.c cblas_csscal.c cblas_ccopy.c
+set(CLEV1 cblas_cswap.c cblas_cscal.c cblas_csscal.c cblas_ccopy.c
          cblas_caxpy.c cblas_cdotu_sub.c cblas_cdotc_sub.c
          cblas_icamax.c cdotcsub.f cdotusub.f icamaxsub.f)
 
 #
 # All object files for double complex precision
 #
-set (ZLEV1 cblas_zswap.c cblas_zscal.c cblas_zdscal.c cblas_zcopy.c
+set(ZLEV1 cblas_zswap.c cblas_zscal.c cblas_zdscal.c cblas_zcopy.c
          cblas_zaxpy.c cblas_zdotu_sub.c cblas_zdotc_sub.c cblas_dznrm2.c
          cblas_dzasum.c cblas_izamax.c zdotcsub.f zdotusub.f
-         dzasumsub.f  dznrm2sub.f  izamaxsub.f)
-
+         dzasumsub.f dznrm2sub.f izamaxsub.f)
 
 #
 # Common files for single complex precision
 #
-set (SCLEV1 cblas_scasum.c scasumsub.f cblas_scnrm2.c scnrm2sub.f)
-
+set(SCLEV1 cblas_scasum.c scasumsub.f cblas_scnrm2.c scnrm2sub.f)
 
 #
 # All object files
 #
-set (ALEV1 ${slev1} ${dlev1} ${clev1} ${zlev1} ${sclev1})
-
+set(ALEV1 ${slev1} ${dlev1} ${clev1} ${zlev1} ${sclev1})
 
 #
 #
@@ -68,24 +66,23 @@ set (ALEV1 ${slev1} ${dlev1} ${clev1} ${zlev1} ${sclev1})
 #
 # All object files for single real precision
 #
-set (SLEV2 cblas_sgemv.c cblas_sgbmv.c cblas_sger.c cblas_ssbmv.c  cblas_sspmv.c
+set(SLEV2 cblas_sgemv.c cblas_sgbmv.c cblas_sger.c  cblas_ssbmv.c cblas_sspmv.c
         cblas_sspr.c  cblas_sspr2.c cblas_ssymv.c cblas_ssyr.c  cblas_ssyr2.c
-        cblas_stbmv.c cblas_stbsv.c cblas_stpmv.c cblas_stpsv.c  cblas_strmv.c
+        cblas_stbmv.c cblas_stbsv.c cblas_stpmv.c cblas_stpsv.c cblas_strmv.c
         cblas_strsv.c)
 
-
 #
 # All object files for double real precision
 #
-set (DLEV2 cblas_dgemv.c cblas_dgbmv.c cblas_dger.c cblas_dsbmv.c  cblas_dspmv.c
+set(DLEV2 cblas_dgemv.c cblas_dgbmv.c cblas_dger.c  cblas_dsbmv.c cblas_dspmv.c
         cblas_dspr.c  cblas_dspr2.c cblas_dsymv.c cblas_dsyr.c  cblas_dsyr2.c
-        cblas_dtbmv.c cblas_dtbsv.c cblas_dtpmv.c cblas_dtpsv.c  cblas_dtrmv.c
+        cblas_dtbmv.c cblas_dtbsv.c cblas_dtpmv.c cblas_dtpsv.c cblas_dtrmv.c
         cblas_dtrsv.c)
 
 #
 # All object files for single complex precision
 #
-set (CLEV2 cblas_cgemv.c cblas_cgbmv.c cblas_chemv.c cblas_chbmv.c cblas_chpmv.c
+set(CLEV2 cblas_cgemv.c cblas_cgbmv.c cblas_chemv.c cblas_chbmv.c cblas_chpmv.c
         cblas_ctrmv.c cblas_ctbmv.c cblas_ctpmv.c cblas_ctrsv.c cblas_ctbsv.c
         cblas_ctpsv.c cblas_cgeru.c cblas_cgerc.c cblas_cher.c  cblas_cher2.c
         cblas_chpr.c  cblas_chpr2.c)
@@ -93,14 +90,15 @@ set (CLEV2 cblas_cgemv.c cblas_cgbmv.c cblas_chemv.c cblas_chbmv.c cblas_chpmv.c
 #
 # All object files for double complex precision
 #
-set (ZLEV2 cblas_zgemv.c cblas_zgbmv.c cblas_zhemv.c cblas_zhbmv.c cblas_zhpmv.c
+set(ZLEV2 cblas_zgemv.c cblas_zgbmv.c cblas_zhemv.c cblas_zhbmv.c cblas_zhpmv.c
         cblas_ztrmv.c cblas_ztbmv.c cblas_ztpmv.c cblas_ztrsv.c cblas_ztbsv.c
         cblas_ztpsv.c cblas_zgeru.c cblas_zgerc.c cblas_zher.c  cblas_zher2.c
         cblas_zhpr.c  cblas_zhpr2.c)
+
 #
 # All object files
 #
-set (AVEL2 ${slev2} ${dlev2} ${clev2} ${zlev2})
+set(AVEL2 ${slev2} ${dlev2} ${clev2} ${zlev2})
 
 #
 #
@@ -113,56 +111,60 @@ set (AVEL2 ${slev2} ${dlev2} ${clev2} ${zlev2})
 #
 # All object files for single real precision
 #
-set (SLEV3 cblas_sgemm.c cblas_ssymm.c cblas_ssyrk.c cblas_ssyr2k.c cblas_strmm.c
+set(SLEV3 cblas_sgemm.c cblas_ssymm.c cblas_ssyrk.c cblas_ssyr2k.c cblas_strmm.c
         cblas_strsm.c)
+
 #
 # All object files for double real precision
 #
-set (DLEV3 cblas_dgemm.c cblas_dsymm.c cblas_dsyrk.c cblas_dsyr2k.c cblas_dtrmm.c
+set(DLEV3 cblas_dgemm.c cblas_dsymm.c cblas_dsyrk.c cblas_dsyr2k.c cblas_dtrmm.c
         cblas_dtrsm.c)
+
 #
 # All object files for single complex precision
 #
-set (CLEV3 cblas_cgemm.c cblas_csymm.c cblas_chemm.c cblas_cherk.c
-        cblas_cher2k.c cblas_ctrmm.c cblas_ctrsm.c  cblas_csyrk.c
+set(CLEV3 cblas_cgemm.c cblas_csymm.c cblas_chemm.c cblas_cherk.c
+        cblas_cher2k.c cblas_ctrmm.c cblas_ctrsm.c cblas_csyrk.c
         cblas_csyr2k.c)
+
 #
 # All object files for double complex precision
 #
-set (ZLEV3 cblas_zgemm.c cblas_zsymm.c cblas_zhemm.c cblas_zherk.c
-        cblas_zher2k.c cblas_ztrmm.c cblas_ztrsm.c  cblas_zsyrk.c
+set(ZLEV3 cblas_zgemm.c cblas_zsymm.c cblas_zhemm.c cblas_zherk.c
+        cblas_zher2k.c cblas_ztrmm.c cblas_ztrsm.c cblas_zsyrk.c
         cblas_zsyr2k.c)
+
 #
 # All object files
 #
-set (ALEV3 ${slev3} ${dlev3} ${clev3} ${zlev3})
+set(ALEV3 ${slev3} ${dlev3} ${clev3} ${zlev3})
 
 # default build all of it
 set(ALLOBJ ${SCLEV1} ${SLEV1} ${SLEV2} ${SLEV3} ${ERRHAND}
            ${DLEV1} ${DLEV2} ${DLEV3}
            ${CLEV1} ${CLEV2} ${CLEV3}
-           ${ZLEV1} ${ZLEV2} ${ZLEV3}   )
+           ${ZLEV1} ${ZLEV2} ${ZLEV3})
 
 # Single real precision
 if(CBLAS_SINGLE)
- set(ALLOBJ ${SCLEV1} ${SLEV1} ${SLEV2} ${SLEV3} ${ERRHAND})
+  set(ALLOBJ ${SCLEV1} ${SLEV1} ${SLEV2} ${SLEV3} ${ERRHAND})
 endif()
 
 # Double real precision
 if(CBLAS_DOUBLE)
- set(ALLOBJ  ${DLEV1} ${DLEV2} ${DLEV3} ${ERRHAND})
+  set(ALLOBJ ${DLEV1} ${DLEV2} ${DLEV3} ${ERRHAND})
 endif()
 
 # Single complex precision
-if (CBLAS_COMPLEX)
- set(ALLOBJ  ${CLEV1} ${SCLEV1} ${CLEV2} ${CLEV3} ${ERRHAND})
+if(CBLAS_COMPLEX)
+  set(ALLOBJ ${CLEV1} ${SCLEV1} ${CLEV2} ${CLEV3} ${ERRHAND})
 endif()
 
 # Double complex precision
-if (CBLAS_COMPLEX16)
- set(ALLOBJ  ${ZLEV1} ${ZLEV2} ${ZLEV3} ${ERRHAND})
+if(CBLAS_COMPLEX16)
+  set(ALLOBJ ${ZLEV1} ${ZLEV2} ${ZLEV3} ${ERRHAND})
 endif()
 
 add_library(cblas ${ALLOBJ})
-target_link_libraries(cblas ${BLAS_LIBRARIES} )
+target_link_libraries(cblas ${BLAS_LIBRARIES})
 lapack_install_library(cblas)
diff --git a/CBLAS/src/Makefile b/CBLAS/src/Makefile
index 30dd476b..1d1a0db8 100644
--- a/CBLAS/src/Makefile
+++ b/CBLAS/src/Makefile
@@ -16,6 +16,7 @@ errhand = cblas_globals.o cblas_xerbla.o xerbla.o
 
 # Object files of all routines
 alev = $(alev1) $(alev2) $(alev3) $(errhand)
+
 #
 #
 # CBLAS routines
@@ -27,34 +28,35 @@ alev = $(alev1) $(alev2) $(alev3) $(errhand)
 #
 # All object files for single real precision
 #
-slev1 = cblas_srotg.o cblas_srotmg.o cblas_srot.o cblas_srotm.o  \
-         cblas_sswap.o cblas_sscal.o  cblas_scopy.o cblas_saxpy.o \
-         cblas_sdot.o  cblas_sdsdot.o cblas_snrm2.o cblas_sasum.o \
-         cblas_isamax.o   sdotsub.o   sdsdotsub.o snrm2sub.o sasumsub.o \
-         isamaxsub.o
+slev1 = cblas_srotg.o cblas_srotmg.o cblas_srot.o  cblas_srotm.o \
+        cblas_sswap.o cblas_sscal.o  cblas_scopy.o cblas_saxpy.o \
+        cblas_sdot.o  cblas_sdsdot.o cblas_snrm2.o cblas_sasum.o \
+        cblas_isamax.o sdotsub.o sdsdotsub.o snrm2sub.o sasumsub.o \
+        isamaxsub.o
+
 #
 # All object files for double real precision
 #
-dlev1 = cblas_drotg.o cblas_drotmg.o cblas_drot.o cblas_drotm.o  \
-         cblas_dswap.o cblas_dscal.o  cblas_dcopy.o cblas_daxpy.o \
-         cblas_ddot.o  cblas_dsdot.o cblas_dnrm2.o cblas_dasum.o  \
-         cblas_idamax.o   ddotsub.o   dsdotsub.o       dnrm2sub.o \
-         dasumsub.o idamaxsub.o
+dlev1 = cblas_drotg.o cblas_drotmg.o cblas_drot.o  cblas_drotm.o \
+        cblas_dswap.o cblas_dscal.o  cblas_dcopy.o cblas_daxpy.o \
+        cblas_ddot.o  cblas_dsdot.o  cblas_dnrm2.o cblas_dasum.o \
+        cblas_idamax.o ddotsub.o dsdotsub.o dnrm2sub.o \
+        dasumsub.o idamaxsub.o
 
 #
 # All object files for single complex precision
 #
 clev1 = cblas_cswap.o cblas_cscal.o cblas_csscal.o cblas_ccopy.o \
-         cblas_caxpy.o cblas_cdotu_sub.o cblas_cdotc_sub.o \
-         cblas_icamax.o cdotcsub.o cdotusub.o icamaxsub.o
+        cblas_caxpy.o cblas_cdotu_sub.o cblas_cdotc_sub.o \
+        cblas_icamax.o cdotcsub.o cdotusub.o icamaxsub.o
 
 #
 # All object files for double complex precision
 #
 zlev1 = cblas_zswap.o cblas_zscal.o cblas_zdscal.o cblas_zcopy.o \
-         cblas_zaxpy.o cblas_zdotu_sub.o cblas_zdotc_sub.o cblas_dznrm2.o \
-         cblas_dzasum.o cblas_izamax.o zdotcsub.o zdotusub.o      \
-         dzasumsub.o  dznrm2sub.o  izamaxsub.o
+        cblas_zaxpy.o cblas_zdotu_sub.o cblas_zdotc_sub.o cblas_dznrm2.o \
+        cblas_dzasum.o cblas_izamax.o zdotcsub.o zdotusub.o \
+        dzasumsub.o dznrm2sub.o izamaxsub.o
 
 #
 # Common files for single / complex precision
@@ -66,7 +68,6 @@ sclev1 = cblas_scasum.o scasumsub.o cblas_scnrm2.o scnrm2sub.o
 #
 alev1 = $(slev1) $(dlev1) $(clev1) $(zlev1) $(sclev1)
 
-
 #
 # Make an archive file
 #
@@ -92,8 +93,8 @@ zlib1: $(zlev1)
 	$(RANLIB) $(CBLASLIB)
 
 # All precisions
-all1:  $(alev1)
-	$(ARCH) $(ARCHFLAGS)  $(CBLASLIB) $(alev1)
+all1: $(alev1)
+	$(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(alev1)
 	$(RANLIB) $(CBLASLIB)
 
 #
@@ -107,17 +108,17 @@ all1:  $(alev1)
 #
 # All object files for single real precision
 #
-slev2 = cblas_sgemv.o cblas_sgbmv.o cblas_sger.o cblas_ssbmv.o  cblas_sspmv.o \
+slev2 = cblas_sgemv.o cblas_sgbmv.o cblas_sger.o  cblas_ssbmv.o cblas_sspmv.o \
         cblas_sspr.o  cblas_sspr2.o cblas_ssymv.o cblas_ssyr.o  cblas_ssyr2.o \
-        cblas_stbmv.o cblas_stbsv.o cblas_stpmv.o cblas_stpsv.o  cblas_strmv.o \
+        cblas_stbmv.o cblas_stbsv.o cblas_stpmv.o cblas_stpsv.o cblas_strmv.o \
         cblas_strsv.o
 
 #
 # All object files for double real precision
 #
-dlev2 = cblas_dgemv.o cblas_dgbmv.o cblas_dger.o cblas_dsbmv.o  cblas_dspmv.o \
+dlev2 = cblas_dgemv.o cblas_dgbmv.o cblas_dger.o  cblas_dsbmv.o cblas_dspmv.o \
         cblas_dspr.o  cblas_dspr2.o cblas_dsymv.o cblas_dsyr.o  cblas_dsyr2.o \
-        cblas_dtbmv.o cblas_dtbsv.o cblas_dtpmv.o cblas_dtpsv.o  cblas_dtrmv.o \
+        cblas_dtbmv.o cblas_dtbsv.o cblas_dtpmv.o cblas_dtpsv.o cblas_dtrmv.o \
         cblas_dtrsv.o
 
 #
@@ -135,6 +136,7 @@ zlev2 = cblas_zgemv.o cblas_zgbmv.o cblas_zhemv.o cblas_zhbmv.o cblas_zhpmv.o \
         cblas_ztrmv.o cblas_ztbmv.o cblas_ztpmv.o cblas_ztrsv.o cblas_ztbsv.o \
         cblas_ztpsv.o cblas_zgeru.o cblas_zgerc.o cblas_zher.o  cblas_zher2.o \
         cblas_zhpr.o  cblas_zhpr2.o
+
 #
 # All object files
 #
@@ -149,7 +151,7 @@ slib2: $(slev2) $(errhand)
 	$(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(slev2) $(errhand)
 	$(RANLIB) $(CBLASLIB)
 
-# Double real  precision
+# Double real precision
 dlib2: $(dlev2) $(errhand)
 	$(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(dlev2) $(errhand)
 	$(RANLIB) $(CBLASLIB)
@@ -165,9 +167,10 @@ zlib2: $(zlev2) $(errhand)
 	$(RANLIB) $(CBLASLIB)
 
 # All precisions
-all2:  $(alev2) $(errhand)
-	$(ARCH) $(ARCHFLAGS)  $(CBLASLIB) $(alev2) $(errhand)
+all2: $(alev2) $(errhand)
+	$(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(alev2) $(errhand)
 	$(RANLIB) $(CBLASLIB)
+
 #
 #
 # CBLAS routines
@@ -179,27 +182,29 @@ all2:  $(alev2) $(errhand)
 #
 # All object files for single real precision
 #
-slev3 = cblas_sgemm.o cblas_ssymm.o cblas_ssyrk.o cblas_ssyr2k.o cblas_strmm.o\
+slev3 = cblas_sgemm.o cblas_ssymm.o cblas_ssyrk.o cblas_ssyr2k.o cblas_strmm.o \
         cblas_strsm.o
 
 #
 # All object files for double real precision
 #
-dlev3 = cblas_dgemm.o cblas_dsymm.o cblas_dsyrk.o cblas_dsyr2k.o cblas_dtrmm.o\
+dlev3 = cblas_dgemm.o cblas_dsymm.o cblas_dsyrk.o cblas_dsyr2k.o cblas_dtrmm.o \
         cblas_dtrsm.o
 
 #
 # All object files for single complex precision
 #
-clev3 = cblas_cgemm.o cblas_csymm.o cblas_chemm.o cblas_cherk.o\
-        cblas_cher2k.o cblas_ctrmm.o cblas_ctrsm.o  cblas_csyrk.o\
+clev3 = cblas_cgemm.o cblas_csymm.o cblas_chemm.o cblas_cherk.o \
+        cblas_cher2k.o cblas_ctrmm.o cblas_ctrsm.o cblas_csyrk.o \
         cblas_csyr2k.o
+
 #
 # All object files for double complex precision
 #
-zlev3 = cblas_zgemm.o cblas_zsymm.o cblas_zhemm.o cblas_zherk.o\
-        cblas_zher2k.o cblas_ztrmm.o cblas_ztrsm.o  cblas_zsyrk.o\
+zlev3 = cblas_zgemm.o cblas_zsymm.o cblas_zhemm.o cblas_zherk.o \
+        cblas_zher2k.o cblas_ztrmm.o cblas_ztrsm.o cblas_zsyrk.o \
         cblas_zsyr2k.o
+
 #
 # All object files
 #
@@ -230,20 +235,20 @@ zlib3: $(zlev3) $(errhand)
 	$(RANLIB) $(CBLASLIB)
 
 # All precisions
-all3:  $(alev3) $(errhand)
+all3: $(alev3) $(errhand)
 	$(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(alev3)
 	$(RANLIB) $(CBLASLIB)
 
 # All levels and precisions
 cblaslib: $(alev)
-	$(ARCH) $(ARCHFLAGS)  $(CBLASLIB) $(alev)
+	$(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(alev)
 	$(RANLIB) $(CBLASLIB)
 
 FRC:
 	@FRC=$(FRC)
 
 .c.o:
-	$(CC) -c $(CFLAGS) -I ../include -o $@ $<
+	$(CC) $(CFLAGS) -I../include -c -o $@ $<
 
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
diff --git a/CBLAS/testing/CMakeLists.txt b/CBLAS/testing/CMakeLists.txt
index c6073547..fe9a51e1 100644
--- a/CBLAS/testing/CMakeLists.txt
+++ b/CBLAS/testing/CMakeLists.txt
@@ -15,35 +15,35 @@ macro(add_cblas_test output input target)
       -DOUTPUT=${TEST_OUTPUT}
       -DINTDIR=${CMAKE_CFG_INTDIR}
       -P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake")
-    else()
-      add_test(NAME CBLAS-${testName} COMMAND "${CMAKE_COMMAND}"
-        -DTEST=$<TARGET_FILE:${target}>
-        -DOUTPUT=${TEST_OUTPUT}
-        -DINTDIR=${CMAKE_CFG_INTDIR}
-        -P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake")
-    endif()
+  else()
+    add_test(NAME CBLAS-${testName} COMMAND "${CMAKE_COMMAND}"
+      -DTEST=$<TARGET_FILE:${target}>
+      -DOUTPUT=${TEST_OUTPUT}
+      -DINTDIR=${CMAKE_CFG_INTDIR}
+      -P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake")
+  endif()
 endmacro()
 
 
 # Object files for single real precision
-set( STESTL1O c_sblas1.c)
-set( STESTL2O c_sblas2.c c_s2chke.c auxiliary.c c_xerbla.c)
-set( STESTL3O c_sblas3.c c_s3chke.c auxiliary.c c_xerbla.c)
+set(STESTL1O c_sblas1.c)
+set(STESTL2O c_sblas2.c c_s2chke.c auxiliary.c c_xerbla.c)
+set(STESTL3O c_sblas3.c c_s3chke.c auxiliary.c c_xerbla.c)
 
 # Object files for double real precision
-set( DTESTL1O  c_dblas1.c)
-set( DTESTL2O  c_dblas2.c c_d2chke.c auxiliary.c c_xerbla.c)
-set( DTESTL3O  c_dblas3.c c_d3chke.c auxiliary.c c_xerbla.c)
+set(DTESTL1O c_dblas1.c)
+set(DTESTL2O c_dblas2.c c_d2chke.c auxiliary.c c_xerbla.c)
+set(DTESTL3O c_dblas3.c c_d3chke.c auxiliary.c c_xerbla.c)
 
 # Object files for single complex precision
-set( CTESTL1O  c_cblat1.f c_cblas1.c)
-set( CTESTL2O  c_cblas2.c c_c2chke.c auxiliary.c c_xerbla.c)
-set( CTESTL3O  c_cblas3.c c_c3chke.c auxiliary.c c_xerbla.c)
+set(CTESTL1O c_cblat1.f c_cblas1.c)
+set(CTESTL2O c_cblas2.c c_c2chke.c auxiliary.c c_xerbla.c)
+set(CTESTL3O c_cblas3.c c_c3chke.c auxiliary.c c_xerbla.c)
 
 # Object files for double complex precision
-set( ZTESTL1O  c_zblas1.c)
-set( ZTESTL2O  c_zblas2.c c_z2chke.c auxiliary.c c_xerbla.c)
-set( ZTESTL3O  c_zblas3.c c_z3chke.c auxiliary.c c_xerbla.c)
+set(ZTESTL1O c_zblas1.c)
+set(ZTESTL2O c_zblas2.c c_z2chke.c auxiliary.c c_xerbla.c)
+set(ZTESTL3O c_zblas3.c c_z3chke.c auxiliary.c c_xerbla.c)
 
 
 
@@ -59,11 +59,9 @@ if(BUILD_SINGLE)
   add_cblas_test(stest1.out ""   xscblat1)
   add_cblas_test(stest2.out sin2 xscblat2)
   add_cblas_test(stest3.out sin3 xscblat3)
-
 endif()
 
 if(BUILD_DOUBLE)
-
   add_executable(xdcblat1 c_dblat1.f ${DTESTL1O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
   add_executable(xdcblat2 c_dblat2.f ${DTESTL2O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
   add_executable(xdcblat3 c_dblat3.f ${DTESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
@@ -75,11 +73,9 @@ if(BUILD_DOUBLE)
   add_cblas_test(dtest1.out ""   xdcblat1)
   add_cblas_test(dtest2.out din2 xdcblat2)
   add_cblas_test(dtest3.out din3 xdcblat3)
-
 endif()
 
 if(BUILD_COMPLEX)
-
   add_executable(xccblat1 c_cblat1.f ${CTESTL1O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
   add_executable(xccblat2 c_cblat2.f ${CTESTL2O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
   add_executable(xccblat3 c_cblat3.f ${CTESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
@@ -91,11 +87,9 @@ if(BUILD_COMPLEX)
   add_cblas_test(ctest1.out ""   xccblat1)
   add_cblas_test(ctest2.out cin2 xccblat2)
   add_cblas_test(ctest3.out cin3 xccblat3)
-
 endif()
 
 if(BUILD_COMPLEX16)
-
   add_executable(xzcblat1 c_zblat1.f ${ZTESTL1O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
   add_executable(xzcblat2 c_zblat2.f ${ZTESTL2O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
   add_executable(xzcblat3 c_zblat3.f ${ZTESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
@@ -107,5 +101,4 @@ if(BUILD_COMPLEX16)
   add_cblas_test(ztest1.out ""   xzcblat1)
   add_cblas_test(ztest2.out zin2 xzcblat2)
   add_cblas_test(ztest3.out zin3 xzcblat3)
-
 endif()
diff --git a/CBLAS/testing/Makefile b/CBLAS/testing/Makefile
index 4a4ced3e..a5a07837 100644
--- a/CBLAS/testing/Makefile
+++ b/CBLAS/testing/Makefile
@@ -9,30 +9,22 @@ LIB = $(CBLASLIB) $(BLASLIB)
 
 # Object files for single real precision
 stestl1o = c_sblas1.o
-
 stestl2o = c_sblas2.o c_s2chke.o auxiliary.o c_xerbla.o
-
 stestl3o = c_sblas3.o c_s3chke.o auxiliary.o c_xerbla.o
 
 # Object files for double real precision
 dtestl1o = c_dblas1.o
-
 dtestl2o = c_dblas2.o c_d2chke.o auxiliary.o c_xerbla.o
-
 dtestl3o = c_dblas3.o c_d3chke.o auxiliary.o c_xerbla.o
 
 # Object files for single complex precision
 ctestl1o = c_cblas1.o
-
 ctestl2o = c_cblas2.o c_c2chke.o auxiliary.o c_xerbla.o
-
 ctestl3o = c_cblas3.o c_c3chke.o auxiliary.o c_xerbla.o
 
 # Object files for double complex precision
 ztestl1o = c_zblas1.o
-
 ztestl2o = c_zblas2.o c_z2chke.o auxiliary.o c_xerbla.o
-
 ztestl3o = c_zblas3.o c_z3chke.o auxiliary.o c_xerbla.o
 
 all: all1 all2 all3
@@ -68,34 +60,34 @@ ztest3: xzcblat3
 
 # Single real
 xscblat1: $(stestl1o) c_sblat1.o
-	$(LOADER) $(LOADOPTS) -o xscblat1 c_sblat1.o $(stestl1o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_sblat1.o $(stestl1o) $(LIB)
 xscblat2: $(stestl2o) c_sblat2.o
-	$(LOADER) $(LOADOPTS) -o xscblat2 c_sblat2.o $(stestl2o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_sblat2.o $(stestl2o) $(LIB)
 xscblat3: $(stestl3o) c_sblat3.o
-	$(LOADER) $(LOADOPTS) -o xscblat3 c_sblat3.o $(stestl3o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_sblat3.o $(stestl3o) $(LIB)
 # Double real
 xdcblat1: $(dtestl1o) c_dblat1.o
-	$(LOADER) $(LOADOPTS) -o xdcblat1 c_dblat1.o $(dtestl1o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_dblat1.o $(dtestl1o) $(LIB)
 xdcblat2: $(dtestl2o) c_dblat2.o
-	$(LOADER) $(LOADOPTS) -o xdcblat2 c_dblat2.o $(dtestl2o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_dblat2.o $(dtestl2o) $(LIB)
 xdcblat3: $(dtestl3o) c_dblat3.o
-	$(LOADER) $(LOADOPTS) -o xdcblat3 c_dblat3.o $(dtestl3o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_dblat3.o $(dtestl3o) $(LIB)
 
 # Single complex
 xccblat1: $(ctestl1o) c_cblat1.o
-	$(LOADER) $(LOADOPTS) -o xccblat1 c_cblat1.o $(ctestl1o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_cblat1.o $(ctestl1o) $(LIB)
 xccblat2: $(ctestl2o) c_cblat2.o
-	$(LOADER) $(LOADOPTS) -o xccblat2 c_cblat2.o $(ctestl2o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_cblat2.o $(ctestl2o) $(LIB)
 xccblat3: $(ctestl3o) c_cblat3.o
-	$(LOADER) $(LOADOPTS) -o xccblat3 c_cblat3.o $(ctestl3o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_cblat3.o $(ctestl3o) $(LIB)
 
 # Double complex
 xzcblat1: $(ztestl1o) c_zblat1.o
-	$(LOADER) $(LOADOPTS) -o xzcblat1 c_zblat1.o $(ztestl1o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_zblat1.o $(ztestl1o) $(LIB)
 xzcblat2: $(ztestl2o) c_zblat2.o
-	$(LOADER) $(LOADOPTS) -o xzcblat2 c_zblat2.o $(ztestl2o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_zblat2.o $(ztestl2o) $(LIB)
 xzcblat3: $(ztestl3o) c_zblat3.o
-	$(LOADER) $(LOADOPTS) -o xzcblat3 c_zblat3.o $(ztestl3o) $(LIB)
+	$(LOADER) $(LOADOPTS) -o $@ c_zblat3.o $(ztestl3o) $(LIB)
 
 
 # RUN TESTS
@@ -103,11 +95,11 @@ run:
 	@echo "--> TESTING CBLAS 1 - SINGLE PRECISION <--"
 	@./xscblat1 > stest1.out
 	@echo "--> TESTING CBLAS 1 - DOUBLE PRECISION <--"
-	@./xdcblat1  > dtest1.out
+	@./xdcblat1 > dtest1.out
 	@echo "--> TESTING CBLAS 1 - COMPLEX PRECISION <--"
-	@./xccblat1  > ctest1.out
+	@./xccblat1 > ctest1.out
 	@echo "--> TESTING CBLAS 1 - DOUBLE COMPLEX PRECISION <--"
-	@./xzcblat1	 > ztest1.out
+	@./xzcblat1 > ztest1.out
 	@echo "--> TESTING CBLAS 2 - SINGLE PRECISION <--"
 	@./xscblat2 < sin2 > stest2.out
 	@echo "--> TESTING CBLAS 2 - DOUBLE PRECISION <--"
@@ -115,7 +107,7 @@ run:
 	@echo "--> TESTING CBLAS 2 - COMPLEX PRECISION <--"
 	@./xccblat2 < cin2 > ctest2.out
 	@echo "--> TESTING CBLAS 2 - DOUBLE COMPLEX PRECISION <--"
-	@./xzcblat2	< zin2	> ztest2.out
+	@./xzcblat2 < zin2 > ztest2.out
 	@echo "--> TESTING CBLAS 3 - SINGLE PRECISION <--"
 	@./xscblat3 < sin3 > stest3.out
 	@echo "--> TESTING CBLAS 3 - DOUBLE PRECISION <--"
@@ -123,12 +115,12 @@ run:
 	@echo "--> TESTING CBLAS 3 - COMPLEX PRECISION <--"
 	@./xccblat3 < cin3 > ctest3.out
 	@echo "--> TESTING CBLAS 3 - DOUBLE COMPLEX PRECISION <--"
-	@./xzcblat3	< zin3 > ztest3.out
+	@./xzcblat3 < zin3 > ztest3.out
 
 .SUFFIXES: .o .f .c
 
 .c.o:
-	$(CC) -c $(CFLAGS) -I ../include -o $@ $<
+	$(CC) $(CFLAGS) -I../include -c -o $@ $<
 
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
diff --git a/CMAKE/tmp.kXjd1oSjcp b/CMAKE/tmp.kXjd1oSjcp
deleted file mode 100644
index e69de29b..00000000
--- a/CMAKE/tmp.kXjd1oSjcp
+++ /dev/null
diff --git a/CMakeLists.txt b/CMakeLists.txt
index 81f4a5d9..36a66694 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -23,14 +23,14 @@ set(
 # the OSX RPATH settings have been updated per recommendations found
 # in the CMake Wiki:
 #  http://www.cmake.org/Wiki/CMake_RPATH_handling#Mac_OS_X_and_the_RPATH
-    set(CMAKE_MACOSX_RPATH ON)
-    set(CMAKE_SKIP_BUILD_RPATH FALSE)
-    set(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE)
-    list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${CMAKE_INSTALL_PREFIX}/lib${LIB_SUFFIX}" isSystemDir)
-    if("${isSystemDir}" STREQUAL "-1")
-        set(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_PREFIX}/lib${LIB_SUFFIX}")
-        set(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE)
-    endif()
+set(CMAKE_MACOSX_RPATH ON)
+set(CMAKE_SKIP_BUILD_RPATH FALSE)
+set(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE)
+list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${CMAKE_INSTALL_PREFIX}/lib${LIB_SUFFIX}" isSystemDir)
+if("${isSystemDir}" STREQUAL "-1")
+  set(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_PREFIX}/lib${LIB_SUFFIX}")
+  set(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE)
+endif()
 
 
 # Configure the warning and code coverage suppression file
@@ -45,58 +45,58 @@ set(CMAKE_MODULE_PATH "${LAPACK_SOURCE_DIR}/CMAKE" ${CMAKE_MODULE_PATH})
 include(PreventInSourceBuilds)
 include(PreventInBuildInstalls)
 
-if (UNIX)
-   if ( "${CMAKE_Fortran_COMPILER}" MATCHES "ifort" )
-  set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fp-model strict" )
-   endif ()
-   if ( "${CMAKE_Fortran_COMPILER}" MATCHES "xlf" )
-  set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qnosave -qstrict=none" )
-   endif ()
+if(UNIX)
+  if("${CMAKE_Fortran_COMPILER}" MATCHES "ifort")
+    set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fp-model strict")
+  endif()
+  if("${CMAKE_Fortran_COMPILER}" MATCHES "xlf")
+    set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qnosave -qstrict=none")
+  endif()
 # Delete libmtsk in linking sequence for Sun/Oracle Fortran Compiler.
 # This library is not present in the Sun package SolarisStudio12.3-linux-x86-bin
-   string(REPLACE \;mtsk\; \; CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES "${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}")
-endif ()
-
-if ( CMAKE_Fortran_COMPILER_ID STREQUAL "Compaq" )
-   if ( WIN32 )
-      if (CMAKE_GENERATOR STREQUAL "NMake Makefiles")
-         get_filename_component(CMAKE_Fortran_COMPILER_CMDNAM ${CMAKE_Fortran_COMPILER} NAME_WE)
-         message(STATUS "Using Compaq Fortran compiler with command name ${CMAKE_Fortran_COMPILER_CMDNAM}")
-         set( cmd ${CMAKE_Fortran_COMPILER_CMDNAM} )
-         string( TOLOWER "${cmd}" cmdlc )
-         if ( cmdlc STREQUAL "df" )
-            message(STATUS "Assume the Compaq Visual Fortran Compiler is being used")
-            set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_OBJECTS 1)
-            set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_INCLUDES 1)
-            #This is a workaround that is needed to avoid forward-slashes in the
-            #filenames listed in response files from incorrectly being interpreted as
-            #introducing compiler command options
-          if (${BUILD_SHARED_LIBS})
-               message(FATAL_ERROR "Making of shared libraries with CVF has not been tested.")
-            endif()
-            set(str "NMake version 9 or later should be used. NMake version 6.0 which is\n")
-            set(str "${str}   included with the CVF distribution fails to build Lapack because\n")
-            set(str "${str}   the number of source files exceeds the limit for NMake v6.0\n")
-            message(STATUS ${str})
-            set(CMAKE_Fortran_LINK_EXECUTABLE "LINK /out:<TARGET> <LINK_FLAGS> <LINK_LIBRARIES> <OBJECTS>")
-         endif()
+  string(REPLACE \;mtsk\; \; CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES "${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}")
+endif()
+
+if(CMAKE_Fortran_COMPILER_ID STREQUAL "Compaq")
+  if(WIN32)
+    if(CMAKE_GENERATOR STREQUAL "NMake Makefiles")
+      get_filename_component(CMAKE_Fortran_COMPILER_CMDNAM ${CMAKE_Fortran_COMPILER} NAME_WE)
+      message(STATUS "Using Compaq Fortran compiler with command name ${CMAKE_Fortran_COMPILER_CMDNAM}")
+      set(cmd ${CMAKE_Fortran_COMPILER_CMDNAM})
+      string(TOLOWER "${cmd}" cmdlc)
+      if(cmdlc STREQUAL "df")
+        message(STATUS "Assume the Compaq Visual Fortran Compiler is being used")
+        set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_OBJECTS 1)
+        set(CMAKE_Fortran_USE_RESPONSE_FILE_FOR_INCLUDES 1)
+        #This is a workaround that is needed to avoid forward-slashes in the
+        #filenames listed in response files from incorrectly being interpreted as
+        #introducing compiler command options
+        if(${BUILD_SHARED_LIBS})
+          message(FATAL_ERROR "Making of shared libraries with CVF has not been tested.")
+        endif()
+        set(str "NMake version 9 or later should be used. NMake version 6.0 which is\n")
+        set(str "${str}   included with the CVF distribution fails to build Lapack because\n")
+        set(str "${str}   the number of source files exceeds the limit for NMake v6.0\n")
+        message(STATUS ${str})
+        set(CMAKE_Fortran_LINK_EXECUTABLE "LINK /out:<TARGET> <LINK_FLAGS> <LINK_LIBRARIES> <OBJECTS>")
       endif()
-   endif()
+    endif()
+  endif()
 endif()
 
 # Get Python
 message(STATUS "Looking for Python greater than 2.6 - ${PYTHONINTERP_FOUND}")
 find_package(PythonInterp 2.7) # lapack_testing.py uses features from python 2.7 and greater
-if (PYTHONINTERP_FOUND)
-   message(STATUS "Using Python version ${PYTHON_VERSION_STRING}")
+if(PYTHONINTERP_FOUND)
+  message(STATUS "Using Python version ${PYTHON_VERSION_STRING}")
 else()
-   message(STATUS "No suitable Python version found, so skipping summary tests.")
+  message(STATUS "No suitable Python version found, so skipping summary tests.")
 endif()
 # --------------------------------------------------
 
 set(LAPACK_INSTALL_EXPORT_NAME lapack-targets)
 
-if (UNIX)
+if(UNIX)
   include(GNUInstallDirs)
   set(ARCHIVE_DIR ${CMAKE_INSTALL_LIBDIR})
   set(LIBRARY_DIR ${CMAKE_INSTALL_LIBDIR})
@@ -140,7 +140,7 @@ set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${LAPACK_BINARY_DIR}/lib)
 
 # --------------------------------------------------
 # Check for any necessary platform specific compiler flags
-include( CheckLAPACKCompilerFlags )
+include(CheckLAPACKCompilerFlags)
 CheckLAPACKCompilerFlags()
 
 # --------------------------------------------------
@@ -155,11 +155,11 @@ CHECK_TIME_FUNCTION(EXT_ETIME_ TIME_FUNC)
 CHECK_TIME_FUNCTION(INT_ETIME TIME_FUNC)
 message(STATUS "--> Will use second_${TIME_FUNC}.f and dsecnd_${TIME_FUNC}.f as timing function.")
 
-set(SECOND_SRC  ${LAPACK_SOURCE_DIR}/INSTALL/second_${TIME_FUNC}.f)
-set(DSECOND_SRC  ${LAPACK_SOURCE_DIR}/INSTALL/dsecnd_${TIME_FUNC}.f)
+set(SECOND_SRC ${LAPACK_SOURCE_DIR}/INSTALL/second_${TIME_FUNC}.f)
+set(DSECOND_SRC ${LAPACK_SOURCE_DIR}/INSTALL/dsecnd_${TIME_FUNC}.f)
 
 # By default static library
-option(BUILD_SHARED_LIBS "Build shared libraries" OFF )
+option(BUILD_SHARED_LIBS "Build shared libraries" OFF)
 
 option(BUILD_TESTING "Build tests" OFF)
 
@@ -183,7 +183,7 @@ if(BLAS_LIBRARIES)
   include(CheckFortranFunctionExists)
   set(CMAKE_REQUIRED_LIBRARIES ${BLAS_LIBRARIES})
   CHECK_FORTRAN_FUNCTION_EXISTS("dgemm" BLAS_FOUND)
-  unset( CMAKE_REQUIRED_LIBRARIES )
+  unset(CMAKE_REQUIRED_LIBRARIES)
   if(BLAS_FOUND)
     message(STATUS "--> BLAS supplied by user is WORKING, will use ${BLAS_LIBRARIES}.")
   else()
@@ -194,23 +194,23 @@ if(BLAS_LIBRARIES)
   endif()
 
 # User did not provide a BLAS Library but specified to search for one
-elseif( USE_OPTIMIZED_BLAS )
-  find_package( BLAS )
-endif ()
+elseif(USE_OPTIMIZED_BLAS)
+  find_package(BLAS)
+endif()
 
 # Neither user specified or optimized BLAS libraries can be used
 if(NOT BLAS_FOUND)
   message(STATUS "Using supplied NETLIB BLAS implementation")
   add_subdirectory(BLAS)
-  set( BLAS_LIBRARIES blas )
+  set(BLAS_LIBRARIES blas)
 else()
-  set( CMAKE_EXE_LINKER_FLAGS
+  set(CMAKE_EXE_LINKER_FLAGS
     "${CMAKE_EXE_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}"
     CACHE STRING "Linker flags for executables" FORCE)
-  set( CMAKE_MODULE_LINKER_FLAGS
+  set(CMAKE_MODULE_LINKER_FLAGS
     "${CMAKE_MODULE_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}"
     CACHE STRING "Linker flags for modules" FORCE)
-  set( CMAKE_SHARED_LINKER_FLAGS
+  set(CMAKE_SHARED_LINKER_FLAGS
     "${CMAKE_SHARED_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}"
     CACHE STRING "Linker flags for shared libs" FORCE)
 endif()
@@ -228,7 +228,7 @@ endif()
 # XBLAS
 
 option(USE_XBLAS "Build extended precision (needs XBLAS)" OFF)
-if (USE_XBLAS)
+if(USE_XBLAS)
   find_library(XBLAS_LIBRARY NAMES xblas)
 endif()
 
@@ -237,9 +237,9 @@ option(USE_OPTIMIZED_LAPACK "Whether or not to use an optimized LAPACK library i
 # --------------------------------------------------
 # LAPACK
 # User did not provide a LAPACK Library but specified to search for one
-if( USE_OPTIMIZED_LAPACK )
-  find_package( LAPACK )
-endif ()
+if(USE_OPTIMIZED_LAPACK)
+  find_package(LAPACK)
+endif()
 
 # Check the usage of the user provided or automatically found LAPACK libraries
 if(LAPACK_LIBRARIES)
@@ -247,35 +247,35 @@ if(LAPACK_LIBRARIES)
   set(CMAKE_REQUIRED_LIBRARIES ${LAPACK_LIBRARIES})
   # Check if new routine of 3.4.0 is in LAPACK_LIBRARIES
   CHECK_FORTRAN_FUNCTION_EXISTS("dgeqrt" LATESTLAPACK_FOUND)
-  unset( CMAKE_REQUIRED_LIBRARIES )
+  unset(CMAKE_REQUIRED_LIBRARIES)
   if(LATESTLAPACK_FOUND)
     message(STATUS "--> LAPACK supplied by user is WORKING, will use ${LAPACK_LIBRARIES}.")
   else()
-    message(ERROR "--> LAPACK supplied by user is not WORKING or is older than LAPACK 3.4.0, 	CANNOT USE ${LAPACK_LIBRARIES}.")
+    message(ERROR "--> LAPACK supplied by user is not WORKING or is older than LAPACK 3.4.0, CANNOT USE ${LAPACK_LIBRARIES}.")
     message(ERROR "-->     Will use REFERENCE LAPACK (by default)")
     message(ERROR "-->     Or Correct your LAPACK_LIBRARIES entry ")
     message(ERROR "-->     Or Consider checking USE_OPTIMIZED_LAPACK")
   endif()
-endif ()
+endif()
 
 # Neither user specified or optimized LAPACK libraries can be used
 if(NOT LATESTLAPACK_FOUND)
   message(STATUS "Using supplied NETLIB LAPACK implementation")
-  set( LAPACK_LIBRARIES lapack )
+  set(LAPACK_LIBRARIES lapack)
   add_subdirectory(SRC)
 else()
-  set( CMAKE_EXE_LINKER_FLAGS
+  set(CMAKE_EXE_LINKER_FLAGS
     "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}"
     CACHE STRING "Linker flags for executables" FORCE)
-  set( CMAKE_MODULE_LINKER_FLAGS
+  set(CMAKE_MODULE_LINKER_FLAGS
     "${CMAKE_MODULE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}"
     CACHE STRING "Linker flags for modules" FORCE)
-  set( CMAKE_SHARED_LINKER_FLAGS
+  set(CMAKE_SHARED_LINKER_FLAGS
     "${CMAKE_SHARED_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}"
     CACHE STRING "Linker flags for shared libs" FORCE)
 endif()
 
-message(STATUS "BUILD TESTING : ${BUILD_TESTING}" )
+message(STATUS "BUILD TESTING : ${BUILD_TESTING}")
 if(BUILD_TESTING)
   add_subdirectory(TESTING)
 endif()
@@ -287,11 +287,11 @@ option(LAPACKE "Build LAPACKE" OFF)
 # LAPACKE has also the interface to some routines from tmglib,
 # if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
 option(LAPACKE_WITH_TMG "Build LAPACKE with tmglib routines" OFF)
-if (LAPACKE_WITH_TMG)
+if(LAPACKE_WITH_TMG)
   set(LAPACKE ON)
 endif()
 if(BUILD_TESTING OR LAPACKE_WITH_TMG) #already included, avoid double inclusion
-     add_subdirectory(TESTING/MATGEN)
+  add_subdirectory(TESTING/MATGEN)
 endif()
 
 if(LAPACKE)
@@ -321,8 +321,8 @@ if(WIN32 AND NOT UNIX)
 else()
   set(CPACK_GENERATOR "TGZ")
   set(CPACK_SOURCE_GENERATOR TGZ)
-  set(CPACK_SOURCE_PACKAGE_FILE_NAME "lapack-${LAPACK_VERSION}" )
-  set(CPACK_SOURCE_IGNORE_FILES ~$ .svn ${CPACK_SOURCE_IGNORE_FILES} )
+  set(CPACK_SOURCE_PACKAGE_FILE_NAME "lapack-${LAPACK_VERSION}")
+  set(CPACK_SOURCE_IGNORE_FILES ~$ .svn ${CPACK_SOURCE_IGNORE_FILES})
 endif()
 include(CPack)
 
@@ -381,7 +381,7 @@ configure_file(${CMAKE_CURRENT_SOURCE_DIR}/lapack.pc.in ${CMAKE_CURRENT_BINARY_D
   install(FILES
   ${CMAKE_CURRENT_BINARY_DIR}/lapack.pc
   DESTINATION ${PKG_CONFIG_DIR}
-   )
+  )
 
 configure_file(${LAPACK_SOURCE_DIR}/CMAKE/lapack-config-install.cmake.in
   ${LAPACK_BINARY_DIR}/CMakeFiles/lapack-config.cmake @ONLY)
diff --git a/DOCS/groups-usr.dox b/DOCS/groups-usr.dox
index 63556ef8..6c31e4cf 100644
--- a/DOCS/groups-usr.dox
+++ b/DOCS/groups-usr.dox
@@ -129,10 +129,10 @@
  ****
  *
  * @defgroup doubleGEsolve double
- *   @ingroup solveGE 
+ *   @ingroup solveGE
  *   This is the group of double solve driver functions for GE matrices
  * @defgroup doublePOsolve double
- *   @ingroup solvePO 
+ *   @ingroup solvePO
  *   This is the group of double solve driver functions for PO matrices
  * @defgroup doubleSYsolve double
  *   @ingroup solveSY
@@ -147,22 +147,22 @@
  *   @ingroup solvePT
  *   This is the group of double solve driver functions for PT matrices
  * @defgroup doubleGEeigen double
- *   @ingroup eigenGE 
+ *   @ingroup eigenGE
  *   This is the group of double eigenvalue driver functions for GE matrices
  * @defgroup doubleSYeigen double
  *   @ingroup eigenSY
  *   This is the group of double eigenvalue driver functions for SY matrices
  * @defgroup doubleGEsing double
- *   @ingroup singGE 
+ *   @ingroup singGE
  *   This is the group of double singular value driver functions for GE matrices
  * @defgroup doubleGEcomputational double
- *   @ingroup computationalGE 
+ *   @ingroup computationalGE
  *   This is the group of double computational functions for GE matrices
  * @defgroup doublePOcomputational double
- *   @ingroup computationalPO 
+ *   @ingroup computationalPO
  *   This is the group of double computational functions for PO matrices
  * @defgroup doubleSYcomputational double
- *   @ingroup computationalSY 
+ *   @ingroup computationalSY
  *   This is the group of double computational functions for SY matrices
  * @defgroup doubleGBcomputational double
  *   @ingroup computationalGB
@@ -174,22 +174,22 @@
  *   @ingroup computationalPT
  *   This is the group of double computational functions for PT matrices
  * @defgroup doubleGEauxiliary double
- *   @ingroup auxiliaryGE 
+ *   @ingroup auxiliaryGE
  *   This is the group of double auxiliary functions for GE matrices
  * @defgroup doublePOauxiliary double
- *   @ingroup auxiliaryPO 
+ *   @ingroup auxiliaryPO
  *   This is the group of double auxiliary functions for PO matrices
  * @defgroup doubleSYauxiliary double
  *   @ingroup auxiliarySY
  *   This is the group of double auxiliary functions for SY matrices
  * @defgroup doubleGBauxiliary double
- *   @ingroup auxiliaryGB 
+ *   @ingroup auxiliaryGB
  *   This is the group of double auxiliary functions for GB matrices
  * @defgroup doublePTauxiliary double
- *   @ingroup auxiliaryPT 
+ *   @ingroup auxiliaryPT
  *   This is the group of double auxiliary functions for PT matrices
  * @defgroup doubleGTauxiliary double
- *   @ingroup auxiliaryGT 
+ *   @ingroup auxiliaryGT
  *   This is the group of double auxiliary functions for GT matrices
  * @defgroup doubleOTHERauxiliary  double
  *   @ingroup OTHERauxiliary
@@ -207,10 +207,10 @@
  ****
  *
  * @defgroup realGEsolve real
- *   @ingroup solveGE 
+ *   @ingroup solveGE
  *   This is the group of real solve driver functions for GE matrices
  * @defgroup realPOsolve real
- *   @ingroup solvePO 
+ *   @ingroup solvePO
  *   This is the group of real solve driver functions for PO matrices
  * @defgroup realSYsolve real
  *   @ingroup solveSY
@@ -225,22 +225,22 @@
  *   @ingroup solvePT
  *   This is the group of real solve driver functions for PT matrices
  * @defgroup realGEeigen real
- *   @ingroup eigenGE 
+ *   @ingroup eigenGE
  *   This is the group of real eigenvalue driver functions for GE matrices
  * @defgroup realSYeigen real
  *   @ingroup eigenSY
  *   This is the group of real eigenvalue driver functions for SY matrices
  * @defgroup realGEsing real
- *   @ingroup singGE 
+ *   @ingroup singGE
  *   This is the group of real singular value driver functions for GE matrices
  * @defgroup realGEcomputational real
- *   @ingroup computationalGE 
+ *   @ingroup computationalGE
  *   This is the group of real computational functions for GE matrices
  * @defgroup realPOcomputational real
- *   @ingroup computationalPO 
+ *   @ingroup computationalPO
  *   This is the group of real computational functions for PO matrices
  * @defgroup realSYcomputational real
- *   @ingroup computationalSY 
+ *   @ingroup computationalSY
  *   This is the group of real computational functions for SY matrices
  * @defgroup realGBcomputational real
  *   @ingroup computationalGB
@@ -252,16 +252,16 @@
  *   @ingroup computationalGT
  *   This is the group of real computational functions for GT matrices
  * @defgroup realGEauxiliary real
- *   @ingroup auxiliaryGE 
+ *   @ingroup auxiliaryGE
  *   This is the group of real auxiliary functions for GE matrices
  * @defgroup realPOauxiliary real
- *   @ingroup auxiliaryPO 
+ *   @ingroup auxiliaryPO
  *   This is the group of real auxiliary functions for PO matrices
  * @defgroup realSYauxiliary real
  *   @ingroup auxiliarySY
  *   This is the group of real auxiliary functions for SY matrices
  * @defgroup realGBauxiliary real
- *   @ingroup auxiliaryGB 
+ *   @ingroup auxiliaryGB
  *   This is the group of real auxiliary functions for GB matrices
  * @defgroup realGTauxiliary real
  *   @ingroup auxiliaryGT
@@ -285,10 +285,10 @@
  ****
  *
  * @defgroup complexGEsolve complex
- *   @ingroup solveGE 
+ *   @ingroup solveGE
  *   This is the group of complex solve driver functions for GE matrices
  * @defgroup complexPOsolve complex
- *   @ingroup solvePO 
+ *   @ingroup solvePO
  *   This is the group of complex solve driver functions for PO matrices
  * @defgroup complexSYsolve complex
  *   @ingroup solveSY
@@ -306,7 +306,7 @@
  *   @ingroup solvePT
  *   This is the group of complex solve driver functions for PT matrices
  * @defgroup complexGEeigen complex
- *   @ingroup eigenGE 
+ *   @ingroup eigenGE
  *   This is the group of complex eigenvalue driver functions for GE matrices
  * @defgroup complexSYeigen complex
  *   @ingroup eigenSY
@@ -315,19 +315,19 @@
  *   @ingroup eigenHE
  *   This is the group of complex eigenvalue driver functions for HE matrices
  * @defgroup complexGEsing complex
- *   @ingroup singGE 
+ *   @ingroup singGE
  *   This is the group of complex singular value driver functions for GE matrices
  * @defgroup complexGEcomputational complex
- *   @ingroup computationalGE 
+ *   @ingroup computationalGE
  *   This is the group of complex computational functions for GE matrices
  * @defgroup complexPOcomputational complex
- *   @ingroup computationalPO 
+ *   @ingroup computationalPO
  *   This is the group of complex computational functions for PO matrices
  * @defgroup complexSYcomputational complex
- *   @ingroup computationalSY 
+ *   @ingroup computationalSY
  *   This is the group of complex computational functions for SY matrices
  * @defgroup complexHEcomputational complex
- *   @ingroup computationalHE 
+ *   @ingroup computationalHE
  *   This is the group of complex computational functions for HE matrices
  * @defgroup complexGBcomputational complex
  *   @ingroup computationalGB
@@ -339,10 +339,10 @@
  *   @ingroup computationalPT
  *   This is the group of complex computational functions for PT matrices
  * @defgroup complexGEauxiliary complex
- *   @ingroup auxiliaryGE 
+ *   @ingroup auxiliaryGE
  *   This is the group of complex auxiliary functions for GE matrices
  * @defgroup complexPOauxiliary complex
- *   @ingroup auxiliaryPO 
+ *   @ingroup auxiliaryPO
  *   This is the group of complex auxiliary functions for PO matrices
  * @defgroup complexSYauxiliary complex
  *   @ingroup auxiliarySY
@@ -351,7 +351,7 @@
  *   @ingroup auxiliaryHE
  *   This is the group of complex auxiliary functions for HE matrices
  * @defgroup complexGBauxiliary complex
- *   @ingroup auxiliaryGB 
+ *   @ingroup auxiliaryGB
  *   This is the group of complex auxiliary functions for GB matrices
  * @defgroup complexOTHERauxiliary  complex
  *   @ingroup OTHERauxiliary
@@ -369,10 +369,10 @@
  ****
  *
  * @defgroup complex16GEsolve complex16
- *   @ingroup solveGE 
+ *   @ingroup solveGE
  *   This is the group of complex16 solve driver functions for GE matrices
  * @defgroup complex16POsolve complex16
- *   @ingroup solvePO 
+ *   @ingroup solvePO
  *   This is the group of complex16 solve driver functions for PO matrices
  * @defgroup complex16SYsolve complex16
  *   @ingroup solveSY
@@ -390,7 +390,7 @@
  *   @ingroup solvePT
  *   This is the group of complex16 solve driver functions for PT matrices
  * @defgroup complex16GEeigen complex16
- *   @ingroup eigenGE 
+ *   @ingroup eigenGE
  *   This is the group of complex16 eigenvalue driver functions for GE matrices
  * @defgroup complex16SYeigen complex16
  *   @ingroup eigenSY
@@ -399,19 +399,19 @@
  *   @ingroup eigenHE
  *   This is the group of complex16 eigenvalue driver functions for HE matrices
  * @defgroup complex16GEsing complex16
- *   @ingroup singGE 
+ *   @ingroup singGE
  *   This is the group of complex16 singular value driver functions for GE matrices
  * @defgroup complex16GEcomputational complex16
- *   @ingroup computationalGE 
+ *   @ingroup computationalGE
  *   This is the group of complex16 computational functions for GE matrices
  * @defgroup complex16POcomputational complex16
- *   @ingroup computationalPO 
+ *   @ingroup computationalPO
  *   This is the group of complex16 computational functions for PO matrices
  * @defgroup complex16SYcomputational complex16
- *   @ingroup computationalSY 
+ *   @ingroup computationalSY
  *   This is the group of complex16 computational functions for SY matrices
  * @defgroup complex16HEcomputational complex16
- *   @ingroup computationalHE 
+ *   @ingroup computationalHE
  *   This is the group of complex16 computational functions for HE matrices
  * @defgroup complex16GBcomputational complex16
  *   @ingroup computationalGB
@@ -423,10 +423,10 @@
  *   @ingroup computationalPT
  *   This is the group of complex16 computational functions for PT matrices
  * @defgroup complex16GEauxiliary complex16
- *   @ingroup auxiliaryGE 
+ *   @ingroup auxiliaryGE
  *   This is the group of complex16 auxiliary functions for GE matrices
  * @defgroup complex16POauxiliary complex16
- *   @ingroup auxiliaryPO 
+ *   @ingroup auxiliaryPO
  *   This is the group of complex16 auxiliary functions for PO matrices
  * @defgroup complex16SYauxiliary complex16
  *   @ingroup auxiliarySY
@@ -435,7 +435,7 @@
  *   @ingroup auxiliaryHE
  *   This is the group of complex16 auxiliary functions for HE matrices
  * @defgroup complex16GBauxiliary complex16
- *   @ingroup auxiliaryGB 
+ *   @ingroup auxiliaryGB
  *   This is the group of complex16 auxiliary functions for GB matrices
  * @defgroup complex16OTHERcomputational  complex16
  *   @ingroup OTHERcomputational
@@ -459,75 +459,75 @@
  *   This is the group of LAPACK TESTING routines.
  *
  * @defgroup matgen Matrix Generation
- *   @ingroup testing 
+ *   @ingroup testing
  *   This is the group of LAPACK TESTING MATGEN routines.
  *
  * @defgroup lin Linear Solve
- *   @ingroup testing 
+ *   @ingroup testing
  *   This is the group of LAPACK TESTING LIN routines.
  *
  * @defgroup eig Eigenvalue and Singular value
- *   @ingroup testing 
+ *   @ingroup testing
  *   This is the group of LAPACK TESTING EIG routines.
  *
  * @defgroup real_matgen real
- *   @ingroup matgen 
+ *   @ingroup matgen
  *   This is the group of real LAPACK TESTING MATGEN routines.
  *
  * @defgroup double_matgen double
- *   @ingroup matgen 
+ *   @ingroup matgen
  *   This is the group of double LAPACK TESTING MATGEN routines.
  *
  * @defgroup complex_matgen complex
- *   @ingroup matgen 
+ *   @ingroup matgen
  *   This is the group of complex LAPACK TESTING MATGEN routines.
  *
  * @defgroup complex16_matgen complex16
- *   @ingroup matgen 
+ *   @ingroup matgen
  *   This is the group of complex16 LAPACK TESTING MATGEN routines.
  *
  * @defgroup aux_matgen aux
- *   @ingroup matgen 
+ *   @ingroup matgen
  *   This is the group of auxiliary LAPACK TESTING MATGEN routines.
  *
  * @defgroup single_lin real
- *   @ingroup lin 
+ *   @ingroup lin
  *   This is the group of real LAPACK TESTING LIN routines.
  *
  * @defgroup double_lin double
- *   @ingroup lin 
+ *   @ingroup lin
  *   This is the group of double LAPACK TESTING LIN routines.
  *
  * @defgroup complex_lin complex
- *   @ingroup lin 
+ *   @ingroup lin
  *   This is the group of complex LAPACK TESTING LIN routines.
  *
  * @defgroup complex16_lin complex16
- *   @ingroup lin 
+ *   @ingroup lin
  *   This is the group of complex16 LAPACK TESTING LIN routines.
  *
  * @defgroup aux_lin aux
- *   @ingroup lin 
+ *   @ingroup lin
  *   This is the group of auxiliary LAPACK TESTING LIN routines.
  *
  * @defgroup single_eig real
- *   @ingroup eig 
+ *   @ingroup eig
  *   This is the group of real LAPACK TESTING EIG routines.
  *
  * @defgroup double_eig double
- *   @ingroup eig 
+ *   @ingroup eig
  *   This is the group of double LAPACK TESTING EIG routines.
  *
  * @defgroup complex_eig complex
- *   @ingroup eig 
+ *   @ingroup eig
  *   This is the group of complex LAPACK TESTING EIG routines.
  *
  * @defgroup complex16_eig complex16
- *   @ingroup eig 
+ *   @ingroup eig
  *   This is the group of complex16 LAPACK TESTING EIG routines.
  *
  * @defgroup aux_eig aux
- *   @ingroup eig 
+ *   @ingroup eig
  *   This is the group of auxiliary LAPACK TESTING EIG routines.
  *
  ****
@@ -543,7 +543,7 @@
  * @defgroup level3 Level3
  *   @ingroup blas
  *   This is the group of LEVEL 3 BLAS routines.
-  * @defgroup aux_blas Auxiliary BLAS 
+  * @defgroup aux_blas Auxiliary BLAS
  *   @ingroup blas
  *   This is the group of Auxiliary 3 BLAS routines.
 * @defgroup blastesting Testing
@@ -554,52 +554,52 @@
  *   @ingroup level1
  *   This is the group of real LEVEL 1 BLAS routines.
  * @defgroup double_blas_level1 double
- *   @ingroup level1 
+ *   @ingroup level1
  *   This is the group of double LEVEL 1 BLAS routines.
  * @defgroup complex_blas_level1 complex
- *   @ingroup level1 
+ *   @ingroup level1
  *   This is the group of complex LEVEL 1 BLAS routines.
  * @defgroup complex16_blas_level1 complex16
- *   @ingroup level1 
+ *   @ingroup level1
  *   This is the group of complex16 LEVEL 1 BLAS routines.
  *
  * @defgroup single_blas_level2 real
  *   @ingroup level2
  *   This is the group of real LEVEL 2 BLAS routines.
  * @defgroup double_blas_level2 double
- *   @ingroup level2 
+ *   @ingroup level2
  *   This is the group of double LEVEL 2 BLAS routines.
  * @defgroup complex_blas_level2 complex
- *   @ingroup level2 
+ *   @ingroup level2
  *   This is the group of complex LEVEL 2 BLAS routines.
  * @defgroup complex16_blas_level2 complex16
- *   @ingroup level2 
+ *   @ingroup level2
  *   This is the group of complex16 LEVEL 2 BLAS routines.
  *
  * @defgroup single_blas_level3 real
  *   @ingroup level3
  *   This is the group of real LEVEL 3 BLAS routines.
  * @defgroup double_blas_level3 double
- *   @ingroup level3 
+ *   @ingroup level3
  *   This is the group of double LEVEL 3 BLAS routines.
  * @defgroup complex_blas_level3 complex
- *   @ingroup level3 
+ *   @ingroup level3
  *   This is the group of complex LEVEL 3 BLAS routines.
  * @defgroup complex16_blas_level3 complex16
- *   @ingroup level3 
+ *   @ingroup level3
  *   This is the group of complex16 LEVEL 3 BLAS routines.
  *
  * @defgroup single_blas_testing real
  *   @ingroup blastesting
  *   This is the group of real BLAS TESTING routines.
  * @defgroup double_blas_testing double
- *   @ingroup blastesting 
+ *   @ingroup blastesting
  *   This is the group of double BLAS TESTING routines.
  * @defgroup complex_blas_testing complex
- *   @ingroup blastesting 
+ *   @ingroup blastesting
  *   This is the group of complex BLAS TESTING routines.
  * @defgroup complex16_blas_testing complex16
- *   @ingroup blastesting 
+ *   @ingroup blastesting
  *   This is the group of complex16 BLAS TESTING routines.
  *
 **/
diff --git a/INSTALL/CMakeLists.txt b/INSTALL/CMakeLists.txt
index 1e2867f1..1e808a64 100644
--- a/INSTALL/CMakeLists.txt
+++ b/INSTALL/CMakeLists.txt
@@ -7,4 +7,3 @@ add_executable(secondtst_INT_ETIME second_INT_ETIME.f secondtst.f)
 add_executable(secondtst_INT_CPU_TIME second_INT_CPU_TIME.f secondtst.f)
 add_executable(testieee tstiee.f)
 add_executable(testversion ilaver.f LAPACK_version.f)
-
diff --git a/INSTALL/Makefile b/INSTALL/Makefile
index 91057de4..15f5252b 100644
--- a/INSTALL/Makefile
+++ b/INSTALL/Makefile
@@ -1,35 +1,35 @@
 include ../make.inc
 
-.SUFFIXES : .o .f
-all:  testlsame testslamch testdlamch testsecond testdsecnd testieee testversion
+.SUFFIXES: .o .f
+all: testlsame testslamch testdlamch testsecond testdsecnd testieee testversion
 
-testlsame:  lsame.o lsametst.o
-	$(LOADER) $(LOADOPTS) -o testlsame lsame.o lsametst.o
+testlsame: lsame.o lsametst.o
+	$(LOADER) $(LOADOPTS) -o $@ lsame.o lsametst.o
 
 testslamch: slamch.o lsame.o slamchtst.o
-	$(LOADER) $(LOADOPTS) -o testslamch slamch.o lsame.o slamchtst.o
+	$(LOADER) $(LOADOPTS) -o $@ slamch.o lsame.o slamchtst.o
 
 testdlamch: dlamch.o lsame.o dlamchtst.o
-	$(LOADER) $(LOADOPTS) -o testdlamch dlamch.o lsame.o dlamchtst.o
+	$(LOADER) $(LOADOPTS) -o $@ dlamch.o lsame.o dlamchtst.o
 
 testsecond: second_$(TIMER).o secondtst.o
 	@echo "[INFO] : TIMER value: $(TIMER) (given by make.inc)"
-	$(LOADER) $(LOADOPTS) -o testsecond second_$(TIMER).o secondtst.o
+	$(LOADER) $(LOADOPTS) -o $@ second_$(TIMER).o secondtst.o
 
 testdsecnd: dsecnd_$(TIMER).o dsecndtst.o
 	@echo "[INFO] : TIMER value: $(TIMER) (given by make.inc)"
-	$(LOADER) $(LOADOPTS) -o testdsecnd dsecnd_$(TIMER).o dsecndtst.o
+	$(LOADER) $(LOADOPTS) -o $@ dsecnd_$(TIMER).o dsecndtst.o
 
 testieee: tstiee.o
-	$(LOADER) $(LOADOPTS) -o testieee tstiee.o
+	$(LOADER) $(LOADOPTS) -o $@ tstiee.o
 
 testversion: ilaver.o LAPACK_version.o
-	$(LOADER) $(LOADOPTS) -o testversion ilaver.o LAPACK_version.o
+	$(LOADER) $(LOADOPTS) -o $@ ilaver.o LAPACK_version.o
 
 clean:
 	rm -f *.o
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
 
-slamch.o: slamch.f ; $(FORTRAN) $(NOOPT) -c $< -o $@
-dlamch.o: dlamch.f ; $(FORTRAN) $(NOOPT) -c $< -o $@
+slamch.o: slamch.f ; $(FORTRAN) $(NOOPT) -c -o $@ $<
+dlamch.o: dlamch.f ; $(FORTRAN) $(NOOPT) -c -o $@ $<
diff --git a/LAPACKE/CMakeLists.txt b/LAPACKE/CMakeLists.txt
index 904025f4..2a60a1ea 100644
--- a/LAPACKE/CMakeLists.txt
+++ b/LAPACKE/CMakeLists.txt
@@ -7,32 +7,32 @@ set(LAPACK_INSTALL_EXPORT_NAME lapacke-targets)
 include(FortranCInterface)
 ## Ensure that the fortran compiler and c compiler specified are compatible
 FortranCInterface_VERIFY()
-FortranCInterface_HEADER( ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h
-    MACRO_NAMESPACE "LAPACK_"
-    SYMBOL_NAMESPACE "LAPACK_" )
-if( NOT FortranCInterface_GLOBAL_FOUND OR NOT FortranCInterface_MODULE_FOUND)
+FortranCInterface_HEADER(${LAPACK_BINARY_DIR}/include/lapacke_mangling.h
+  MACRO_NAMESPACE "LAPACK_"
+  SYMBOL_NAMESPACE "LAPACK_")
+if(NOT FortranCInterface_GLOBAL_FOUND OR NOT FortranCInterface_MODULE_FOUND)
   message(WARNING "Reverting to pre-defined include/lapacke_mangling.h")
-  configure_file( include/lapacke_mangling_with_flags.h.in
-                  ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h )
-endif ()
+  configure_file(include/lapacke_mangling_with_flags.h.in
+                 ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h)
+endif()
 
-if (WIN32 AND NOT UNIX)
- add_definitions(-DHAVE_LAPACK_CONFIG_H -DLAPACK_COMPLEX_STRUCTURE)
- message (STATUS "Windows BUILD")
-endif ()
+if(WIN32 AND NOT UNIX)
+  add_definitions(-DHAVE_LAPACK_CONFIG_H -DLAPACK_COMPLEX_STRUCTURE)
+  message(STATUS "Windows BUILD")
+endif()
 
-get_directory_property( DirDefs COMPILE_DEFINITIONS )
+get_directory_property(DirDefs COMPILE_DEFINITIONS)
 
-include_directories( include ${LAPACK_BINARY_DIR}/include )
+include_directories(include ${LAPACK_BINARY_DIR}/include)
 add_subdirectory(include)
 add_subdirectory(src)
 add_subdirectory(utils)
 
 macro(append_subdir_files variable dirname)
-get_directory_property(holder DIRECTORY ${dirname} DEFINITION ${variable})
-foreach(depfile ${holder})
-  list(APPEND ${variable} "${dirname}/${depfile}")
-endforeach()
+  get_directory_property(holder DIRECTORY ${dirname} DEFINITION ${variable})
+  foreach(depfile ${holder})
+    list(APPEND ${variable} "${dirname}/${depfile}")
+  endforeach()
 endmacro()
 
 append_subdir_files(LAPACKE_INCLUDE "include")
@@ -41,32 +41,32 @@ append_subdir_files(SRCX_OBJ "src")
 append_subdir_files(MATGEN_OBJ "src")
 append_subdir_files(UTILS_OBJ "utils")
 
-if (USE_XBLAS)
-   add_library(lapacke ${SRC_OBJ} ${SRCX_OBJ} ${UTILS_OBJ})
-   target_link_libraries(lapacke ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${XBLAS_LIBRARY})
-else ()
-  if (LAPACKE_WITH_TMG)
-   add_library(lapacke ${SRC_OBJ} ${MATGEN_OBJ} ${UTILS_OBJ})
-   target_link_libraries(lapacke tmglib ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
-  else ()
-   add_library(lapacke ${SRC_OBJ} ${UTILS_OBJ})
-   target_link_libraries(lapacke ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
+if(USE_XBLAS)
+  add_library(lapacke ${SRC_OBJ} ${SRCX_OBJ} ${UTILS_OBJ})
+  target_link_libraries(lapacke ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${XBLAS_LIBRARY})
+else()
+  if(LAPACKE_WITH_TMG)
+    add_library(lapacke ${SRC_OBJ} ${MATGEN_OBJ} ${UTILS_OBJ})
+    target_link_libraries(lapacke tmglib ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
+  else()
+    add_library(lapacke ${SRC_OBJ} ${UTILS_OBJ})
+    target_link_libraries(lapacke ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
   endif()
 endif()
 
 lapack_install_library(lapacke)
-install( FILES ${LAPACKE_INCLUDE} ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h DESTINATION include )
+install(FILES ${LAPACKE_INCLUDE} ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h DESTINATION include)
 
 if(BUILD_TESTING)
-   add_subdirectory(example)
+  add_subdirectory(example)
 endif()
 
 
 configure_file(${CMAKE_CURRENT_SOURCE_DIR}/lapacke.pc.in ${CMAKE_CURRENT_BINARY_DIR}/lapacke.pc @ONLY)
- install(FILES
+install(FILES
   ${CMAKE_CURRENT_BINARY_DIR}/lapacke.pc
   DESTINATION ${PKG_CONFIG_DIR}
-   )
+  )
 
 configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cmake/lapacke-config-version.cmake.in
   ${LAPACK_BINARY_DIR}/lapacke-config-version.cmake @ONLY)
diff --git a/LAPACKE/LICENSE b/LAPACKE/LICENSE
index 8fc2ed90..2c954cd6 100644
--- a/LAPACKE/LICENSE
+++ b/LAPACKE/LICENSE
@@ -1,26 +1,26 @@
-  Copyright (c) 2012, Intel Corp.

-  All rights reserved.

-

-  Redistribution and use in source and binary forms, with or without

-  modification, are permitted provided that the following conditions are met:

-

-    * Redistributions of source code must retain the above copyright notice,

-      this list of conditions and the following disclaimer.

-    * Redistributions in binary form must reproduce the above copyright

-      notice, this list of conditions and the following disclaimer in the

-      documentation and/or other materials provided with the distribution.

-    * Neither the name of Intel Corporation nor the names of its contributors

-      may be used to endorse or promote products derived from this software

-      without specific prior written permission.

-

-  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"

-  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE

-  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE

-  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE

-  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR

-  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF

-  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS

-  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN

-  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)

-  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF

-  THE POSSIBILITY OF SUCH DAMAGE.

+  Copyright (c) 2012, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/LAPACKE/Makefile b/LAPACKE/Makefile
index 8d282880..f1b07ad5 100644
--- a/LAPACKE/Makefile
+++ b/LAPACKE/Makefile
@@ -61,4 +61,3 @@ cleanlib:
 cleanall: clean
 	rm -f $(LAPACKE)
 	cd example && $(MAKE) clean
-
diff --git a/LAPACKE/cmake/tmp.dnyp4S2eiM b/LAPACKE/cmake/tmp.dnyp4S2eiM
deleted file mode 100644
index e69de29b..00000000
--- a/LAPACKE/cmake/tmp.dnyp4S2eiM
+++ /dev/null
diff --git a/LAPACKE/example/Makefile b/LAPACKE/example/Makefile
index c142a33c..80968e8c 100644
--- a/LAPACKE/example/Makefile
+++ b/LAPACKE/example/Makefile
@@ -5,31 +5,27 @@ all: xexample_DGESV_rowmajor \
      xexample_DGELS_rowmajor \
      xexample_DGELS_colmajor
 
-LIBRAIRIES= ../../$(LAPACKELIB) ../../$(LAPACKLIB) $(BLASLIB)
+LIBRARIES = ../../$(LAPACKELIB) ../../$(LAPACKLIB) $(BLASLIB)
 
 # Double Precision Examples
-xexample_DGESV_rowmajor: example_DGESV_rowmajor.o lapacke_example_aux.o $(LIBRAIRIES)
-	$(LOADER) $(LOADOPTS)  example_DGESV_rowmajor.o lapacke_example_aux.o \
-	$(LIBRAIRIES) -o $@
+xexample_DGESV_rowmajor: example_DGESV_rowmajor.o lapacke_example_aux.o $(LIBRARIES)
+	$(LOADER) $(LOADOPTS) -o $@ example_DGESV_rowmajor.o lapacke_example_aux.o $(LIBRARIES)
 	./$@
 
-xexample_DGESV_colmajor: example_DGESV_colmajor.o lapacke_example_aux.o $(LIBRAIRIES)
-	$(LOADER) $(LOADOPTS)  example_DGESV_colmajor.o lapacke_example_aux.o \
-	$(LIBRAIRIES) -o $@
+xexample_DGESV_colmajor: example_DGESV_colmajor.o lapacke_example_aux.o $(LIBRARIES)
+	$(LOADER) $(LOADOPTS) -o $@ example_DGESV_colmajor.o lapacke_example_aux.o $(LIBRARIES)
 	./$@
 
-xexample_DGELS_rowmajor: example_DGELS_rowmajor.o lapacke_example_aux.o $(LIBRAIRIES)
-	$(LOADER) $(LOADOPTS)  example_DGELS_rowmajor.o lapacke_example_aux.o \
-	$(LIBRAIRIES) -o $@
+xexample_DGELS_rowmajor: example_DGELS_rowmajor.o lapacke_example_aux.o $(LIBRARIES)
+	$(LOADER) $(LOADOPTS) -o $@ example_DGELS_rowmajor.o lapacke_example_aux.o $(LIBRARIES)
 	./$@
 
-xexample_DGELS_colmajor: example_DGELS_colmajor.o lapacke_example_aux.o $(LIBRAIRIES)
-	$(LOADER) $(LOADOPTS)  example_DGELS_colmajor.o lapacke_example_aux.o \
-	$(LIBRAIRIES) -o $@
+xexample_DGELS_colmajor: example_DGELS_colmajor.o lapacke_example_aux.o $(LIBRARIES)
+	$(LOADER) $(LOADOPTS) -o $@ example_DGELS_colmajor.o lapacke_example_aux.o $(LIBRARIES)
 	./$@
 
 .c.o:
-	$(CC) -c $(CFLAGS) -I. -I ../include -o $@ $<
+	$(CC) $(CFLAGS) -I. -I../include -c -o $@ $<
 
 clean:
 	rm -f *.o x*
diff --git a/LAPACKE/include/CMakeLists.txt b/LAPACKE/include/CMakeLists.txt
index 3034962b..4c30c050 100644
--- a/LAPACKE/include/CMakeLists.txt
+++ b/LAPACKE/include/CMakeLists.txt
@@ -1,3 +1,3 @@
-set (LAPACKE_INCLUDE lapacke.h lapacke_config.h lapacke_utils.h )
+set(LAPACKE_INCLUDE lapacke.h lapacke_config.h lapacke_utils.h)
 
 file(COPY ${LAPACKE_INCLUDE} DESTINATION ${LAPACK_BINARY_DIR}/include)
diff --git a/LAPACKE/include/lapacke.h b/LAPACKE/include/lapacke.h
index b191d380..a319a469 100644
--- a/LAPACKE/include/lapacke.h
+++ b/LAPACKE/include/lapacke.h
@@ -11439,6 +11439,24 @@ lapack_int LAPACKE_dsysv_aa_work( int matrix_layout, char uplo, lapack_int n,
                                lapack_int nrhs, double* a, lapack_int lda,
                                lapack_int* ipiv, double* b, lapack_int ldb,
                                double* work, lapack_int lwork );
+lapack_int LAPACKE_csysv_aa( int matrix_layout, char uplo, lapack_int n,
+                          lapack_int nrhs, lapack_complex_float* a,
+                          lapack_int lda, lapack_int* ipiv,
+                          lapack_complex_float* b, lapack_int ldb );
+lapack_int LAPACKE_csysv_aa_work( int matrix_layout, char uplo, lapack_int n,
+                               lapack_int nrhs, lapack_complex_float* a,
+                               lapack_int lda, lapack_int* ipiv,
+                               lapack_complex_float* b, lapack_int ldb,
+                               lapack_complex_float* work, lapack_int lwork );
+lapack_int LAPACKE_zsysv_aa( int matrix_layout, char uplo, lapack_int n,
+                          lapack_int nrhs, lapack_complex_double* a,
+                          lapack_int lda, lapack_int* ipiv,
+                          lapack_complex_double* b, lapack_int ldb );
+lapack_int LAPACKE_zsysv_aa_work( int matrix_layout, char uplo, lapack_int n,
+                               lapack_int nrhs, lapack_complex_double* a,
+                               lapack_int lda, lapack_int* ipiv,
+                               lapack_complex_double* b, lapack_int ldb,
+                               lapack_complex_double* work, lapack_int lwork );
 lapack_int LAPACKE_chesv_aa( int matrix_layout, char uplo, lapack_int n,
                           lapack_int nrhs, lapack_complex_float* a,
                           lapack_int lda, lapack_int* ipiv,
@@ -11462,6 +11480,12 @@ lapack_int LAPACKE_ssytrf_aa( int matrix_layout, char uplo, lapack_int n, float*
                            lapack_int lda, lapack_int* ipiv );
 lapack_int LAPACKE_dsytrf_aa( int matrix_layout, char uplo, lapack_int n, double* a,
                            lapack_int lda, lapack_int* ipiv );
+lapack_int LAPACKE_csytrf_aa( int matrix_layout, char uplo, lapack_int n,
+                           lapack_complex_float* a, lapack_int lda,
+                           lapack_int* ipiv );
+lapack_int LAPACKE_zsytrf_aa( int matrix_layout, char uplo, lapack_int n,
+                           lapack_complex_double* a, lapack_int lda,
+                           lapack_int* ipiv );
 lapack_int LAPACKE_chetrf_aa( int matrix_layout, char uplo, lapack_int n,
                            lapack_complex_float* a, lapack_int lda,
                            lapack_int* ipiv );
@@ -11475,6 +11499,14 @@ lapack_int LAPACKE_ssytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
 lapack_int LAPACKE_dsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
                                 double* a, lapack_int lda, lapack_int* ipiv,
                                 double* work, lapack_int lwork );
+lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
+                                lapack_complex_float* a, lapack_int lda,
+                                lapack_int* ipiv, lapack_complex_float* work,
+                                lapack_int lwork );
+lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
+                                lapack_complex_double* a, lapack_int lda,
+                                lapack_int* ipiv, lapack_complex_double* work,
+                                lapack_int lwork );
 lapack_int LAPACKE_chetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
                                 lapack_complex_float* a, lapack_int lda,
                                 lapack_int* ipiv, lapack_complex_float* work,
@@ -11485,6 +11517,15 @@ lapack_int LAPACKE_zhetrf_aa_work( int matrix_layout, char uplo, lapack_int n,
                                 lapack_int lwork );
 
 
+lapack_int LAPACKE_csytrs_aa( int matrix_layout, char uplo, lapack_int n,
+                            lapack_int nrhs, const lapack_complex_float* a,
+                            lapack_int lda, const lapack_int* ipiv,
+                            lapack_complex_float* b, lapack_int ldb );
+lapack_int LAPACKE_csytrs_aa_work( int matrix_layout, char uplo, lapack_int n,
+                                 lapack_int nrhs, const lapack_complex_float* a,
+                                 lapack_int lda, const lapack_int* ipiv,
+                                 lapack_complex_float* b, lapack_int ldb,
+                                 lapack_complex_float* work, lapack_int lwork );
 lapack_int LAPACKE_chetrs_aa( int matrix_layout, char uplo, lapack_int n,
                             lapack_int nrhs, const lapack_complex_float* a,
                             lapack_int lda, const lapack_int* ipiv,
@@ -11508,6 +11549,15 @@ lapack_int LAPACKE_ssytrs_aa_work( int matrix_layout, char uplo, lapack_int n,
                                 lapack_int nrhs, const float* a, lapack_int lda,
                                 const lapack_int* ipiv, float* b,
                                 lapack_int ldb, float* work, lapack_int lwork );
+lapack_int LAPACKE_zsytrs_aa( int matrix_layout, char uplo, lapack_int n,
+                            lapack_int nrhs, const lapack_complex_double* a,
+                            lapack_int lda, const lapack_int* ipiv,
+                            lapack_complex_double* b, lapack_int ldb );
+lapack_int LAPACKE_zsytrs_aa_work( int matrix_layout, char uplo, lapack_int n,
+                                 lapack_int nrhs, const lapack_complex_double* a,
+                                 lapack_int lda, const lapack_int* ipiv,
+                                 lapack_complex_double* b, lapack_int ldb,
+                                 lapack_complex_double* work,  lapack_int lwork);
 lapack_int LAPACKE_zhetrs_aa( int matrix_layout, char uplo, lapack_int n,
                             lapack_int nrhs, const lapack_complex_double* a,
                             lapack_int lda, const lapack_int* ipiv,
@@ -12629,14 +12679,20 @@ lapack_int LAPACKE_zhetrs_aa_work( int matrix_layout, char uplo, lapack_int n,
 // LAPACK 3.7.0
 #define LAPACK_ssysv_aa LAPACK_GLOBAL(ssysv_aa,SSYSV_AA)
 #define LAPACK_dsysv_aa LAPACK_GLOBAL(dsysv_aa,DSYSV_AA)
-#define LAPACK_chesv_aa LAPACK_GLOBAL(chesv_aa,CHESV_AA)
+#define LAPACK_csysv_aa LAPACK_GLOBAL(chesv_aa,CHESV_AA)
+#define LAPACK_zsysv_aa LAPACK_GLOBAL(zsysv_aa,ZSYSV_AA)
+#define LAPACK_chesv_aa LAPACK_GLOBAL(csysv_aa,CSYSV_AA)
 #define LAPACK_zhesv_aa LAPACK_GLOBAL(zhesv_aa,ZHESV_AA)
 #define LAPACK_ssytrs_aa LAPACK_GLOBAL(ssytrs_aa,SSYTRS_AA)
 #define LAPACK_dsytrs_aa LAPACK_GLOBAL(dsytrs_aa,DSYTRS_AA)
+#define LAPACK_csytrs_aa LAPACK_GLOBAL(csytrs_aa,CSYTRS_AA)
+#define LAPACK_zsytrs_aa LAPACK_GLOBAL(zsytrs_aa,ZSYTRS_AA)
 #define LAPACK_chetrs_aa LAPACK_GLOBAL(chetrs_aa,CHETRS_AA)
 #define LAPACK_zhetrs_aa LAPACK_GLOBAL(zhetrs_aa,ZHETRS_AA)
 #define LAPACK_ssytrf_aa LAPACK_GLOBAL(ssytrf_aa,SSYTRF_AA)
 #define LAPACK_dsytrf_aa LAPACK_GLOBAL(dsytrf_aa,DSYTRF_AA)
+#define LAPACK_csytrf_aa LAPACK_GLOBAL(csytrf_aa,CSYTRF_AA)
+#define LAPACK_zsytrf_aa LAPACK_GLOBAL(zsytrf_aa,ZSYTRF_AA)
 #define LAPACK_chetrf_aa LAPACK_GLOBAL(chetrf_aa,CHETRF_AA)
 #define LAPACK_zhetrf_aa LAPACK_GLOBAL(zhetrf_aa,ZHETRF_AA)
 
@@ -17662,6 +17718,16 @@ void LAPACK_dsysv_aa( char* uplo, lapack_int* n, lapack_int* nrhs, double* a,
                    lapack_int* lda, lapack_int* ipiv, double* b,
                    lapack_int* ldb, double* work, lapack_int* lwork,
                    lapack_int *info );
+void LAPACK_csysv_aa( char* uplo, lapack_int* n, lapack_int* nrhs,
+                   lapack_complex_float* a, lapack_int* lda, lapack_int* ipiv,
+                   lapack_complex_float* b, lapack_int* ldb,
+                   lapack_complex_float* work, lapack_int* lwork,
+                   lapack_int *info );
+void LAPACK_zsysv_aa( char* uplo, lapack_int* n, lapack_int* nrhs,
+                   lapack_complex_double* a, lapack_int* lda, lapack_int* ipiv,
+                   lapack_complex_double* b, lapack_int* ldb,
+                   lapack_complex_double* work, lapack_int* lwork,
+                   lapack_int *info );
 void LAPACK_chesv_aa( char* uplo, lapack_int* n, lapack_int* nrhs,
                    lapack_complex_float* a, lapack_int* lda, lapack_int* ipiv,
                    lapack_complex_float* b, lapack_int* ldb,
@@ -17679,6 +17745,14 @@ void LAPACK_ssytrf_aa( char* uplo, lapack_int* n, float* a, lapack_int* lda,
 void LAPACK_dsytrf_aa( char* uplo, lapack_int* n, double* a, lapack_int* lda,
                     lapack_int* ipiv, double* work, lapack_int* lwork,
                     lapack_int *info );
+void LAPACK_csytrf_aa( char* uplo, lapack_int* n, lapack_complex_float* a,
+                    lapack_int* lda, lapack_int* ipiv,
+                    lapack_complex_float* work, lapack_int* lwork,
+                    lapack_int *info );
+void LAPACK_zsytrf_aa( char* uplo, lapack_int* n, lapack_complex_double* a,
+                    lapack_int* lda, lapack_int* ipiv,
+                    lapack_complex_double* work, lapack_int* lwork,
+                    lapack_int *info );
 void LAPACK_chetrf_aa( char* uplo, lapack_int* n, lapack_complex_float* a,
                     lapack_int* lda, lapack_int* ipiv,
                     lapack_complex_float* work, lapack_int* lwork,
@@ -17696,6 +17770,17 @@ void LAPACK_dsytrs_aa( char* uplo, lapack_int* n,
                      lapack_int* nrhs, const double* a,
                      lapack_int* lda, const lapack_int* ipiv,
                      double* b, lapack_int* ldb, double* work, lapack_int* lwork,  lapack_int *info );
+void LAPACK_csytrs_aa( char* uplo, lapack_int* n,
+                     lapack_int* nrhs, const lapack_complex_float* a,
+                     lapack_int* lda, const lapack_int* ipiv,
+                     lapack_complex_float* b, lapack_int* ldb,
+                     lapack_complex_float* work , lapack_int* lwork, lapack_int *info );
+void LAPACK_zsytrs_aa( char* uplo, lapack_int* n,
+                     lapack_int* nrhs,
+                     const lapack_complex_double* a, lapack_int* lda,
+                     const lapack_int* ipiv,
+                     lapack_complex_double* b, lapack_int* ldb,
+                     lapack_complex_double* work, lapack_int* lwork, lapack_int *info );
 void LAPACK_chetrs_aa( char* uplo, lapack_int* n,
                      lapack_int* nrhs, const lapack_complex_float* a,
                      lapack_int* lda, const lapack_int* ipiv,
diff --git a/LAPACKE/src/CMakeLists.txt b/LAPACKE/src/CMakeLists.txt
index fe590a35..5ebebbaf 100644
--- a/LAPACKE/src/CMakeLists.txt
+++ b/LAPACKE/src/CMakeLists.txt
@@ -1,6 +1,6 @@
 #aux_source_directory(${CMAKE_CURRENT_SOURCE_DIR} SRC_OBJ)
 
-set (SRC_OBJ
+set(SRC_OBJ
 lapacke_cbbcsd.c
 lapacke_cbbcsd_work.c
 lapacke_cbdsqr.c
@@ -403,6 +403,8 @@ lapacke_csysv.c
 lapacke_csysv_rook.c
 lapacke_csysv_rook_work.c
 lapacke_csysv_work.c
+lapacke_csysv_aa.c
+lapacke_csysv_aa_work.c
 lapacke_csysvx.c
 lapacke_csysvx_work.c
 lapacke_csyswapr.c
@@ -411,6 +413,8 @@ lapacke_csytrf.c
 lapacke_csytrf_work.c
 lapacke_csytrf_rook.c
 lapacke_csytrf_rook_work.c
+lapacke_csytrf_aa.c
+lapacke_csytrf_aa_work.c
 lapacke_csytri.c
 lapacke_csytri2.c
 lapacke_csytri2_work.c
@@ -423,6 +427,8 @@ lapacke_csytrs2.c
 lapacke_csytrs2_work.c
 lapacke_csytrs_work.c
 lapacke_csytrs_rook_work.c
+lapacke_csytrs_aa.c
+lapacke_csytrs_aa_work.c
 lapacke_ctbcon.c
 lapacke_ctbcon_work.c
 lapacke_ctbrfs.c
@@ -1971,6 +1977,8 @@ lapacke_zsysv.c
 lapacke_zsysv_rook.c
 lapacke_zsysv_rook_work.c
 lapacke_zsysv_work.c
+lapacke_zsysv_aa.c
+lapacke_zsysv_aa_work.c
 lapacke_zsysvx.c
 lapacke_zsysvx_work.c
 lapacke_zsyswapr.c
@@ -1979,6 +1987,8 @@ lapacke_zsytrf.c
 lapacke_zsytrf_work.c
 lapacke_zsytrf_rook.c
 lapacke_zsytrf_rook_work.c
+lapacke_zsytrf_aa.c
+lapacke_zsytrf_aa_work.c
 lapacke_zsytri.c
 lapacke_zsytri2.c
 lapacke_zsytri2_work.c
@@ -1991,6 +2001,8 @@ lapacke_zsytrs2.c
 lapacke_zsytrs2_work.c
 lapacke_zsytrs_work.c
 lapacke_zsytrs_rook_work.c
+lapacke_zsytrs_aa.c
+lapacke_zsytrs_aa_work.c
 lapacke_ztbcon.c
 lapacke_ztbcon_work.c
 lapacke_ztbrfs.c
@@ -2153,7 +2165,7 @@ lapacke_chesvxx_work.c  lapacke_dgbsvxx_work.c  lapacke_dsysvxx_work.c  lapacke_
 )
 
 # FILE PARTS OF TMGLIB
-set (MATGEN_OBJ
+set(MATGEN_OBJ
 lapacke_clatms.c
 lapacke_clatms_work.c
 lapacke_dlatms.c
diff --git a/LAPACKE/src/Makefile b/LAPACKE/src/Makefile
index e308b031..e3266aed 100644
--- a/LAPACKE/src/Makefile
+++ b/LAPACKE/src/Makefile
@@ -437,6 +437,8 @@ lapacke_csysv.o \
 lapacke_csysv_rook.o \
 lapacke_csysv_rook_work.o \
 lapacke_csysv_work.o \
+lapacke_csysv_aa.o \
+lapacke_csysv_aa_work.o \
 lapacke_csysvx.o \
 lapacke_csysvx_work.o \
 lapacke_csyswapr.o \
@@ -445,6 +447,8 @@ lapacke_csytrf.o \
 lapacke_csytrf_work.o \
 lapacke_csytrf_rook.o \
 lapacke_csytrf_rook_work.o \
+lapacke_csytrf_aa.o \
+lapacke_csytrf_aa_work.o \
 lapacke_csytri.o \
 lapacke_csytri2.o \
 lapacke_csytri2_work.o \
@@ -457,6 +461,8 @@ lapacke_csytrs2.o \
 lapacke_csytrs2_work.o \
 lapacke_csytrs_work.o \
 lapacke_csytrs_rook_work.o \
+lapacke_csytrs_aa.o \
+lapacke_csytrs_aa_work.o \
 lapacke_ctbcon.o \
 lapacke_ctbcon_work.o \
 lapacke_ctbrfs.o \
@@ -2005,6 +2011,8 @@ lapacke_zsysv.o \
 lapacke_zsysv_rook.o \
 lapacke_zsysv_rook_work.o \
 lapacke_zsysv_work.o \
+lapacke_zsysv_aa.o \
+lapacke_zsysv_aa_work.o \
 lapacke_zsysvx.o \
 lapacke_zsysvx_work.o \
 lapacke_zsyswapr.o \
@@ -2013,6 +2021,8 @@ lapacke_zsytrf.o \
 lapacke_zsytrf_work.o \
 lapacke_zsytrf_rook.o \
 lapacke_zsytrf_rook_work.o \
+lapacke_zsytrf_aa.o \
+lapacke_zsytrf_aa_work.o \
 lapacke_zsytri.o \
 lapacke_zsytri2.o \
 lapacke_zsytri2_work.o \
@@ -2025,6 +2035,8 @@ lapacke_zsytrs2.o \
 lapacke_zsytrs2_work.o \
 lapacke_zsytrs_work.o \
 lapacke_zsytrs_rook_work.o \
+lapacke_zsytrs_aa.o \
+lapacke_zsytrs_aa_work.o \
 lapacke_ztbcon.o \
 lapacke_ztbcon_work.o \
 lapacke_ztbrfs.o \
@@ -2223,16 +2235,14 @@ ifdef BUILD_DEPRECATED
 DEPRECATED = $(DEPRECSRC)
 endif
 
-OBJ_FILES := $(C_FILES:.o=.o)
-
 all: ../../$(LAPACKELIB)
 
 ../../$(LAPACKELIB): $(ALLOBJ) $(ALLXOBJ) $(DEPRECATED)
-	$(ARCH) $(ARCHFLAGS) ../../$(LAPACKELIB) $(ALLOBJ) $(ALLXOBJ) $(DEPRECATED)
-	$(RANLIB) ../../$(LAPACKELIB)
+	$(ARCH) $(ARCHFLAGS) $@ $(ALLOBJ) $(ALLXOBJ) $(DEPRECATED)
+	$(RANLIB) $@
 
 .c.o:
-	$(CC) -c $(CFLAGS) -I ../include -o $@ $<
+	$(CC) $(CFLAGS) -I../include -c -o $@ $<
 
 clean:
 	rm -f *.o
diff --git a/LAPACKE/src/lapacke_csysv_aa.c b/LAPACKE/src/lapacke_csysv_aa.c
new file mode 100644
index 00000000..8f03a0ca
--- /dev/null
+++ b/LAPACKE/src/lapacke_csysv_aa.c
@@ -0,0 +1,82 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function csysv_aa
+* Author: Intel Corporation
+* Generated November 2016
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csysv_aa( int matrix_layout, char uplo, lapack_int n,
+                          lapack_int nrhs, lapack_complex_float* a,
+                          lapack_int lda, lapack_int* ipiv,
+                          lapack_complex_float* b, lapack_int ldb )
+{
+    lapack_int info = 0;
+    lapack_int lwork = -1;
+    lapack_complex_float* work = NULL;
+    lapack_complex_float work_query;
+    if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+        LAPACKE_xerbla( "LAPACKE_csysv_aa", -1 );
+        return -1;
+    }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+    /* Optionally csyck input matrices for NaNs */
+    if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+        return -5;
+    }
+    if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+        return -8;
+    }
+#endif
+    /* Query optimal working array(s) size */
+    info = LAPACKE_csysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
+                               ldb, &work_query, lwork );
+    if( info != 0 ) {
+        goto exit_level_0;
+    }
+    lwork = LAPACK_C2INT( work_query );
+    /* Allocate memory for work arrays */
+    work = (lapack_complex_float*)
+        LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
+    if( work == NULL ) {
+        info = LAPACK_WORK_MEMORY_ERROR;
+        goto exit_level_0;
+    }
+    /* Call middle-level interface */
+    info = LAPACKE_csysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
+                               ldb, work, lwork );
+    /* Release memory and exit */
+    LAPACKE_free( work );
+exit_level_0:
+    if( info == LAPACK_WORK_MEMORY_ERROR ) {
+        LAPACKE_xerbla( "LAPACKE_csysv_aa", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_csysv_aa_work.c b/LAPACKE/src/lapacke_csysv_aa_work.c
new file mode 100644
index 00000000..370fe3f6
--- /dev/null
+++ b/LAPACKE/src/lapacke_csysv_aa_work.c
@@ -0,0 +1,111 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function csysv_aa
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csysv_aa_work( int matrix_layout, char uplo, lapack_int n,
+                               lapack_int nrhs, lapack_complex_float* a,
+                               lapack_int lda, lapack_int* ipiv,
+                               lapack_complex_float* b, lapack_int ldb,
+                               lapack_complex_float* work, lapack_int lwork )
+{
+    lapack_int info = 0;
+    if( matrix_layout == LAPACK_COL_MAJOR ) {
+        /* Call LAPACK function and adjust info */
+        LAPACK_csysv_aa( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, work, &lwork,
+                      &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+        lapack_int lda_t = MAX(1,n);
+        lapack_int ldb_t = MAX(1,n);
+        lapack_complex_float* a_t = NULL;
+        lapack_complex_float* b_t = NULL;
+        /* Check leading dimension(s) */
+        if( lda < n ) {
+            info = -6;
+            LAPACKE_xerbla( "LAPACKE_csysv_aa_work", info );
+            return info;
+        }
+        if( ldb < nrhs ) {
+            info = -9;
+            LAPACKE_xerbla( "LAPACKE_csysv_aa_work", info );
+            return info;
+        }
+        /* Query optimal working array(s) size if requested */
+        if( lwork == -1 ) {
+            LAPACK_csysv_aa( &uplo, &n, &nrhs, a, &lda_t, ipiv, b, &ldb_t, work,
+                          &lwork, &info );
+            return (info < 0) ? (info - 1) : info;
+        }
+        /* Allocate memory for temporary array(s) */
+        a_t = (lapack_complex_float*)
+            LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
+        if( a_t == NULL ) {
+            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+            goto exit_level_0;
+        }
+        b_t = (lapack_complex_float*)
+            LAPACKE_malloc( sizeof(lapack_complex_float) *
+                            ldb_t * MAX(1,nrhs) );
+        if( b_t == NULL ) {
+            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+            goto exit_level_1;
+        }
+        /* Transpose input matrices */
+        LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+        LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+        /* Call LAPACK function and adjust info */
+        LAPACK_csysv_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work,
+                      &lwork, &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+        /* Transpose output matrices */
+        LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+        LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+        /* Release memory and exit */
+        LAPACKE_free( b_t );
+exit_level_1:
+        LAPACKE_free( a_t );
+exit_level_0:
+        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+            LAPACKE_xerbla( "LAPACKE_csysv_aa_work", info );
+        }
+    } else {
+        info = -1;
+        LAPACKE_xerbla( "LAPACKE_csysv_aa_work", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_csytrf_aa.c b/LAPACKE/src/lapacke_csytrf_aa.c
new file mode 100644
index 00000000..a3bd58f8
--- /dev/null
+++ b/LAPACKE/src/lapacke_csytrf_aa.c
@@ -0,0 +1,78 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function csytrf
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csytrf( int matrix_layout, char uplo, lapack_int n,
+                           lapack_complex_float* a, lapack_int lda,
+                           lapack_int* ipiv )
+{
+    lapack_int info = 0;
+    lapack_int lwork = -1;
+    lapack_complex_float* work = NULL;
+    lapack_complex_float work_query;
+    if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+        LAPACKE_xerbla( "LAPACKE_csytrf", -1 );
+        return -1;
+    }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+    /* Optionally csyck input matrices for NaNs */
+    if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+        return -4;
+    }
+#endif
+    /* Query optimal working array(s) size */
+    info = LAPACKE_csytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv,
+                                &work_query, lwork );
+    if( info != 0 ) {
+        goto exit_level_0;
+    }
+    lwork = LAPACK_C2INT( work_query );
+    /* Allocate memory for work arrays */
+    work = (lapack_complex_float*)
+        LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
+    if( work == NULL ) {
+        info = LAPACK_WORK_MEMORY_ERROR;
+        goto exit_level_0;
+    }
+    /* Call middle-level interface */
+    info = LAPACKE_csytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, work,
+                                lwork );
+    /* Release memory and exit */
+    LAPACKE_free( work );
+exit_level_0:
+    if( info == LAPACK_WORK_MEMORY_ERROR ) {
+        LAPACKE_xerbla( "LAPACKE_csytrf", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_csytrf_aa_work.c b/LAPACKE/src/lapacke_csytrf_aa_work.c
new file mode 100644
index 00000000..a5f1cf22
--- /dev/null
+++ b/LAPACKE/src/lapacke_csytrf_aa_work.c
@@ -0,0 +1,89 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function csytrf
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
+                                lapack_complex_float* a, lapack_int lda,
+                                lapack_int* ipiv, lapack_complex_float* work,
+                                lapack_int lwork )
+{
+    lapack_int info = 0;
+    if( matrix_layout == LAPACK_COL_MAJOR ) {
+        /* Call LAPACK function and adjust info */
+        LAPACK_csytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+        lapack_int lda_t = MAX(1,n);
+        lapack_complex_float* a_t = NULL;
+        /* Check leading dimension(s) */
+        if( lda < n ) {
+            info = -5;
+            LAPACKE_xerbla( "LAPACKE_csytrf_aa_work", info );
+            return info;
+        }
+        /* Query optimal working array(s) size if requested */
+        if( lwork == -1 ) {
+            LAPACK_csytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
+            return (info < 0) ? (info - 1) : info;
+        }
+        /* Allocate memory for temporary array(s) */
+        a_t = (lapack_complex_float*)
+            LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
+        if( a_t == NULL ) {
+            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+            goto exit_level_0;
+        }
+        /* Transpose input matrices */
+        LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+        /* Call LAPACK function and adjust info */
+        LAPACK_csytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+        /* Transpose output matrices */
+        LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+        /* Release memory and exit */
+        LAPACKE_free( a_t );
+exit_level_0:
+        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+            LAPACKE_xerbla( "LAPACKE_csytrf_aa_work", info );
+        }
+    } else {
+        info = -1;
+        LAPACKE_xerbla( "LAPACKE_csytrf_aa_work", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_csytrs_aa.c b/LAPACKE/src/lapacke_csytrs_aa.c
new file mode 100644
index 00000000..561e5f84
--- /dev/null
+++ b/LAPACKE/src/lapacke_csytrs_aa.c
@@ -0,0 +1,82 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function csytrs_aa
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csytrs_aa( int matrix_layout, char uplo, lapack_int n,
+                            lapack_int nrhs, const lapack_complex_float* a,
+                            lapack_int lda, const lapack_int* ipiv,
+                            lapack_complex_float* b, lapack_int ldb )
+{
+    lapack_int info = 0;
+    lapack_int lwork = -1;
+    lapack_complex_float* work = NULL;
+    lapack_complex_float work_query;
+    if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+        LAPACKE_xerbla( "LAPACKE_csytrs_aa", -1 );
+        return -1;
+    }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+    /* Optionally csyck input matrices for NaNs */
+    if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+        return -5;
+    }
+    if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+        return -8;
+    }
+#endif
+    /* Query optimal working array(s) size */
+    info = LAPACKE_csytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
+                                 ldb, &work_query, lwork );
+    if( info != 0 ) {
+        goto exit_level_0;
+    }
+    lwork = LAPACK_C2INT( work_query );
+    /* Allocate memory for work arrays */
+    work = (lapack_complex_float*)
+        LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
+    if( work == NULL ) {
+        info = LAPACK_WORK_MEMORY_ERROR;
+        goto exit_level_0;
+    }
+    /* Call middle-level interface */
+    info = LAPACKE_csytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
+                                 ldb, work, lwork );
+    /* Release memory and exit */
+    LAPACKE_free( work );
+exit_level_0:
+    if( info == LAPACK_WORK_MEMORY_ERROR ) {
+        LAPACKE_xerbla( "LAPACKE_csytrs_aa", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_csytrs_aa_work.c b/LAPACKE/src/lapacke_csytrs_aa_work.c
new file mode 100644
index 00000000..0dc6e28b
--- /dev/null
+++ b/LAPACKE/src/lapacke_csytrs_aa_work.c
@@ -0,0 +1,103 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function csytrs_aa
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csytrs_aa_work( int matrix_layout, char uplo, lapack_int n,
+                                 lapack_int nrhs, const lapack_complex_float* a,
+                                 lapack_int lda, const lapack_int* ipiv,
+                                 lapack_complex_float* b, lapack_int ldb,
+                                 lapack_complex_float* work, lapack_int lwork )
+{
+    lapack_int info = 0;
+    if( matrix_layout == LAPACK_COL_MAJOR ) {
+        /* Call LAPACK function and adjust info */
+        LAPACK_csytrs_aa( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, work, &lwork, &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+        lapack_int lda_t = MAX(1,n);
+        lapack_int ldb_t = MAX(1,n);
+        lapack_complex_float* a_t = NULL;
+        lapack_complex_float* b_t = NULL;
+        /* Check leading dimension(s) */
+        if( lda < n ) {
+            info = -6;
+            LAPACKE_xerbla( "LAPACKE_csytrs_aa_work", info );
+            return info;
+        }
+        if( ldb < nrhs ) {
+            info = -9;
+            LAPACKE_xerbla( "LAPACKE_csytrs_aa_work", info );
+            return info;
+        }
+        /* Allocate memory for temporary array(s) */
+        a_t = (lapack_complex_float*)
+            LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
+        if( a_t == NULL ) {
+            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+            goto exit_level_0;
+        }
+        b_t = (lapack_complex_float*)
+            LAPACKE_malloc( sizeof(lapack_complex_float) *
+                            ldb_t * MAX(1,nrhs) );
+        if( b_t == NULL ) {
+            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+            goto exit_level_1;
+        }
+        /* Transpose input matrices */
+        LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+        LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+        /* Call LAPACK function and adjust info */
+        LAPACK_csytrs_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work,
+                         &lwork, &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+        /* Transpose output matrices */
+        LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+        /* Release memory and exit */
+        LAPACKE_free( b_t );
+exit_level_1:
+        LAPACKE_free( a_t );
+exit_level_0:
+        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+            LAPACKE_xerbla( "LAPACKE_csytrs_aa_work", info );
+        }
+    } else {
+        info = -1;
+        LAPACKE_xerbla( "LAPACKE_csytrs_aa_work", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_zsysv_aa.c b/LAPACKE/src/lapacke_zsysv_aa.c
new file mode 100644
index 00000000..7045d279
--- /dev/null
+++ b/LAPACKE/src/lapacke_zsysv_aa.c
@@ -0,0 +1,82 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zsysv_aa
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsysv_aa( int matrix_layout, char uplo, lapack_int n,
+                          lapack_int nrhs, lapack_complex_double* a,
+                          lapack_int lda, lapack_int* ipiv,
+                          lapack_complex_double* b, lapack_int ldb )
+{
+    lapack_int info = 0;
+    lapack_int lwork = -1;
+    lapack_complex_double* work = NULL;
+    lapack_complex_double work_query;
+    if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+        LAPACKE_xerbla( "LAPACKE_zsysv_aa", -1 );
+        return -1;
+    }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+    /* Optionally check input matrices for NaNs */
+    if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+        return -5;
+    }
+    if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+        return -8;
+    }
+#endif
+    /* Query optimal working array(s) size */
+    info = LAPACKE_zsysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
+                               ldb, &work_query, lwork );
+    if( info != 0 ) {
+        goto exit_level_0;
+    }
+    lwork = LAPACK_Z2INT( work_query );
+    /* Allocate memory for work arrays */
+    work = (lapack_complex_double*)
+        LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
+    if( work == NULL ) {
+        info = LAPACK_WORK_MEMORY_ERROR;
+        goto exit_level_0;
+    }
+    /* Call middle-level interface */
+    info = LAPACKE_zsysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
+                               ldb, work, lwork );
+    /* Release memory and exit */
+    LAPACKE_free( work );
+exit_level_0:
+    if( info == LAPACK_WORK_MEMORY_ERROR ) {
+        LAPACKE_xerbla( "LAPACKE_zsysv_aa", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_zsysv_aa_work.c b/LAPACKE/src/lapacke_zsysv_aa_work.c
new file mode 100644
index 00000000..bd2beef7
--- /dev/null
+++ b/LAPACKE/src/lapacke_zsysv_aa_work.c
@@ -0,0 +1,111 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zsysv_aa
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsysv_aa_work( int matrix_layout, char uplo, lapack_int n,
+                               lapack_int nrhs, lapack_complex_double* a,
+                               lapack_int lda, lapack_int* ipiv,
+                               lapack_complex_double* b, lapack_int ldb,
+                               lapack_complex_double* work, lapack_int lwork )
+{
+    lapack_int info = 0;
+    if( matrix_layout == LAPACK_COL_MAJOR ) {
+        /* Call LAPACK function and adjust info */
+        LAPACK_zsysv_aa( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, work, &lwork,
+                      &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+        lapack_int lda_t = MAX(1,n);
+        lapack_int ldb_t = MAX(1,n);
+        lapack_complex_double* a_t = NULL;
+        lapack_complex_double* b_t = NULL;
+        /* Check leading dimension(s) */
+        if( lda < n ) {
+            info = -6;
+            LAPACKE_xerbla( "LAPACKE_zsysv_aa_work", info );
+            return info;
+        }
+        if( ldb < nrhs ) {
+            info = -9;
+            LAPACKE_xerbla( "LAPACKE_zsysv_aa_work", info );
+            return info;
+        }
+        /* Query optimal working array(s) size if requested */
+        if( lwork == -1 ) {
+            LAPACK_zsysv_aa( &uplo, &n, &nrhs, a, &lda_t, ipiv, b, &ldb_t, work,
+                          &lwork, &info );
+            return (info < 0) ? (info - 1) : info;
+        }
+        /* Allocate memory for temporary array(s) */
+        a_t = (lapack_complex_double*)
+            LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
+        if( a_t == NULL ) {
+            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+            goto exit_level_0;
+        }
+        b_t = (lapack_complex_double*)
+            LAPACKE_malloc( sizeof(lapack_complex_double) *
+                            ldb_t * MAX(1,nrhs) );
+        if( b_t == NULL ) {
+            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+            goto exit_level_1;
+        }
+        /* Transpose input matrices */
+        LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+        LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+        /* Call LAPACK function and adjust info */
+        LAPACK_zsysv_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work,
+                      &lwork, &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+        /* Transpose output matrices */
+        LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+        LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+        /* Release memory and exit */
+        LAPACKE_free( b_t );
+exit_level_1:
+        LAPACKE_free( a_t );
+exit_level_0:
+        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+            LAPACKE_xerbla( "LAPACKE_zsysv_aa_work", info );
+        }
+    } else {
+        info = -1;
+        LAPACKE_xerbla( "LAPACKE_zsysv_aa_work", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_zsytrf_aa.c b/LAPACKE/src/lapacke_zsytrf_aa.c
new file mode 100644
index 00000000..28c0b9ec
--- /dev/null
+++ b/LAPACKE/src/lapacke_zsytrf_aa.c
@@ -0,0 +1,78 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zsytrf
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsytrf( int matrix_layout, char uplo, lapack_int n,
+                           lapack_complex_double* a, lapack_int lda,
+                           lapack_int* ipiv )
+{
+    lapack_int info = 0;
+    lapack_int lwork = -1;
+    lapack_complex_double* work = NULL;
+    lapack_complex_double work_query;
+    if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+        LAPACKE_xerbla( "LAPACKE_zsytrf", -1 );
+        return -1;
+    }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+    /* Optionally check input matrices for NaNs */
+    if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+        return -4;
+    }
+#endif
+    /* Query optimal working array(s) size */
+    info = LAPACKE_zsytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv,
+                                &work_query, lwork );
+    if( info != 0 ) {
+        goto exit_level_0;
+    }
+    lwork = LAPACK_Z2INT( work_query );
+    /* Allocate memory for work arrays */
+    work = (lapack_complex_double*)
+        LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
+    if( work == NULL ) {
+        info = LAPACK_WORK_MEMORY_ERROR;
+        goto exit_level_0;
+    }
+    /* Call middle-level interface */
+    info = LAPACKE_zsytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, work,
+                                lwork );
+    /* Release memory and exit */
+    LAPACKE_free( work );
+exit_level_0:
+    if( info == LAPACK_WORK_MEMORY_ERROR ) {
+        LAPACKE_xerbla( "LAPACKE_zsytrf", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_zsytrf_aa_work.c b/LAPACKE/src/lapacke_zsytrf_aa_work.c
new file mode 100644
index 00000000..9fa8e68d
--- /dev/null
+++ b/LAPACKE/src/lapacke_zsytrf_aa_work.c
@@ -0,0 +1,89 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zsytrf
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n,
+                                lapack_complex_double* a, lapack_int lda,
+                                lapack_int* ipiv, lapack_complex_double* work,
+                                lapack_int lwork )
+{
+    lapack_int info = 0;
+    if( matrix_layout == LAPACK_COL_MAJOR ) {
+        /* Call LAPACK function and adjust info */
+        LAPACK_zsytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+        lapack_int lda_t = MAX(1,n);
+        lapack_complex_double* a_t = NULL;
+        /* Check leading dimension(s) */
+        if( lda < n ) {
+            info = -5;
+            LAPACKE_xerbla( "LAPACKE_zsytrf_aa_work", info );
+            return info;
+        }
+        /* Query optimal working array(s) size if requested */
+        if( lwork == -1 ) {
+            LAPACK_zsytrf( &uplo, &n, a, &lda_t, ipiv, work, &lwork, &info );
+            return (info < 0) ? (info - 1) : info;
+        }
+        /* Allocate memory for temporary array(s) */
+        a_t = (lapack_complex_double*)
+            LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
+        if( a_t == NULL ) {
+            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+            goto exit_level_0;
+        }
+        /* Transpose input matrices */
+        LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+        /* Call LAPACK function and adjust info */
+        LAPACK_zsytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+        /* Transpose output matrices */
+        LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+        /* Release memory and exit */
+        LAPACKE_free( a_t );
+exit_level_0:
+        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+            LAPACKE_xerbla( "LAPACKE_zsytrf_aa_work", info );
+        }
+    } else {
+        info = -1;
+        LAPACKE_xerbla( "LAPACKE_zsytrf_aa_work", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_zsytrs_aa.c b/LAPACKE/src/lapacke_zsytrs_aa.c
new file mode 100644
index 00000000..b5cbe4bb
--- /dev/null
+++ b/LAPACKE/src/lapacke_zsytrs_aa.c
@@ -0,0 +1,82 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zsytrs_aa
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsytrs_aa( int matrix_layout, char uplo, lapack_int n,
+                            lapack_int nrhs, const lapack_complex_double* a,
+                            lapack_int lda, const lapack_int* ipiv,
+                            lapack_complex_double* b, lapack_int ldb )
+{
+    lapack_int info = 0;
+    lapack_int lwork = -1;
+    lapack_complex_double* work = NULL;
+    lapack_complex_double work_query;
+    if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+        LAPACKE_xerbla( "LAPACKE_zsytrs_aa", -1 );
+        return -1;
+    }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+    /* Optionally check input matrices for NaNs */
+    if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+        return -5;
+    }
+    if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+        return -8;
+    }
+#endif
+    /* Query optimal working array(s) size */
+    info = LAPACKE_zsytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
+                                 ldb, &work_query, lwork );
+    if( info != 0 ) {
+        goto exit_level_0;
+    }
+    lwork = LAPACK_Z2INT( work_query );
+    /* Allocate memory for work arrays */
+    work = (lapack_complex_double*)
+        LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
+    if( work == NULL ) {
+        info = LAPACK_WORK_MEMORY_ERROR;
+        goto exit_level_0;
+    }
+    /* Call middle-level interface */
+    info = LAPACKE_zsytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
+                                 ldb, work, lwork );
+    /* Release memory and exit */
+    LAPACKE_free( work );
+exit_level_0:
+    if( info == LAPACK_WORK_MEMORY_ERROR ) {
+        LAPACKE_xerbla( "LAPACKE_zsytrs_aa", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/src/lapacke_zsytrs_aa_work.c b/LAPACKE/src/lapacke_zsytrs_aa_work.c
new file mode 100644
index 00000000..1b7f7d7f
--- /dev/null
+++ b/LAPACKE/src/lapacke_zsytrs_aa_work.c
@@ -0,0 +1,104 @@
+/*****************************************************************************
+  Copyright (c) 2014, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zsytrs_aa
+* Author: Intel Corporation
+* Generated November 2015
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsytrs_aa_work( int matrix_layout, char uplo, lapack_int n,
+                                 lapack_int nrhs,
+                                 const lapack_complex_double* a, lapack_int lda,
+                                 const lapack_int* ipiv,
+                                 lapack_complex_double* b, lapack_int ldb,
+                                 lapack_complex_double* work, lapack_int lwork )
+{
+    lapack_int info = 0;
+    if( matrix_layout == LAPACK_COL_MAJOR ) {
+        /* Call LAPACK function and adjust info */
+        LAPACK_zsytrs_aa( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, work, &lwork, &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+        lapack_int lda_t = MAX(1,n);
+        lapack_int ldb_t = MAX(1,n);
+        lapack_complex_double* a_t = NULL;
+        lapack_complex_double* b_t = NULL;
+        /* Check leading dimension(s) */
+        if( lda < n ) {
+            info = -6;
+            LAPACKE_xerbla( "LAPACKE_zsytrs_aa_work", info );
+            return info;
+        }
+        if( ldb < nrhs ) {
+            info = -9;
+            LAPACKE_xerbla( "LAPACKE_zsytrs_aa_work", info );
+            return info;
+        }
+        /* Allocate memory for temporary array(s) */
+        a_t = (lapack_complex_double*)
+            LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
+        if( a_t == NULL ) {
+            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+            goto exit_level_0;
+        }
+        b_t = (lapack_complex_double*)
+            LAPACKE_malloc( sizeof(lapack_complex_double) *
+                            ldb_t * MAX(1,nrhs) );
+        if( b_t == NULL ) {
+            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+            goto exit_level_1;
+        }
+        /* Transpose input matrices */
+        LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+        LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+        /* Call LAPACK function and adjust info */
+        LAPACK_zsytrs_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work,
+                        &lwork, &info );
+        if( info < 0 ) {
+            info = info - 1;
+        }
+        /* Transpose output matrices */
+        LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+        /* Release memory and exit */
+        LAPACKE_free( b_t );
+exit_level_1:
+        LAPACKE_free( a_t );
+exit_level_0:
+        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+            LAPACKE_xerbla( "LAPACKE_zsytrs_aa_work", info );
+        }
+    } else {
+        info = -1;
+        LAPACKE_xerbla( "LAPACKE_zsytrs_aa_work", info );
+    }
+    return info;
+}
diff --git a/LAPACKE/utils/CMakeLists.txt b/LAPACKE/utils/CMakeLists.txt
index 66be48bc..c8b8511e 100644
--- a/LAPACKE/utils/CMakeLists.txt
+++ b/LAPACKE/utils/CMakeLists.txt
@@ -1,4 +1,4 @@
-set (UTILS_OBJ
+set(UTILS_OBJ
 lapacke_c_nancheck.c            lapacke_ctr_trans.c             lapacke_make_complex_float.c    lapacke_zgb_nancheck.c
 lapacke_cgb_nancheck.c          lapacke_d_nancheck.c            lapacke_s_nancheck.c            lapacke_zgb_trans.c
 lapacke_cgb_trans.c             lapacke_dgb_nancheck.c          lapacke_sgb_nancheck.c          lapacke_zge_nancheck.c
@@ -30,10 +30,10 @@ lapacke_cst_nancheck.c          lapacke_dtb_nancheck.c          lapacke_stb_nanc
 lapacke_csy_nancheck.c          lapacke_dtb_trans.c             lapacke_stb_trans.c             lapacke_zsy_trans.c
 lapacke_csy_trans.c             lapacke_dtf_nancheck.c          lapacke_stf_nancheck.c          lapacke_ztb_nancheck.c
 lapacke_ctb_nancheck.c          lapacke_dtf_trans.c             lapacke_stf_trans.c             lapacke_ztb_trans.c
-lapacke_ctb_trans.c	            lapacke_dtp_nancheck.c          lapacke_stp_nancheck.c          lapacke_ztf_nancheck.c
+lapacke_ctb_trans.c             lapacke_dtp_nancheck.c          lapacke_stp_nancheck.c          lapacke_ztf_nancheck.c
 lapacke_ctf_nancheck.c          lapacke_dtp_trans.c             lapacke_stp_trans.c             lapacke_ztf_trans.c
 lapacke_ctf_trans.c             lapacke_dtr_nancheck.c          lapacke_str_nancheck.c          lapacke_ztp_nancheck.c
 lapacke_ctp_nancheck.c          lapacke_dtr_trans.c             lapacke_str_trans.c             lapacke_ztp_trans.c
 lapacke_ctp_trans.c             lapacke_lsame.c                 lapacke_xerbla.c                lapacke_ztr_nancheck.c
 lapacke_ctr_nancheck.c          lapacke_make_complex_double.c   lapacke_z_nancheck.c            lapacke_ztr_trans.c
-)
\ No newline at end of file
+)
diff --git a/LAPACKE/utils/Makefile b/LAPACKE/utils/Makefile
index 1d785678..57b8f0dd 100644
--- a/LAPACKE/utils/Makefile
+++ b/LAPACKE/utils/Makefile
@@ -190,7 +190,7 @@ lib: $(OBJ)
 	$(RANLIB) ../../$(LAPACKELIB)
 
 .c.o:
-	$(CC) -c $(CFLAGS) -I ../include -o $@ $<
+	$(CC) $(CFLAGS) -I../include -c -o $@ $<
 
 clean:
 	rm -f *.o
diff --git a/Makefile b/Makefile
index 86d3ce7d..497fc3cd 100644
--- a/Makefile
+++ b/Makefile
@@ -23,7 +23,7 @@ blaslib:
 cblaslib:
 	( cd CBLAS; $(MAKE) )
 
-lapacklib:	lapack_install
+lapacklib: lapack_install
 	( cd SRC; $(MAKE) )
 
 lapackelib: lapacklib
@@ -36,28 +36,28 @@ lapacke_example: lapackelib
 	( cd LAPACKE/example; $(MAKE) )
 
 variants:
-	( cd SRC/VARIANTS ; $(MAKE))
+	( cd SRC/VARIANTS; $(MAKE) )
 
 tmglib:
 	( cd TESTING/MATGEN; $(MAKE) )
 
-lapack_testing:	lib
-	( cd TESTING ; $(MAKE) )
+lapack_testing: lib
+	( cd TESTING; $(MAKE) )
 	./lapack_testing.py
 
 variants_testing: lib variants
-	( cd TESTING ; rm -f xlintst* ; $(MAKE)  VARLIB='SRC/VARIANTS/LIB/cholrl.a' ; \
-	mv stest.out stest_cholrl.out ; mv dtest.out dtest_cholrl.out ; mv ctest.out ctest_cholrl.out ; mv ztest.out ztest_cholrl.out )
-	( cd TESTING ; rm -f xlintst* ; $(MAKE)  VARLIB='SRC/VARIANTS/LIB/choltop.a' ; \
-	mv stest.out stest_choltop.out ; mv dtest.out dtest_choltop.out ; mv ctest.out ctest_choltop.out ; mv ztest.out ztest_choltop.out )
-	( cd TESTING ; rm -f xlintst* ; $(MAKE)  VARLIB='SRC/VARIANTS/LIB/lucr.a' ; \
-	mv stest.out stest_lucr.out ; mv dtest.out dtest_lucr.out ; mv ctest.out ctest_lucr.out ; mv ztest.out ztest_lucr.out )
-	( cd TESTING ;  rm -f xlintst* ; $(MAKE)  VARLIB='SRC/VARIANTS/LIB/lull.a' ; \
-	mv stest.out stest_lull.out ; mv dtest.out dtest_lull.out ; mv ctest.out ctest_lull.out ; mv ztest.out ztest_lull.out )
-	( cd TESTING ;  rm -f xlintst* ; $(MAKE)  VARLIB='SRC/VARIANTS/LIB/lurec.a' ; \
-	mv stest.out stest_lurec.out ; mv dtest.out dtest_lurec.out ; mv ctest.out ctest_lurec.out ; mv ztest.out ztest_lurec.out )
-	( cd TESTING ;  rm -f xlintst* ; $(MAKE)  VARLIB='SRC/VARIANTS/LIB/qrll.a' ; \
-	mv stest.out stest_qrll.out ; mv dtest.out dtest_qrll.out ; mv ctest.out ctest_qrll.out ; mv ztest.out ztest_qrll.out )
+	( cd TESTING; rm -f xlintst*; $(MAKE) VARLIB='SRC/VARIANTS/LIB/cholrl.a'; \
+	mv stest.out stest_cholrl.out; mv dtest.out dtest_cholrl.out; mv ctest.out ctest_cholrl.out; mv ztest.out ztest_cholrl.out )
+	( cd TESTING; rm -f xlintst*; $(MAKE) VARLIB='SRC/VARIANTS/LIB/choltop.a'; \
+	mv stest.out stest_choltop.out; mv dtest.out dtest_choltop.out; mv ctest.out ctest_choltop.out; mv ztest.out ztest_choltop.out )
+	( cd TESTING; rm -f xlintst*; $(MAKE) VARLIB='SRC/VARIANTS/LIB/lucr.a'; \
+	mv stest.out stest_lucr.out; mv dtest.out dtest_lucr.out; mv ctest.out ctest_lucr.out; mv ztest.out ztest_lucr.out )
+	( cd TESTING; rm -f xlintst*; $(MAKE) VARLIB='SRC/VARIANTS/LIB/lull.a'; \
+	mv stest.out stest_lull.out; mv dtest.out dtest_lull.out; mv ctest.out ctest_lull.out; mv ztest.out ztest_lull.out )
+	( cd TESTING; rm -f xlintst*; $(MAKE) VARLIB='SRC/VARIANTS/LIB/lurec.a'; \
+	mv stest.out stest_lurec.out; mv dtest.out dtest_lurec.out; mv ctest.out ctest_lurec.out; mv ztest.out ztest_lurec.out )
+	( cd TESTING; rm -f xlintst*; $(MAKE) VARLIB='SRC/VARIANTS/LIB/qrll.a'; \
+	mv stest.out stest_qrll.out; mv dtest.out dtest_qrll.out; mv ctest.out ctest_qrll.out; mv ztest.out ztest_qrll.out )
 
 blas_testing:
 	( cd BLAS/TESTING; $(MAKE) -f Makeblat1 )
@@ -77,8 +77,8 @@ blas_testing:
 	           ./xblat3z < zblat3.in     )
 
 cblas_testing: blaslib
-	( cd CBLAS ; $(MAKE) cblas_testing)
-	( cd CBLAS ; $(MAKE) runtst)
+	( cd CBLAS; $(MAKE) cblas_testing )
+	( cd CBLAS; $(MAKE) runtst )
 
 
 
@@ -125,5 +125,4 @@ cleantesting:
 	( cd TESTING; rm -f xlin* xeig* )
 
 cleanall: cleanlib cleanblas_testing cleancblas_testing cleantesting
-	rm -f *.a TESTING/*.out INSTALL/test*  BLAS/*.out
-
+	rm -f *.a TESTING/*.out INSTALL/test* BLAS/*.out
diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt
index 35dba277..ada9158d 100644
--- a/SRC/CMakeLists.txt
+++ b/SRC/CMakeLists.txt
@@ -1,25 +1,33 @@
 #######################################################################
 #  This is the makefile to create a library for LAPACK.
 #  The files are organized as follows:
-#       ALLAUX -- Auxiliary routines called from all precisions
-#       ALLXAUX -- Auxiliary routines called from all precisions but
-#                  only from routines using extra precision.
-#       SCLAUX -- Auxiliary routines called from both REAL and COMPLEX
-#       DZLAUX -- Auxiliary routines called from both DOUBLE PRECISION
-#                 and COMPLEX*16
-#       SLASRC -- Single precision real LAPACK routines
+#       ALLAUX  -- Auxiliary routines called from all precisions
+#
+#       SCLAUX  -- Auxiliary routines called from both REAL and COMPLEX.
+#       DZLAUX  -- Auxiliary routines called from both DOUBLE and COMPLEX*16.
+#
+#       DSLASRC -- Double-single mixed precision real routines called from
+#                  single, single-extra and double precision real LAPACK
+#                  routines (i.e. from SLASRC, SXLASRC, DLASRC).
+#       ZCLASRC -- Double-single mixed precision complex routines called from
+#                  single, single-extra and double precision complex LAPACK
+#                  routines (i.e. from CLASRC, CXLASRC, ZLASRC).
+#
+#       SLASRC  -- Single precision real LAPACK routines
 #       SXLASRC -- Single precision real LAPACK routines using extra
 #                  precision.
-#       CLASRC -- Single precision complex LAPACK routines
+#       CLASRC  -- Single precision complex LAPACK routines
 #       CXLASRC -- Single precision complex LAPACK routines using extra
 #                  precision.
-#       DLASRC -- Double precision real LAPACK routines
+#       DLASRC  -- Double precision real LAPACK routines
 #       DXLASRC -- Double precision real LAPACK routines using extra
 #                  precision.
-#       ZLASRC -- Double precision complex LAPACK routines
+#       ZLASRC  -- Double precision complex LAPACK routines
 #       ZXLASRC -- Double precision complex LAPACK routines using extra
 #                  precision.
 #
+#    DEPRECATED -- Deprecated routines in all precisions
+#
 #  The library can be set up to include routines for any combination
 #  of the four precisions.  To create or add to the library, enter make
 #  followed by one or more of the precisions desired.  Some examples:
@@ -46,12 +54,10 @@
 #
 #######################################################################
 
-set(ALLAUX  ilaenv.f ieeeck.f lsamen.f  iparmq.f
-    ilaprec.f ilatrans.f ilauplo.f iladiag.f chla_transtype.f
-    ../INSTALL/ilaver.f ../INSTALL/lsame.f xerbla.f xerbla_array.f
-    ../INSTALL/slamch.f)
-
-set(ALLXAUX )
+set(ALLAUX ilaenv.f ieeeck.f lsamen.f iparmq.f iparam2stage.F
+   ilaprec.f ilatrans.f ilauplo.f iladiag.f chla_transtype.f
+   ../INSTALL/ilaver.f ../INSTALL/lsame.f xerbla.f xerbla_array.f
+   ../INSTALL/slamch.f)
 
 set(SCLAUX
    sbdsdc.f
@@ -112,9 +118,10 @@ set(SLASRC
    slaqgb.f slaqge.f slaqp2.f slaqps.f slaqsb.f slaqsp.f slaqsy.f
    slaqr0.f slaqr1.f slaqr2.f slaqr3.f slaqr4.f slaqr5.f
    slaqtr.f slar1v.f slar2v.f ilaslr.f ilaslc.f
-   slarf.f  slarfb.f slarfg.f slarfgp.f slarft.f slarfx.f slargv.f
+   slarf.f  slarfb.f slarfg.f slarfgp.f slarft.f slarfx.f slarfy.f slargv.f
    slarrv.f slartv.f
-   slarz.f  slarzb.f slarzt.f slaswp.f slasy2.f slasyf.f slasyf_rook.f slasyf_aa.f
+   slarz.f  slarzb.f slarzt.f slaswp.f slasy2.f 
+   slasyf.f slasyf_rook.f slasyf_rk.f slasyf_aa.f
    slatbs.f slatdf.f slatps.f slatrd.f slatrs.f slatrz.f
    slauu2.f slauum.f sopgtr.f sopmtr.f sorg2l.f sorg2r.f
    sorgbr.f sorghr.f sorgl2.f sorglq.f sorgql.f sorgqr.f sorgr2.f
@@ -134,10 +141,14 @@ set(SLASRC
    sstevx.f ssycon.f ssyev.f  ssyevd.f ssyevr.f ssyevx.f ssygs2.f
    ssygst.f ssygv.f  ssygvd.f ssygvx.f ssyrfs.f ssysv.f  ssysvx.f
    ssytd2.f ssytf2.f ssytrd.f ssytrf.f ssytri.f ssytri2.f ssytri2x.f
-   ssyswapr.f ssytrs.f ssytrs2.f ssyconv.f
+   ssyswapr.f ssytrs.f ssytrs2.f
+   ssyconv.f ssyconvf.f ssyconvf_rook.f
    ssysv_aa.f ssytrf_aa.f ssytrs_aa.f
    ssytf2_rook.f ssytrf_rook.f ssytrs_rook.f
    ssytri_rook.f ssycon_rook.f ssysv_rook.f
+   ssytf2_rk.f ssytrf_rk.f ssytrs_3.f
+   ssytri_3.f ssytri_3x.f ssycon_3.f ssysv_rk.f
+   ssysv_aa.f ssytrf_aa.f ssytrs_aa.f
    stbcon.f
    stbrfs.f stbtrs.f stgevc.f stgex2.f stgexc.f stgsen.f
    stgsja.f stgsna.f stgsy2.f stgsyl.f stpcon.f stprfs.f stptri.f
@@ -146,7 +157,7 @@ set(SLASRC
    strti2.f strtri.f strtrs.f stzrzf.f sstemr.f
    slansf.f spftrf.f spftri.f spftrs.f ssfrk.f stfsm.f stftri.f stfttp.f
    stfttr.f stpttf.f stpttr.f strttf.f strttp.f
-   sgejsv.f  sgesvj.f  sgsvj0.f  sgsvj1.f
+   sgejsv.f sgesvj.f sgsvj0.f sgsvj1.f
    sgeequb.f ssyequb.f spoequb.f sgbequb.f
    sbbcsd.f slapmr.f sorbdb.f sorbdb1.f sorbdb2.f sorbdb3.f sorbdb4.f
    sorbdb5.f sorbdb6.f sorcsd.f sorcsd2by1.f
@@ -155,11 +166,14 @@ set(SLASRC
    sgelqt.f sgelqt3.f sgemlqt.f
    sgetsls.f sgeqr.f slatsqr.f slamtsqr.f sgemqr.f
    sgelq.f slaswlq.f slamswlq.f sgemlq.f
-   stplqt.f stplqt2.f stpmlqt.f)
+   stplqt.f stplqt2.f stpmlqt.f
+   ssytrd_2stage.f ssytrd_sy2sb.f ssytrd_sb2st.F ssb2st_kernels.f
+   ssyevd_2stage.f ssyev_2stage.f ssyevx_2stage.f ssyevr_2stage.f
+   ssbev_2stage.f ssbevx_2stage.f ssbevd_2stage.f ssygv_2stage.f)
 
 set(DSLASRC spotrs.f sgetrs.f spotrf.f sgetrf.f)
 
-set(SXLASRC  sgesvxx.f sgerfsx.f sla_gerfsx_extended.f sla_geamv.f
+set(SXLASRC sgesvxx.f sgerfsx.f sla_gerfsx_extended.f sla_geamv.f
    sla_gercond.f sla_gerpvgrw.f ssysvxx.f ssyrfsx.f
    sla_syrfsx_extended.f sla_syamv.f sla_syrcond.f sla_syrpvgrw.f
    sposvxx.f sporfsx.f sla_porfsx_extended.f sla_porcond.f
@@ -189,8 +203,11 @@ set(CLASRC
    chetf2.f chetrd.f
    chetrf.f chetri.f chetri2.f chetri2x.f cheswapr.f
    chetrs.f chetrs2.f
+   chetf2_rook.f chetrf_rook.f chetri_rook.f
+   chetrs_rook.f checon_rook.f chesv_rook.f
+   chetf2_rk.f chetrf_rk.f chetri_3.f chetri_3x.f
+   chetrs_3.f checon_3.f chesv_rk.f
    chesv_aa.f chetrf_aa.f chetrs_aa.f
-   chetf2_rook.f chetrf_rook.f chetri_rook.f chetrs_rook.f checon_rook.f chesv_rook.f
    chgeqz.f chpcon.f chpev.f  chpevd.f
    chpevx.f chpgst.f chpgv.f  chpgvd.f chpgvx.f chprfs.f chpsv.f
    chpsvx.f
@@ -198,7 +215,7 @@ set(CLASRC
    clacgv.f clacon.f clacn2.f clacp2.f clacpy.f clacrm.f clacrt.f cladiv.f
    claed0.f claed7.f claed8.f
    claein.f claesy.f claev2.f clags2.f clagtm.f
-   clahef.f clahef_rook.f clahef_aa.f clahqr.f
+   clahef.f clahef_rook.f clahef_rk.f clahef_aa.f clahqr.f
    clahr2.f claic1.f clals0.f clalsa.f clalsd.f clangb.f clange.f clangt.f
    clanhb.f clanhe.f
    clanhp.f clanhs.f clanht.f clansb.f clansp.f clansy.f clantb.f
@@ -207,9 +224,10 @@ set(CLASRC
    claqr0.f claqr1.f claqr2.f claqr3.f claqr4.f claqr5.f
    claqsp.f claqsy.f clar1v.f clar2v.f ilaclr.f ilaclc.f
    clarf.f  clarfb.f clarfg.f clarfgp.f clarft.f
-   clarfx.f clargv.f clarnv.f clarrv.f clartg.f clartv.f
+   clarfx.f clarfy.f clargv.f clarnv.f clarrv.f clartg.f clartv.f
    clarz.f  clarzb.f clarzt.f clascl.f claset.f clasr.f  classq.f
-   claswp.f clasyf.f clasyf_rook.f clatbs.f clatdf.f clatps.f clatrd.f clatrs.f clatrz.f
+   claswp.f clasyf.f clasyf_rook.f clasyf_rk.f clasyf_aa.f
+   clatbs.f clatdf.f clatps.f clatrd.f clatrs.f clatrz.f
    clauu2.f clauum.f cpbcon.f cpbequ.f cpbrfs.f cpbstf.f cpbsv.f
    cpbsvx.f cpbtf2.f cpbtrf.f cpbtrs.f cpocon.f cpoequ.f cporfs.f
    cposv.f  cposvx.f cpotf2.f cpotrf.f cpotrf2.f cpotri.f cpotrs.f cpstrf.f cpstf2.f
@@ -220,9 +238,12 @@ set(CLASRC
    cstegr.f cstein.f csteqr.f csycon.f csymv.f
    csyr.f   csyrfs.f csysv.f  csysvx.f csytf2.f csytrf.f csytri.f
    csytri2.f csytri2x.f csyswapr.f
-   csytrs.f csytrs2.f csyconv.f
+   csytrs.f csytrs2.f
+   csyconv.f csyconvf.f csyconvf_rook.f
    csytf2_rook.f csytrf_rook.f csytrs_rook.f
    csytri_rook.f csycon_rook.f csysv_rook.f
+   csytf2_rk.f csytrf_rk.f csytrf_aa.f csytrs_3.f csytrs_aa.f
+   csytri_3.f csytri_3x.f csycon_3.f csysv_rk.f csysv_aa.f
    ctbcon.f ctbrfs.f ctbtrs.f ctgevc.f ctgex2.f
    ctgexc.f ctgsen.f ctgsja.f ctgsna.f ctgsy2.f ctgsyl.f ctpcon.f
    ctprfs.f ctptri.f
@@ -242,9 +263,12 @@ set(CLASRC
    cgelqt.f cgelqt3.f cgemlqt.f
    cgetsls.f cgeqr.f clatsqr.f clamtsqr.f cgemqr.f
    cgelq.f claswlq.f clamswlq.f cgemlq.f
-   ctplqt.f ctplqt2.f ctpmlqt.f)
+   ctplqt.f ctplqt2.f ctpmlqt.f
+   chetrd_2stage.f chetrd_he2hb.f chetrd_hb2st.F chb2st_kernels.f
+   cheevd_2stage.f cheev_2stage.f cheevx_2stage.f cheevr_2stage.f
+   chbev_2stage.f chbevx_2stage.f chbevd_2stage.f chegv_2stage.f)
 
-set(CXLASRC     cgesvxx.f cgerfsx.f cla_gerfsx_extended.f cla_geamv.f
+set(CXLASRC cgesvxx.f cgerfsx.f cla_gerfsx_extended.f cla_geamv.f
    cla_gercond_c.f cla_gercond_x.f cla_gerpvgrw.f
    csysvxx.f csyrfsx.f cla_syrfsx_extended.f cla_syamv.f
    cla_syrcond_c.f cla_syrcond_x.f cla_syrpvgrw.f
@@ -281,9 +305,10 @@ set(DLASRC
    dlaqgb.f dlaqge.f dlaqp2.f dlaqps.f dlaqsb.f dlaqsp.f dlaqsy.f
    dlaqr0.f dlaqr1.f dlaqr2.f dlaqr3.f dlaqr4.f dlaqr5.f
    dlaqtr.f dlar1v.f dlar2v.f iladlr.f iladlc.f
-   dlarf.f  dlarfb.f dlarfg.f dlarfgp.f dlarft.f dlarfx.f dlargv.f
-   dlarrv.f dlartv.f
-   dlarz.f  dlarzb.f dlarzt.f dlaswp.f dlasy2.f dlasyf.f dlasyf_rook.f dlasyf_aa.f
+   dlarf.f  dlarfb.f dlarfg.f dlarfgp.f dlarft.f dlarfx.f dlarfy.f
+   dlargv.f dlarrv.f dlartv.f
+   dlarz.f  dlarzb.f dlarzt.f dlaswp.f dlasy2.f 
+   dlasyf.f dlasyf_rook.f dlasyf_rk.f dlasyf_aa.f
    dlatbs.f dlatdf.f dlatps.f dlatrd.f dlatrs.f dlatrz.f dlauu2.f
    dlauum.f dopgtr.f dopmtr.f dorg2l.f dorg2r.f
    dorgbr.f dorghr.f dorgl2.f dorglq.f dorgql.f dorgqr.f dorgr2.f
@@ -297,17 +322,20 @@ set(DLASRC
    dpprfs.f dppsv.f  dppsvx.f dpptrf.f dpptri.f dpptrs.f dptcon.f
    dpteqr.f dptrfs.f dptsv.f  dptsvx.f dpttrs.f dptts2.f drscl.f
    dsbev.f  dsbevd.f dsbevx.f dsbgst.f dsbgv.f  dsbgvd.f dsbgvx.f
-   dsbtrd.f  dspcon.f dspev.f  dspevd.f dspevx.f dspgst.f
+   dsbtrd.f dspcon.f dspev.f  dspevd.f dspevx.f dspgst.f
    dspgv.f  dspgvd.f dspgvx.f dsprfs.f dspsv.f  dspsvx.f dsptrd.f
    dsptrf.f dsptri.f dsptrs.f dstegr.f dstein.f dstev.f  dstevd.f dstevr.f
    dstevx.f dsycon.f dsyev.f  dsyevd.f dsyevr.f
    dsyevx.f dsygs2.f dsygst.f dsygv.f  dsygvd.f dsygvx.f dsyrfs.f
    dsysv.f  dsysvx.f
    dsytd2.f dsytf2.f dsytrd.f dsytrf.f dsytri.f dsytrs.f dsytrs2.f
-   dsytri2.f dsytri2x.f dsyswapr.f dsyconv.f
-   dsysv_aa.f dsytrf_aa.f dsytrs_aa.f
+   dsytri2.f dsytri2x.f dsyswapr.f
+   dsyconv.f dsyconvf.f dsyconvf_rook.f
    dsytf2_rook.f dsytrf_rook.f dsytrs_rook.f
    dsytri_rook.f dsycon_rook.f dsysv_rook.f
+   dsytf2_rk.f dsytrf_rk.f dsytrs_3.f
+   dsytri_3.f dsytri_3x.f dsycon_3.f dsysv_rk.f
+   dsysv_aa.f dsytrf_aa.f dsytrs_aa.f
    dtbcon.f
    dtbrfs.f dtbtrs.f dtgevc.f dtgex2.f dtgexc.f dtgsen.f
    dtgsja.f dtgsna.f dtgsy2.f dtgsyl.f dtpcon.f dtprfs.f dtptri.f
@@ -317,7 +345,7 @@ set(DLASRC
    dsgesv.f dsposv.f dlag2s.f slag2d.f dlat2s.f
    dlansf.f dpftrf.f dpftri.f dpftrs.f dsfrk.f dtfsm.f dtftri.f dtfttp.f
    dtfttr.f dtpttf.f dtpttr.f dtrttf.f dtrttp.f
-   dgejsv.f  dgesvj.f  dgsvj0.f  dgsvj1.f
+   dgejsv.f dgesvj.f dgsvj0.f dgsvj1.f
    dgeequb.f dsyequb.f dpoequb.f dgbequb.f
    dbbcsd.f dlapmr.f dorbdb.f dorbdb1.f dorbdb2.f dorbdb3.f dorbdb4.f
    dorbdb5.f dorbdb6.f dorcsd.f dorcsd2by1.f
@@ -326,7 +354,10 @@ set(DLASRC
    dgelqt.f dgelqt3.f dgemlqt.f
    dgetsls.f dgeqr.f dlatsqr.f dlamtsqr.f dgemqr.f
    dgelq.f dlaswlq.f dlamswlq.f dgemlq.f
-   dtplqt.f dtplqt2.f dtpmlqt.f )
+   dtplqt.f dtplqt2.f dtpmlqt.f
+   dsytrd_2stage.f dsytrd_sy2sb.f dsytrd_sb2st.F dsb2st_kernels.f
+   dsyevd_2stage.f dsyev_2stage.f dsyevx_2stage.f dsyevr_2stage.f
+   dsbev_2stage.f dsbevx_2stage.f dsbevd_2stage.f dsygv_2stage.f)
 
 set(DXLASRC dgesvxx.f dgerfsx.f dla_gerfsx_extended.f dla_geamv.f
    dla_gercond.f dla_gerpvgrw.f dsysvxx.f dsyrfsx.f
@@ -358,8 +389,11 @@ set(ZLASRC
    zhetf2.f zhetrd.f
    zhetrf.f zhetri.f zhetri2.f zhetri2x.f zheswapr.f
    zhetrs.f zhetrs2.f
+   zhetf2_rook.f zhetrf_rook.f zhetri_rook.f
+   zhetrs_rook.f zhecon_rook.f zhesv_rook.f
+   zhetf2_rk.f zhetrf_rk.f zhetri_3.f zhetri_3x.f
+   zhetrs_3.f zhecon_3.f zhesv_rk.f
    zhesv_aa.f zhetrf_aa.f zhetrs_aa.f
-   zhetf2_rook.f zhetrf_rook.f zhetri_rook.f zhetrs_rook.f zhecon_rook.f zhesv_rook.f
    zhgeqz.f zhpcon.f zhpev.f  zhpevd.f
    zhpevx.f zhpgst.f zhpgv.f  zhpgvd.f zhpgvx.f zhprfs.f zhpsv.f
    zhpsvx.f
@@ -367,7 +401,7 @@ set(ZLASRC
    zlacgv.f zlacon.f zlacn2.f zlacp2.f zlacpy.f zlacrm.f zlacrt.f zladiv.f
    zlaed0.f zlaed7.f zlaed8.f
    zlaein.f zlaesy.f zlaev2.f zlags2.f zlagtm.f
-   zlahef.f zlahef_rook.f zlahef_aa.f zlahqr.f
+   zlahef.f zlahef_rook.f zlahef_rk.f zlahef_aa.f zlahqr.f
    zlahr2.f zlaic1.f zlals0.f zlalsa.f zlalsd.f zlangb.f zlange.f
    zlangt.f zlanhb.f
    zlanhe.f
@@ -378,9 +412,9 @@ set(ZLASRC
    zlaqsp.f zlaqsy.f zlar1v.f zlar2v.f ilazlr.f ilazlc.f
    zlarcm.f zlarf.f  zlarfb.f
    zlarfg.f zlarfgp.f zlarft.f
-   zlarfx.f zlargv.f zlarnv.f zlarrv.f zlartg.f zlartv.f
+   zlarfx.f zlarfy.f zlargv.f zlarnv.f zlarrv.f zlartg.f zlartv.f
    zlarz.f  zlarzb.f zlarzt.f zlascl.f zlaset.f zlasr.f
-   zlassq.f zlaswp.f zlasyf.f zlasyf_rook.f
+   zlassq.f zlaswp.f zlasyf.f zlasyf_rook.f zlasyf_rk.f zlasyf_aa.f
    zlatbs.f zlatdf.f zlatps.f zlatrd.f zlatrs.f zlatrz.f zlauu2.f
    zlauum.f zpbcon.f zpbequ.f zpbrfs.f zpbstf.f zpbsv.f
    zpbsvx.f zpbtf2.f zpbtrf.f zpbtrs.f zpocon.f zpoequ.f zporfs.f
@@ -392,9 +426,12 @@ set(ZLASRC
    zstegr.f zstein.f zsteqr.f zsycon.f zsymv.f
    zsyr.f   zsyrfs.f zsysv.f  zsysvx.f zsytf2.f zsytrf.f zsytri.f
    zsytri2.f zsytri2x.f zsyswapr.f
-   zsytrs.f zsytrs2.f zsyconv.f
-   zsytf2_rook.f zsytrf_rook.f zsytrs_rook.f
+   zsytrs.f zsytrs2.f
+   zsyconv.f zsyconvf.f zsyconvf_rook.f
+   zsytf2_rook.f zsytrf_rook.f zsytrs_rook.f zsytrs_aa.f
    zsytri_rook.f zsycon_rook.f zsysv_rook.f
+   zsytf2_rk.f zsytrf_rk.f zsytrf_aa.f zsytrs_3.f
+   zsytri_3.f zsytri_3x.f zsycon_3.f zsysv_rk.f zsysv_aa.f
    ztbcon.f ztbrfs.f ztbtrs.f ztgevc.f ztgex2.f
    ztgexc.f ztgsen.f ztgsja.f ztgsna.f ztgsy2.f ztgsyl.f ztpcon.f
    ztprfs.f ztptri.f
@@ -417,9 +454,12 @@ set(ZLASRC
    zgelqt.f zgelqt3.f zgemlqt.f
    zgetsls.f zgeqr.f zlatsqr.f zlamtsqr.f zgemqr.f
    zgelq.f zlaswlq.f zlamswlq.f zgemlq.f
-   ztplqt.f ztplqt2.f ztpmlqt.f)
+   ztplqt.f ztplqt2.f ztpmlqt.f
+   zhetrd_2stage.f zhetrd_he2hb.f zhetrd_hb2st.F zhb2st_kernels.f
+   zheevd_2stage.f zheev_2stage.f zheevx_2stage.f zheevr_2stage.f
+   zhbev_2stage.f zhbevx_2stage.f zhbevd_2stage.f zhegv_2stage.f)
 
-set(ZXLASRC  zgesvxx.f zgerfsx.f zla_gerfsx_extended.f zla_geamv.f
+set(ZXLASRC zgesvxx.f zgerfsx.f zla_gerfsx_extended.f zla_geamv.f
    zla_gercond_c.f zla_gercond_x.f zla_gerpvgrw.f zsysvxx.f zsyrfsx.f
    zla_syrfsx_extended.f zla_syamv.f zla_syrcond_c.f zla_syrcond_x.f
    zla_syrpvgrw.f zposvxx.f zporfsx.f zla_porfsx_extended.f
@@ -430,45 +470,45 @@ set(ZXLASRC  zgesvxx.f zgerfsx.f zla_gerfsx_extended.f zla_geamv.f
    zla_lin_berr.f zlarscl2.f zlascl2.f zla_wwaddw.f)
 
 
-if( USE_XBLAS)
-  set(ALLXOBJ ${SXLASRC} ${DXLASRC} ${CXLASRC} ${ZXLASRC} ${ALLXAUX})
+if(USE_XBLAS)
+  set(ALLXOBJ ${SXLASRC} ${DXLASRC} ${CXLASRC} ${ZXLASRC})
 endif()
 
 if(BUILD_DEPRECATED)
-	list(APPEND SLASRC DEPRECATED/sgegs.f DEPRECATED/sgegv.f
+  list(APPEND SLASRC DEPRECATED/sgegs.f DEPRECATED/sgegv.f
     DEPRECATED/sgeqpf.f DEPRECATED/sgelsx.f DEPRECATED/sggsvd.f
     DEPRECATED/sggsvp.f DEPRECATED/slahrd.f DEPRECATED/slatzm.f DEPRECATED/stzrqf.f)
-	list(APPEND DLASRC DEPRECATED/dgegs.f DEPRECATED/dgegv.f
+  list(APPEND DLASRC DEPRECATED/dgegs.f DEPRECATED/dgegv.f
     DEPRECATED/dgeqpf.f DEPRECATED/dgelsx.f DEPRECATED/dggsvd.f
-    DEPRECATED/dggsvp.f DEPRECATED/dlahrd.f DEPRECATED/dlatzm.f DEPRECATED/dtzrqf.f )
+    DEPRECATED/dggsvp.f DEPRECATED/dlahrd.f DEPRECATED/dlatzm.f DEPRECATED/dtzrqf.f)
   list(APPEND CLASRC DEPRECATED/cgegs.f DEPRECATED/cgegv.f
     DEPRECATED/cgeqpf.f DEPRECATED/cgelsx.f DEPRECATED/cggsvd.f
     DEPRECATED/cggsvp.f DEPRECATED/clahrd.f DEPRECATED/clatzm.f DEPRECATED/ctzrqf.f)
   list(APPEND ZLASRC DEPRECATED/zgegs.f DEPRECATED/zgegv.f
     DEPRECATED/zgeqpf.f DEPRECATED/zgelsx.f DEPRECATED/zggsvd.f
     DEPRECATED/zggsvp.f DEPRECATED/zlahrd.f DEPRECATED/zlatzm.f DEPRECATED/ztzrqf.f)
-	message(STATUS "Building deprecated routines")
+  message(STATUS "Building deprecated routines")
 endif()
 
 if(BUILD_SINGLE)
-set(ALLOBJ  ${SLASRC} ${ALLAUX}	${SCLAUX} )
-message(STATUS "Building Single Precision")
+  set(ALLOBJ ${SLASRC} ${ALLAUX} ${SCLAUX})
+  message(STATUS "Building Single Precision")
 endif()
 if(BUILD_DOUBLE)
   set(ALLOBJ ${ALLOBJ} ${DLASRC} ${ALLAUX} ${DZLAUX} ${DSLASRC})
-message(STATUS "Building Double Precision")
+  message(STATUS "Building Double Precision")
 endif()
 if(BUILD_COMPLEX)
-  set(ALLOBJ ${ALLOBJ} ${CLASRC} ${ALLAUX} ${SCLAUX} )
-message(STATUS "Building Complex Precision")
+  set(ALLOBJ ${ALLOBJ} ${CLASRC} ${ALLAUX} ${SCLAUX})
+  message(STATUS "Building Complex Precision")
 endif()
 if(BUILD_COMPLEX16)
-  set(ALLOBJ  ${ALLOBJ} ${ZLASRC} ${ALLAUX} ${DZLAUX} ${ZCLASRC})
-message(STATUS "Building Double Complex Precision")
+  set(ALLOBJ ${ALLOBJ} ${ZLASRC} ${ALLAUX} ${DZLAUX} ${ZCLASRC})
+  message(STATUS "Building Double Complex Precision")
 endif()
 
-if (NOT ALLOBJ)
-    message(FATAL_ERROR "-->LAPACK SRC BUILD: NOTHING TO BUILD, NO PRECISION SELECTED:
+if(NOT ALLOBJ)
+  message(FATAL_ERROR "-->LAPACK SRC BUILD: NOTHING TO BUILD, NO PRECISION SELECTED:
      PLEASE ENABLE AT LEAST ONE OF THOSE: BUILD_SINGLE, BUILD_COMPLEX, BUILD_DOUBLE, BUILD_COMPLEX16.")
 endif()
 
diff --git a/SRC/Makefile b/SRC/Makefile
index 33058ec8..e5703733 100644
--- a/SRC/Makefile
+++ b/SRC/Makefile
@@ -28,7 +28,7 @@ include ../make.inc
 #       ZXLASRC -- Double precision complex LAPACK routines using extra
 #                  precision.
 #
-#	      DEPRECATED -- Deprecated routines in all precisions
+#    DEPRECATED -- Deprecated routines in all precisions
 #
 #  The library can be set up to include routines for any combination
 #  of the four precisions.  To create or add to the library, enter make
@@ -56,9 +56,9 @@ include ../make.inc
 #
 #######################################################################
 
-ALLAUX = ilaenv.o ieeeck.o lsamen.o xerbla.o xerbla_array.o iparmq.o	\
-    ilaprec.o ilatrans.o ilauplo.o iladiag.o chla_transtype.o \
-    ../INSTALL/ilaver.o ../INSTALL/lsame.o ../INSTALL/slamch.o
+ALLAUX = ilaenv.o ieeeck.o lsamen.o xerbla.o xerbla_array.o iparmq.o iparam2stage.o\
+   ilaprec.o ilatrans.o ilauplo.o iladiag.o chla_transtype.o \
+   ../INSTALL/ilaver.o ../INSTALL/lsame.o ../INSTALL/slamch.o
 
 SCLAUX = \
    sbdsdc.o \
@@ -76,7 +76,7 @@ SCLAUX = \
    slasr.o  slasrt.o slassq.o slasv2.o spttrf.o sstebz.o sstedc.o \
    ssteqr.o ssterf.o slaisnan.o sisnan.o \
    slartgp.o slartgs.o \
-    ../INSTALL/second_$(TIMER).o
+   ../INSTALL/second_$(TIMER).o
 
 DZLAUX = \
    dbdsdc.o \
@@ -98,7 +98,7 @@ DZLAUX = \
 
 SLASRC = \
    sbdsvdx.o spotrf2.o sgetrf2.o \
-   sgbbrd.o sgbcon.o sgbequ.o sgbrfs.o sgbsv.o  \
+   sgbbrd.o sgbcon.o sgbequ.o sgbrfs.o sgbsv.o \
    sgbsvx.o sgbtf2.o sgbtrf.o sgbtrs.o sgebak.o sgebal.o sgebd2.o \
    sgebrd.o sgecon.o sgeequ.o sgees.o  sgeesx.o sgeev.o  sgeevx.o \
    sgehd2.o sgehrd.o sgelq2.o sgelqf.o \
@@ -109,7 +109,7 @@ SLASRC = \
    sggbak.o sggbal.o sgges.o  sgges3.o sggesx.o \
    sggev.o  sggev3.o sggevx.o \
    sggglm.o sgghrd.o sgghd3.o sgglse.o sggqrf.o \
-   sggrqf.o sggsvd3.o sggsvp3.o sgtcon.o sgtrfs.o sgtsv.o  \
+   sggrqf.o sggsvd3.o sggsvp3.o sgtcon.o sgtrfs.o sgtsv.o \
    sgtsvx.o sgttrf.o sgttrs.o sgtts2.o shgeqz.o \
    shsein.o shseqr.o slabrd.o slacon.o slacn2.o \
    slaein.o slaexc.o slag2.o  slags2.o slagtm.o slagv2.o slahqr.o \
@@ -120,9 +120,10 @@ SLASRC = \
    slaqgb.o slaqge.o slaqp2.o slaqps.o slaqsb.o slaqsp.o slaqsy.o \
    slaqr0.o slaqr1.o slaqr2.o slaqr3.o slaqr4.o slaqr5.o \
    slaqtr.o slar1v.o slar2v.o ilaslr.o ilaslc.o \
-   slarf.o  slarfb.o slarfg.o slarfgp.o slarft.o slarfx.o slargv.o \
-   slarrv.o slartv.o  \
+   slarf.o  slarfb.o slarfg.o slarfgp.o slarft.o slarfx.o slarfy.o slargv.o \
+   slarrv.o slartv.o \
    slarz.o  slarzb.o slarzt.o slaswp.o slasy2.o slasyf.o slasyf_rook.o \
+   slasyf_rk.o \
    slatbs.o slatdf.o slatps.o slatrd.o slatrs.o slatrz.o \
    slauu2.o slauum.o sopgtr.o sopmtr.o sorg2l.o sorg2r.o \
    sorgbr.o sorghr.o sorgl2.o sorglq.o sorgql.o sorgqr.o sorgr2.o \
@@ -130,11 +131,11 @@ SLASRC = \
    sormbr.o sormhr.o sorml2.o sormlq.o sormql.o sormqr.o sormr2.o \
    sormr3.o sormrq.o sormrz.o sormtr.o spbcon.o spbequ.o spbrfs.o \
    spbstf.o spbsv.o  spbsvx.o \
-   spbtf2.o spbtrf.o spbtrs.o spocon.o spoequ.o sporfs.o sposv.o  \
-   sposvx.o spotf2.o  spotri.o  spstrf.o spstf2.o \
+   spbtf2.o spbtrf.o spbtrs.o spocon.o spoequ.o sporfs.o sposv.o \
+   sposvx.o spotf2.o spotri.o spstrf.o spstf2.o \
    sppcon.o sppequ.o \
    spprfs.o sppsv.o  sppsvx.o spptrf.o spptri.o spptrs.o sptcon.o \
-   spteqr.o sptrfs.o sptsv.o  sptsvx.o spttrs.o sptts2.o srscl.o  \
+   spteqr.o sptrfs.o sptsv.o  sptsvx.o spttrs.o sptts2.o srscl.o \
    ssbev.o  ssbevd.o ssbevx.o ssbgst.o ssbgv.o  ssbgvd.o ssbgvx.o \
    ssbtrd.o sspcon.o sspev.o  sspevd.o sspevx.o sspgst.o \
    sspgv.o  sspgvd.o sspgvx.o ssprfs.o sspsv.o  sspsvx.o ssptrd.o \
@@ -143,10 +144,12 @@ SLASRC = \
    ssycon.o ssyev.o  ssyevd.o ssyevr.o ssyevx.o ssygs2.o \
    ssygst.o ssygv.o  ssygvd.o ssygvx.o ssyrfs.o ssysv.o  ssysvx.o \
    ssytd2.o ssytf2.o ssytrd.o ssytrf.o ssytri.o ssytri2.o ssytri2x.o \
-   ssyswapr.o ssytrs.o ssytrs2.o ssyconv.o \
+   ssyswapr.o ssytrs.o ssytrs2.o ssyconv.o ssyconvf_rook.o \
    ssytf2_rook.o ssytrf_rook.o ssytrs_rook.o \
-   slasyf_aa.o ssysv_aa.o ssytrf_aa.o ssytrs_aa.o \
    ssytri_rook.o ssycon_rook.o ssysv_rook.o \
+   ssytf2_rk.o ssytrf_rk.o ssytrs_3.o \
+   ssytri_3.o ssytri_3x.o ssycon_3.o ssysv_rk.o \
+   slasyf_aa.o ssysv_aa.o ssytrf_aa.o ssytrs_aa.o \
    stbcon.o \
    stbrfs.o stbtrs.o stgevc.o stgex2.o stgexc.o stgsen.o \
    stgsja.o stgsna.o stgsy2.o stgsyl.o stpcon.o stprfs.o stptri.o \
@@ -155,7 +158,7 @@ SLASRC = \
    strti2.o strtri.o strtrs.o stzrzf.o sstemr.o \
    slansf.o spftrf.o spftri.o spftrs.o ssfrk.o stfsm.o stftri.o stfttp.o \
    stfttr.o stpttf.o stpttr.o strttf.o strttp.o \
-   sgejsv.o  sgesvj.o  sgsvj0.o  sgsvj1.o \
+   sgejsv.o sgesvj.o sgsvj0.o sgsvj1.o \
    sgeequb.o ssyequb.o spoequb.o sgbequb.o \
    sbbcsd.o slapmr.o sorbdb.o sorbdb1.o sorbdb2.o sorbdb3.o sorbdb4.o \
    sorbdb5.o sorbdb6.o sorcsd.o sorcsd2by1.o \
@@ -164,17 +167,20 @@ SLASRC = \
    sgelqt.o sgelqt3.o sgemlqt.o \
    sgetsls.o sgeqr.o slatsqr.o slamtsqr.o sgemqr.o \
    sgelq.o slaswlq.o slamswlq.o sgemlq.o \
-   stplqt.o stplqt2.o stpmlqt.o
+   stplqt.o stplqt2.o stpmlqt.o \
+   ssytrd_2stage.o ssytrd_sy2sb.o ssytrd_sb2st.o ssb2st_kernels.o \
+   ssyevd_2stage.o ssyev_2stage.o ssyevx_2stage.o ssyevr_2stage.o \
+   ssbev_2stage.o ssbevx_2stage.o ssbevd_2stage.o ssygv_2stage.o
 
 DSLASRC = spotrs.o sgetrs.o spotrf.o sgetrf.o
 
 ifdef USEXBLAS
-SXLASRC = sgesvxx.o sgerfsx.o sla_gerfsx_extended.o sla_geamv.o		\
-   sla_gercond.o sla_gerpvgrw.o ssysvxx.o ssyrfsx.o			\
-   sla_syrfsx_extended.o sla_syamv.o sla_syrcond.o sla_syrpvgrw.o	\
-   sposvxx.o sporfsx.o sla_porfsx_extended.o sla_porcond.o		\
-   sla_porpvgrw.o sgbsvxx.o sgbrfsx.o sla_gbrfsx_extended.o		\
-   sla_gbamv.o sla_gbrcond.o sla_gbrpvgrw.o sla_lin_berr.o slarscl2.o	\
+SXLASRC = sgesvxx.o sgerfsx.o sla_gerfsx_extended.o sla_geamv.o \
+   sla_gercond.o sla_gerpvgrw.o ssysvxx.o ssyrfsx.o \
+   sla_syrfsx_extended.o sla_syamv.o sla_syrcond.o sla_syrpvgrw.o \
+   sposvxx.o sporfsx.o sla_porfsx_extended.o sla_porcond.o \
+   sla_porpvgrw.o sgbsvxx.o sgbrfsx.o sla_gbrfsx_extended.o \
+   sla_gbamv.o sla_gbrcond.o sla_gbrpvgrw.o sla_lin_berr.o slarscl2.o \
    slascl2.o sla_wwaddw.o
 endif
 
@@ -190,26 +196,29 @@ CLASRC = \
    cgesvj.o cgejsv.o cgsvj0.o cgsvj1.o \
    cgesvx.o cgetc2.o cgetf2.o cgetri.o \
    cggbak.o cggbal.o cgges.o  cgges3.o cggesx.o \
-   cggev.o  cggev3.o cggevx.o cggglm.o\
+   cggev.o  cggev3.o cggevx.o cggglm.o \
    cgghrd.o cgghd3.o cgglse.o cggqrf.o cggrqf.o \
    cggsvd3.o cggsvp3.o \
-   cgtcon.o cgtrfs.o cgtsv.o  cgtsvx.o cgttrf.o cgttrs.o cgtts2.o chbev.o  \
+   cgtcon.o cgtrfs.o cgtsv.o  cgtsvx.o cgttrf.o cgttrs.o cgtts2.o chbev.o \
    chbevd.o chbevx.o chbgst.o chbgv.o  chbgvd.o chbgvx.o chbtrd.o \
    checon.o cheev.o  cheevd.o cheevr.o cheevx.o chegs2.o chegst.o \
    chegv.o  chegvd.o chegvx.o cherfs.o chesv.o  chesvx.o chetd2.o \
    chetf2.o chetrd.o \
    chetrf.o chetri.o chetri2.o chetri2x.o cheswapr.o \
    chetrs.o chetrs2.o \
-   chetf2_rook.o chetrf_rook.o chetri_rook.o chetrs_rook.o checon_rook.o chesv_rook.o \
+   chetf2_rook.o chetrf_rook.o chetri_rook.o \
+   chetrs_rook.o checon_rook.o chesv_rook.o \
+   chetf2_rk.o chetrf_rk.o chetri_3.o chetri_3x.o \
+   chetrs_3.o checon_3.o chesv_rk.o \
    chesv_aa.o chetrf_aa.o chetrs_aa.o clahef_aa.o\
    chgeqz.o chpcon.o chpev.o  chpevd.o \
-   chpevx.o chpgst.o chpgv.o  chpgvd.o chpgvx.o chprfs.o chpsv.o  \
+   chpevx.o chpgst.o chpgv.o  chpgvd.o chpgvx.o chprfs.o chpsv.o \
    chpsvx.o \
    chptrd.o chptrf.o chptri.o chptrs.o chsein.o chseqr.o clabrd.o \
    clacgv.o clacon.o clacn2.o clacp2.o clacpy.o clacrm.o clacrt.o cladiv.o \
    claed0.o claed7.o claed8.o \
    claein.o claesy.o claev2.o clags2.o clagtm.o \
-   clahef.o clahef_rook.o clahqr.o \
+   clahef.o clahef_rook.o clahef_rk.o clahqr.o \
    clahr2.o claic1.o clals0.o clalsa.o clalsd.o clangb.o clange.o clangt.o \
    clanhb.o clanhe.o \
    clanhp.o clanhs.o clanht.o clansb.o clansp.o clansy.o clantb.o \
@@ -218,22 +227,26 @@ CLASRC = \
    claqr0.o claqr1.o claqr2.o claqr3.o claqr4.o claqr5.o \
    claqsp.o claqsy.o clar1v.o clar2v.o ilaclr.o ilaclc.o \
    clarf.o  clarfb.o clarfg.o clarft.o clarfgp.o \
-   clarfx.o clargv.o clarnv.o clarrv.o clartg.o clartv.o \
+   clarfx.o clarfy.o clargv.o clarnv.o clarrv.o clartg.o clartv.o \
    clarz.o  clarzb.o clarzt.o clascl.o claset.o clasr.o  classq.o \
-   claswp.o clasyf.o clasyf_rook.o clatbs.o clatdf.o clatps.o clatrd.o clatrs.o clatrz.o \
-   clauu2.o clauum.o cpbcon.o cpbequ.o cpbrfs.o cpbstf.o cpbsv.o  \
+   claswp.o clasyf.o clasyf_rook.o clasyf_rk.o clasyf_aa.o \
+   clatbs.o clatdf.o clatps.o clatrd.o clatrs.o clatrz.o \
+   clauu2.o clauum.o cpbcon.o cpbequ.o cpbrfs.o cpbstf.o cpbsv.o \
    cpbsvx.o cpbtf2.o cpbtrf.o cpbtrs.o cpocon.o cpoequ.o cporfs.o \
    cposv.o  cposvx.o cpotf2.o cpotri.o cpstrf.o cpstf2.o \
    cppcon.o cppequ.o cpprfs.o cppsv.o  cppsvx.o cpptrf.o cpptri.o cpptrs.o \
    cptcon.o cpteqr.o cptrfs.o cptsv.o  cptsvx.o cpttrf.o cpttrs.o cptts2.o \
-   crot.o   cspcon.o cspmv.o  cspr.o   csprfs.o cspsv.o  \
+   crot.o   cspcon.o cspmv.o  cspr.o   csprfs.o cspsv.o \
    cspsvx.o csptrf.o csptri.o csptrs.o csrscl.o cstedc.o \
    cstegr.o cstein.o csteqr.o \
    csycon.o csymv.o \
-   csyr.o csyrfs.o csysv.o  csysvx.o csytf2.o csytrf.o csytri.o csytri2.o csytri2x.o \
-   csyswapr.o csytrs.o csytrs2.o csyconv.o \
+   csyr.o csyrfs.o csysv.o csysvx.o csytf2.o csytrf.o csytri.o csytri2.o csytri2x.o \
+   csyswapr.o csytrs.o csytrs2.o \
+   csyconv.o csyconvf.o csyconvf_rook.o \
    csytf2_rook.o csytrf_rook.o csytrs_rook.o \
    csytri_rook.o csycon_rook.o csysv_rook.o \
+   csytf2_rk.o csytrf_rk.o csytrf_aa.o csytrs_3.o csytrs_aa.o \
+   csytri_3.o csytri_3x.o csycon_3.o csysv_rk.o csysv_aa.o \
    ctbcon.o ctbrfs.o ctbtrs.o ctgevc.o ctgex2.o \
    ctgexc.o ctgsen.o ctgsja.o ctgsna.o ctgsy2.o ctgsyl.o ctpcon.o \
    ctprfs.o ctptri.o \
@@ -253,7 +266,10 @@ CLASRC = \
    cgelqt.o cgelqt3.o cgemlqt.o \
    cgetsls.o cgeqr.o clatsqr.o clamtsqr.o cgemqr.o \
    cgelq.o claswlq.o clamswlq.o cgemlq.o \
-   ctplqt.o ctplqt2.o ctpmlqt.o
+   ctplqt.o ctplqt2.o ctpmlqt.o \
+   chetrd_2stage.o chetrd_he2hb.o chetrd_hb2st.o chb2st_kernels.o \
+   cheevd_2stage.o cheev_2stage.o cheevx_2stage.o cheevr_2stage.o \
+   chbev_2stage.o chbevx_2stage.o chbevd_2stage.o chegv_2stage.o
 
 ifdef USEXBLAS
 CXLASRC = cgesvxx.o cgerfsx.o cla_gerfsx_extended.o cla_geamv.o \
@@ -274,18 +290,18 @@ ZCLASRC = cpotrs.o cgetrs.o cpotrf.o cgetrf.o
 DLASRC = \
    dpotrf2.o dgetrf2.o \
    dbdsvdx.o \
-   dgbbrd.o dgbcon.o dgbequ.o dgbrfs.o dgbsv.o  \
+   dgbbrd.o dgbcon.o dgbequ.o dgbrfs.o dgbsv.o \
    dgbsvx.o dgbtf2.o dgbtrf.o dgbtrs.o dgebak.o dgebal.o dgebd2.o \
    dgebrd.o dgecon.o dgeequ.o dgees.o  dgeesx.o dgeev.o  dgeevx.o \
    dgehd2.o dgehrd.o dgelq2.o dgelqf.o \
    dgels.o  dgelsd.o dgelss.o dgelsy.o dgeql2.o dgeqlf.o \
    dgeqp3.o dgeqr2.o dgeqr2p.o dgeqrf.o dgeqrfp.o dgerfs.o \
-   dgerq2.o dgerqf.o dgesc2.o dgesdd.o dgesv.o  dgesvd.o dgesvdx.o dgesvx.o  \
+   dgerq2.o dgerqf.o dgesc2.o dgesdd.o dgesv.o  dgesvd.o dgesvdx.o dgesvx.o \
    dgetc2.o dgetf2.o dgetrf.o dgetri.o \
    dgetrs.o dggbak.o dggbal.o dgges.o  dgges3.o dggesx.o \
    dggev.o  dggev3.o dggevx.o \
    dggglm.o dgghrd.o dgghd3.o dgglse.o dggqrf.o \
-   dggrqf.o dggsvd3.o dggsvp3.o dgtcon.o dgtrfs.o dgtsv.o  \
+   dggrqf.o dggsvd3.o dggsvp3.o dgtcon.o dgtrfs.o dgtsv.o \
    dgtsvx.o dgttrf.o dgttrs.o dgtts2.o dhgeqz.o \
    dhsein.o dhseqr.o dlabrd.o dlacon.o dlacn2.o \
    dlaein.o dlaexc.o dlag2.o  dlags2.o dlagtm.o dlagv2.o dlahqr.o \
@@ -296,9 +312,10 @@ DLASRC = \
    dlaqgb.o dlaqge.o dlaqp2.o dlaqps.o dlaqsb.o dlaqsp.o dlaqsy.o \
    dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o \
    dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o \
-   dlarf.o  dlarfb.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o \
-   dlargv.o dlarrv.o dlartv.o  \
-   dlarz.o  dlarzb.o dlarzt.o dlaswp.o dlasy2.o dlasyf.o dlasyf_rook.o \
+   dlarf.o  dlarfb.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \
+   dlargv.o dlarrv.o dlartv.o \
+   dlarz.o  dlarzb.o dlarzt.o dlaswp.o dlasy2.o \
+   dlasyf.o dlasyf_rook.o dlasyf_rk.o \
    dlatbs.o dlatdf.o dlatps.o dlatrd.o dlatrs.o dlatrz.o dlauu2.o \
    dlauum.o dopgtr.o dopmtr.o dorg2l.o dorg2r.o \
    dorgbr.o dorghr.o dorgl2.o dorglq.o dorgql.o dorgqr.o dorgr2.o \
@@ -306,13 +323,13 @@ DLASRC = \
    dormbr.o dormhr.o dorml2.o dormlq.o dormql.o dormqr.o dormr2.o \
    dormr3.o dormrq.o dormrz.o dormtr.o dpbcon.o dpbequ.o dpbrfs.o \
    dpbstf.o dpbsv.o  dpbsvx.o \
-   dpbtf2.o dpbtrf.o dpbtrs.o dpocon.o dpoequ.o dporfs.o dposv.o  \
+   dpbtf2.o dpbtrf.o dpbtrs.o dpocon.o dpoequ.o dporfs.o dposv.o \
    dposvx.o dpotf2.o dpotrf.o dpotri.o dpotrs.o dpstrf.o dpstf2.o \
    dppcon.o dppequ.o \
    dpprfs.o dppsv.o  dppsvx.o dpptrf.o dpptri.o dpptrs.o dptcon.o \
-   dpteqr.o dptrfs.o dptsv.o  dptsvx.o dpttrs.o dptts2.o drscl.o  \
+   dpteqr.o dptrfs.o dptsv.o  dptsvx.o dpttrs.o dptts2.o drscl.o \
    dsbev.o  dsbevd.o dsbevx.o dsbgst.o dsbgv.o  dsbgvd.o dsbgvx.o \
-   dsbtrd.o  dspcon.o dspev.o  dspevd.o dspevx.o dspgst.o \
+   dsbtrd.o dspcon.o dspev.o  dspevd.o dspevx.o dspgst.o \
    dspgv.o  dspgvd.o dspgvx.o dsprfs.o dspsv.o  dspsvx.o dsptrd.o \
    dsptrf.o dsptri.o dsptrs.o dstegr.o dstein.o dstev.o  dstevd.o dstevr.o \
    dstevx.o \
@@ -320,10 +337,13 @@ DLASRC = \
    dsyevx.o dsygs2.o dsygst.o dsygv.o  dsygvd.o dsygvx.o dsyrfs.o \
    dsysv.o  dsysvx.o \
    dsytd2.o dsytf2.o dsytrd.o dsytrf.o dsytri.o dsytri2.o dsytri2x.o \
-   dsyswapr.o dsytrs.o dsytrs2.o dsyconv.o \
+   dsyswapr.o dsytrs.o dsytrs2.o \
+   dsyconv.o dsyconvf.o dsyconvf_rook.o \
    dsytf2_rook.o dsytrf_rook.o dsytrs_rook.o \
-   dlasyf_aa.o dsysv_aa.o dsytrf_aa.o dsytrs_aa.o \
    dsytri_rook.o dsycon_rook.o dsysv_rook.o \
+   dsytf2_rk.o dsytrf_rk.o dsytrs_3.o \
+   dsytri_3.o dsytri_3x.o dsycon_3.o dsysv_rk.o \
+   dlasyf_aa.o dsysv_aa.o dsytrf_aa.o dsytrs_aa.o \
    dtbcon.o dtbrfs.o dtbtrs.o dtgevc.o dtgex2.o dtgexc.o dtgsen.o \
    dtgsja.o dtgsna.o dtgsy2.o dtgsyl.o dtpcon.o dtprfs.o dtptri.o \
    dtptrs.o \
@@ -332,7 +352,7 @@ DLASRC = \
    dsgesv.o dsposv.o dlag2s.o slag2d.o dlat2s.o \
    dlansf.o dpftrf.o dpftri.o dpftrs.o dsfrk.o dtfsm.o dtftri.o dtfttp.o \
    dtfttr.o dtpttf.o dtpttr.o dtrttf.o dtrttp.o \
-   dgejsv.o  dgesvj.o  dgsvj0.o  dgsvj1.o \
+   dgejsv.o dgesvj.o dgsvj0.o dgsvj1.o \
    dgeequb.o dsyequb.o dpoequb.o dgbequb.o \
    dbbcsd.o dlapmr.o dorbdb.o dorbdb1.o dorbdb2.o dorbdb3.o dorbdb4.o \
    dorbdb5.o dorbdb6.o dorcsd.o dorcsd2by1.o \
@@ -341,15 +361,18 @@ DLASRC = \
    dgelqt.o dgelqt3.o dgemlqt.o \
    dgetsls.o dgeqr.o dlatsqr.o dlamtsqr.o dgemqr.o \
    dgelq.o dlaswlq.o dlamswlq.o dgemlq.o \
-   dtplqt.o dtplqt2.o dtpmlqt.o 
+   dtplqt.o dtplqt2.o dtpmlqt.o \
+   dsytrd_2stage.o dsytrd_sy2sb.o dsytrd_sb2st.o dsb2st_kernels.o \
+   dsyevd_2stage.o dsyev_2stage.o dsyevx_2stage.o dsyevr_2stage.o \
+   dsbev_2stage.o dsbevx_2stage.o dsbevd_2stage.o dsygv_2stage.o
 
 ifdef USEXBLAS
-DXLASRC = dgesvxx.o dgerfsx.o dla_gerfsx_extended.o dla_geamv.o		\
-   dla_gercond.o dla_gerpvgrw.o dsysvxx.o dsyrfsx.o			\
-   dla_syrfsx_extended.o dla_syamv.o dla_syrcond.o dla_syrpvgrw.o	\
-   dposvxx.o dporfsx.o dla_porfsx_extended.o dla_porcond.o		\
-   dla_porpvgrw.o dgbsvxx.o dgbrfsx.o dla_gbrfsx_extended.o		\
-   dla_gbamv.o dla_gbrcond.o dla_gbrpvgrw.o dla_lin_berr.o dlarscl2.o	\
+DXLASRC = dgesvxx.o dgerfsx.o dla_gerfsx_extended.o dla_geamv.o \
+   dla_gercond.o dla_gerpvgrw.o dsysvxx.o dsyrfsx.o \
+   dla_syrfsx_extended.o dla_syamv.o dla_syrcond.o dla_syrpvgrw.o \
+   dposvxx.o dporfsx.o dla_porfsx_extended.o dla_porcond.o \
+   dla_porpvgrw.o dgbsvxx.o dgbrfsx.o dla_gbrfsx_extended.o \
+   dla_gbamv.o dla_gbrcond.o dla_gbrpvgrw.o dla_lin_berr.o dlarscl2.o \
    dlascl2.o dla_wwaddw.o
 endif
 
@@ -365,27 +388,30 @@ ZLASRC = \
    zgesvj.o zgejsv.o zgsvj0.o zgsvj1.o \
    zgesvx.o zgetc2.o zgetf2.o zgetrf.o \
    zgetri.o zgetrs.o \
-   zggbak.o zggbal.o zgges.o  zgges3.o zggesx.o  \
+   zggbak.o zggbal.o zgges.o  zgges3.o zggesx.o \
    zggev.o  zggev3.o zggevx.o zggglm.o \
    zgghrd.o zgghd3.o zgglse.o zggqrf.o zggrqf.o \
    zggsvd3.o zggsvp3.o \
-   zgtcon.o zgtrfs.o zgtsv.o  zgtsvx.o zgttrf.o zgttrs.o zgtts2.o zhbev.o  \
+   zgtcon.o zgtrfs.o zgtsv.o  zgtsvx.o zgttrf.o zgttrs.o zgtts2.o zhbev.o \
    zhbevd.o zhbevx.o zhbgst.o zhbgv.o  zhbgvd.o zhbgvx.o zhbtrd.o \
    zhecon.o zheev.o  zheevd.o zheevr.o zheevx.o zhegs2.o zhegst.o \
    zhegv.o  zhegvd.o zhegvx.o zherfs.o zhesv.o  zhesvx.o zhetd2.o \
    zhetf2.o zhetrd.o \
    zhetrf.o zhetri.o zhetri2.o zhetri2x.o zheswapr.o \
    zhetrs.o zhetrs2.o \
-   zhetf2_rook.o zhetrf_rook.o zhetri_rook.o zhetrs_rook.o zhecon_rook.o zhesv_rook.o \
+   zhetf2_rook.o zhetrf_rook.o zhetri_rook.o \
+   zhetrs_rook.o zhecon_rook.o zhesv_rook.o \
+   zhetf2_rk.o zhetrf_rk.o zhetri_3.o zhetri_3x.o \
+   zhetrs_3.o zhecon_3.o zhesv_rk.o \
    zhesv_aa.o zhetrf_aa.o zhetrs_aa.o zlahef_aa.o \
    zhgeqz.o zhpcon.o zhpev.o  zhpevd.o \
-   zhpevx.o zhpgst.o zhpgv.o  zhpgvd.o zhpgvx.o zhprfs.o zhpsv.o  \
+   zhpevx.o zhpgst.o zhpgv.o  zhpgvd.o zhpgvx.o zhprfs.o zhpsv.o \
    zhpsvx.o \
    zhptrd.o zhptrf.o zhptri.o zhptrs.o zhsein.o zhseqr.o zlabrd.o \
    zlacgv.o zlacon.o zlacn2.o zlacp2.o zlacpy.o zlacrm.o zlacrt.o zladiv.o \
    zlaed0.o zlaed7.o zlaed8.o \
    zlaein.o zlaesy.o zlaev2.o zlags2.o zlagtm.o \
-   zlahef.o zlahef_rook.o zlahqr.o \
+   zlahef.o zlahef_rook.o zlahef_rk.o zlahqr.o \
    zlahr2.o zlaic1.o zlals0.o zlalsa.o zlalsd.o zlangb.o zlange.o \
    zlangt.o zlanhb.o \
    zlanhe.o \
@@ -396,23 +422,26 @@ ZLASRC = \
    zlaqsp.o zlaqsy.o zlar1v.o zlar2v.o ilazlr.o ilazlc.o \
    zlarcm.o zlarf.o  zlarfb.o \
    zlarfg.o zlarft.o zlarfgp.o \
-   zlarfx.o zlargv.o zlarnv.o zlarrv.o zlartg.o zlartv.o \
-   zlarz.o  zlarzb.o zlarzt.o zlascl.o zlaset.o zlasr.o  \
-   zlassq.o zlaswp.o zlasyf.o zlasyf_rook.o \
+   zlarfx.o zlarfy.o zlargv.o zlarnv.o zlarrv.o zlartg.o zlartv.o \
+   zlarz.o  zlarzb.o zlarzt.o zlascl.o zlaset.o zlasr.o \
+   zlassq.o zlaswp.o zlasyf.o zlasyf_rook.o zlasyf_rk.o zlasyf_aa.o \
    zlatbs.o zlatdf.o zlatps.o zlatrd.o zlatrs.o zlatrz.o zlauu2.o \
-   zlauum.o zpbcon.o zpbequ.o zpbrfs.o zpbstf.o zpbsv.o  \
+   zlauum.o zpbcon.o zpbequ.o zpbrfs.o zpbstf.o zpbsv.o \
    zpbsvx.o zpbtf2.o zpbtrf.o zpbtrs.o zpocon.o zpoequ.o zporfs.o \
    zposv.o  zposvx.o zpotf2.o zpotrf.o zpotri.o zpotrs.o zpstrf.o zpstf2.o \
    zppcon.o zppequ.o zpprfs.o zppsv.o  zppsvx.o zpptrf.o zpptri.o zpptrs.o \
    zptcon.o zpteqr.o zptrfs.o zptsv.o  zptsvx.o zpttrf.o zpttrs.o zptts2.o \
-   zrot.o   zspcon.o zspmv.o  zspr.o   zsprfs.o zspsv.o  \
+   zrot.o   zspcon.o zspmv.o  zspr.o   zsprfs.o zspsv.o \
    zspsvx.o zsptrf.o zsptri.o zsptrs.o zdrscl.o zstedc.o \
    zstegr.o zstein.o zsteqr.o \
    zsycon.o zsymv.o \
-   zsyr.o zsyrfs.o zsysv.o  zsysvx.o zsytf2.o zsytrf.o zsytri.o zsytri2.o zsytri2x.o \
-   zsyswapr.o zsytrs.o zsytrs2.o zsyconv.o \
-   zsytf2_rook.o zsytrf_rook.o zsytrs_rook.o \
+   zsyr.o zsyrfs.o zsysv.o zsysvx.o zsytf2.o zsytrf.o zsytri.o zsytri2.o zsytri2x.o \
+   zsyswapr.o zsytrs.o zsytrs2.o \
+   zsyconv.o zsyconvf.o zsyconvf_rook.o \
+   zsytf2_rook.o zsytrf_rook.o zsytrs_rook.o zsytrs_aa.o \
    zsytri_rook.o zsycon_rook.o zsysv_rook.o \
+   zsytf2_rk.o zsytrf_rk.o zsytrf_aa.o zsytrs_3.o \
+   zsytri_3.o zsytri_3x.o zsycon_3.o zsysv_rk.o zsysv_aa.o \
    ztbcon.o ztbrfs.o ztbtrs.o ztgevc.o ztgex2.o \
    ztgexc.o ztgsen.o ztgsja.o ztgsna.o ztgsy2.o ztgsyl.o ztpcon.o \
    ztprfs.o ztptri.o \
@@ -435,32 +464,35 @@ ZLASRC = \
    zgelqt.o zgelqt3.o zgemlqt.o \
    zgetsls.o zgeqr.o zlatsqr.o zlamtsqr.o zgemqr.o \
    zgelq.o zlaswlq.o zlamswlq.o zgemlq.o \
-   ztplqt.o ztplqt2.o ztpmlqt.o  
+   ztplqt.o ztplqt2.o ztpmlqt.o \
+   zhetrd_2stage.o zhetrd_he2hb.o zhetrd_hb2st.o zhb2st_kernels.o \
+   zheevd_2stage.o zheev_2stage.o zheevx_2stage.o zheevr_2stage.o \
+   zhbev_2stage.o zhbevx_2stage.o zhbevd_2stage.o zhegv_2stage.o
 
 ifdef USEXBLAS
-ZXLASRC = zgesvxx.o zgerfsx.o zla_gerfsx_extended.o zla_geamv.o		\
-   zla_gercond_c.o zla_gercond_x.o zla_gerpvgrw.o zsysvxx.o zsyrfsx.o	\
-   zla_syrfsx_extended.o zla_syamv.o zla_syrcond_c.o zla_syrcond_x.o	\
-   zla_syrpvgrw.o zposvxx.o zporfsx.o zla_porfsx_extended.o		\
-   zla_porcond_c.o zla_porcond_x.o zla_porpvgrw.o zgbsvxx.o zgbrfsx.o	\
-   zla_gbrfsx_extended.o zla_gbamv.o zla_gbrcond_c.o zla_gbrcond_x.o	\
-   zla_gbrpvgrw.o zhesvxx.o zherfsx.o zla_herfsx_extended.o		\
-   zla_heamv.o zla_hercond_c.o zla_hercond_x.o zla_herpvgrw.o		\
+ZXLASRC = zgesvxx.o zgerfsx.o zla_gerfsx_extended.o zla_geamv.o \
+   zla_gercond_c.o zla_gercond_x.o zla_gerpvgrw.o zsysvxx.o zsyrfsx.o \
+   zla_syrfsx_extended.o zla_syamv.o zla_syrcond_c.o zla_syrcond_x.o \
+   zla_syrpvgrw.o zposvxx.o zporfsx.o zla_porfsx_extended.o \
+   zla_porcond_c.o zla_porcond_x.o zla_porpvgrw.o zgbsvxx.o zgbrfsx.o \
+   zla_gbrfsx_extended.o zla_gbamv.o zla_gbrcond_c.o zla_gbrcond_x.o \
+   zla_gbrpvgrw.o zhesvxx.o zherfsx.o zla_herfsx_extended.o \
+   zla_heamv.o zla_hercond_c.o zla_hercond_x.o zla_herpvgrw.o \
    zla_lin_berr.o zlarscl2.o zlascl2.o zla_wwaddw.o
 endif
 
-DEPRECSRC = DEPRECATED/cgegs.o DEPRECATED/cgegv.o DEPRECATED/cgelsx.o	\
-    DEPRECATED/cgeqpf.o DEPRECATED/cggsvd.o DEPRECATED/cggsvp.o				\
-    DEPRECATED/clahrd.o DEPRECATED/clatzm.o DEPRECATED/ctzrqf.o \
-    DEPRECATED/dgegs.o	DEPRECATED/dgegv.o DEPRECATED/dgelsx.o \
-    DEPRECATED/dgeqpf.o	DEPRECATED/dggsvd.o DEPRECATED/dggsvp.o \
-    DEPRECATED/dlahrd.o DEPRECATED/dlatzm.o	DEPRECATED/dtzrqf.o \
-    DEPRECATED/sgegs.o DEPRECATED/sgegv.o DEPRECATED/sgelsx.o \
-    DEPRECATED/sgeqpf.o DEPRECATED/sggsvd.o	DEPRECATED/sggsvp.o \
-    DEPRECATED/slahrd.o DEPRECATED/slatzm.o DEPRECATED/stzrqf.o	\
-    DEPRECATED/zgegs.o DEPRECATED/zgegv.o DEPRECATED/zgelsx.o \
-    DEPRECATED/zgeqpf.o DEPRECATED/zggsvd.o DEPRECATED/zggsvp.o	\
-	DEPRECATED/zlahrd.o  DEPRECATED/zlatzm.o DEPRECATED/ztzrqf.o
+DEPRECSRC = DEPRECATED/cgegs.o DEPRECATED/cgegv.o DEPRECATED/cgelsx.o \
+   DEPRECATED/cgeqpf.o DEPRECATED/cggsvd.o DEPRECATED/cggsvp.o \
+   DEPRECATED/clahrd.o DEPRECATED/clatzm.o DEPRECATED/ctzrqf.o \
+   DEPRECATED/dgegs.o  DEPRECATED/dgegv.o  DEPRECATED/dgelsx.o \
+   DEPRECATED/dgeqpf.o DEPRECATED/dggsvd.o DEPRECATED/dggsvp.o \
+   DEPRECATED/dlahrd.o DEPRECATED/dlatzm.o DEPRECATED/dtzrqf.o \
+   DEPRECATED/sgegs.o  DEPRECATED/sgegv.o  DEPRECATED/sgelsx.o \
+   DEPRECATED/sgeqpf.o DEPRECATED/sggsvd.o DEPRECATED/sggsvp.o \
+   DEPRECATED/slahrd.o DEPRECATED/slatzm.o DEPRECATED/stzrqf.o \
+   DEPRECATED/zgegs.o  DEPRECATED/zgegv.o  DEPRECATED/zgelsx.o \
+   DEPRECATED/zgeqpf.o DEPRECATED/zggsvd.o DEPRECATED/zggsvp.o \
+   DEPRECATED/zlahrd.o DEPRECATED/zlatzm.o DEPRECATED/ztzrqf.o
 
 ALLOBJ = $(SLASRC) $(DLASRC) $(DSLASRC) $(CLASRC) $(ZLASRC) $(ZCLASRC) \
    $(SCLAUX) $(DZLAUX) $(ALLAUX)
@@ -481,22 +513,22 @@ all: ../$(LAPACKLIB)
 
 single: $(SLASRC) $(DSLASRC) $(SXLASRC) $(SCLAUX) $(ALLAUX)
 	$(ARCH) $(ARCHFLAGS) ../$(LAPACKLIB) $(SLASRC) $(DSLASRC) \
-	$(SXLASRC) $(SCLAUX) $(ALLAUX) $(ALLXAUX)
+	$(SXLASRC) $(SCLAUX) $(ALLAUX)
 	$(RANLIB) ../$(LAPACKLIB)
 
 complex: $(CLASRC) $(ZCLASRC) $(CXLASRC) $(SCLAUX) $(ALLAUX)
 	$(ARCH) $(ARCHFLAGS) ../$(LAPACKLIB) $(CLASRC) $(ZCLASRC) \
-	$(CXLASRC) $(SCLAUX) $(ALLAUX) $(ALLXAUX)
+	$(CXLASRC) $(SCLAUX) $(ALLAUX)
 	$(RANLIB) ../$(LAPACKLIB)
 
 double: $(DLASRC) $(DSLASRC) $(DXLASRC) $(DZLAUX) $(ALLAUX)
 	$(ARCH) $(ARCHFLAGS) ../$(LAPACKLIB) $(DLASRC) $(DSLASRC) \
-	$(DXLASRC) $(DZLAUX) $(ALLAUX) $(ALLXAUX)
+	$(DXLASRC) $(DZLAUX) $(ALLAUX)
 	$(RANLIB) ../$(LAPACKLIB)
 
 complex16: $(ZLASRC) $(ZCLASRC) $(ZXLASRC) $(DZLAUX) $(ALLAUX)
 	$(ARCH) $(ARCHFLAGS) ../$(LAPACKLIB) $(ZLASRC) $(ZCLASRC) \
-	$(ZXLASRC) $(DZLAUX) $(ALLAUX) $(ALLXAUX)
+	$(ZXLASRC) $(DZLAUX) $(ALLAUX)
 	$(RANLIB) ../$(LAPACKLIB)
 
 $(ALLAUX): $(FRC)
@@ -522,12 +554,14 @@ clean:
 	rm -f *.o DEPRECATED/*.o
 
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
-
-slaruv.o: slaruv.f ; $(FORTRAN) $(NOOPT) -c $< -o $@
-dlaruv.o: dlaruv.f ; $(FORTRAN) $(NOOPT) -c $< -o $@
-sla_wwaddw.o: sla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c $< -o $@
-dla_wwaddw.o: dla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c $< -o $@
-cla_wwaddw.o: cla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c $< -o $@
-zla_wwaddw.o: zla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
 
+.F.o:
+	$(FORTRAN) $(OPTS) -c $< -o $@
+	
+slaruv.o: slaruv.f ; $(FORTRAN) $(NOOPT) -c -o $@ $<
+dlaruv.o: dlaruv.f ; $(FORTRAN) $(NOOPT) -c -o $@ $<
+sla_wwaddw.o: sla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c -o $@ $<
+dla_wwaddw.o: dla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c -o $@ $<
+cla_wwaddw.o: cla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c -o $@ $<
+zla_wwaddw.o: zla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c -o $@ $<
diff --git a/SRC/VARIANTS/Makefile b/SRC/VARIANTS/Makefile
index 403a0b23..6db97e95 100644
--- a/SRC/VARIANTS/Makefile
+++ b/SRC/VARIANTS/Makefile
@@ -17,7 +17,7 @@ include ../../make.inc
 #  1065-1081. http://dx.doi.org/10.1137/S0895479896297744
 #######################################################################
 
-VARIANTSDIR=LIB
+VARIANTSDIR = LIB
 
 CHOLRL = cholesky/RL/cpotrf.o cholesky/RL/dpotrf.o cholesky/RL/spotrf.o cholesky/RL/zpotrf.o
 
@@ -29,7 +29,7 @@ LULL = lu/LL/cgetrf.o lu/LL/dgetrf.o lu/LL/sgetrf.o lu/LL/zgetrf.o
 
 LUREC = lu/REC/cgetrf.o lu/REC/dgetrf.o lu/REC/sgetrf.o lu/REC/zgetrf.o
 
-QRLL = qr/LL/cgeqrf.o qr/LL/dgeqrf.o qr/LL/sgeqrf.o qr/LL/zgeqrf.o  qr/LL/sceil.o
+QRLL = qr/LL/cgeqrf.o qr/LL/dgeqrf.o qr/LL/sgeqrf.o qr/LL/zgeqrf.o qr/LL/sceil.o
 
 
 all: cholrl choltop lucr lull lurec qrll
@@ -55,13 +55,13 @@ lurec: $(LUREC)
 	$(RANLIB) $(VARIANTSDIR)/lurec.a
 
 qrll: $(QRLL)
-	$(ARCH) $(ARCHFLAGS) $(VARIANTSDIR)/qrll.a  $(QRLL)
+	$(ARCH) $(ARCHFLAGS) $(VARIANTSDIR)/qrll.a $(QRLL)
 	$(RANLIB) $(VARIANTSDIR)/qrll.a
 
 
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
 
 clean:
 	rm -f $(CHOLRL) $(CHOLTOP) $(LUCR) $(LULL) $(LUREC) $(QRLL) \
-	      $(VARIANTSDIR)/*.a
\ No newline at end of file
+	      $(VARIANTSDIR)/*.a
diff --git a/SRC/cgejsv.f b/SRC/cgejsv.f
index f69ab9d1..0641e42c 100644
--- a/SRC/cgejsv.f
+++ b/SRC/cgejsv.f
@@ -85,7 +85,7 @@
 *>              rows, then using this condition number gives too pessimistic
 *>              error bound.
 *>       = 'A': Small singular values are the noise and the matrix is treated
-*>              as numerically rank defficient. The error in the computed
+*>              as numerically rank deficient. The error in the computed
 *>              singular values is bounded by f(m,n)*epsilon*||A||.
 *>              The computed SVD A = U * S * V^* restores A up to
 *>              f(m,n)*epsilon*||A||.
@@ -469,7 +469,7 @@
 *>     The rank revealing QR factorization (in this code: CGEQP3) should be
 *>  implemented as in [3]. We have a new version of CGEQP3 under development
 *>  that is more robust than the current one in LAPACK, with a cleaner cut in
-*>  rank defficient cases. It will be available in the SIGMA library [4].
+*>  rank deficient cases. It will be available in the SIGMA library [4].
 *>  If M is much larger than N, it is obvious that the initial QRF with
 *>  column pivoting can be preprocessed by the QRF without pivoting. That
 *>  well known trick is not used in CGEJSV because in some cases heavy row
@@ -1021,7 +1021,7 @@
       ELSE IF ( L2RANK ) THEN
 *        .. similarly as above, only slightly more gentle (less agressive).
 *        Sudden drop on the diagonal of R1 is used as the criterion for
-*        close-to-rank-defficient.
+*        close-to-rank-deficient.
          TEMP1 = SQRT(SFMIN)
          DO 3401 p = 2, N
             IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR.
diff --git a/SRC/cgels.f b/SRC/cgels.f
index 05447cb3..17a8c341 100644
--- a/SRC/cgels.f
+++ b/SRC/cgels.f
@@ -49,7 +49,7 @@
 *>    an underdetermined system A * X = B.
 *>
 *> 3. If TRANS = 'C' and m >= n:  find the minimum norm solution of
-*>    an undetermined system A**H * X = B.
+*>    an underdetermined system A**H * X = B.
 *>
 *> 4. If TRANS = 'C' and m < n:  find the least squares solution of
 *>    an overdetermined system, i.e., solve the least squares problem
@@ -380,7 +380,7 @@
 *
          ELSE
 *
-*           Overdetermined system of equations A**H * X = B
+*           Underdetermined system of equations A**T * X = B
 *
 *           B(1:N,1:NRHS) := inv(R**H) * B(1:N,1:NRHS)
 *
diff --git a/SRC/cgesdd.f b/SRC/cgesdd.f
index d10f5281..719cac5f 100644
--- a/SRC/cgesdd.f
+++ b/SRC/cgesdd.f
@@ -330,8 +330,10 @@
 *       real workspace. NB refers to the optimal block size for the
 *       immediately following subroutine, as returned by ILAENV.)
 *
-      IF( INFO.EQ.0 .AND. M.GT.0 .AND. N.GT.0 ) THEN
-         IF( M.GE.N ) THEN
+      IF( INFO.EQ.0 ) THEN
+         MINWRK = 1
+         MAXWRK = 1
+         IF( M.GE.N .AND. MINMN.GT.0 ) THEN
 *
 *           There is no complex work space needed for bidiagonal SVD
 *           The real work space needed for bidiagonal SVD (sbdsdc) is
@@ -472,7 +474,7 @@
                   MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_PRC_NN )
                END IF
             END IF
-         ELSE
+         ELSE IF( MINMN.GT.0 ) THEN
 *
 *           There is no complex work space needed for bidiagonal SVD
 *           The real work space needed for bidiagonal SVD (sbdsdc) is
diff --git a/SRC/chb2st_kernels.f b/SRC/chb2st_kernels.f
new file mode 100644
index 00000000..8b0a4b28
--- /dev/null
+++ b/SRC/chb2st_kernels.f
@@ -0,0 +1,320 @@
+*> \brief \b CHB2ST_KERNELS
+*
+*  @generated from zhb2st_kernels.f, fortran z -> c, Sun Nov  6 19:34:06 2016
+*      
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download CHB2ST_KERNELS + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chb2st_kernels.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chb2st_kernels.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chb2st_kernels.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE  CHB2ST_KERNELS( UPLO, WANTZ, TTYPE, 
+*                                   ST, ED, SWEEP, N, NB, IB,
+*                                   A, LDA, V, TAU, LDVT, WORK)
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       LOGICAL            WANTZ
+*       INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX            A( LDA, * ), V( * ), 
+*                          TAU( * ), WORK( * )
+*  
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHB2ST_KERNELS is an internal routine used by the CHETRD_HB2ST
+*> subroutine.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> @param[in] n
+*>          The order of the matrix A.
+*>
+*> @param[in] nb
+*>          The size of the band.
+*>
+*> @param[in, out] A
+*>          A pointer to the matrix A.
+*>
+*> @param[in] lda
+*>          The leading dimension of the matrix A.
+*>
+*> @param[out] V
+*>          COMPLEX array, dimension 2*n if eigenvalues only are
+*>          requested or to be queried for vectors.
+*>
+*> @param[out] TAU
+*>          COMPLEX array, dimension (2*n).
+*>          The scalar factors of the Householder reflectors are stored
+*>          in this array.
+*>
+*> @param[in] st
+*>          internal parameter for indices.
+*>
+*> @param[in] ed
+*>          internal parameter for indices.
+*>
+*> @param[in] sweep
+*>          internal parameter for indices.
+*>
+*> @param[in] Vblksiz
+*>          internal parameter for indices.
+*>
+*> @param[in] wantz
+*>          logical which indicate if Eigenvalue are requested or both
+*>          Eigenvalue/Eigenvectors.
+*>
+*> @param[in] work
+*>          Workspace of size nb.
+*>
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE  CHB2ST_KERNELS( UPLO, WANTZ, TTYPE, 
+     $                            ST, ED, SWEEP, N, NB, IB,
+     $                            A, LDA, V, TAU, LDVT, WORK)
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      LOGICAL            WANTZ
+      INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
+*     ..
+*     .. Array Arguments ..
+      COMPLEX            A( LDA, * ), V( * ), 
+     $                   TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX            ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   ONE = ( 1.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, J1, J2, LM, LN, VPOS, TAUPOS,
+     $                   DPOS, OFDPOS, AJETER 
+      COMPLEX            CTMP 
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CLARFG, CLARFX, CLARFY
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          CONJG, MOD
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     ..
+*     .. Executable Statements ..
+*      
+      AJETER = IB + LDVT
+      UPPER = LSAME( UPLO, 'U' )
+
+      IF( UPPER ) THEN
+          DPOS    = 2 * NB + 1
+          OFDPOS  = 2 * NB
+      ELSE
+          DPOS    = 1
+          OFDPOS  = 2
+      ENDIF
+
+*
+*     Upper case
+*  
+      IF( UPPER ) THEN
+*      
+          IF( WANTZ ) THEN
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ELSE
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ENDIF
+          GO TO ( 101, 102, 103 ) TTYPE
+*
+  101     CONTINUE
+          LM = ED - ST + 1
+*
+          V( VPOS ) = ONE
+          DO 10 I = 1, LM-1
+              V( VPOS+I )         = CONJG( A( OFDPOS-I, ST+I ) )
+              A( OFDPOS-I, ST+I ) = ZERO  
+   10     CONTINUE
+          CTMP = CONJG( A( OFDPOS, ST ) )
+          CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, 
+     $                                   TAU( TAUPOS ) )
+          A( OFDPOS, ST ) = CTMP
+* 
+  103     CONTINUE
+          LM = ED - ST + 1
+          CALL CLARFY( UPLO, LM, V( VPOS ), 1, CONJG( TAU( TAUPOS ) ),
+     $                             A( DPOS, ST ), LDA-1, WORK)
+          GOTO 300
+*
+  102     CONTINUE
+          J1 = ED+1
+          J2 = MIN( ED+NB, N )
+          LN = ED-ST+1
+          LM = J2-J1+1
+          IF( LM.GT.0) THEN
+              CALL CLARFX( 'Left', LN, LM, V( VPOS ),
+     $                     CONJG( TAU( TAUPOS ) ), A( DPOS-NB, J1 ),
+     $                     LDA-1, WORK)
+*
+              IF( WANTZ ) THEN
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ELSE
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ENDIF
+*
+              V( VPOS ) = ONE
+              DO 30 I = 1, LM-1
+                  V( VPOS+I )          = CONJG( A( DPOS-NB-I, J1+I ) )
+                  A( DPOS-NB-I, J1+I ) = ZERO
+   30         CONTINUE
+              CTMP = CONJG( A( DPOS-NB, J1 ) )
+              CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) )
+              A( DPOS-NB, J1 ) = CTMP
+*             
+              CALL CLARFX( 'Right', LN-1, LM, V( VPOS ), 
+     $                     TAU( TAUPOS ),
+     $                     A( DPOS-NB+1, J1 ), LDA-1, WORK)
+          ENDIF
+          GOTO 300
+*
+*     Lower case
+*  
+      ELSE
+*      
+          IF( WANTZ ) THEN
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ELSE
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ENDIF
+          GO TO ( 201, 202, 203 ) TTYPE
+*  
+  201     CONTINUE
+          LM = ED - ST + 1
+*
+          V( VPOS ) = ONE
+          DO 20 I = 1, LM-1
+              V( VPOS+I )         = A( OFDPOS+I, ST-1 )
+              A( OFDPOS+I, ST-1 ) = ZERO  
+   20     CONTINUE
+          CALL CLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, 
+     $                                   TAU( TAUPOS ) )
+*
+  203     CONTINUE
+          LM = ED - ST + 1
+*
+          CALL CLARFY( UPLO, LM, V( VPOS ), 1, CONJG( TAU( TAUPOS ) ),
+     $                                      A( DPOS, ST ), LDA-1, WORK)
+
+          GOTO 300
+*
+  202     CONTINUE
+          J1 = ED+1
+          J2 = MIN( ED+NB, N )
+          LN = ED-ST+1
+          LM = J2-J1+1
+*
+          IF( LM.GT.0) THEN
+              CALL CLARFX( 'Right', LM, LN, V( VPOS ), 
+     $                     TAU( TAUPOS ), A( DPOS+NB, ST ),
+     $                     LDA-1, WORK)
+*
+              IF( WANTZ ) THEN
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ELSE
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ENDIF
+*              
+              V( VPOS ) = ONE
+              DO 40 I = 1, LM-1
+                  V( VPOS+I )        = A( DPOS+NB+I, ST )
+                  A( DPOS+NB+I, ST ) = ZERO
+   40         CONTINUE
+              CALL CLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, 
+     $                                    TAU( TAUPOS ) )
+*                  
+              CALL CLARFX( 'Left', LM, LN-1, V( VPOS ), 
+     $                     CONJG( TAU( TAUPOS ) ),
+     $                     A( DPOS+NB-1, ST+1 ), LDA-1, WORK)
+
+          ENDIF
+          GOTO 300
+      ENDIF
+
+  300 CONTINUE    
+      RETURN
+*
+*     END OF CHB2ST_KERNELS
+*
+      END      
diff --git a/SRC/chbev_2stage.f b/SRC/chbev_2stage.f
new file mode 100644
index 00000000..182d3d93
--- /dev/null
+++ b/SRC/chbev_2stage.f
@@ -0,0 +1,386 @@
+*> \brief <b> CHBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @generated from zhbev_2stage.f, fortran z -> c, Sat Nov  5 23:18:20 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHBEV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chbev_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chbev_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chbev_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+*                                WORK, LWORK, RWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, KD, LDAB, LDZ, N, LWORK
+*       ..
+*       .. Array Arguments ..
+*       REAL               RWORK( * ), W( * )
+*       COMPLEX            AB( LDAB, * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHBEV_2STAGE computes all the eigenvalues and, optionally, eigenvectors of
+*> a complex Hermitian band matrix A using the 2stage technique for
+*> the reduction to tridiagonal.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is COMPLEX array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the Hermitian band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.  If UPLO = 'U', the first
+*>          superdiagonal and the diagonal of the tridiagonal matrix T
+*>          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+*>          the diagonal and first subdiagonal of T are returned in the
+*>          first two rows of AB.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX array, dimension (LDZ, N)
+*>          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+*>          eigenvectors of the matrix A, with the i-th column of Z
+*>          holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension LWORK
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK, RWORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (max(1,3*N-2))
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit.
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value.
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexOTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+     $                         WORK, LWORK, RWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, KD, LDAB, LDZ, N, LWORK
+*     ..
+*     .. Array Arguments ..
+      REAL               RWORK( * ), W( * )
+      COMPLEX            AB( LDAB, * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, WANTZ, LQUERY
+      INTEGER            IINFO, IMAX, INDE, INDWRK, INDRWK, ISCALE,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, IB, INDHOUS
+      REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, CLANHB
+      EXTERNAL           LSAME, SLAMCH, CLANHB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SSCAL, SSTERF, XERBLA, CLASCL, CSTEQR
+     $                   CHETRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -6
+      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+         INFO = -9
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            IB    = ILAENV( 18, 'CHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+            LWMIN = LHTRD + LWTRD
+            WORK( 1 )  = LWMIN
+         ENDIF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -11
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHBEV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            W( 1 ) = REAL( AB( 1, 1 ) )
+         ELSE
+            W( 1 ) = REAL( AB( KD+1, 1 ) )
+         END IF
+         IF( WANTZ )
+     $      Z( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = CLANHB( 'M', UPLO, N, KD, AB, LDAB, RWORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+      END IF
+*
+*     Call CHBTRD_HB2ST to reduce Hermitian band matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDHOUS = 1
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL CHETRD_HB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, W,
+     $                    RWORK( INDE ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call SSTERF.  For eigenvectors, call CSTEQR.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL SSTERF( N, W, RWORK( INDE ), INFO )
+      ELSE
+         INDRWK = INDE + N
+         CALL CSTEQR( JOBZ, N, W, RWORK( INDE ), Z, LDZ,
+     $                RWORK( INDRWK ), INFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of CHBEV_2STAGE
+*
+      END
diff --git a/SRC/chbevd_2stage.f b/SRC/chbevd_2stage.f
new file mode 100644
index 00000000..89c118d3
--- /dev/null
+++ b/SRC/chbevd_2stage.f
@@ -0,0 +1,458 @@
+*> \brief <b> CHBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @generated from zhbevd_2stage.f, fortran z -> c, Sat Nov  5 23:18:17 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHBEVD_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chbevd_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chbevd_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chbevd_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+*                                 WORK, LWORK, RWORK, LRWORK, IWORK, 
+*                                 LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, KD, LDAB, LDZ, LIWORK, LRWORK, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IWORK( * )
+*       REAL               RWORK( * ), W( * )
+*       COMPLEX            AB( LDAB, * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHBEVD_2STAGE computes all the eigenvalues and, optionally, eigenvectors of
+*> a complex Hermitian band matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  If eigenvectors are desired, it
+*> uses a divide and conquer algorithm.
+*>
+*> The divide and conquer algorithm makes very mild assumptions about
+*> floating point arithmetic. It will work on machines with a guard
+*> digit in add/subtract, or on those binary machines without guard
+*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
+*> without guard digits, but we know of none.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is COMPLEX array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the Hermitian band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.  If UPLO = 'U', the first
+*>          superdiagonal and the diagonal of the tridiagonal matrix T
+*>          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+*>          the diagonal and first subdiagonal of T are returned in the
+*>          first two rows of AB.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX array, dimension (LDZ, N)
+*>          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+*>          eigenvectors of the matrix A, with the i-th column of Z
+*>          holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK, RWORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array,
+*>                                         dimension (LRWORK)
+*>          On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
+*> \endverbatim
+*>
+*> \param[in] LRWORK
+*> \verbatim
+*>          LRWORK is INTEGER
+*>          The dimension of array RWORK.
+*>          If N <= 1,               LRWORK must be at least 1.
+*>          If JOBZ = 'N' and N > 1, LRWORK must be at least N.
+*>          If JOBZ = 'V' and N > 1, LRWORK must be at least
+*>                        1 + 5*N + 2*N**2.
+*>
+*>          If LRWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of array IWORK.
+*>          If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
+*>          If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N .
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit.
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value.
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexOTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+     $                          WORK, LWORK, RWORK, LRWORK, IWORK, 
+     $                          LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, KD, LDAB, LDZ, LIWORK, LRWORK, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IWORK( * )
+      REAL               RWORK( * ), W( * )
+      COMPLEX            AB( LDAB, * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+      COMPLEX            CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0E0, 0.0E0 ),
+     $                   CONE = ( 1.0E0, 0.0E0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, IMAX, INDE, INDWK2, INDRWK, ISCALE,
+     $                   LLWORK, INDWK, LHTRD, LWTRD, IB, INDHOUS,
+     $                   LIWMIN, LLRWK, LLWK2, LRWMIN, LWMIN
+      REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, CLANHB
+      EXTERNAL           LSAME, SLAMCH, CLANHB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SSCAL, SSTERF, XERBLA, CGEMM, CLACPY,
+     $                   CLASCL, CSTEDC, CHETRD_HB2ST
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 .OR. LRWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( N.LE.1 ) THEN
+         LWMIN = 1
+         LRWMIN = 1
+         LIWMIN = 1
+      ELSE
+         IB    = ILAENV( 18, 'CHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+         IF( WANTZ ) THEN
+            LWMIN = 2*N**2
+            LRWMIN = 1 + 5*N + 2*N**2
+            LIWMIN = 3 + 5*N
+         ELSE
+            LWMIN  = MAX( N, LHTRD + LWTRD )
+            LRWMIN = N
+            LIWMIN = 1
+         END IF
+      END IF
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -6
+      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+         INFO = -9
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         WORK( 1 )  = LWMIN
+         RWORK( 1 ) = LRWMIN
+         IWORK( 1 ) = LIWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -11
+         ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -13
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -15
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHBEVD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = REAL( AB( 1, 1 ) )
+         IF( WANTZ )
+     $      Z( 1, 1 ) = CONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = CLANHB( 'M', UPLO, N, KD, AB, LDAB, RWORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+      END IF
+*
+*     Call CHBTRD_HB2ST to reduce Hermitian band matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDRWK  = INDE + N
+      LLRWK   = LRWORK - INDRWK + 1
+      INDHOUS = 1
+      INDWK   = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWK + 1
+      INDWK2  = INDWK + N*N
+      LLWK2   = LWORK - INDWK2 + 1
+*
+      CALL CHETRD_HB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, W,
+     $                    RWORK( INDE ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call SSTERF.  For eigenvectors, call CSTEDC.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL SSTERF( N, W, RWORK( INDE ), INFO )
+      ELSE
+         CALL CSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ),
+     $                LLWK2, RWORK( INDRWK ), LLRWK, IWORK, LIWORK,
+     $                INFO )
+         CALL CGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO,
+     $               WORK( INDWK2 ), N )
+         CALL CLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+      WORK( 1 )  = LWMIN
+      RWORK( 1 ) = LRWMIN
+      IWORK( 1 ) = LIWMIN
+      RETURN
+*
+*     End of CHBEVD_2STAGE
+*
+      END
diff --git a/SRC/chbevx_2stage.f b/SRC/chbevx_2stage.f
new file mode 100644
index 00000000..07eb6153
--- /dev/null
+++ b/SRC/chbevx_2stage.f
@@ -0,0 +1,646 @@
+*> \brief <b> CHBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @generated from zhbevx_2stage.f, fortran z -> c, Sat Nov  5 23:18:22 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHBEVX_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chbevx_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chbevx_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chbevx_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB,
+*                                 Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W,
+*                                 Z, LDZ, WORK, LWORK, RWORK, IWORK, 
+*                                 IFAIL, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
+*       REAL               ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IFAIL( * ), IWORK( * )
+*       REAL               RWORK( * ), W( * )
+*       COMPLEX            AB( LDAB, * ), Q( LDQ, * ), WORK( * ),
+*      $                   Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHBEVX_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a complex Hermitian band matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  Eigenvalues and eigenvectors
+*> can be selected by specifying either a range of values or a range of
+*> indices for the desired eigenvalues.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found;
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found;
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is COMPLEX array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the Hermitian band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] Q
+*> \verbatim
+*>          Q is COMPLEX array, dimension (LDQ, N)
+*>          If JOBZ = 'V', the N-by-N unitary matrix used in the
+*>                          reduction to tridiagonal form.
+*>          If JOBZ = 'N', the array Q is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDQ
+*> \verbatim
+*>          LDQ is INTEGER
+*>          The leading dimension of the array Q.  If JOBZ = 'V', then
+*>          LDQ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is REAL
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is REAL
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is REAL
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing AB to tridiagonal form.
+*>
+*>          Eigenvalues will be computed most accurately when ABSTOL is
+*>          set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+*>          If this routine returns with INFO>0, indicating that some
+*>          eigenvectors did not converge, try setting ABSTOL to
+*>          2*SLAMCH('S').
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          The first M elements contain the selected eigenvalues in
+*>          ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If an eigenvector fails to converge, then that column of Z
+*>          contains the latest approximation to the eigenvector, and the
+*>          index of the eigenvector is returned in IFAIL.
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (LWORK)
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK, RWORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (7*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (5*N)
+*> \endverbatim
+*>
+*> \param[out] IFAIL
+*> \verbatim
+*>          IFAIL is INTEGER array, dimension (N)
+*>          If JOBZ = 'V', then if INFO = 0, the first M elements of
+*>          IFAIL are zero.  If INFO > 0, then IFAIL contains the
+*>          indices of the eigenvectors that failed to converge.
+*>          If JOBZ = 'N', then IFAIL is not referenced.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, then i eigenvectors failed to converge.
+*>                Their indices are stored in array IFAIL.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup complexOTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB,
+     $                          Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W,
+     $                          Z, LDZ, WORK, LWORK, RWORK, IWORK, 
+     $                          IFAIL, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
+      REAL               ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IFAIL( * ), IWORK( * )
+      REAL               RWORK( * ), W( * )
+      COMPLEX            AB( LDAB, * ), Q( LDQ, * ), WORK( * ),
+     $                   Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+      COMPLEX            CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0E0, 0.0E0 ),
+     $                   CONE = ( 1.0E0, 0.0E0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ,
+     $                   LQUERY
+      CHARACTER          ORDER
+      INTEGER            I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
+     $                   INDISP, INDIWK, INDRWK, INDWRK, ISCALE, ITMP1,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, IB, INDHOUS,
+     $                   J, JJ, NSPLIT
+      REAL               ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+      COMPLEX            CTMP1
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, CLANHB
+      EXTERNAL           LSAME, SLAMCH, CLANHB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CCOPY,
+     $                   CGEMV, CLACPY, CLASCL, CSTEIN, CSTEQR,
+     $                   CSWAP, CHETRD_HB2ST
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -7
+      ELSE IF( WANTZ .AND. LDQ.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -11
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -12
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -13
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) )
+     $      INFO = -18
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            IB    = ILAENV( 18, 'CHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+            LWMIN = LHTRD + LWTRD
+            WORK( 1 )  = LWMIN
+         ENDIF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -20
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHBEVX_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         M = 1
+         IF( LOWER ) THEN
+            CTMP1 = AB( 1, 1 )
+         ELSE
+            CTMP1 = AB( KD+1, 1 )
+         END IF
+         TMP1 = REAL( CTMP1 )
+         IF( VALEIG ) THEN
+            IF( .NOT.( VL.LT.TMP1 .AND. VU.GE.TMP1 ) )
+     $         M = 0
+         END IF
+         IF( M.EQ.1 ) THEN
+            W( 1 ) = REAL( CTMP1 )
+            IF( WANTZ )
+     $         Z( 1, 1 ) = CONE
+         END IF
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF( VALEIG ) THEN
+         VLL = VL
+         VUU = VU
+      ELSE
+         VLL = ZERO
+         VUU = ZERO
+      END IF
+      ANRM = CLANHB( 'M', UPLO, N, KD, AB, LDAB, RWORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+*
+*     Call CHBTRD_HB2ST to reduce Hermitian band matrix to tridiagonal form.
+*
+      INDD = 1
+      INDE = INDD + N
+      INDRWK = INDE + N
+*
+      INDHOUS = 1
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL CHETRD_HB2ST( 'N', JOBZ, UPLO, N, KD, AB, LDAB,
+     $                    RWORK( INDD ), RWORK( INDE ), WORK( INDHOUS ),
+     $                    LHTRD, WORK( INDWRK ), LLWORK, IINFO )
+*
+*     If all eigenvalues are desired and ABSTOL is less than or equal
+*     to zero, then call SSTERF or CSTEQR.  If this fails for some
+*     eigenvalue, then try SSTEBZ.
+*
+      TEST = .FALSE.
+      IF (INDEIG) THEN
+         IF (IL.EQ.1 .AND. IU.EQ.N) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF ((ALLEIG .OR. TEST) .AND. (ABSTOL.LE.ZERO)) THEN
+         CALL SCOPY( N, RWORK( INDD ), 1, W, 1 )
+         INDEE = INDRWK + 2*N
+         IF( .NOT.WANTZ ) THEN
+            CALL SCOPY( N-1, RWORK( INDE ), 1, RWORK( INDEE ), 1 )
+            CALL SSTERF( N, W, RWORK( INDEE ), INFO )
+         ELSE
+            CALL CLACPY( 'A', N, N, Q, LDQ, Z, LDZ )
+            CALL SCOPY( N-1, RWORK( INDE ), 1, RWORK( INDEE ), 1 )
+            CALL CSTEQR( JOBZ, N, W, RWORK( INDEE ), Z, LDZ,
+     $                   RWORK( INDRWK ), INFO )
+            IF( INFO.EQ.0 ) THEN
+               DO 10 I = 1, N
+                  IFAIL( I ) = 0
+   10          CONTINUE
+            END IF
+         END IF
+         IF( INFO.EQ.0 ) THEN
+            M = N
+            GO TO 30
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call SSTEBZ and, if eigenvectors are desired, CSTEIN.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+      INDIBL = 1
+      INDISP = INDIBL + N
+      INDIWK = INDISP + N
+      CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
+     $             IWORK( INDIWK ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
+*
+*        Apply unitary matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by CSTEIN.
+*
+         DO 20 J = 1, M
+            CALL CCOPY( N, Z( 1, J ), 1, WORK( 1 ), 1 )
+            CALL CGEMV( 'N', N, N, CONE, Q, LDQ, WORK, 1, CZERO,
+     $                  Z( 1, J ), 1 )
+   20    CONTINUE
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+   30 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.
+*
+      IF( WANTZ ) THEN
+         DO 50 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 40 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   40       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               ITMP1 = IWORK( INDIBL+I-1 )
+               W( I ) = W( J )
+               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
+               W( J ) = TMP1
+               IWORK( INDIBL+J-1 ) = ITMP1
+               CALL CSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+               IF( INFO.NE.0 ) THEN
+                  ITMP1 = IFAIL( I )
+                  IFAIL( I ) = IFAIL( J )
+                  IFAIL( J ) = ITMP1
+               END IF
+            END IF
+   50    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of CHBEVX_2STAGE
+*
+      END
diff --git a/SRC/checon_3.f b/SRC/checon_3.f
new file mode 100644
index 00000000..438ee3ae
--- /dev/null
+++ b/SRC/checon_3.f
@@ -0,0 +1,285 @@
+*> \brief \b CHECON_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHECON_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/checon_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/checon_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/checon_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHECON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+*                            WORK, IWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       REAL               ANORM, RCOND
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * ), IWORK( * )
+*       COMPLEX            A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CHECON_3 estimates the reciprocal of the condition number (in the
+*> 1-norm) of a complex Hermitian matrix A using the factorization
+*> computed by CHETRF_RK or CHETRF_BK:
+*>
+*>    A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
+*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+*> This routine uses BLAS3 solver CHETRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**H)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**H)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by CHETRF_RK and CHETRF_BK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by CHETRF_RK or CHETRF_BK.
+*> \endverbatim
+*>
+*> \param[in] ANORM
+*> \verbatim
+*>          ANORM is REAL
+*>          The 1-norm of the original matrix A.
+*> \endverbatim
+*>
+*> \param[out] RCOND
+*> \verbatim
+*>          RCOND is REAL
+*>          The reciprocal of the condition number of the matrix A,
+*>          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+*>          estimate of the 1-norm of inv(A) computed in this routine.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (2*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHECON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+     $                     WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+      REAL               ANORM, RCOND
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, KASE
+      REAL               AINVNM
+*     ..
+*     .. Local Arrays ..
+      INTEGER            ISAVE( 3 )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CHETRS_3, CLACN2, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( ANORM.LT.ZERO ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHECON_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      RCOND = ZERO
+      IF( N.EQ.0 ) THEN
+         RCOND = ONE
+         RETURN
+      ELSE IF( ANORM.LE.ZERO ) THEN
+         RETURN
+      END IF
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO I = N, 1, -1
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO I = 1, N
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+*     Estimate the 1-norm of the inverse.
+*
+      KASE = 0
+   30 CONTINUE
+      CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
+      IF( KASE.NE.0 ) THEN
+*
+*        Multiply by inv(L*D*L**H) or inv(U*D*U**H).
+*
+         CALL CHETRS_3( UPLO, N, 1, A, LDA, E, IPIV, WORK, N, INFO )
+         GO TO 30
+      END IF
+*
+*     Compute the estimate of the reciprocal condition number.
+*
+      IF( AINVNM.NE.ZERO )
+     $   RCOND = ( ONE / AINVNM ) / ANORM
+*
+      RETURN
+*
+*     End of CHECON_3
+*
+      END
diff --git a/SRC/cheev_2stage.f b/SRC/cheev_2stage.f
new file mode 100644
index 00000000..b98dac76
--- /dev/null
+++ b/SRC/cheev_2stage.f
@@ -0,0 +1,355 @@
+*> \brief <b> CHEEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>
+*
+*  @generated from zheev_2stage.f, fortran z -> c, Sat Nov  5 23:18:06 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHEEV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cheev_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cheev_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cheev_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+*                                RWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               RWORK( * ), W( * )
+*       COMPLEX            A( LDA, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHEEV_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
+*> complex Hermitian matrix A using the 2stage technique for
+*> the reduction to tridiagonal.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA, N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          orthonormal eigenvectors of the matrix A.
+*>          If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+*>          or the upper triangle (if UPLO='U') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (max(1, 3*N-2))
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+     $                         RWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      REAL               RWORK( * ), W( * )
+      COMPLEX            A( LDA, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+      COMPLEX            CONE
+      PARAMETER          ( CONE = ( 1.0E0, 0.0E0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, KD, IB, INDHOUS
+      REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, CLANHE
+      EXTERNAL           LSAME, ILAENV, SLAMCH, CLANHE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SSCAL, SSTERF, XERBLA, CLASCL, CSTEQR,
+     $                   CUNGTR, CHETRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL, MAX, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         KD    = ILAENV( 17, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+         IB    = ILAENV( 18, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWMIN = N + LHTRD + LWTRD
+         WORK( 1 )  = LWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -8
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHEEV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = REAL( A( 1, 1 ) )
+         WORK( 1 ) = 1
+         IF( WANTZ )
+     $      A( 1, 1 ) = CONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = CLANHE( 'M', UPLO, N, A, LDA, RWORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 )
+     $   CALL CLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
+*
+*     Call CHETRD_2STAGE to reduce Hermitian matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDTAU  = 1
+      INDHOUS = INDTAU + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL CHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, RWORK( INDE ),
+     $                    WORK( INDTAU ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call SSTERF.  For eigenvectors, first call
+*     CUNGTR to generate the unitary matrix, then call CSTEQR.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL SSTERF( N, W, RWORK( INDE ), INFO )
+      ELSE
+         CALL CUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
+     $                LLWORK, IINFO )
+         INDWRK = INDE + N
+         CALL CSTEQR( JOBZ, N, W, RWORK( INDE ), A, LDA,
+     $                RWORK( INDWRK ), INFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     Set WORK(1) to optimal complex workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of CHEEV_2STAGE
+*
+      END
diff --git a/SRC/cheevd_2stage.f b/SRC/cheevd_2stage.f
new file mode 100644
index 00000000..9d1057fc
--- /dev/null
+++ b/SRC/cheevd_2stage.f
@@ -0,0 +1,451 @@
+*> \brief <b> CHEEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>
+*
+*  @generated from zheevd_2stage.f, fortran z -> c, Sat Nov  5 23:18:14 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHEEVD_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cheevd_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cheevd_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cheevd_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+*                          RWORK, LRWORK, IWORK, LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, LDA, LIWORK, LRWORK, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IWORK( * )
+*       REAL               RWORK( * ), W( * )
+*       COMPLEX            A( LDA, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHEEVD_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
+*> complex Hermitian matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  If eigenvectors are desired, it uses a
+*> divide and conquer algorithm.
+*>
+*> The divide and conquer algorithm makes very mild assumptions about
+*> floating point arithmetic. It will work on machines with a guard
+*> digit in add/subtract, or on those binary machines without guard
+*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
+*> without guard digits, but we know of none.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA, N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          orthonormal eigenvectors of the matrix A.
+*>          If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+*>          or the upper triangle (if UPLO='U') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          If N <= 1,               LWORK must be at least 1.
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + N+1
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + N+1
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be at least 2*N + N**2
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK, RWORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array,
+*>                                         dimension (LRWORK)
+*>          On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
+*> \endverbatim
+*>
+*> \param[in] LRWORK
+*> \verbatim
+*>          LRWORK is INTEGER
+*>          The dimension of the array RWORK.
+*>          If N <= 1,                LRWORK must be at least 1.
+*>          If JOBZ  = 'N' and N > 1, LRWORK must be at least N.
+*>          If JOBZ  = 'V' and N > 1, LRWORK must be at least
+*>                         1 + 5*N + 2*N**2.
+*>
+*>          If LRWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of the array IWORK.
+*>          If N <= 1,                LIWORK must be at least 1.
+*>          If JOBZ  = 'N' and N > 1, LIWORK must be at least 1.
+*>          If JOBZ  = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i and JOBZ = 'N', then the algorithm failed
+*>                to converge; i off-diagonal elements of an intermediate
+*>                tridiagonal form did not converge to zero;
+*>                if INFO = i and JOBZ = 'V', then the algorithm failed
+*>                to compute an eigenvalue while working on the submatrix
+*>                lying in rows and columns INFO/(N+1) through
+*>                mod(INFO,N+1).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*>  Modified description of INFO. Sven, 16 Feb 05.
+*
+*> \par Contributors:
+*  ==================
+*>
+*> Jeff Rutter, Computer Science Division, University of California
+*> at Berkeley, USA
+*>
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+     $                   RWORK, LRWORK, IWORK, LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, LDA, LIWORK, LRWORK, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IWORK( * )
+      REAL               RWORK( * ), W( * )
+      COMPLEX            A( LDA, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+      COMPLEX            CONE
+      PARAMETER          ( CONE = ( 1.0E0, 0.0E0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, IMAX, INDE, INDRWK, INDTAU, INDWK2,
+     $                   INDWRK, ISCALE, LIWMIN, LLRWK, LLWORK,
+     $                   LLWRK2, LRWMIN, LWMIN,
+     $                   LHTRD, LWTRD, KD, IB, INDHOUS
+
+
+      REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, CLANHE
+      EXTERNAL           LSAME, ILAENV, SLAMCH, CLANHE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SSCAL, SSTERF, XERBLA, CLACPY, CLASCL,
+     $                   CSTEDC, CUNMTR, CHETRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL, MAX, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            LRWMIN = 1
+            LIWMIN = 1
+         ELSE
+            KD    = ILAENV( 17, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+            IB    = ILAENV( 18, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            IF( WANTZ ) THEN
+               LWMIN = 2*N + N*N
+               LRWMIN = 1 + 5*N + 2*N**2
+               LIWMIN = 3 + 5*N
+            ELSE
+               LWMIN = N + 1 + LHTRD + LWTRD
+               LRWMIN = N
+               LIWMIN = 1
+            END IF
+         END IF
+         WORK( 1 )  = LWMIN
+         RWORK( 1 ) = LRWMIN
+         IWORK( 1 ) = LIWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -8
+         ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -10
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -12
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHEEVD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = REAL( A( 1, 1 ) )
+         IF( WANTZ )
+     $      A( 1, 1 ) = CONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = CLANHE( 'M', UPLO, N, A, LDA, RWORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 )
+     $   CALL CLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
+*
+*     Call CHETRD_2STAGE to reduce Hermitian matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDRWK  = INDE + N
+      LLRWK   = LRWORK - INDRWK + 1
+      INDTAU  = 1
+      INDHOUS = INDTAU + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+      INDWK2  = INDWRK + N*N
+      LLWRK2  = LWORK - INDWK2 + 1
+*
+      CALL CHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, RWORK( INDE ),
+     $                    WORK( INDTAU ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call SSTERF.  For eigenvectors, first call
+*     CSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
+*     tridiagonal matrix, then call CUNMTR to multiply it to the
+*     Householder transformations represented as Householder vectors in
+*     A.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL SSTERF( N, W, RWORK( INDE ), INFO )
+      ELSE
+         CALL CSTEDC( 'I', N, W, RWORK( INDE ), WORK( INDWRK ), N,
+     $                WORK( INDWK2 ), LLWRK2, RWORK( INDRWK ), LLRWK,
+     $                IWORK, LIWORK, INFO )
+         CALL CUNMTR( 'L', UPLO, 'N', N, N, A, LDA, WORK( INDTAU ),
+     $                WORK( INDWRK ), N, WORK( INDWK2 ), LLWRK2, IINFO )
+         CALL CLACPY( 'A', N, N, WORK( INDWRK ), N, A, LDA )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+      WORK( 1 )  = LWMIN
+      RWORK( 1 ) = LRWMIN
+      IWORK( 1 ) = LIWMIN
+*
+      RETURN
+*
+*     End of CHEEVD_2STAGE
+*
+      END
diff --git a/SRC/cheevr_2stage.f b/SRC/cheevr_2stage.f
new file mode 100644
index 00000000..23a98389
--- /dev/null
+++ b/SRC/cheevr_2stage.f
@@ -0,0 +1,779 @@
+*> \brief <b> CHEEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>
+*
+*  @generated from zheevr_2stage.f, fortran z -> c, Sat Nov  5 23:18:11 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHEEVR_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cheevr_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cheevr_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cheevr_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+*                                 IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ,
+*                                 WORK, LWORK, RWORK, LRWORK, IWORK,
+*                                 LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
+*      $                   M, N
+*       REAL               ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            ISUPPZ( * ), IWORK( * )
+*       REAL               RWORK( * ), W( * )
+*       COMPLEX            A( LDA, * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHEEVR_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a complex Hermitian matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  Eigenvalues and eigenvectors can
+*> be selected by specifying either a range of values or a range of
+*> indices for the desired eigenvalues.
+*>
+*> CHEEVR_2STAGE first reduces the matrix A to tridiagonal form T with a call
+*> to CHETRD.  Then, whenever possible, CHEEVR_2STAGE calls CSTEMR to compute
+*> eigenspectrum using Relatively Robust Representations.  CSTEMR
+*> computes eigenvalues by the dqds algorithm, while orthogonal
+*> eigenvectors are computed from various "good" L D L^T representations
+*> (also known as Relatively Robust Representations). Gram-Schmidt
+*> orthogonalization is avoided as far as possible. More specifically,
+*> the various steps of the algorithm are as follows.
+*>
+*> For each unreduced block (submatrix) of T,
+*>    (a) Compute T - sigma I  = L D L^T, so that L and D
+*>        define all the wanted eigenvalues to high relative accuracy.
+*>        This means that small relative changes in the entries of D and L
+*>        cause only small relative changes in the eigenvalues and
+*>        eigenvectors. The standard (unfactored) representation of the
+*>        tridiagonal matrix T does not have this property in general.
+*>    (b) Compute the eigenvalues to suitable accuracy.
+*>        If the eigenvectors are desired, the algorithm attains full
+*>        accuracy of the computed eigenvalues only right before
+*>        the corresponding vectors have to be computed, see steps c) and d).
+*>    (c) For each cluster of close eigenvalues, select a new
+*>        shift close to the cluster, find a new factorization, and refine
+*>        the shifted eigenvalues to suitable accuracy.
+*>    (d) For each eigenvalue with a large enough relative separation compute
+*>        the corresponding eigenvector by forming a rank revealing twisted
+*>        factorization. Go back to (c) for any clusters that remain.
+*>
+*> The desired accuracy of the output can be specified by the input
+*> parameter ABSTOL.
+*>
+*> For more details, see DSTEMR's documentation and:
+*> - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
+*>   to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
+*>   Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+*> - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
+*>   Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
+*>   2004.  Also LAPACK Working Note 154.
+*> - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+*>   tridiagonal eigenvalue/eigenvector problem",
+*>   Computer Science Division Technical Report No. UCB/CSD-97-971,
+*>   UC Berkeley, May 1997.
+*>
+*>
+*> Note 1 : CHEEVR_2STAGE calls CSTEMR when the full spectrum is requested
+*> on machines which conform to the ieee-754 floating point standard.
+*> CHEEVR_2STAGE calls SSTEBZ and CSTEIN on non-ieee machines and
+*> when partial spectrum requests are made.
+*>
+*> Normal execution of CSTEMR may create NaNs and infinities and
+*> hence may abort due to a floating point exception in environments
+*> which do not handle NaNs and infinities in the ieee standard default
+*> manner.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found.
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found.
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*>          For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and
+*>          CSTEIN are called
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA, N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, the lower triangle (if UPLO='L') or the upper
+*>          triangle (if UPLO='U') of A, including the diagonal, is
+*>          destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is REAL
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is REAL
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is REAL
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing A to tridiagonal form.
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*>
+*>          If high relative accuracy is important, set ABSTOL to
+*>          SLAMCH( 'Safe minimum' ).  Doing so will guarantee that
+*>          eigenvalues are computed to high relative accuracy when
+*>          possible in future releases.  The current code does not
+*>          make any guarantees about high relative accuracy, but
+*>          furutre releases will. See J. Barlow and J. Demmel,
+*>          "Computing Accurate Eigensystems of Scaled Diagonally
+*>          Dominant Matrices", LAPACK Working Note #7, for a discussion
+*>          of which matrices define their eigenvalues to high relative
+*>          accuracy.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          The first M elements contain the selected eigenvalues in
+*>          ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] ISUPPZ
+*> \verbatim
+*>          ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
+*>          The support of the eigenvectors in Z, i.e., the indices
+*>          indicating the nonzero elements in Z. The i-th eigenvector
+*>          is nonzero only in elements ISUPPZ( 2*i-1 ) through
+*>          ISUPPZ( 2*i ). This is an output of CSTEMR (tridiagonal
+*>          matrix). The support of the eigenvectors of A is typically 
+*>          1:N because of the unitary transformations applied by CUNMTR.
+*>          Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, 26*N, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK, RWORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (MAX(1,LRWORK))
+*>          On exit, if INFO = 0, RWORK(1) returns the optimal
+*>          (and minimal) LRWORK.
+*> \endverbatim
+*>
+*> \param[in] LRWORK
+*> \verbatim
+*>          LRWORK is INTEGER
+*>          The length of the array RWORK.  LRWORK >= max(1,24*N).
+*>
+*>          If LRWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal
+*>          (and minimal) LIWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of the array IWORK.  LIWORK >= max(1,10*N).
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  Internal error
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup complexHEeigen
+*
+*> \par Contributors:
+*  ==================
+*>
+*>     Inderjit Dhillon, IBM Almaden, USA \n
+*>     Osni Marques, LBNL/NERSC, USA \n
+*>     Ken Stanley, Computer Science Division, University of
+*>       California at Berkeley, USA \n
+*>     Jason Riedy, Computer Science Division, University of
+*>       California at Berkeley, USA \n
+*>
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+     $                          IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ,
+     $                          WORK, LWORK, RWORK, LRWORK, IWORK,
+     $                          LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
+     $                   M, N
+      REAL               ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            ISUPPZ( * ), IWORK( * )
+      REAL               RWORK( * ), W( * )
+      COMPLEX            A( LDA, * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE, TWO
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
+     $                   WANTZ, TRYRAC
+      CHARACTER          ORDER
+      INTEGER            I, IEEEOK, IINFO, IMAX, INDIBL, INDIFL, INDISP,
+     $                   INDIWO, INDRD, INDRDD, INDRE, INDREE, INDRWK,
+     $                   INDTAU, INDWK, INDWKN, ISCALE, ITMP1, J, JJ,
+     $                   LIWMIN, LLWORK, LLRWORK, LLWRKN, LRWMIN,
+     $                   LWMIN, NSPLIT, LHTRD, LWTRD, KD, IB, INDHOUS
+      REAL               ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, CLANSY
+      EXTERNAL           LSAME, ILAENV, SLAMCH, CLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL,
+     $                   CHETRD_2STAGE, CSTEMR, CSTEIN, CSWAP, CUNMTR
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      IEEEOK = ILAENV( 10, 'CHEEVR', 'N', 1, 2, 3, 4 )
+*
+      LOWER = LSAME( UPLO, 'L' )
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+*
+      LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR.
+     $         ( LIWORK.EQ.-1 ) )
+*
+      KD     = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+      IB     = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+      LHTRD  = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+      LWTRD  = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+      LWMIN  = N + LHTRD + LWTRD
+      LRWMIN = MAX( 1, 24*N )
+      LIWMIN = MAX( 1, 10*N )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -8
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -9
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -10
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+            INFO = -15
+         END IF
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         WORK( 1 )  = LWMIN
+         RWORK( 1 ) = LRWMIN
+         IWORK( 1 ) = LIWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -18
+         ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -20
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -22
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHEEVR_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         WORK( 1 ) = 2
+         IF( ALLEIG .OR. INDEIG ) THEN
+            M = 1
+            W( 1 ) = REAL( A( 1, 1 ) )
+         ELSE
+            IF( VL.LT.REAL( A( 1, 1 ) ) .AND. VU.GE.REAL( A( 1, 1 ) ) )
+     $           THEN
+               M = 1
+               W( 1 ) = REAL( A( 1, 1 ) )
+            END IF
+         END IF
+         IF( WANTZ ) THEN
+            Z( 1, 1 ) = ONE
+            ISUPPZ( 1 ) = 1
+            ISUPPZ( 2 ) = 1
+         END IF
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF (VALEIG) THEN
+         VLL = VL
+         VUU = VU
+      END IF
+      ANRM = CLANSY( 'M', UPLO, N, A, LDA, RWORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            DO 10 J = 1, N
+               CALL CSSCAL( N-J+1, SIGMA, A( J, J ), 1 )
+   10       CONTINUE
+         ELSE
+            DO 20 J = 1, N
+               CALL CSSCAL( J, SIGMA, A( 1, J ), 1 )
+   20       CONTINUE
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+
+*     Initialize indices into workspaces.  Note: The IWORK indices are
+*     used only if SSTERF or CSTEMR fail.
+
+*     WORK(INDTAU:INDTAU+N-1) stores the complex scalar factors of the
+*     elementary reflectors used in CHETRD.
+      INDTAU = 1
+*     INDWK is the starting offset of the remaining complex workspace,
+*     and LLWORK is the remaining complex workspace size.
+      INDHOUS = INDTAU + N
+      INDWK   = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWK + 1
+
+*     RWORK(INDRD:INDRD+N-1) stores the real tridiagonal's diagonal
+*     entries.
+      INDRD = 1
+*     RWORK(INDRE:INDRE+N-1) stores the off-diagonal entries of the
+*     tridiagonal matrix from CHETRD.
+      INDRE = INDRD + N
+*     RWORK(INDRDD:INDRDD+N-1) is a copy of the diagonal entries over
+*     -written by CSTEMR (the SSTERF path copies the diagonal to W).
+      INDRDD = INDRE + N
+*     RWORK(INDREE:INDREE+N-1) is a copy of the off-diagonal entries over
+*     -written while computing the eigenvalues in SSTERF and CSTEMR.
+      INDREE = INDRDD + N
+*     INDRWK is the starting offset of the left-over real workspace, and
+*     LLRWORK is the remaining workspace size.
+      INDRWK = INDREE + N
+      LLRWORK = LRWORK - INDRWK + 1
+
+*     IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in SSTEBZ and
+*     stores the block indices of each of the M<=N eigenvalues.
+      INDIBL = 1
+*     IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in SSTEBZ and
+*     stores the starting and finishing indices of each block.
+      INDISP = INDIBL + N
+*     IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
+*     that corresponding to eigenvectors that fail to converge in
+*     CSTEIN.  This information is discarded; if any fail, the driver
+*     returns INFO > 0.
+      INDIFL = INDISP + N
+*     INDIWO is the offset of the remaining integer workspace.
+      INDIWO = INDIFL + N
+
+*
+*     Call CHETRD_2STAGE to reduce Hermitian matrix to tridiagonal form.
+*
+      CALL CHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, RWORK( INDRD ), 
+     $                    RWORK( INDRE ), WORK( INDTAU ),
+     $                    WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWK ), LLWORK, IINFO )
+*
+*     If all eigenvalues are desired
+*     then call SSTERF or CSTEMR and CUNMTR.
+*
+      TEST = .FALSE.
+      IF( INDEIG ) THEN
+         IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN
+         IF( .NOT.WANTZ ) THEN
+            CALL SCOPY( N, RWORK( INDRD ), 1, W, 1 )
+            CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
+            CALL SSTERF( N, W, RWORK( INDREE ), INFO )
+         ELSE
+            CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
+            CALL SCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 )
+*
+            IF (ABSTOL .LE. TWO*N*EPS) THEN
+               TRYRAC = .TRUE.
+            ELSE
+               TRYRAC = .FALSE.
+            END IF
+            CALL CSTEMR( JOBZ, 'A', N, RWORK( INDRDD ),
+     $                   RWORK( INDREE ), VL, VU, IL, IU, M, W,
+     $                   Z, LDZ, N, ISUPPZ, TRYRAC,
+     $                   RWORK( INDRWK ), LLRWORK,
+     $                   IWORK, LIWORK, INFO )
+*
+*           Apply unitary matrix used in reduction to tridiagonal
+*           form to eigenvectors returned by CSTEMR.
+*
+            IF( WANTZ .AND. INFO.EQ.0 ) THEN
+               INDWKN = INDWK
+               LLWRKN = LWORK - INDWKN + 1
+               CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA,
+     $                      WORK( INDTAU ), Z, LDZ, WORK( INDWKN ),
+     $                      LLWRKN, IINFO )
+            END IF
+         END IF
+*
+*
+         IF( INFO.EQ.0 ) THEN
+            M = N
+            GO TO 30
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call SSTEBZ and, if eigenvectors are desired, CSTEIN.
+*     Also call SSTEBZ and CSTEIN if CSTEMR fails.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+
+      CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             RWORK( INDRD ), RWORK( INDRE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
+     $             IWORK( INDIWO ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL CSTEIN( N, RWORK( INDRD ), RWORK( INDRE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                RWORK( INDRWK ), IWORK( INDIWO ), IWORK( INDIFL ),
+     $                INFO )
+*
+*        Apply unitary matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by CSTEIN.
+*
+         INDWKN = INDWK
+         LLWRKN = LWORK - INDWKN + 1
+         CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
+     $                LDZ, WORK( INDWKN ), LLWRKN, IINFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+   30 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.
+*
+      IF( WANTZ ) THEN
+         DO 50 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 40 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   40       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               ITMP1 = IWORK( INDIBL+I-1 )
+               W( I ) = W( J )
+               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
+               W( J ) = TMP1
+               IWORK( INDIBL+J-1 ) = ITMP1
+               CALL CSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+            END IF
+   50    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 )  = LWMIN
+      RWORK( 1 ) = LRWMIN
+      IWORK( 1 ) = LIWMIN
+*
+      RETURN
+*
+*     End of CHEEVR_2STAGE
+*
+      END
diff --git a/SRC/cheevx_2stage.f b/SRC/cheevx_2stage.f
new file mode 100644
index 00000000..84ae438d
--- /dev/null
+++ b/SRC/cheevx_2stage.f
@@ -0,0 +1,618 @@
+*> \brief <b> CHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>
+*
+*  @generated from zheevx_2stage.f, fortran z -> c, Sat Nov  5 23:18:09 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHEEVX_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cheevx_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cheevx_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cheevx_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHEEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+*                                 IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
+*                                 LWORK, RWORK, IWORK, IFAIL, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, LDA, LDZ, LWORK, M, N
+*       REAL               ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IFAIL( * ), IWORK( * )
+*       REAL               RWORK( * ), W( * )
+*       COMPLEX            A( LDA, * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHEEVX_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a complex Hermitian matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  Eigenvalues and eigenvectors can
+*> be selected by specifying either a range of values or a range of
+*> indices for the desired eigenvalues.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found.
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found.
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA, N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, the lower triangle (if UPLO='L') or the upper
+*>          triangle (if UPLO='U') of A, including the diagonal, is
+*>          destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is REAL
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is REAL
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is REAL
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing A to tridiagonal form.
+*>
+*>          Eigenvalues will be computed most accurately when ABSTOL is
+*>          set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+*>          If this routine returns with INFO>0, indicating that some
+*>          eigenvectors did not converge, try setting ABSTOL to
+*>          2*SLAMCH('S').
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          On normal exit, the first M elements contain the selected
+*>          eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If an eigenvector fails to converge, then that column of Z
+*>          contains the latest approximation to the eigenvector, and the
+*>          index of the eigenvector is returned in IFAIL.
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, 8*N, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (7*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (5*N)
+*> \endverbatim
+*>
+*> \param[out] IFAIL
+*> \verbatim
+*>          IFAIL is INTEGER array, dimension (N)
+*>          If JOBZ = 'V', then if INFO = 0, the first M elements of
+*>          IFAIL are zero.  If INFO > 0, then IFAIL contains the
+*>          indices of the eigenvectors that failed to converge.
+*>          If JOBZ = 'N', then IFAIL is not referenced.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, then i eigenvectors failed to converge.
+*>                Their indices are stored in array IFAIL.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup complexHEeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHEEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+     $                          IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
+     $                          LWORK, RWORK, IWORK, IFAIL, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, LDA, LDZ, LWORK, M, N
+      REAL               ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IFAIL( * ), IWORK( * )
+      REAL               RWORK( * ), W( * )
+      COMPLEX            A( LDA, * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      COMPLEX            CONE
+      PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
+     $                   WANTZ
+      CHARACTER          ORDER
+      INTEGER            I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
+     $                   INDISP, INDIWK, INDRWK, INDTAU, INDWRK, ISCALE,
+     $                   ITMP1, J, JJ, LLWORK, 
+     $                   NSPLIT, LWMIN, LHTRD, LWTRD, KD, IB, INDHOUS
+      REAL               ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, CLANHE
+      EXTERNAL           LSAME, ILAENV, SLAMCH, CLANHE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL,
+     $                   CLACPY, CSTEIN, CSTEQR, CSWAP, CUNGTR, CUNMTR,
+     $                   CHETRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      LOWER = LSAME( UPLO, 'L' )
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -8
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -9
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -10
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+            INFO = -15
+         END IF
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            KD    = ILAENV( 17, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+            IB    = ILAENV( 18, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWMIN = N + LHTRD + LWTRD
+            WORK( 1 )  = LWMIN
+         END IF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -17
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHEEVX_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 ) THEN
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         IF( ALLEIG .OR. INDEIG ) THEN
+            M = 1
+            W( 1 ) = REAL( A( 1, 1 ) )
+         ELSE IF( VALEIG ) THEN
+            IF( VL.LT.REAL( A( 1, 1 ) ) .AND. VU.GE.REAL( A( 1, 1 ) ) )
+     $           THEN
+               M = 1
+               W( 1 ) = REAL( A( 1, 1 ) )
+            END IF
+         END IF
+         IF( WANTZ )
+     $      Z( 1, 1 ) = CONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF( VALEIG ) THEN
+         VLL = VL
+         VUU = VU
+      END IF
+      ANRM = CLANHE( 'M', UPLO, N, A, LDA, RWORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            DO 10 J = 1, N
+               CALL CSSCAL( N-J+1, SIGMA, A( J, J ), 1 )
+   10       CONTINUE
+         ELSE
+            DO 20 J = 1, N
+               CALL CSSCAL( J, SIGMA, A( 1, J ), 1 )
+   20       CONTINUE
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+*
+*     Call CHETRD_2STAGE to reduce Hermitian matrix to tridiagonal form.
+*
+      INDD    = 1
+      INDE    = INDD + N
+      INDRWK  = INDE + N
+      INDTAU  = 1
+      INDHOUS = INDTAU + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL CHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, RWORK( INDD ),
+     $                    RWORK( INDE ), WORK( INDTAU ), 
+     $                    WORK( INDHOUS ), LHTRD, WORK( INDWRK ),
+     $                    LLWORK, IINFO )
+*
+*     If all eigenvalues are desired and ABSTOL is less than or equal to
+*     zero, then call SSTERF or CUNGTR and CSTEQR.  If this fails for
+*     some eigenvalue, then try SSTEBZ.
+*
+      TEST = .FALSE.
+      IF( INDEIG ) THEN
+         IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF( ( ALLEIG .OR. TEST ) .AND. ( ABSTOL.LE.ZERO ) ) THEN
+         CALL SCOPY( N, RWORK( INDD ), 1, W, 1 )
+         INDEE = INDRWK + 2*N
+         IF( .NOT.WANTZ ) THEN
+            CALL SCOPY( N-1, RWORK( INDE ), 1, RWORK( INDEE ), 1 )
+            CALL SSTERF( N, W, RWORK( INDEE ), INFO )
+         ELSE
+            CALL CLACPY( 'A', N, N, A, LDA, Z, LDZ )
+            CALL CUNGTR( UPLO, N, Z, LDZ, WORK( INDTAU ),
+     $                   WORK( INDWRK ), LLWORK, IINFO )
+            CALL SCOPY( N-1, RWORK( INDE ), 1, RWORK( INDEE ), 1 )
+            CALL CSTEQR( JOBZ, N, W, RWORK( INDEE ), Z, LDZ,
+     $                   RWORK( INDRWK ), INFO )
+            IF( INFO.EQ.0 ) THEN
+               DO 30 I = 1, N
+                  IFAIL( I ) = 0
+   30          CONTINUE
+            END IF
+         END IF
+         IF( INFO.EQ.0 ) THEN
+            M = N
+            GO TO 40
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call SSTEBZ and, if eigenvectors are desired, CSTEIN.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+      INDIBL = 1
+      INDISP = INDIBL + N
+      INDIWK = INDISP + N
+      CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
+     $             IWORK( INDIWK ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
+*
+*        Apply unitary matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by CSTEIN.
+*
+         CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
+     $                LDZ, WORK( INDWRK ), LLWORK, IINFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+   40 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.
+*
+      IF( WANTZ ) THEN
+         DO 60 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 50 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   50       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               ITMP1 = IWORK( INDIBL+I-1 )
+               W( I ) = W( J )
+               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
+               W( J ) = TMP1
+               IWORK( INDIBL+J-1 ) = ITMP1
+               CALL CSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+               IF( INFO.NE.0 ) THEN
+                  ITMP1 = IFAIL( I )
+                  IFAIL( I ) = IFAIL( J )
+                  IFAIL( J ) = ITMP1
+               END IF
+            END IF
+   60    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal complex workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of CHEEVX_2STAGE
+*
+      END
diff --git a/SRC/chegv_2stage.f b/SRC/chegv_2stage.f
new file mode 100644
index 00000000..71d58d74
--- /dev/null
+++ b/SRC/chegv_2stage.f
@@ -0,0 +1,379 @@
+*> \brief \b CHEGV_2STAGE
+*
+*  @generated from zhegv_2stage.f, fortran z -> c, Sun Nov  6 13:09:52 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHEGV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chegv_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chegv_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chegv_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W,
+*                                WORK, LWORK, RWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, ITYPE, LDA, LDB, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               RWORK( * ), W( * )
+*       COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHEGV_2STAGE computes all the eigenvalues, and optionally, the eigenvectors
+*> of a complex generalized Hermitian-definite eigenproblem, of the form
+*> A*x=(lambda)*B*x,  A*Bx=(lambda)*x,  or B*A*x=(lambda)*x.
+*> Here A and B are assumed to be Hermitian and B is also
+*> positive definite.
+*> This routine use the 2stage technique for the reduction to tridiagonal
+*> which showed higher performance on recent architecture and for large
+*  sizes N>2000.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] ITYPE
+*> \verbatim
+*>          ITYPE is INTEGER
+*>          Specifies the problem type to be solved:
+*>          = 1:  A*x = (lambda)*B*x
+*>          = 2:  A*B*x = (lambda)*x
+*>          = 3:  B*A*x = (lambda)*x
+*> \endverbatim
+*>
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangles of A and B are stored;
+*>          = 'L':  Lower triangles of A and B are stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrices A and B.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA, N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          matrix Z of eigenvectors.  The eigenvectors are normalized
+*>          as follows:
+*>          if ITYPE = 1 or 2, Z**H*B*Z = I;
+*>          if ITYPE = 3, Z**H*inv(B)*Z = I.
+*>          If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+*>          or the lower triangle (if UPLO='L') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (LDB, N)
+*>          On entry, the Hermitian positive definite matrix B.
+*>          If UPLO = 'U', the leading N-by-N upper triangular part of B
+*>          contains the upper triangular part of the matrix B.
+*>          If UPLO = 'L', the leading N-by-N lower triangular part of B
+*>          contains the lower triangular part of the matrix B.
+*>
+*>          On exit, if INFO <= N, the part of B containing the matrix is
+*>          overwritten by the triangular factor U or L from the Cholesky
+*>          factorization B = U**H*U or B = L*L**H.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (max(1, 3*N-2))
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  CPOTRF or CHEEV returned an error code:
+*>             <= N:  if INFO = i, CHEEV failed to converge;
+*>                    i off-diagonal elements of an intermediate
+*>                    tridiagonal form did not converge to zero;
+*>             > N:   if INFO = N + i, for 1 <= i <= N, then the leading
+*>                    minor of order i of B is not positive definite.
+*>                    The factorization of B could not be completed and
+*>                    no eigenvalues or eigenvectors were computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W,
+     $                         WORK, LWORK, RWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, ITYPE, LDA, LDB, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      REAL               RWORK( * ), W( * )
+      COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX            ONE
+      PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER, WANTZ
+      CHARACTER          TRANS
+      INTEGER            NEIG, LWMIN, LHTRD, LWTRD, KD, IB
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, CHEGST, CPOTRF, CTRMM, CTRSM,
+     $                   CHEEV_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         KD    = ILAENV( 17, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+         IB    = ILAENV( 18, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWMIN = N + LHTRD + LWTRD
+         WORK( 1 )  = LWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -11
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHEGV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Form a Cholesky factorization of B.
+*
+      CALL CPOTRF( UPLO, N, B, LDB, INFO )
+      IF( INFO.NE.0 ) THEN
+         INFO = N + INFO
+         RETURN
+      END IF
+*
+*     Transform problem to standard eigenvalue problem and solve.
+*
+      CALL CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
+      CALL CHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, 
+     $                   WORK, LWORK, RWORK, INFO )
+*
+      IF( WANTZ ) THEN
+*
+*        Backtransform eigenvectors to the original problem.
+*
+         NEIG = N
+         IF( INFO.GT.0 )
+     $      NEIG = INFO - 1
+         IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
+*
+*           For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
+*           backtransform eigenvectors: x = inv(L)**H *y or inv(U)*y
+*
+            IF( UPPER ) THEN
+               TRANS = 'N'
+            ELSE
+               TRANS = 'C'
+            END IF
+*
+            CALL CTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
+     $                  B, LDB, A, LDA )
+*
+         ELSE IF( ITYPE.EQ.3 ) THEN
+*
+*           For B*A*x=(lambda)*x;
+*           backtransform eigenvectors: x = L*y or U**H *y
+*
+            IF( UPPER ) THEN
+               TRANS = 'C'
+            ELSE
+               TRANS = 'N'
+            END IF
+*
+            CALL CTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
+     $                  B, LDB, A, LDA )
+         END IF
+      END IF
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of CHEGV_2STAGE
+*
+      END
diff --git a/SRC/chesv_aa.f b/SRC/chesv_aa.f
index aae45e60..642c9932 100644
--- a/SRC/chesv_aa.f
+++ b/SRC/chesv_aa.f
@@ -19,7 +19,7 @@
 *  ===========
 *
 *       SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-*                               LWORK, INFO )
+*                            LWORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
@@ -27,7 +27,7 @@
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * )
-*       COMPLEX         A( LDA, * ), B( LDB, * ), WORK( * )
+*       COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
 *       ..
 *
 *
@@ -126,9 +126,9 @@
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
-*>          The length of WORK.  LWORK >= 1, and for best performance
-*>          LWORK >= max(1,N*NB), where NB is the optimal blocksize for
-*>          CHETRF.
+*>          The length of WORK.  LWORK >= MAX(1,2*N,3*N-2), and for best 
+*>          performance LWORK >= MAX(1,N*NB), where NB is the optimal
+*>          blocksize for CHETRF.
 *>          for LWORK < N, TRS will be done with Level BLAS 2
 *>          for LWORK >= N, TRS will be done with Level BLAS 3
 *>
@@ -162,7 +162,7 @@
 *
 *  =====================================================================
       SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-     $                        LWORK, INFO )
+     $                     LWORK, INFO )
 *
 *  -- LAPACK driver routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -175,7 +175,7 @@
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * )
-      COMPLEX         A( LDA, * ), B( LDB, * ), WORK( * )
+      COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
 *     ..
 *
 *  =====================================================================
diff --git a/SRC/chesv_rk.f b/SRC/chesv_rk.f
new file mode 100644
index 00000000..ac02082e
--- /dev/null
+++ b/SRC/chesv_rk.f
@@ -0,0 +1,316 @@
+*> \brief <b> CHESV_RK computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHESV_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chesv_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chesv_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chesv_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            WORK, LWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CHESV_RK computes the solution to a complex system of linear
+*> equations A * X = B, where A is an N-by-N Hermitian matrix
+*> and X and B are N-by-NRHS matrices.
+*>
+*> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used
+*> to factor A as
+*>    A = P*U*D*(U**H)*(P**T),  if UPLO = 'U', or
+*>    A = P*L*D*(L**H)*(P**T),  if UPLO = 'L',
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> CHETRF_RK is called to compute the factorization of a complex
+*> Hermitian matrix.  The factored form of A is then used to solve
+*> the system of equations A * X = B by calling BLAS3 routine CHETRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix A is stored:
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of linear equations, i.e., the order of the
+*>          matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, if INFO = 0, diagonal of the block diagonal
+*>          matrix D and factors U or L  as computed by CHETRF_RK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          For more info see the description of CHETRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On exit, contains the output computed by the factorization
+*>          routine CHETRF_RK, i.e. the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*>
+*>          For more info see the description of CHETRF_RK routine.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D,
+*>          as determined by CHETRF_RK.
+*>
+*>          For more info see the description of CHETRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (LDB,NRHS)
+*>          On entry, the N-by-NRHS right hand side matrix B.
+*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension ( MAX(1,LWORK) ).
+*>          Work array used in the factorization stage.
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >= 1. For best performance
+*>          of factorization stage LWORK >= max(1,N*NB), where NB is
+*>          the optimal blocksize for CHETRF_RK.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array for factorization stage, returns this value as
+*>          the first entry of the WORK array, and no error message
+*>          related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEsolve
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK,
+     $                     LWORK, INFO )
+*
+*  -- LAPACK driver routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            LWKOPT
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, CHETRF_RK, CHETRS_3
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -11
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.EQ.0 ) THEN
+            LWKOPT = 1
+         ELSE
+            CALL CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
+            LWKOPT = WORK(1)
+         END IF
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHESV_RK ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Compute the factorization A = U*D*U**T or A = L*D*L**T.
+*
+      CALL CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO )
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Solve the system A*X = B with BLAS3 solver, overwriting B with X.
+*
+         CALL CHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO )
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of CHESV_RK
+*
+      END
diff --git a/SRC/chetf2_rk.f b/SRC/chetf2_rk.f
new file mode 100644
index 00000000..18afea06
--- /dev/null
+++ b/SRC/chetf2_rk.f
@@ -0,0 +1,1039 @@
+*> \brief \b CHETF2_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHETF2_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetf2_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetf2_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetf2_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), E ( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CHETF2_RK computes the factorization of a complex Hermitian matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the Hermitian block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put further details
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*>  01-01-96 - Based on modifications by
+*>    J. Lewis, Boeing Computer Services Company
+*>    A. Petitet, Computer Science Dept.,
+*>                Univ. of Tenn., Knoxville abd , USA
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * )
+*     ..
+*
+*  ======================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      REAL               EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
+      COMPLEX            CZERO
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            DONE, UPPER
+      INTEGER            I, II, IMAX, ITEMP, J, JMAX, K, KK, KP, KSTEP,
+     $                   P
+      REAL               ABSAKK, ALPHA, COLMAX, D, D11, D22, R1, STEMP,
+     $                   ROWMAX, TT, SFMIN
+      COMPLEX            D12, D21, T, WK, WKM1, WKP1, Z
+*     ..
+*     .. External Functions ..
+*
+      LOGICAL            LSAME
+      INTEGER            ICAMAX
+      REAL               SLAMCH, SLAPY2
+      EXTERNAL           LSAME, ICAMAX, SLAMCH, SLAPY2
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, CSSCAL, CHER, CSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, AIMAG, CMPLX, CONJG, MAX, REAL, SQRT
+*     ..
+*     .. Statement Functions ..
+      REAL               CABS1
+*     ..
+*     .. Statement Function definitions ..
+      CABS1( Z ) = ABS( REAL( Z ) ) + ABS( AIMAG( Z ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHETF2_RK', -INFO )
+         RETURN
+      END IF
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = SLAMCH( 'S' )
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**H using the upper triangle of A
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = CZERO
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 34
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( REAL( A( K, K ) ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = ICAMAX( K-1, A( 1, K ), 1 )
+            COLMAX = CABS1( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( ( MAX( ABSAKK, COLMAX ).EQ.ZERO ) ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            A( K, K ) = REAL( A( K, K ) )
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           BEGIN pivot search
+*
+*           Case(1)
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   12          CONTINUE
+*
+*                 BEGIN pivot search loop body
+*
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + ICAMAX( K-IMAX, A( IMAX, IMAX+1 ),
+     $                                     LDA )
+                     ROWMAX = CABS1( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = ICAMAX( IMAX-1, A( 1, IMAX ), 1 )
+                     STEMP = CABS1( A( ITEMP, IMAX ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Case(2)
+*                 Equivalent to testing for
+*                 ABS( REAL( W( IMAX,KW-1 ) ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( ABS( REAL( A( IMAX, IMAX ) ) )
+     $                       .LT.ALPHA*ROWMAX ) ) THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Case(3)
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K-1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+*
+*                 Case(4)
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*                 END pivot search loop body
+*
+               IF( .NOT.DONE ) GOTO 12
+*
+            END IF
+*
+*           END pivot search
+*
+*           ============================================================
+*
+*           KK is the column of A where pivoting step stopped
+*
+            KK = K - KSTEP + 1
+*
+*           For only a 2x2 pivot, interchange rows and columns K and P
+*           in the leading submatrix A(1:k,1:k)
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*              (1) Swap columnar parts
+               IF( P.GT.1 )
+     $            CALL CSWAP( P-1, A( 1, K ), 1, A( 1, P ), 1 )
+*              (2) Swap and conjugate middle parts
+               DO 14 J = P + 1, K - 1
+                  T = CONJG( A( J, K ) )
+                  A( J, K ) = CONJG( A( P, J ) )
+                  A( P, J ) = T
+   14          CONTINUE
+*              (3) Swap and conjugate corner elements at row-col interserction
+               A( P, K ) = CONJG( A( P, K ) )
+*              (4) Swap diagonal elements at row-col intersection
+               R1 = REAL( A( K, K ) )
+               A( K, K ) = REAL( A( P, P ) )
+               A( P, P ) = R1
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL CSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA )
+*
+            END IF
+*
+*           For both 1x1 and 2x2 pivots, interchange rows and
+*           columns KK and KP in the leading submatrix A(1:k,1:k)
+*
+            IF( KP.NE.KK ) THEN
+*              (1) Swap columnar parts
+               IF( KP.GT.1 )
+     $            CALL CSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 )
+*              (2) Swap and conjugate middle parts
+               DO 15 J = KP + 1, KK - 1
+                  T = CONJG( A( J, KK ) )
+                  A( J, KK ) = CONJG( A( KP, J ) )
+                  A( KP, J ) = T
+   15          CONTINUE
+*              (3) Swap and conjugate corner elements at row-col interserction
+               A( KP, KK ) = CONJG( A( KP, KK ) )
+*              (4) Swap diagonal elements at row-col intersection
+               R1 = REAL( A( KK, KK ) )
+               A( KK, KK ) = REAL( A( KP, KP ) )
+               A( KP, KP ) = R1
+*
+               IF( KSTEP.EQ.2 ) THEN
+*                 (*) Make sure that diagonal element of pivot is real
+                  A( K, K ) = REAL( A( K, K ) )
+*                 (5) Swap row elements
+                  T = A( K-1, K )
+                  A( K-1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL CSWAP( N-K, A( KK, K+1 ), LDA, A( KP, K+1 ),
+     $                        LDA )
+*
+            ELSE
+*              (*) Make sure that diagonal element of pivot is real
+               A( K, K ) = REAL( A( K, K ) )
+               IF( KSTEP.EQ.2 )
+     $            A( K-1, K-1 ) = REAL( A( K-1, K-1 ) )
+            END IF
+*
+*           Update the leading submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k now holds
+*
+*              W(k) = U(k)*D(k)
+*
+*              where U(k) is the k-th column of U
+*
+               IF( K.GT.1 ) THEN
+*
+*                 Perform a rank-1 update of A(1:k-1,1:k-1) and
+*                 store U(k) in column k
+*
+                  IF( ABS( REAL( A( K, K ) ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(1:k-1,1:k-1) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*1/D(k)*W(k)**T
+*
+                     D11 = ONE / REAL( A( K, K ) )
+                     CALL CHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+*
+*                    Store U(k) in column k
+*
+                     CALL CSSCAL( K-1, D11, A( 1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column K
+*
+                     D11 = REAL( A( K, K ) )
+                     DO 16 II = 1, K - 1
+                        A( II, K ) = A( II, K ) / D11
+   16                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL CHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+                  END IF
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k-1 now hold
+*
+*              ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+*              Perform a rank-2 update of A(1:k-2,1:k-2) as
+*
+*              A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )**T
+*                 = A - ( ( A(k-1)A(k) )*inv(D(k)) ) * ( A(k-1)A(k) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.GT.2 ) THEN
+*                 D = |A12|
+                  D = SLAPY2( REAL( A( K-1, K ) ),
+     $                AIMAG( A( K-1, K ) ) )
+                  D11 = A( K, K ) / D
+                  D22 = A( K-1, K-1 ) / D
+                  D12 = A( K-1, K ) / D
+                  TT = ONE / ( D11*D22-ONE )
+*
+                  DO 30 J = K - 2, 1, -1
+*
+*                    Compute  D21 * ( W(k)W(k+1) ) * inv(D(k)) for row J
+*
+                     WKM1 = TT*( D11*A( J, K-1 )-CONJG( D12 )*
+     $                      A( J, K ) )
+                     WK = TT*( D22*A( J, K )-D12*A( J, K-1 ) )
+*
+*                    Perform a rank-2 update of A(1:k-2,1:k-2)
+*
+                     DO 20 I = J, 1, -1
+                        A( I, J ) = A( I, J ) -
+     $                              ( A( I, K ) / D )*CONJG( WK ) -
+     $                              ( A( I, K-1 ) / D )*CONJG( WKM1 )
+   20                CONTINUE
+*
+*                    Store U(k) and U(k-1) in cols k and k-1 for row J
+*
+                     A( J, K ) = WK / D
+                     A( J, K-1 ) = WKM1 / D
+*                    (*) Make sure that diagonal element of pivot is real
+                     A( J, J ) = CMPLX( REAL( A( J, J ) ), ZERO )
+*
+   30             CONTINUE
+*
+               END IF
+*
+*              Copy superdiagonal elements of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               E( K ) = A( K-1, K )
+               E( K-1 ) = CZERO
+               A( K-1, K ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   34    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**H using the lower triangle of A
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = CZERO
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        1 or 2
+*
+         K = 1
+   40    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 64
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( REAL( A( K, K ) ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + ICAMAX( N-K, A( K+1, K ), 1 )
+            COLMAX = CABS1( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            A( K, K ) = REAL( A( K, K ) )
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           BEGIN pivot search
+*
+*           Case(1)
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   42          CONTINUE
+*
+*                 BEGIN pivot search loop body
+*
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), LDA )
+                     ROWMAX = CABS1( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + ICAMAX( N-IMAX, A( IMAX+1, IMAX ),
+     $                                     1 )
+                     STEMP = CABS1( A( ITEMP, IMAX ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Case(2)
+*                 Equivalent to testing for
+*                 ABS( REAL( W( IMAX,KW-1 ) ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( ABS( REAL( A( IMAX, IMAX ) ) )
+     $                       .LT.ALPHA*ROWMAX ) ) THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Case(3)
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+*
+*                 Case(4)
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*
+*                 END pivot search loop body
+*
+               IF( .NOT.DONE ) GOTO 42
+*
+            END IF
+*
+*           END pivot search
+*
+*           ============================================================
+*
+*           KK is the column of A where pivoting step stopped
+*
+            KK = K + KSTEP - 1
+*
+*           For only a 2x2 pivot, interchange rows and columns K and P
+*           in the trailing submatrix A(k:n,k:n)
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*              (1) Swap columnar parts
+               IF( P.LT.N )
+     $            CALL CSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 )
+*              (2) Swap and conjugate middle parts
+               DO 44 J = K + 1, P - 1
+                  T = CONJG( A( J, K ) )
+                  A( J, K ) = CONJG( A( P, J ) )
+                  A( P, J ) = T
+   44          CONTINUE
+*              (3) Swap and conjugate corner elements at row-col interserction
+               A( P, K ) = CONJG( A( P, K ) )
+*              (4) Swap diagonal elements at row-col intersection
+               R1 = REAL( A( K, K ) )
+               A( K, K ) = REAL( A( P, P ) )
+               A( P, P ) = R1
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL CSWAP( K-1, A( K, 1 ), LDA, A( P, 1 ), LDA )
+*
+            END IF
+*
+*           For both 1x1 and 2x2 pivots, interchange rows and
+*           columns KK and KP in the trailing submatrix A(k:n,k:n)
+*
+            IF( KP.NE.KK ) THEN
+*              (1) Swap columnar parts
+               IF( KP.LT.N )
+     $            CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+*              (2) Swap and conjugate middle parts
+               DO 45 J = KK + 1, KP - 1
+                  T = CONJG( A( J, KK ) )
+                  A( J, KK ) = CONJG( A( KP, J ) )
+                  A( KP, J ) = T
+   45          CONTINUE
+*              (3) Swap and conjugate corner elements at row-col interserction
+               A( KP, KK ) = CONJG( A( KP, KK ) )
+*              (4) Swap diagonal elements at row-col intersection
+               R1 = REAL( A( KK, KK ) )
+               A( KK, KK ) = REAL( A( KP, KP ) )
+               A( KP, KP ) = R1
+*
+               IF( KSTEP.EQ.2 ) THEN
+*                 (*) Make sure that diagonal element of pivot is real
+                  A( K, K ) = REAL( A( K, K ) )
+*                 (5) Swap row elements
+                  T = A( K+1, K )
+                  A( K+1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL CSWAP( K-1, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+*
+            ELSE
+*              (*) Make sure that diagonal element of pivot is real
+               A( K, K ) = REAL( A( K, K ) )
+               IF( KSTEP.EQ.2 )
+     $            A( K+1, K+1 ) = REAL( A( K+1, K+1 ) )
+            END IF
+*
+*           Update the trailing submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k of A now holds
+*
+*              W(k) = L(k)*D(k),
+*
+*              where L(k) is the k-th column of L
+*
+               IF( K.LT.N ) THEN
+*
+*                 Perform a rank-1 update of A(k+1:n,k+1:n) and
+*                 store L(k) in column k
+*
+*                 Handle division by a small number
+*
+                  IF( ABS( REAL( A( K, K ) ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*
+                     D11 = ONE / REAL( A( K, K ) )
+                     CALL CHER( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+*
+*                    Store L(k) in column k
+*
+                     CALL CSSCAL( N-K, D11, A( K+1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column k
+*
+                     D11 = REAL( A( K, K ) )
+                     DO 46 II = K + 1, N
+                        A( II, K ) = A( II, K ) / D11
+   46                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL CHER( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+                  END IF
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+*
+*              Perform a rank-2 update of A(k+2:n,k+2:n) as
+*
+*              A := A - ( L(k) L(k+1) ) * D(k) * ( L(k) L(k+1) )**T
+*                 = A - ( ( A(k)A(k+1) )*inv(D(k) ) * ( A(k)A(k+1) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.LT.N-1 ) THEN
+*                 D = |A21|
+                  D = SLAPY2( REAL( A( K+1, K ) ),
+     $                AIMAG( A( K+1, K ) ) )
+                  D11 = REAL( A( K+1, K+1 ) ) / D
+                  D22 = REAL( A( K, K ) ) / D
+                  D21 = A( K+1, K ) / D
+                  TT = ONE / ( D11*D22-ONE )
+*
+                  DO 60 J = K + 2, N
+*
+*                    Compute  D21 * ( W(k)W(k+1) ) * inv(D(k)) for row J
+*
+                     WK = TT*( D11*A( J, K )-D21*A( J, K+1 ) )
+                     WKP1 = TT*( D22*A( J, K+1 )-CONJG( D21 )*
+     $                      A( J, K ) )
+*
+*                    Perform a rank-2 update of A(k+2:n,k+2:n)
+*
+                     DO 50 I = J, N
+                        A( I, J ) = A( I, J ) -
+     $                              ( A( I, K ) / D )*CONJG( WK ) -
+     $                              ( A( I, K+1 ) / D )*CONJG( WKP1 )
+   50                CONTINUE
+*
+*                    Store L(k) and L(k+1) in cols k and k+1 for row J
+*
+                     A( J, K ) = WK / D
+                     A( J, K+1 ) = WKP1 / D
+*                    (*) Make sure that diagonal element of pivot is real
+                     A( J, J ) = CMPLX( REAL( A( J, J ) ), ZERO )
+*
+   60             CONTINUE
+*
+               END IF
+*
+*              Copy subdiagonal elements of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               E( K ) = A( K+1, K )
+               E( K+1 ) = CZERO
+               A( K+1, K ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 40
+*
+   64    CONTINUE
+*
+      END IF
+*
+      RETURN
+*
+*     End of CHETF2_RK
+*
+      END
diff --git a/SRC/chetrd_2stage.f b/SRC/chetrd_2stage.f
new file mode 100644
index 00000000..795462c6
--- /dev/null
+++ b/SRC/chetrd_2stage.f
@@ -0,0 +1,337 @@
+*> \brief \b CHETRD_2STAGE
+*
+*  @generated from zhetrd_2stage.f, fortran z -> c, Sun Nov  6 19:34:06 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download CHETRD_2STAGE + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrd_2stage.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrd_2stage.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrd_2stage.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, 
+*                                 HOUS2, LHOUS2, WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*      .. Scalar Arguments ..
+*       CHARACTER          VECT, UPLO
+*       INTEGER            N, LDA, LWORK, LHOUS2, INFO
+*      ..
+*      .. Array Arguments ..
+*       REAL               D( * ), E( * )
+*       COMPLEX            A( LDA, * ), TAU( * ),
+*                          HOUS2( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHETRD_2STAGE reduces a complex Hermitian matrix A to real symmetric
+*> tridiagonal form T by a unitary similarity transformation:
+*> Q1**H Q2**H* A * Q2 * Q1 = T.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] VECT
+*> \verbatim
+*>          VECT is CHARACTER*1
+*>          = 'N':  No need for the Housholder representation, 
+*>                  in particular for the second stage (Band to
+*>                  tridiagonal) and thus LHOUS2 is of size max(1, 4*N);
+*>          = 'V':  the Householder representation is needed to 
+*>                  either generate Q1 Q2 or to apply Q1 Q2, 
+*>                  then LHOUS2 is to be queried and computed.
+*>                  (NOT AVAILABLE IN THIS RELEASE).
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>          On exit, if UPLO = 'U', the band superdiagonal
+*>          of A are overwritten by the corresponding elements of the
+*>          internal band-diagonal matrix AB, and the elements above 
+*>          the KD superdiagonal, with the array TAU, represent the unitary
+*>          matrix Q1 as a product of elementary reflectors; if UPLO
+*>          = 'L', the diagonal and band subdiagonal of A are over-
+*>          written by the corresponding elements of the internal band-diagonal
+*>          matrix AB, and the elements below the KD subdiagonal, with
+*>          the array TAU, represent the unitary matrix Q1 as a product
+*>          of elementary reflectors. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] D
+*> \verbatim
+*>          D is REAL array, dimension (N)
+*>          The diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is REAL array, dimension (N-1)
+*>          The off-diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is COMPLEX array, dimension (N-KD)
+*>          The scalar factors of the elementary reflectors of 
+*>          the first stage (see Further Details).
+*> \endverbatim
+*>
+*> \param[out] HOUS2
+*> \verbatim
+*>          HOUS2 is COMPLEX array, dimension LHOUS2, that
+*>          store the Householder representation of the stage2
+*>          band to tridiagonal.
+*> \endverbatim
+*>
+*> \param[in] LHOUS2
+*> \verbatim
+*>          LHOUS2 is INTEGER
+*>          The dimension of the array HOUS2. LHOUS2 = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS2=-1,
+*>          then a query is assumed; the routine
+*>          only calculates the optimal size of the HOUS2 array, returns
+*>          this value as the first entry of the HOUS2 array, and no error
+*>          message related to LHOUS2 is issued by XERBLA.
+*>          LHOUS2 = MAX(1, dimension) where
+*>          dimension = 4*N if VECT='N'
+*>          not available now if VECT='H'
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK. LWORK = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS2=-1,
+*>          then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK = MAX(1, dimension) where
+*>          dimension   = max(stage1,stage2) + (KD+1)*N
+*>                      = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                        + max(2*KD*KD, KD*NTHREADS) 
+*>                        + (KD+1)*N 
+*>          where KD is the blocking size of the reduction,
+*>          FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice
+*>          NTHREADS is the number of threads used when
+*>          openMP compilation is enabled, otherwise =1.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2016
+*
+*> \ingroup complexHEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, 
+     $                          HOUS2, LHOUS2, WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          VECT, UPLO
+      INTEGER            N, LDA, LWORK, LHOUS2, INFO
+*     ..
+*     .. Array Arguments ..
+      REAL               D( * ), E( * )
+      COMPLEX            A( LDA, * ), TAU( * ),
+     $                   HOUS2( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER, WANTQ
+      INTEGER            KD, IB, LWMIN, LHMIN, LWRK, LDAB, WPOS, ABPOS
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, CHETRD_HE2HB, CHETRD_HB2ST
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters
+*
+      INFO   = 0
+      WANTQ  = LSAME( VECT, 'V' )
+      UPPER  = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 ) .OR. ( LHOUS2.EQ.-1 )
+*
+*     Determine the block size, the workspace size and the hous size.
+*
+      KD     = ILAENV( 17, 'CHETRD_2STAGE', VECT, N, -1, -1, -1 )
+      IB     = ILAENV( 18, 'CHETRD_2STAGE', VECT, N, KD, -1, -1 )
+      LHMIN  = ILAENV( 19, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 )
+      LWMIN  = ILAENV( 20, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 )
+*      WRITE(*,*),'CHETRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
+*     $            LHMIN, LWMIN
+*
+      IF( .NOT.LSAME( VECT, 'N' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LHOUS2.LT.LHMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -10
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -12
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         HOUS2( 1 ) = LHMIN
+         WORK( 1 )  = LWMIN
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHETRD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+*     Determine pointer position
+*
+      LDAB  = KD+1
+      LWRK  = LWORK-LDAB*N
+      ABPOS = 1
+      WPOS  = ABPOS + LDAB*N
+      CALL CHETRD_HE2HB( UPLO, N, KD, A, LDA, WORK( ABPOS ), LDAB, 
+     $                   TAU, WORK( WPOS ), LWRK, INFO )
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHETRD_HE2HB', -INFO )
+         RETURN
+      END IF
+      CALL CHETRD_HB2ST( 'Y', VECT, UPLO, N, KD, 
+     $                   WORK( ABPOS ), LDAB, D, E, 
+     $                   HOUS2, LHOUS2, WORK( WPOS ), LWRK, INFO )
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHETRD_HB2ST', -INFO )
+         RETURN
+      END IF
+*
+*
+      HOUS2( 1 ) = LHMIN
+      WORK( 1 )  = LWMIN
+      RETURN
+*
+*     End of CHETRD_2STAGE
+*
+      END
diff --git a/SRC/chetrd_hb2st.F b/SRC/chetrd_hb2st.F
new file mode 100644
index 00000000..c4d44803
--- /dev/null
+++ b/SRC/chetrd_hb2st.F
@@ -0,0 +1,580 @@
+*> \brief \b CHBTRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric tridiagonal form T
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHBTRD_HB2ST + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chbtrd_hb2st.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chbtrd_hb2st.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chbtrd_hb2st.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 
+*                               D, E, HOUS, LHOUS, WORK, LWORK, INFO )
+*
+*       #if defined(_OPENMP)
+*       use omp_lib
+*       #endif
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          STAGE1, UPLO, VECT
+*       INTEGER            N, KD, IB, LDAB, LHOUS, LWORK, INFO
+*       ..
+*       .. Array Arguments ..
+*       REAL               D( * ), E( * )
+*       COMPLEX            AB( LDAB, * ), HOUS( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric
+*> tridiagonal form T by a unitary similarity transformation:
+*> Q**H * A * Q = T.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] STAGE
+*> \verbatim
+*>          STAGE is CHARACTER*1
+*>          = 'N':  "No": to mention that the stage 1 of the reduction  
+*>                  from dense to band using the chetrd_he2hb routine
+*>                  was not called before this routine to reproduce AB. 
+*>                  In other term this routine is called as standalone. 
+*>          = 'Y':  "Yes": to mention that the stage 1 of the 
+*>                  reduction from dense to band using the chetrd_he2hb 
+*>                  routine has been called to produce AB (e.g., AB is
+*>                  the output of chetrd_he2hb.
+*> \endverbatim
+*>
+*> \param[in] VECT
+*> \verbatim
+*>          VECT is CHARACTER*1
+*>          = 'N':  No need for the Housholder representation, 
+*>                  and thus LHOUS is of size max(1, 4*N);
+*>          = 'V':  the Householder representation is needed to 
+*>                  either generate or to apply Q later on, 
+*>                  then LHOUS is to be queried and computed.
+*>                  (NOT AVAILABLE IN THIS RELEASE).
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is COMPLEX array, dimension (LDAB,N)
+*>          On entry, the upper or lower triangle of the Hermitian band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>          On exit, the diagonal elements of AB are overwritten by the
+*>          diagonal elements of the tridiagonal matrix T; if KD > 0, the
+*>          elements on the first superdiagonal (if UPLO = 'U') or the
+*>          first subdiagonal (if UPLO = 'L') are overwritten by the
+*>          off-diagonal elements of T; the rest of AB is overwritten by
+*>          values generated during the reduction.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD+1.
+*> \endverbatim
+*>
+*> \param[out] D
+*> \verbatim
+*>          D is REAL array, dimension (N)
+*>          The diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is REAL array, dimension (N-1)
+*>          The off-diagonal elements of the tridiagonal matrix T:
+*>          E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
+*> \endverbatim
+*>
+*> \param[out] HOUS
+*> \verbatim
+*>          HOUS is COMPLEX array, dimension LHOUS, that
+*>          store the Householder representation.
+*> \endverbatim
+*>
+*> \param[in] LHOUS
+*> \verbatim
+*>          LHOUS is INTEGER
+*>          The dimension of the array HOUS. LHOUS = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS=-1,
+*>          then a query is assumed; the routine
+*>          only calculates the optimal size of the HOUS array, returns
+*>          this value as the first entry of the HOUS array, and no error
+*>          message related to LHOUS is issued by XERBLA.
+*>          LHOUS = MAX(1, dimension) where
+*>          dimension = 4*N if VECT='N'
+*>          not available now if VECT='H'     
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK. LWORK = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS=-1,
+*>          then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK = MAX(1, dimension) where
+*>          dimension   = (2KD+1)*N + KD*NTHREADS
+*>          where KD is the blocking size of the reduction,
+*>          FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice
+*>          NTHREADS is the number of threads used when
+*>          openMP compilation is enabled, otherwise =1.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 
+     $                         D, E, HOUS, LHOUS, WORK, LWORK, INFO )
+*
+*
+#if defined(_OPENMP)
+      use omp_lib
+#endif
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          STAGE1, UPLO, VECT
+      INTEGER            N, KD, LDAB, LHOUS, LWORK, INFO
+*     ..
+*     .. Array Arguments ..
+      REAL               D( * ), E( * )
+      COMPLEX            AB( LDAB, * ), HOUS( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               RZERO
+      COMPLEX            ZERO, ONE
+      PARAMETER          ( RZERO = 0.0E+0,
+     $                   ZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   ONE  = ( 1.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, WANTQ, UPPER, AFTERS1
+      INTEGER            I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST, 
+     $                   ED, STIND, EDIND, BLKLASTIND, COLPT, THED,
+     $                   STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID,
+     $                   NBTILES, TTYPE, TID, NTHREADS, DEBUG,
+     $                   ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS, 
+     $                   INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
+     $                   SICEV, SIZETAU, LDV, LHMIN, LWMIN
+      REAL               ABSTMP
+      COMPLEX            TMP
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CHB2ST_KERNELS, CLACPY, CLASET
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN, MAX, CEILING, REAL
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV 
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Determine the minimal workspace size required.
+*     Test the input parameters
+*
+      DEBUG   = 0
+      INFO    = 0
+      AFTERS1 = LSAME( STAGE1, 'Y' )
+      WANTQ   = LSAME( VECT, 'V' )
+      UPPER   = LSAME( UPLO, 'U' )
+      LQUERY  = ( LWORK.EQ.-1 ) .OR. ( LHOUS.EQ.-1 )
+*
+*     Determine the block size, the workspace size and the hous size.
+*
+      IB     = ILAENV( 18, 'CHETRD_HB2ST', VECT, N, KD, -1, -1 )
+      LHMIN  = ILAENV( 19, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 )
+      LWMIN  = ILAENV( 20, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 )
+*
+      IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.LSAME( VECT, 'N' ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.(KD+1) ) THEN
+         INFO = -7
+      ELSE IF( LHOUS.LT.LHMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -11
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -13
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         HOUS( 1 ) = LHMIN
+         WORK( 1 ) = LWMIN
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHETRD_HB2ST', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+*     Determine pointer position
+*
+      LDV      = KD + IB
+      SIZETAU  = 2 * N
+      SICEV    = 2 * N
+      INDTAU   = 1
+      INDV     = INDTAU + SIZETAU
+      LDA      = 2 * KD + 1
+      SIZEA    = LDA * N
+      INDA     = 1
+      INDW     = INDA + SIZEA
+      NTHREADS = 1
+      TID      = 0
+*
+      IF( UPPER ) THEN
+          APOS     = INDA + KD
+          AWPOS    = INDA
+          DPOS     = APOS + KD
+          OFDPOS   = DPOS - 1
+          ABDPOS   = KD + 1
+          ABOFDPOS = KD
+      ELSE
+          APOS     = INDA 
+          AWPOS    = INDA + KD + 1
+          DPOS     = APOS
+          OFDPOS   = DPOS + 1
+          ABDPOS   = 1
+          ABOFDPOS = 2
+
+      ENDIF
+*      
+*     Case KD=0: 
+*     The matrix is diagonal. We just copy it (convert to "real" for 
+*     complex because D is double and the imaginary part should be 0) 
+*     and store it in D. A sequential code here is better or 
+*     in a parallel environment it might need two cores for D and E
+*
+      IF( KD.EQ.0 ) THEN
+          DO 30 I = 1, N
+              D( I ) = REAL( AB( ABDPOS, I ) )
+   30     CONTINUE
+          DO 40 I = 1, N-1
+              E( I ) = RZERO
+   40     CONTINUE
+         RETURN
+      END IF
+*      
+*     Case KD=1: 
+*     The matrix is already Tridiagonal. We have to make diagonal 
+*     and offdiagonal elements real, and store them in D and E.
+*     For that, for real precision just copy the diag and offdiag 
+*     to D and E while for the COMPLEX case the bulge chasing is  
+*     performed to convert the hermetian tridiagonal to symmetric 
+*     tridiagonal. A simpler coversion formula might be used, but then 
+*     updating the Q matrix will be required and based if Q is generated
+*     or not this might complicate the story. 
+*      
+      IF( KD.EQ.1 ) THEN
+          DO 50 I = 1, N
+              D( I ) = REAL( AB( ABDPOS, I ) )
+   50     CONTINUE
+*
+*         make off-diagonal elements real and copy them to E
+*
+          IF( UPPER ) THEN
+              DO 60 I = 1, N - 1
+                  TMP = AB( ABOFDPOS, I+1 )
+                  ABSTMP = ABS( TMP )
+                  AB( ABOFDPOS, I+1 ) = ABSTMP
+                  E( I ) = ABSTMP
+                  IF( ABSTMP.NE.RZERO ) THEN
+                     TMP = TMP / ABSTMP
+                  ELSE
+                     TMP = ONE
+                  END IF
+                  IF( I.LT.N-1 )
+     $               AB( ABOFDPOS, I+2 ) = AB( ABOFDPOS, I+2 )*TMP
+C                  IF( WANTZ ) THEN
+C                     CALL CSCAL( N, CONJG( TMP ), Q( 1, I+1 ), 1 )
+C                  END IF
+   60         CONTINUE
+          ELSE
+              DO 70 I = 1, N - 1
+                 TMP = AB( ABOFDPOS, I )
+                 ABSTMP = ABS( TMP )
+                 AB( ABOFDPOS, I ) = ABSTMP
+                 E( I ) = ABSTMP
+                 IF( ABSTMP.NE.RZERO ) THEN
+                    TMP = TMP / ABSTMP
+                 ELSE
+                    TMP = ONE
+                 END IF
+                 IF( I.LT.N-1 )
+     $              AB( ABOFDPOS, I+1 ) = AB( ABOFDPOS, I+1 )*TMP
+C                 IF( WANTQ ) THEN
+C                    CALL CSCAL( N, TMP, Q( 1, I+1 ), 1 )
+C                 END IF
+   70         CONTINUE
+          ENDIF
+          RETURN
+      END IF
+*
+*     Main code start here. 
+*     Reduce the hermitian band of A to a tridiagonal matrix.
+*
+      THGRSIZ   = N
+      GRSIZ     = 1
+      SHIFT     = 3
+      NBTILES   = CEILING( REAL(N)/REAL(KD) )
+      STEPERCOL = CEILING( REAL(SHIFT)/REAL(GRSIZ) )
+      THGRNB    = CEILING( REAL(N-1)/REAL(THGRSIZ) )
+*      
+      CALL CLACPY( "A", KD+1, N, AB, LDAB, WORK( APOS ), LDA )
+      CALL CLASET( "A", KD,   N, ZERO, ZERO, WORK( AWPOS ), LDA )
+*
+*
+*     openMP parallelisation start here
+*
+#if defined(_OPENMP)
+!$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND )
+!$OMP$         PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID ) 
+!$OMP$         PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND )
+!$OMP$         SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK)
+!$OMP$         SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA )
+!$OMP$         SHARED ( STEPERCOL, THGRNB, THGRSIZ, GRSIZ, SHIFT )
+!$OMP MASTER
+#endif
+*
+*     main bulge chasing loop
+*      
+      DO 100 THGRID = 1, THGRNB
+          STT  = (THGRID-1)*THGRSIZ+1
+          THED = MIN( (STT + THGRSIZ -1), (N-1))
+          DO 110 I = STT, N-1
+              ED = MIN( I, THED )
+              IF( STT.GT.ED ) GOTO 100
+              DO 120 M = 1, STEPERCOL
+                  ST = STT
+                  DO 130 SWEEPID = ST, ED
+                      DO 140 K = 1, GRSIZ
+                          MYID  = (I-SWEEPID)*(STEPERCOL*GRSIZ) 
+     $                           + (M-1)*GRSIZ + K
+                          IF ( MYID.EQ.1 ) THEN
+                              TTYPE = 1
+                          ELSE
+                              TTYPE = MOD( MYID, 2 ) + 2
+                          ENDIF
+
+                          IF( TTYPE.EQ.2 ) THEN
+                              COLPT      = (MYID/2)*KD + SWEEPID
+                              STIND      = COLPT-KD+1
+                              EDIND      = MIN(COLPT,N)
+                              BLKLASTIND = COLPT
+                          ELSE
+                              COLPT      = ((MYID+1)/2)*KD + SWEEPID
+                              STIND      = COLPT-KD+1
+                              EDIND      = MIN(COLPT,N)
+                              IF( ( STIND.GE.EDIND-1 ).AND.
+     $                            ( EDIND.EQ.N ) ) THEN
+                                  BLKLASTIND = N
+                              ELSE
+                                  BLKLASTIND = 0
+                              ENDIF
+                          ENDIF
+*
+*                         Call the kernel
+*                             
+#if defined(_OPENMP)
+                          IF( TTYPE.NE.1 ) THEN      
+!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
+!$OMP$     DEPEND(in:WORK(MYID-1))
+!$OMP$     DEPEND(out:WORK(MYID))
+                              TID      = OMP_GET_THREAD_NUM()
+                              CALL CHB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                             STIND, EDIND, SWEEPID, N, KD, IB,
+     $                             WORK ( INDA ), LDA, 
+     $                             HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                             WORK( INDW + TID*KD ) )
+!$OMP END TASK
+                          ELSE
+!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
+!$OMP$     DEPEND(out:WORK(MYID))
+                              TID      = OMP_GET_THREAD_NUM()
+                              CALL CHB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                             STIND, EDIND, SWEEPID, N, KD, IB,
+     $                             WORK ( INDA ), LDA, 
+     $                             HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                             WORK( INDW + TID*KD ) )
+!$OMP END TASK
+                          ENDIF
+#else
+                          CALL CHB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                         STIND, EDIND, SWEEPID, N, KD, IB,
+     $                         WORK ( INDA ), LDA, 
+     $                         HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                         WORK( INDW + TID*KD ) )
+#endif 
+                          IF ( BLKLASTIND.GE.(N-1) ) THEN
+                              STT = STT + 1
+                              GOTO 130
+                          ENDIF
+  140                 CONTINUE
+  130             CONTINUE
+  120         CONTINUE
+  110     CONTINUE
+  100 CONTINUE
+*
+#if defined(_OPENMP)
+!$OMP END MASTER
+!$OMP END PARALLEL
+#endif
+*      
+*     Copy the diagonal from A to D. Note that D is REAL thus only
+*     the Real part is needed, the imaginary part should be zero.
+*
+      DO 150 I = 1, N
+          D( I ) = REAL( WORK( DPOS+(I-1)*LDA ) )
+  150 CONTINUE
+*      
+*     Copy the off diagonal from A to E. Note that E is REAL thus only
+*     the Real part is needed, the imaginary part should be zero.
+*
+      IF( UPPER ) THEN
+          DO 160 I = 1, N-1
+             E( I ) = REAL( WORK( OFDPOS+I*LDA ) )
+  160     CONTINUE
+      ELSE
+          DO 170 I = 1, N-1
+             E( I ) = REAL( WORK( OFDPOS+(I-1)*LDA ) )
+  170     CONTINUE
+      ENDIF
+*
+      HOUS( 1 ) = LHMIN
+      WORK( 1 ) = LWMIN
+      RETURN
+*
+*     End of CHETRD_HB2ST
+*
+      END
+      
diff --git a/SRC/chetrd_he2hb.f b/SRC/chetrd_he2hb.f
new file mode 100644
index 00000000..28f5dc60
--- /dev/null
+++ b/SRC/chetrd_he2hb.f
@@ -0,0 +1,517 @@
+*> \brief \b CHETRD_HE2HB
+*
+*  @generated from zhetrd_he2hb.f, fortran z -> c, Sun Nov  6 19:34:06 2016
+*      
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download CHETRD_HE2HB + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrd.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrd.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrd.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, 
+*                              WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDAB, LWORK, N, KD
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX            A( LDA, * ), AB( LDAB, * ), 
+*                          TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian
+*> band-diagonal form AB by a unitary similarity transformation:
+*> Q**H * A * Q = AB.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the reduced matrix if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*>          The reduced matrix is stored in the array AB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>          On exit, if UPLO = 'U', the diagonal and first superdiagonal
+*>          of A are overwritten by the corresponding elements of the
+*>          tridiagonal matrix T, and the elements above the first
+*>          superdiagonal, with the array TAU, represent the unitary
+*>          matrix Q as a product of elementary reflectors; if UPLO
+*>          = 'L', the diagonal and first subdiagonal of A are over-
+*>          written by the corresponding elements of the tridiagonal
+*>          matrix T, and the elements below the first subdiagonal, with
+*>          the array TAU, represent the unitary matrix Q as a product
+*>          of elementary reflectors. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] AB
+*> \verbatim
+*>          AB is COMPLEX array, dimension (LDAB,N)
+*>          On exit, the upper or lower triangle of the Hermitian band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD+1.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is COMPLEX array, dimension (N-KD)
+*>          The scalar factors of the elementary reflectors (see Further
+*>          Details).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension LWORK.
+*>          On exit, if INFO = 0, or if LWORK=-1, 
+*>          WORK(1) returns the size of LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK which should be calculated
+*           by a workspace query. LWORK = MAX(1, LWORK_QUERY)
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK_QUERY = N*KD + N*max(KD,FACTOPTNB) + 2*KD*KD
+*>          where FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice otherwise
+*>          putting LWORK=-1 will provide the size of WORK.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2016
+*
+*> \ingroup complexHEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*> \verbatim
+*>
+*>  If UPLO = 'U', the matrix Q is represented as a product of elementary
+*>  reflectors
+*>
+*>     Q = H(k)**H . . . H(2)**H H(1)**H, where k = n-kd.
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**H
+*>
+*>  where tau is a complex scalar, and v is a complex vector with
+*>  v(1:i+kd-1) = 0 and v(i+kd) = 1; conjg(v(i+kd+1:n)) is stored on exit in
+*>  A(i,i+kd+1:n), and tau in TAU(i).
+*>
+*>  If UPLO = 'L', the matrix Q is represented as a product of elementary
+*>  reflectors
+*>
+*>     Q = H(1) H(2) . . . H(k), where k = n-kd.
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**H
+*>
+*>  where tau is a complex scalar, and v is a complex vector with
+*>  v(kd+1:i) = 0 and v(i+kd+1) = 1; v(i+kd+2:n) is stored on exit in
+*   A(i+kd+2:n,i), and tau in TAU(i).
+*>
+*>  The contents of A on exit are illustrated by the following examples
+*>  with n = 5:
+*>
+*>  if UPLO = 'U':                       if UPLO = 'L':
+*>
+*>    (  ab  ab/v1  v1      v1     v1    )              (  ab                            )
+*>    (      ab     ab/v2   v2     v2    )              (  ab/v1  ab                     )
+*>    (             ab      ab/v3  v3    )              (  v1     ab/v2  ab              )
+*>    (                     ab     ab/v4 )              (  v1     v2     ab/v3  ab       )
+*>    (                            ab    )              (  v1     v2     v3     ab/v4 ab )
+*>
+*>  where d and e denote diagonal and off-diagonal elements of T, and vi
+*>  denotes an element of the vector defining H(i).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, 
+     $                         WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDAB, LWORK, N, KD
+*     ..
+*     .. Array Arguments ..
+      COMPLEX            A( LDA, * ), AB( LDAB, * ), 
+     $                   TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               RONE
+      COMPLEX            ZERO, ONE, HALF
+      PARAMETER          ( RONE = 1.0E+0,
+     $                   ZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   ONE = ( 1.0E+0, 0.0E+0 ),
+     $                   HALF = ( 0.5E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, J, IINFO, LWMIN, PN, PK, LK,
+     $                   LDT, LDW, LDS2, LDS1, 
+     $                   LS2, LS1, LW, LT,
+     $                   TPOS, WPOS, S2POS, S1POS
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, CHER2K, CHEMM, CGEMM,
+     $                   CLARFT, CGELQF, CGEQRF, CLASET
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN, MAX
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV 
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Determine the minimal workspace size required 
+*     and test the input parameters
+*
+      INFO   = 0
+      UPPER  = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      LWMIN  = ILAENV( 20, 'CHETRD_HE2HB', '', N, KD, -1, -1 )
+      
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.MAX( 1, KD+1 ) ) THEN
+         INFO = -7
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -10
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHETRD_HE2HB', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         WORK( 1 ) = LWMIN
+         RETURN
+      END IF
+*
+*     Quick return if possible        
+*     Copy the upper/lower portion of A into AB 
+*
+      IF( N.LE.KD+1 ) THEN
+          IF( UPPER ) THEN
+              DO 100 I = 1, N
+                  LK = MIN( KD+1, I )
+                  CALL CCOPY( LK, A( I-LK+1, I ), 1, 
+     $                            AB( KD+1-LK+1, I ), 1 )
+  100         CONTINUE
+          ELSE
+              DO 110 I = 1, N
+                  LK = MIN( KD+1, N-I+1 )
+                  CALL CCOPY( LK, A( I, I ), 1, AB( 1, I ), 1 )
+  110         CONTINUE
+          ENDIF
+          WORK( 1 ) = 1
+          RETURN
+      END IF
+*
+*     Determine the pointer position for the workspace
+*      
+      LDT    = KD
+      LDS1   = KD
+      LT     = LDT*KD
+      LW     = N*KD
+      LS1    = LDS1*KD
+      LS2    = LWMIN - LT - LW - LS1
+*      LS2 = N*MAX(KD,FACTOPTNB) 
+      TPOS   = 1
+      WPOS   = TPOS  + LT
+      S1POS  = WPOS  + LW
+      S2POS  = S1POS + LS1 
+      IF( UPPER ) THEN
+          LDW    = KD
+          LDS2   = KD
+      ELSE
+          LDW    = N
+          LDS2   = N
+      ENDIF
+*
+*
+*     Set the workspace of the triangular matrix T to zero once such a
+*     way everytime T is generated the upper/lower portion will be always zero  
+*   
+      CALL CLASET( "A", LDT, KD, ZERO, ZERO, WORK( TPOS ), LDT )
+*
+      IF( UPPER ) THEN
+          DO 10 I = 1, N - KD, KD
+             PN = N-I-KD+1
+             PK = MIN( N-I-KD+1, KD )
+*        
+*            Compute the LQ factorization of the current block
+*        
+             CALL CGELQF( KD, PN, A( I, I+KD ), LDA,
+     $                    TAU( I ), WORK( S2POS ), LS2, IINFO )
+*        
+*            Copy the upper portion of A into AB
+*        
+             DO 20 J = I, I+PK-1
+                LK = MIN( KD, N-J ) + 1
+                CALL CCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 )
+   20        CONTINUE
+*                
+             CALL CLASET( 'Lower', PK, PK, ZERO, ONE, 
+     $                    A( I, I+KD ), LDA )
+*        
+*            Form the matrix T
+*        
+             CALL CLARFT( 'Forward', 'Rowwise', PN, PK,
+     $                    A( I, I+KD ), LDA, TAU( I ), 
+     $                    WORK( TPOS ), LDT )
+*        
+*            Compute W:
+*             
+             CALL CGEMM( 'Conjugate', 'No transpose', PK, PN, PK,
+     $                   ONE,  WORK( TPOS ), LDT,
+     $                         A( I, I+KD ), LDA,
+     $                   ZERO, WORK( S2POS ), LDS2 )
+*        
+             CALL CHEMM( 'Right', UPLO, PK, PN,
+     $                   ONE,  A( I+KD, I+KD ), LDA,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( WPOS ), LDW )
+*        
+             CALL CGEMM( 'No transpose', 'Conjugate', PK, PK, PN,
+     $                   ONE,  WORK( WPOS ), LDW,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( S1POS ), LDS1 )
+*        
+             CALL CGEMM( 'No transpose', 'No transpose', PK, PN, PK,
+     $                   -HALF, WORK( S1POS ), LDS1, 
+     $                          A( I, I+KD ), LDA,
+     $                   ONE,   WORK( WPOS ), LDW )
+*             
+*        
+*            Update the unreduced submatrix A(i+kd:n,i+kd:n), using
+*            an update of the form:  A := A - V'*W - W'*V
+*        
+             CALL CHER2K( UPLO, 'Conjugate', PN, PK,
+     $                    -ONE, A( I, I+KD ), LDA,
+     $                          WORK( WPOS ), LDW,
+     $                    RONE, A( I+KD, I+KD ), LDA )
+   10     CONTINUE
+*
+*        Copy the upper band to AB which is the band storage matrix
+*
+         DO 30 J = N-KD+1, N
+            LK = MIN(KD, N-J) + 1
+            CALL CCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 )
+   30    CONTINUE
+*
+      ELSE
+*
+*         Reduce the lower triangle of A to lower band matrix
+*        
+          DO 40 I = 1, N - KD, KD
+             PN = N-I-KD+1
+             PK = MIN( N-I-KD+1, KD )
+*        
+*            Compute the QR factorization of the current block
+*        
+             CALL CGEQRF( PN, KD, A( I+KD, I ), LDA,
+     $                    TAU( I ), WORK( S2POS ), LS2, IINFO )
+*        
+*            Copy the upper portion of A into AB 
+*        
+             DO 50 J = I, I+PK-1
+                LK = MIN( KD, N-J ) + 1
+                CALL CCOPY( LK, A( J, J ), 1, AB( 1, J ), 1 )
+   50        CONTINUE
+*                
+             CALL CLASET( 'Upper', PK, PK, ZERO, ONE, 
+     $                    A( I+KD, I ), LDA )
+*        
+*            Form the matrix T
+*        
+             CALL CLARFT( 'Forward', 'Columnwise', PN, PK,
+     $                    A( I+KD, I ), LDA, TAU( I ), 
+     $                    WORK( TPOS ), LDT )
+*        
+*            Compute W:
+*             
+             CALL CGEMM( 'No transpose', 'No transpose', PN, PK, PK,
+     $                   ONE, A( I+KD, I ), LDA,
+     $                         WORK( TPOS ), LDT,
+     $                   ZERO, WORK( S2POS ), LDS2 )
+*        
+             CALL CHEMM( 'Left', UPLO, PN, PK,
+     $                   ONE, A( I+KD, I+KD ), LDA,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( WPOS ), LDW )
+*        
+             CALL CGEMM( 'Conjugate', 'No transpose', PK, PK, PN,
+     $                   ONE, WORK( S2POS ), LDS2,
+     $                         WORK( WPOS ), LDW,
+     $                   ZERO, WORK( S1POS ), LDS1 )
+*        
+             CALL CGEMM( 'No transpose', 'No transpose', PN, PK, PK,
+     $                   -HALF, A( I+KD, I ), LDA,
+     $                         WORK( S1POS ), LDS1,
+     $                   ONE, WORK( WPOS ), LDW )
+*             
+*        
+*            Update the unreduced submatrix A(i+kd:n,i+kd:n), using
+*            an update of the form:  A := A - V*W' - W*V'
+*        
+             CALL CHER2K( UPLO, 'No transpose', PN, PK,
+     $                    -ONE, A( I+KD, I ), LDA,
+     $                           WORK( WPOS ), LDW,
+     $                    RONE, A( I+KD, I+KD ), LDA )
+*            ==================================================================
+*            RESTORE A FOR COMPARISON AND CHECKING TO BE REMOVED
+*             DO 45 J = I, I+PK-1
+*                LK = MIN( KD, N-J ) + 1
+*                CALL CCOPY( LK, AB( 1, J ), 1, A( J, J ), 1 )
+*   45        CONTINUE
+*            ==================================================================
+   40     CONTINUE
+*
+*        Copy the lower band to AB which is the band storage matrix
+*
+         DO 60 J = N-KD+1, N
+            LK = MIN(KD, N-J) + 1
+            CALL CCOPY( LK, A( J, J ), 1, AB( 1, J ), 1 )
+   60    CONTINUE
+
+      END IF
+*
+      WORK( 1 ) = LWMIN
+      RETURN
+*
+*     End of CHETRD_HE2HB
+*
+      END
diff --git a/SRC/chetrf_aa.f b/SRC/chetrf_aa.f
index 883e9f00..3dd7c036 100644
--- a/SRC/chetrf_aa.f
+++ b/SRC/chetrf_aa.f
@@ -37,7 +37,7 @@
 *> CHETRF_AA computes the factorization of a complex hermitian matrix A
 *> using the Aasen's algorithm.  The form of the factorization is
 *>
-*>    A = U*T*U**T  or  A = L*T*L**T
+*>    A = U*T*U**H  or  A = L*T*L**H
 *>
 *> where U (or L) is a product of permutation and unit upper (lower)
 *> triangular matrices, and T is a hermitian tridiagonal matrix.
@@ -230,7 +230,7 @@
       IF( UPPER ) THEN
 *
 *        .....................................................
-*        Factorize A as L*D*L**T using the upper triangle of A
+*        Factorize A as L*D*L**H using the upper triangle of A
 *        .....................................................
 *
 *        copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N))
@@ -353,7 +353,7 @@
       ELSE
 *
 *        .....................................................
-*        Factorize A as L*D*L**T using the lower triangle of A
+*        Factorize A as L*D*L**H using the lower triangle of A
 *        .....................................................
 *
 *        copy first column A(1:N, 1) into H(1:N, 1)
diff --git a/SRC/chetrf_rk.f b/SRC/chetrf_rk.f
new file mode 100644
index 00000000..458b0ad5
--- /dev/null
+++ b/SRC/chetrf_rk.f
@@ -0,0 +1,498 @@
+*> \brief \b CHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHETRF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrf_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrf_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrf_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CHETRF_RK computes the factorization of a complex Hermitian matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the Hermitian block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension ( MAX(1,LWORK) ).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >=1.  For best performance
+*>          LWORK >= N*NB, where NB is the block size returned
+*>          by ILAENV.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array, returns this value as the first entry of the WORK
+*>          array, and no error message related to LWORK is issued
+*>          by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put correct description
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, IINFO, IP, IWS, K, KB, LDWORK, LWKOPT,
+     $                   NB, NBMIN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CLAHEF_RK, CHETF2_RK, CSWAP, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size
+*
+         NB = ILAENV( 1, 'CHETRF_RK', UPLO, N, -1, -1, -1 )
+         LWKOPT = N*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHETRF_RK', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+      NBMIN = 2
+      LDWORK = N
+      IF( NB.GT.1 .AND. NB.LT.N ) THEN
+         IWS = LDWORK*NB
+         IF( LWORK.LT.IWS ) THEN
+            NB = MAX( LWORK / LDWORK, 1 )
+            NBMIN = MAX( 2, ILAENV( 2, 'CHETRF_RK',
+     $                              UPLO, N, -1, -1, -1 ) )
+         END IF
+      ELSE
+         IWS = 1
+      END IF
+      IF( NB.LT.NBMIN )
+     $   NB = N
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**T using the upper triangle of A
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        KB, where KB is the number of columns factorized by CLAHEF_RK;
+*        KB is either NB or NB-1, or K for the last block
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 15
+*
+         IF( K.GT.NB ) THEN
+*
+*           Factorize columns k-kb+1:k of A and use blocked code to
+*           update columns 1:k-kb
+*
+            CALL CLAHEF_RK( UPLO, K, NB, KB, A, LDA, E,
+     $                      IPIV, WORK, LDWORK, IINFO )
+         ELSE
+*
+*           Use unblocked code to factorize columns 1:k of A
+*
+            CALL CHETF2_RK( UPLO, K, A, LDA, E, IPIV, IINFO )
+            KB = K
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO
+*
+*        No need to adjust IPIV
+*
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k-kb+1:k and apply row permutations to the
+*        last k+1 colunms k+1:N after that block
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.LT.N ) THEN
+            DO I = K, ( K - KB + 1 ), -1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL CSWAP( N-K, A( I, K+1 ), LDA,
+     $                        A( IP, K+1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KB
+         GO TO 10
+*
+*        This label is the exit from main loop over K decreasing
+*        from N to 1 in steps of KB
+*
+   15    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**T using the lower triangle of A
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        KB, where KB is the number of columns factorized by CLAHEF_RK;
+*        KB is either NB or NB-1, or N-K+1 for the last block
+*
+         K = 1
+   20    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 35
+*
+         IF( K.LE.N-NB ) THEN
+*
+*           Factorize columns k:k+kb-1 of A and use blocked code to
+*           update columns k+kb:n
+*
+            CALL CLAHEF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ),
+     $                        IPIV( K ), WORK, LDWORK, IINFO )
+
+
+         ELSE
+*
+*           Use unblocked code to factorize columns k:n of A
+*
+            CALL CHETF2_RK( UPLO, N-K+1, A( K, K ), LDA, E( K ),
+     $                      IPIV( K ), IINFO )
+            KB = N - K + 1
+*
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO + K - 1
+*
+*        Adjust IPIV
+*
+         DO I = K, K + KB - 1
+            IF( IPIV( I ).GT.0 ) THEN
+               IPIV( I ) = IPIV( I ) + K - 1
+            ELSE
+               IPIV( I ) = IPIV( I ) - K + 1
+            END IF
+         END DO
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k:k+kb-1 and apply row permutations to the
+*        first k-1 colunms 1:k-1 before that block
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.GT.1 ) THEN
+            DO I = K, ( K + KB - 1 ), 1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL CSWAP( K-1, A( I, 1 ), LDA,
+     $                        A( IP, 1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KB
+         GO TO 20
+*
+*        This label is the exit from main loop over K increasing
+*        from 1 to N in steps of KB
+*
+   35    CONTINUE
+*
+*     End Lower
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+      RETURN
+*
+*     End of CHETRF_RK
+*
+      END
diff --git a/SRC/chetri_3.f b/SRC/chetri_3.f
new file mode 100644
index 00000000..3a479172
--- /dev/null
+++ b/SRC/chetri_3.f
@@ -0,0 +1,248 @@
+*> \brief \b CHETRI_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHETRI_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetri_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetri_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetri_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CHETRI_3 computes the inverse of a complex Hermitian indefinite
+*> matrix A using the factorization computed by CHETRF_RK or CHETRF_BK:
+*>
+*>     A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> CHETRI_3 sets the leading dimension of the workspace  before calling
+*> CHETRI_3X that actually computes the inverse.  This is the blocked
+*> version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by CHETRF_RK and CHETRF_BK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the Hermitian inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by CHETRF_RK or CHETRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (N+NB+1)*(NB+3).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK. LWORK >= (N+NB+1)*(NB+3).
+*>
+*>          If LDWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the optimal
+*>          size of the WORK array, returns this value as the first
+*>          entry of the WORK array, and no error message related to
+*>          LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            UPPER, LQUERY
+      INTEGER            LWKOPT, NB
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CHETRI_3X
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+*     Determine the block size
+*
+      NB = MAX( 1, ILAENV( 1, 'CHETRI_3', UPLO, N, -1, -1, -1 ) )
+      LWKOPT = ( N+NB+1 ) * ( NB+3 )
+*
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHETRI_3', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         WORK( 1 ) = LWKOPT
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      CALL CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of CHETRI_3
+*
+      END
diff --git a/SRC/chetri_3x.f b/SRC/chetri_3x.f
new file mode 100644
index 00000000..f6584bd3
--- /dev/null
+++ b/SRC/chetri_3x.f
@@ -0,0 +1,649 @@
+*> \brief \b CHETRI_3X
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHETRI_3X + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetri_3x.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetri_3x.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetri_3x.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ),  E( * ), WORK( N+NB+1, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CHETRI_3X computes the inverse of a complex Hermitian indefinite
+*> matrix A using the factorization computed by CHETRF_RK or CHETRF_BK:
+*>
+*>     A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by CHETRF_RK and CHETRF_BK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the Hermitian inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by CHETRF_RK or CHETRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (N+NB+1,NB+3).
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          Block size.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * ), WORK( N+NB+1, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE
+      PARAMETER          ( ONE = 1.0E+0 )
+      COMPLEX            CONE, CZERO
+      PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ),
+     $                     CZERO = ( 0.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            CUT, I, ICOUNT, INVD, IP, K, NNB, J, U11
+      REAL               AK, AKP1, T
+      COMPLEX            AKKP1, D, U01_I_J, U01_IP1_J, U11_I_J,
+     $                   U11_IP1_J
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CGEMM, CHESWAPR, CTRTRI, CTRMM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, CONJG, MAX, REAL
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+*
+*     Quick return if possible
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHETRI_3X', -INFO )
+         RETURN
+      END IF
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Workspace got Non-diag elements of D
+*
+      DO K = 1, N
+         WORK( K, 1 ) = E( K )
+      END DO
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO INFO = N, 1, -1
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.CZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO INFO = 1, N
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.CZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+      INFO = 0
+*
+*     Splitting Workspace
+*     U01 is a block ( N, NB+1 )
+*     The first element of U01 is in WORK( 1, 1 )
+*     U11 is a block ( NB+1, NB+1 )
+*     The first element of U11 is in WORK( N+1, 1 )
+*
+      U11 = N
+*
+*     INVD is a block ( N, 2 )
+*     The first element of INVD is in WORK( 1, INVD )
+*
+      INVD = NB + 2
+
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        invA = P * inv(U**H) * inv(D) * inv(U) * P**T.
+*
+         CALL CTRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(U)
+*
+         K = 1
+         DO WHILE( K.LE.N )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = ONE / REAL( A( K, K ) )
+               WORK( K, INVD+1 ) = CZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = ABS( WORK( K+1, 1 ) )
+               AK = REAL( A( K, K ) ) / T
+               AKP1 = REAL( A( K+1, K+1 ) ) / T
+               AKKP1 = WORK( K+1, 1 )  / T
+               D = T*( AK*AKP1-CONE )
+               WORK( K, INVD ) = AKP1 / D
+               WORK( K+1, INVD+1 ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K+1, INVD ) = CONJG( WORK( K, INVD+1 ) )
+               K = K + 1
+            END IF
+            K = K + 1
+         END DO
+*
+*        inv(U**H) = (inv(U))**H
+*
+*        inv(U**H) * inv(D) * inv(U)
+*
+         CUT = N
+         DO WHILE( CUT.GT.0 )
+            NNB = NB
+            IF( CUT.LE.NNB ) THEN
+               NNB = CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT+1-NNB, CUT
+                  IF( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+
+            CUT = CUT - NNB
+*
+*           U01 Block
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  WORK( I, J ) = A( I, CUT+J )
+               END DO
+            END DO
+*
+*           U11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I ) = CONE
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = CZERO
+                END DO
+                DO J = I+1, NNB
+                   WORK( U11+I, J ) = A( CUT+I, CUT+J )
+                END DO
+            END DO
+*
+*           invD * U01
+*
+            I = 1
+            DO WHILE( I.LE.CUT )
+               IF( IPIV( I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( I, INVD ) * WORK( I, J )
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK( I, J )
+                     U01_IP1_J = WORK( I+1, J )
+                     WORK( I, J ) = WORK( I, INVD ) * U01_I_J
+     $                            + WORK( I, INVD+1 ) * U01_IP1_J
+                     WORK( I+1, J ) = WORK( I+1, INVD ) * U01_I_J
+     $                              + WORK( I+1, INVD+1 ) * U01_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           invD1 * U11
+*
+            I = 1
+            DO WHILE ( I.LE.NNB )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = I, NNB
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+                  END DO
+               ELSE
+                  DO J = I, NNB
+                     U11_I_J = WORK(U11+I,J)
+                     U11_IP1_J = WORK(U11+I+1,J)
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                            + WORK(CUT+I,INVD+1) * WORK(U11+I+1,J)
+                     WORK( U11+I+1, J ) = WORK(CUT+I+1,INVD) * U11_I_J
+     $                               + WORK(CUT+I+1,INVD+1) * U11_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           U11**H * invD1 * U11 -> U11
+*
+            CALL CTRMM( 'L', 'U', 'C', 'U', NNB, NNB,
+     $                 CONE, A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                 N+NB+1 )
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+*           U01**H * invD * U01 -> A( CUT+I, CUT+J )
+*
+            CALL CGEMM( 'C', 'N', NNB, NNB, CUT, CONE, A( 1, CUT+1 ),
+     $                  LDA, WORK, N+NB+1, CZERO, WORK(U11+1,1),
+     $                  N+NB+1 )
+
+*
+*           U11 =  U11**H * invD1 * U11 + U01**H * invD * U01
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = A( CUT+I, CUT+J ) + WORK(U11+I,J)
+               END DO
+            END DO
+*
+*           U01 =  U00**H * invD0 * U01
+*
+            CALL CTRMM( 'L', UPLO, 'C', 'U', CUT, NNB,
+     $                  CONE, A, LDA, WORK, N+NB+1 )
+
+*
+*           Update U01
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  A( I, CUT+J ) = WORK( I, J )
+               END DO
+            END DO
+*
+*           Next Block
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(U**H) * inv(D) * inv(U) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Upper case.
+*
+*        ( We can use a loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = 1, N
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        inv A = P * inv(L**H) * inv(D) * inv(L) * P**T.
+*
+         CALL CTRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(L)
+*
+         K = N
+         DO WHILE ( K .GE. 1 )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = ONE / REAL( A( K, K ) )
+               WORK( K, INVD+1 ) = CZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = ABS( WORK( K-1, 1 ) )
+               AK = REAL( A( K-1, K-1 ) ) / T
+               AKP1 = REAL( A( K, K ) ) / T
+               AKKP1 = WORK( K-1, 1 ) / T
+               D = T*( AK*AKP1-CONE )
+               WORK( K-1, INVD ) = AKP1 / D
+               WORK( K, INVD ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K-1, INVD+1 ) = CONJG( WORK( K, INVD+1 ) )
+               K = K - 1
+            END IF
+            K = K - 1
+         END DO
+*
+*        inv(L**H) = (inv(L))**H
+*
+*        inv(L**H) * inv(D) * inv(L)
+*
+         CUT = 0
+         DO WHILE( CUT.LT.N )
+            NNB = NB
+            IF( (CUT + NNB).GT.N ) THEN
+               NNB = N - CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT + 1, CUT+NNB
+                  IF ( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+*
+*           L21 Block
+*
+            DO I = 1, N-CUT-NNB
+               DO J = 1, NNB
+                 WORK( I, J ) = A( CUT+NNB+I, CUT+J )
+               END DO
+            END DO
+*
+*           L11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I) = CONE
+               DO J = I+1, NNB
+                  WORK( U11+I, J ) = CZERO
+               END DO
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = A( CUT+I, CUT+J )
+               END DO
+            END DO
+*
+*           invD*L21
+*
+            I = N-CUT-NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+NNB+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( CUT+NNB+I, INVD) * WORK( I, J)
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK(I,J)
+                     U01_IP1_J = WORK(I-1,J)
+                     WORK(I,J)=WORK(CUT+NNB+I,INVD)*U01_I_J+
+     $                        WORK(CUT+NNB+I,INVD+1)*U01_IP1_J
+                     WORK(I-1,J)=WORK(CUT+NNB+I-1,INVD+1)*U01_I_J+
+     $                        WORK(CUT+NNB+I-1,INVD)*U01_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           invD1*L11
+*
+            I = NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( U11+I, J ) = WORK( CUT+I, INVD)*WORK(U11+I,J)
+                  END DO
+
+               ELSE
+                  DO J = 1, NNB
+                     U11_I_J = WORK( U11+I, J )
+                     U11_IP1_J = WORK( U11+I-1, J )
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                                + WORK(CUT+I,INVD+1) * U11_IP1_J
+                     WORK( U11+I-1, J ) = WORK(CUT+I-1,INVD+1) * U11_I_J
+     $                                  + WORK(CUT+I-1,INVD) * U11_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           L11**H * invD1 * L11 -> L11
+*
+            CALL CTRMM( 'L', UPLO, 'C', 'U', NNB, NNB, CONE,
+     $                   A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                   N+NB+1 )
+
+*
+            DO I = 1, NNB
+               DO J = 1, I
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+            IF( (CUT+NNB).LT.N ) THEN
+*
+*              L21**H * invD2*L21 -> A( CUT+I, CUT+J )
+*
+               CALL CGEMM( 'C', 'N', NNB, NNB, N-NNB-CUT, CONE,
+     $                     A( CUT+NNB+1, CUT+1 ), LDA, WORK, N+NB+1,
+     $                     CZERO, WORK( U11+1, 1 ), N+NB+1 )
+
+*
+*              L11 =  L11**H * invD1 * L11 + U01**H * invD * U01
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = A( CUT+I, CUT+J )+WORK(U11+I,J)
+                  END DO
+               END DO
+*
+*              L01 =  L22**H * invD2 * L21
+*
+               CALL CTRMM( 'L', UPLO, 'C', 'U', N-NNB-CUT, NNB, CONE,
+     $                     A( CUT+NNB+1, CUT+NNB+1 ), LDA, WORK,
+     $                     N+NB+1 )
+*
+*              Update L21
+*
+               DO I = 1, N-CUT-NNB
+                  DO J = 1, NNB
+                     A( CUT+NNB+I, CUT+J ) = WORK( I, J )
+                  END DO
+               END DO
+*
+            ELSE
+*
+*              L11 =  L11**H * invD1 * L11
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = WORK( U11+I, J )
+                  END DO
+               END DO
+            END IF
+*
+*           Next Block
+*
+            CUT = CUT + NNB
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(L**H) * inv(D) * inv(L) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Lower case.
+*
+*        ( We can use a loop over IPIV with increment -1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = N, 1, -1
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of CHETRI_3X
+*
+      END
diff --git a/SRC/chetrs_3.f b/SRC/chetrs_3.f
new file mode 100644
index 00000000..2799aa24
--- /dev/null
+++ b/SRC/chetrs_3.f
@@ -0,0 +1,374 @@
+*> \brief \b CHETRS_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHETRS_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrs_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrs_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrs_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), B( LDB, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CHETRS_3 solves a system of linear equations A * X = B with a complex
+*> Hermitian matrix A using the factorization computed
+*> by CHETRF_RK or CHETRF_BK:
+*>
+*>    A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This algorithm is using Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**H)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**H)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by CHETRF_RK and CHETRF_BK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by CHETRF_RK or CHETRF_BK.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (LDB,NRHS)
+*>          On entry, the right hand side matrix B.
+*>          On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), B( LDB, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX            ONE
+      PARAMETER          ( ONE = ( 1.0E+0,0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, J, K, KP
+      REAL               S
+      COMPLEX            AK, AKM1, AKM1K, BK, BKM1, DENOM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CSSCAL, CSWAP, CTRSM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, CONJG, MAX, REAL
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CHETRS_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. NRHS.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        Solve A*X = B, where A = U*D*U**H.
+*
+*        P**T * B
+*
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]
+*
+         CALL CTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (U \P**T * B) ]
+*
+         I = N
+         DO WHILE ( I.GE.1 )
+            IF( IPIV( I ).GT.0 ) THEN
+               S = REAL( ONE ) / REAL( A( I, I ) )
+               CALL CSSCAL( NRHS, S, B( I, 1 ), LDB )
+            ELSE IF ( I.GT.1 ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I-1, I-1 ) / AKM1K
+               AK = A( I, I ) / CONJG( AKM1K )
+               DENOM = AKM1*AK - ONE
+               DO J = 1, NRHS
+                  BKM1 = B( I-1, J ) / AKM1K
+                  BK = B( I, J ) / CONJG( AKM1K )
+                  B( I-1, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I - 1
+            END IF
+            I = I - 1
+         END DO
+*
+*        Compute (U**H \ B) -> B   [ U**H \ (D \ (U \P**T * B) ) ]
+*
+         CALL CTRSM( 'L', 'U', 'C', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (U**H \ (D \ (U \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N, 1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        Solve A*X = B, where A = L*D*L**H.
+*
+*        P**T * B
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N, 1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]
+*
+         CALL CTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (L \P**T * B) ]
+*
+         I = 1
+         DO WHILE ( I.LE.N )
+            IF( IPIV( I ).GT.0 ) THEN
+               S = REAL( ONE ) / REAL( A( I, I ) )
+               CALL CSSCAL( NRHS, S, B( I, 1 ), LDB )
+            ELSE IF( I.LT.N ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I, I ) / CONJG( AKM1K )
+               AK = A( I+1, I+1 ) / AKM1K
+               DENOM = AKM1*AK - ONE
+               DO  J = 1, NRHS
+                  BKM1 = B( I, J ) / CONJG( AKM1K )
+                  BK = B( I+1, J ) / AKM1K
+                  B( I, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I + 1
+            END IF
+            I = I + 1
+         END DO
+*
+*        Compute (L**H \ B) -> B   [ L**H \ (D \ (L \P**T * B) ) ]
+*
+         CALL CTRSM('L', 'L', 'C', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (L**H \ (D \ (L \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        END Lower
+*
+      END IF
+*
+      RETURN
+*
+*     End of CHETRS_3
+*
+      END
diff --git a/SRC/chetrs_aa.f b/SRC/chetrs_aa.f
index 47d7825d..ef55c8f0 100644
--- a/SRC/chetrs_aa.f
+++ b/SRC/chetrs_aa.f
@@ -27,7 +27,7 @@
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * )
-*       COMPLEX   A( LDA, * ), B( LDB, * ), WORK( * )
+*       COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
 *       ..
 *
 *
@@ -36,9 +36,9 @@
 *>
 *> \verbatim
 *>
-*> CHETRS_AA solves a system of linear equations A*X = B with a real
-*> hermitian matrix A using the factorization A = U*T*U**T or
-*> A = L*T*L**T computed by CHETRF_AA.
+*> CHETRS_AA solves a system of linear equations A*X = B with a complex
+*> hermitian matrix A using the factorization A = U*T*U**H or
+*> A = L*T*L**H computed by CHETRF_AA.
 *> \endverbatim
 *
 *  Arguments:
@@ -49,8 +49,8 @@
 *>          UPLO is CHARACTER*1
 *>          Specifies whether the details of the factorization are stored
 *>          as an upper or lower triangular matrix.
-*>          = 'U':  Upper triangular, form is A = U*T*U**T;
-*>          = 'L':  Lower triangular, form is A = L*T*L**T.
+*>          = 'U':  Upper triangular, form is A = U*T*U**H;
+*>          = 'L':  Lower triangular, form is A = L*T*L**H.
 *> \endverbatim
 *>
 *> \param[in] N
@@ -104,7 +104,7 @@
 *>
 *> \param[in] LWORK
 *> \verbatim
-*>          LWORK is INTEGER, LWORK >= 3*N-2.
+*>          LWORK is INTEGER, LWORK >= MAX(1,3*N-2).
 *>
 *> \param[out] INFO
 *> \verbatim
@@ -142,12 +142,12 @@
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * )
-      COMPLEX   A( LDA, * ), B( LDB, * ), WORK( * )
+      COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
 *     ..
 *
 *  =====================================================================
 *
-      COMPLEX   ONE
+      COMPLEX            ONE
       PARAMETER          ( ONE = 1.0E+0 )
 *     ..
 *     .. Local Scalars ..
@@ -179,7 +179,7 @@
          INFO = -5
       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
          INFO = -8
-      ELSE IF( LWORK.LT.(3*N-2) .AND. .NOT.LQUERY ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
          INFO = -10
       END IF
       IF( INFO.NE.0 ) THEN
diff --git a/SRC/chetrs_aa_REMOTE_88868.f b/SRC/chetrs_aa_REMOTE_88868.f
deleted file mode 100644
index 33f32fac..00000000
--- a/SRC/chetrs_aa_REMOTE_88868.f
+++ /dev/null
@@ -1,292 +0,0 @@
-*> \brief \b CHETRS_AASEN
-*
-*  =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-*            http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download CHETRS_AASEN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrs_aasen.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrs_aasen.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrs_aasen.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-*  Definition:
-*  ===========
-*
-*       SUBROUTINE CHETRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
-*                                WORK, LWORK, INFO )
-*
-*       .. Scalar Arguments ..
-*       CHARACTER          UPLO
-*       INTEGER            N, NRHS, LDA, LDB, LWORK, INFO
-*       ..
-*       .. Array Arguments ..
-*       INTEGER            IPIV( * )
-*       COMPLEX   A( LDA, * ), B( LDB, * ), WORK( * )
-*       ..
-*
-*
-*> \par Purpose:
-*  =============
-*>
-*> \verbatim
-*>
-*> CHETRS_AASEN solves a system of linear equations A*X = B with a real
-*> hermitian matrix A using the factorization A = U*T*U**T or
-*> A = L*T*L**T computed by CHETRF_AASEN.
-*> \endverbatim
-*
-*  Arguments:
-*  ==========
-*
-*> \param[in] UPLO
-*> \verbatim
-*>          UPLO is CHARACTER*1
-*>          Specifies whether the details of the factorization are stored
-*>          as an upper or lower triangular matrix.
-*>          = 'U':  Upper triangular, form is A = U*T*U**T;
-*>          = 'L':  Lower triangular, form is A = L*T*L**T.
-*> \endverbatim
-*>
-*> \param[in] N
-*> \verbatim
-*>          N is INTEGER
-*>          The order of the matrix A.  N >= 0.
-*> \endverbatim
-*>
-*> \param[in] NRHS
-*> \verbatim
-*>          NRHS is INTEGER
-*>          The number of right hand sides, i.e., the number of columns
-*>          of the matrix B.  NRHS >= 0.
-*> \endverbatim
-*>
-*> \param[in,out] A
-*> \verbatim
-*>          A is COMPLEX array, dimension (LDA,N)
-*>          Details of factors computed by CHETRF_AASEN.
-*> \endverbatim
-*>
-*> \param[in] LDA
-*> \verbatim
-*>          LDA is INTEGER
-*>          The leading dimension of the array A.  LDA >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] IPIV
-*> \verbatim
-*>          IPIV is INTEGER array, dimension (N)
-*>          Details of the interchanges as computed by CHETRF_AASEN.
-*> \endverbatim
-*>
-*> \param[in,out] B
-*> \verbatim
-*>          B is COMPLEX array, dimension (LDB,NRHS)
-*>          On entry, the right hand side matrix B.
-*>          On exit, the solution matrix X.
-*> \endverbatim
-*>
-*> \param[in] LDB
-*> \verbatim
-*>          LDB is INTEGER
-*>          The leading dimension of the array B.  LDB >= max(1,N).
-*> \endverbatim
-*>
-*> \param[in] WORK
-*> \verbatim
-*>          WORK is DOUBLE array, dimension (MAX(1,LWORK))
-*> \endverbatim
-*>
-*> \param[in] LWORK
-*> \verbatim
-*>          LWORK is INTEGER, LWORK >= 3*N-2.
-*>
-*> \param[out] INFO
-*> \verbatim
-*>          INFO is INTEGER
-*>          = 0:  successful exit
-*>          < 0:  if INFO = -i, the i-th argument had an illegal value
-*> \endverbatim
-*
-*  Authors:
-*  ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date November 2016
-*
-*> \ingroup complexSYcomputational
-*
-*  @generated from zhetrs_aasen.f, fortran z -> c, Fri Sep 23 00:09:52 2016
-*
-*  =====================================================================
-      SUBROUTINE CHETRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
-     $                         WORK, LWORK, INFO )
-*
-*  -- LAPACK computational routine (version 3.4.0) --
-*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
-*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2016
-*
-      IMPLICIT NONE
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            N, NRHS, LDA, LDB, LWORK, INFO
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      COMPLEX   A( LDA, * ), B( LDB, * ), WORK( * )
-*     ..
-*
-*  =====================================================================
-*
-      COMPLEX   ONE
-      PARAMETER          ( ONE = 1.0E+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            K, KP
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           CGTSV, CSWAP, CTRSM, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-      UPPER = LSAME( UPLO, 'U' )
-      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( NRHS.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -8
-      ELSE IF( LWORK.LT.(3*N-2) ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'CHETRS_AASEN', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 .OR. NRHS.EQ.0 )
-     $   RETURN
-*
-      IF( UPPER ) THEN
-*
-*        Solve A*X = B, where A = U*T*U**T.
-*
-*        P**T * B
-*
-         K = 1
-         DO WHILE ( K.LE.N )
-            KP = IPIV( K )
-            IF( KP.NE.K )
-     $          CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K + 1
-         END DO
-*
-*        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]
-*
-         CALL CTRSM('L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
-     $               B( 2, 1 ), LDB)
-*
-*        Compute T \ B -> B   [ T \ (U \P**T * B) ]
-*
-         CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
-         IF( N.GT.1 ) THEN
-             CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1)
-             CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1)
-             CALL CLACGV( N-1, WORK( 1 ), 1 )
-         END IF
-         CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
-     $              INFO)
-*
-*        Compute (U**T \ B) -> B   [ U**T \ (T \ (U \P**T * B) ) ]
-*
-         CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
-     $               B(2, 1), LDB)
-*
-*        Pivot, P * B  [ P * (U**T \ (T \ (U \P**T * B) )) ]
-*
-         K = N
-         DO WHILE ( K.GE.1 )
-            KP = IPIV( K )
-            IF( KP.NE.K )
-     $         CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K - 1
-         END DO
-*
-      ELSE
-*
-*        Solve A*X = B, where A = L*T*L**T.
-*
-*        Pivot, P**T * B
-*
-         K = 1
-         DO WHILE ( K.LE.N )
-            KP = IPIV( K )
-            IF( KP.NE.K )
-     $         CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K + 1
-         END DO
-*
-*        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]
-*
-         CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), LDA,
-     $               B(2, 1), LDB)
-*
-*        Compute T \ B -> B   [ T \ (L \P**T * B) ]
-*
-         CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
-         IF( N.GT.1 ) THEN
-             CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1)
-             CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1)
-             CALL CLACGV( N-1, WORK( 2*N ), 1 )
-         END IF
-         CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
-     $              INFO)
-*
-*        Compute (L**T \ B) -> B   [ L**T \ (T \ (L \P**T * B) ) ]
-*
-         CALL CTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
-     $              B( 2, 1 ), LDB)
-*
-*        Pivot, P * B  [ P * (L**T \ (T \ (L \P**T * B) )) ]
-*
-         K = N
-         DO WHILE ( K.GE.1 )
-            KP = IPIV( K )
-            IF( KP.NE.K )
-     $         CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K - 1
-         END DO
-*
-      END IF
-*
-      RETURN
-*
-*     End of CHETRS_AASEN
-*
-      END
diff --git a/SRC/clahef_aa.f b/SRC/clahef_aa.f
index 01e8f98c..81ca9023 100644
--- a/SRC/clahef_aa.f
+++ b/SRC/clahef_aa.f
@@ -19,7 +19,7 @@
 *  ===========
 *
 *       SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-*                                H, LDH, WORK, INFO )
+*                             H, LDH, WORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER    UPLO
@@ -27,7 +27,7 @@
 *       ..
 *       .. Array Arguments ..
 *       INTEGER      IPIV( * )
-*       COMPLEX   A( LDA, * ), H( LDH, * ), WORK( * )
+*       COMPLEX      A( LDA, * ), H( LDH, * ), WORK( * )
 *       ..
 *
 *
@@ -36,7 +36,7 @@
 *>
 *> \verbatim
 *>
-*> DLATRF_AA factorizes a panel of a real hermitian matrix A using
+*> CLAHEF_AA factorizes a panel of a complex hermitian matrix A using
 *> the Aasen's algorithm. The panel consists of a set of NB rows of A
 *> when UPLO is U, or a set of NB columns when UPLO is L.
 *>
@@ -46,7 +46,7 @@
 *> which is used to factorize the first panel.
 *>
 *> The resulting J-th row of U, or J-th column of L, is stored in the
-*> (J-1)-th row, or column, of A (without the unit diatonals), while
+*> (J-1)-th row, or column, of A (without the unit diagonals), while
 *> the diagonal and subdiagonal of A are overwritten by those of T.
 *>
 *> \endverbatim
@@ -152,7 +152,7 @@
 *
 *  =====================================================================
       SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-     $                         H, LDH, WORK, INFO )
+     $                      H, LDH, WORK, INFO )
 *
 *  -- LAPACK computational routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -167,17 +167,17 @@
 *     ..
 *     .. Array Arguments ..
       INTEGER      IPIV( * )
-      COMPLEX   A( LDA, * ), H( LDH, * ), WORK( * )
+      COMPLEX      A( LDA, * ), H( LDH, * ), WORK( * )
 *     ..
 *
 *  =====================================================================
 *     .. Parameters ..
-      COMPLEX   ZERO, ONE
+      COMPLEX      ZERO, ONE
       PARAMETER    ( ZERO = (0.0E+0, 0.0E+0), ONE = (1.0E+0, 0.0E+0) )
 *
 *     .. Local Scalars ..
       INTEGER      J, K, K1, I1, I2
-      COMPLEX   PIV, ALPHA
+      COMPLEX      PIV, ALPHA
 *     ..
 *     .. External Functions ..
       LOGICAL      LSAME
diff --git a/SRC/clahef_rk.f b/SRC/clahef_rk.f
new file mode 100644
index 00000000..c981a9c8
--- /dev/null
+++ b/SRC/clahef_rk.f
@@ -0,0 +1,1234 @@
+*> \brief \b CLAHEF_RK computes a partial factorization of a complex Hermitian indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLAHEF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clahef_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clahef_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clahef_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, KB, LDA, LDW, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), E( * ), W( LDW, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CLAHEF_RK computes a partial factorization of a complex Hermitian
+*> matrix A using the bounded Bunch-Kaufman (rook) diagonal
+*> pivoting method. The partial factorization has the form:
+*>
+*> A  =  ( I  U12 ) ( A11  0  ) (  I       0    )  if UPLO = 'U', or:
+*>       ( 0  U22 ) (  0   D  ) ( U12**H U22**H )
+*>
+*> A  =  ( L11  0 ) (  D   0  ) ( L11**H L21**H )  if UPLO = 'L',
+*>       ( L21  I ) (  0  A22 ) (  0       I    )
+*>
+*> where the order of D is at most NB. The actual order is returned in
+*> the argument KB, and is either NB or NB-1, or N if N <= NB.
+*>
+*> CLAHEF_RK is an auxiliary routine called by CHETRF_RK. It uses
+*> blocked code (calling Level 3 BLAS) to update the submatrix
+*> A11 (if UPLO = 'U') or A22 (if UPLO = 'L').
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The maximum number of columns of the matrix A that should be
+*>          factored.  NB should be at least 2 to allow for 2-by-2 pivot
+*>          blocks.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*>          KB is INTEGER
+*>          The number of columns of A that were actually factored.
+*>          KB is either NB-1 or NB, or N if N <= NB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the Hermitian block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,N-KB+1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,1:KB).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is COMPLEX array, dimension (LDW,NB)
+*> \endverbatim
+*>
+*> \param[in] LDW
+*> \verbatim
+*>          LDW is INTEGER
+*>          The leading dimension of the array W.  LDW >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexHEcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, KB, LDA, LDW, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), W( LDW, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      REAL               EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
+      COMPLEX            CONE, CZERO
+      PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ),
+     $                   CZERO = ( 0.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            DONE
+      INTEGER            IMAX, ITEMP, II, J, JB, JJ, JMAX, K, KK, KKW,
+     $                   KP, KSTEP, KW, P
+      REAL               ABSAKK, ALPHA, COLMAX, STEMP, R1, ROWMAX, T,
+     $                   SFMIN
+      COMPLEX            D11, D21, D22, Z
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ICAMAX
+      REAL               SLAMCH
+      EXTERNAL           LSAME, ICAMAX, SLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CCOPY, CSSCAL, CGEMM, CGEMV, CLACGV, CSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, CONJG, AIMAG, MAX, MIN, REAL, SQRT
+*     ..
+*     .. Statement Functions ..
+      REAL               CABS1
+*     ..
+*     .. Statement Function definitions ..
+      CABS1( Z ) = ABS( REAL( Z ) ) + ABS( AIMAG( Z ) )
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = SLAMCH( 'S' )
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+*
+*        Factorize the trailing columns of A using the upper triangle
+*        of A and working backwards, and compute the matrix W = U12*D
+*        for use in updating A11 (note that conjg(W) is actually stored)
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = CZERO
+*
+*        K is the main loop index, decreasing from N in steps of 1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        KW is the column of W which corresponds to column K of A
+*
+         KW = NB + K - N
+*
+*        Exit from loop
+*
+         IF( ( K.LE.N-NB+1 .AND. NB.LT.N ) .OR. K.LT.1 )
+     $      GO TO 30
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column KW of W and update it
+*
+         IF( K.GT.1 )
+     $      CALL CCOPY( K-1, A( 1, K ), 1, W( 1, KW ), 1 )
+         W( K, KW ) = REAL( A( K, K ) )
+         IF( K.LT.N ) THEN
+            CALL CGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA,
+     $                  W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 )
+            W( K, KW ) = REAL( W( K, KW ) )
+         END IF
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( REAL( W( K, KW ) ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = ICAMAX( K-1, W( 1, KW ), 1 )
+            COLMAX = CABS1( W( IMAX, KW ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            A( K, K ) = REAL( W( K, KW ) )
+            IF( K.GT.1 )
+     $         CALL CCOPY( K-1, W( 1, KW ), 1, A( 1, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           BEGIN pivot search
+*
+*           Case(1)
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+*              Lop until pivot found
+*
+               DONE = .FALSE.
+*
+   12          CONTINUE
+*
+*                 BEGIN pivot search loop body
+*
+*
+*                 Copy column IMAX to column KW-1 of W and update it
+*
+                  IF( IMAX.GT.1 )
+     $               CALL CCOPY( IMAX-1, A( 1, IMAX ), 1, W( 1, KW-1 ),
+     $                           1 )
+                  W( IMAX, KW-1 ) = REAL( A( IMAX, IMAX ) )
+*
+                  CALL CCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA,
+     $                        W( IMAX+1, KW-1 ), 1 )
+                  CALL CLACGV( K-IMAX, W( IMAX+1, KW-1 ), 1 )
+*
+                  IF( K.LT.N ) THEN
+                     CALL CGEMV( 'No transpose', K, N-K, -CONE,
+     $                           A( 1, K+1 ), LDA, W( IMAX, KW+1 ), LDW,
+     $                           CONE, W( 1, KW-1 ), 1 )
+                     W( IMAX, KW-1 ) = REAL( W( IMAX, KW-1 ) )
+                  END IF
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + ICAMAX( K-IMAX, W( IMAX+1, KW-1 ),
+     $                                     1 )
+                     ROWMAX = CABS1( W( JMAX, KW-1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = ICAMAX( IMAX-1, W( 1, KW-1 ), 1 )
+                     STEMP = CABS1( W( ITEMP, KW-1 ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Case(2)
+*                 Equivalent to testing for
+*                 ABS( REAL( W( IMAX,KW-1 ) ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( ABS( REAL( W( IMAX,KW-1 ) ) )
+     $                       .LT.ALPHA*ROWMAX ) ) THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column KW-1 of W to column KW of W
+*
+                     CALL CCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Case(3)
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K-1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+*
+*                 Case(4)
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL CCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                  END IF
+*
+*
+*                 END pivot search loop body
+*
+               IF( .NOT.DONE ) GOTO 12
+*
+            END IF
+*
+*           END pivot search
+*
+*           ============================================================
+*
+*           KK is the column of A where pivoting step stopped
+*
+            KK = K - KSTEP + 1
+*
+*           KKW is the column of W which corresponds to column KK of A
+*
+            KKW = NB + KK - N
+*
+*           Interchange rows and columns P and K.
+*           Updated column P is already stored in column KW of W.
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column K to column P of submatrix A
+*              at step K. No need to copy element into columns
+*              K and K-1 of A for 2-by-2 pivot, since these columns
+*              will be later overwritten.
+*
+               A( P, P ) = REAL( A( K, K ) )
+               CALL CCOPY( K-1-P, A( P+1, K ), 1, A( P, P+1 ),
+     $                     LDA )
+               CALL CLACGV( K-1-P, A( P, P+1 ), LDA )
+               IF( P.GT.1 )
+     $            CALL CCOPY( P-1, A( 1, K ), 1, A( 1, P ), 1 )
+*
+*              Interchange rows K and P in the last K+1 to N columns of A
+*              (columns K and K-1 of A for 2-by-2 pivot will be
+*              later overwritten). Interchange rows K and P
+*              in last KKW to NB columns of W.
+*
+               IF( K.LT.N )
+     $            CALL CSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ),
+     $                        LDA )
+               CALL CSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ),
+     $                     LDW )
+            END IF
+*
+*           Interchange rows and columns KP and KK.
+*           Updated column KP is already stored in column KKW of W.
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP of submatrix A
+*              at step K. No need to copy element into column K
+*              (or K and K-1 for 2-by-2 pivot) of A, since these columns
+*              will be later overwritten.
+*
+               A( KP, KP ) = REAL( A( KK, KK ) )
+               CALL CCOPY( KK-1-KP, A( KP+1, KK ), 1, A( KP, KP+1 ),
+     $                     LDA )
+               CALL CLACGV( KK-1-KP, A( KP, KP+1 ), LDA )
+               IF( KP.GT.1 )
+     $            CALL CCOPY( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 )
+*
+*              Interchange rows KK and KP in last K+1 to N columns of A
+*              (columns K (or K and K-1 for 2-by-2 pivot) of A will be
+*              later overwritten). Interchange rows KK and KP
+*              in last KKW to NB columns of W.
+*
+               IF( K.LT.N )
+     $            CALL CSWAP( N-K, A( KK, K+1 ), LDA, A( KP, K+1 ),
+     $                        LDA )
+               CALL CSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ),
+     $                     LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column kw of W now holds
+*
+*              W(kw) = U(k)*D(k),
+*
+*              where U(k) is the k-th column of U
+*
+*              (1) Store subdiag. elements of column U(k)
+*              and 1-by-1 block D(k) in column k of A.
+*              (NOTE: Diagonal element U(k,k) is a UNIT element
+*              and not stored)
+*                 A(k,k) := D(k,k) = W(k,kw)
+*                 A(1:k-1,k) := U(1:k-1,k) = W(1:k-1,kw)/D(k,k)
+*
+*              (NOTE: No need to use for Hermitian matrix
+*              A( K, K ) = REAL( W( K, K) ) to separately copy diagonal
+*              element D(k,k) from W (potentially saves only one load))
+               CALL CCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
+               IF( K.GT.1 ) THEN
+*
+*                 (NOTE: No need to check if A(k,k) is NOT ZERO,
+*                  since that was ensured earlier in pivot search:
+*                  case A(k,k) = 0 falls into 2x2 pivot case(3))
+*
+*                 Handle division by a small number
+*
+                  T = REAL( A( K, K ) )
+                  IF( ABS( T ).GE.SFMIN ) THEN
+                     R1 = ONE / T
+                     CALL CSSCAL( K-1, R1, A( 1, K ), 1 )
+                  ELSE
+                     DO 14 II = 1, K-1
+                        A( II, K ) = A( II, K ) / T
+   14                CONTINUE
+                  END IF
+*
+*                 (2) Conjugate column W(kw)
+*
+                  CALL CLACGV( K-1, W( 1, KW ), 1 )
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns kw and kw-1 of W now hold
+*
+*              ( W(kw-1) W(kw) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+*              (1) Store U(1:k-2,k-1) and U(1:k-2,k) and 2-by-2
+*              block D(k-1:k,k-1:k) in columns k-1 and k of A.
+*              (NOTE: 2-by-2 diagonal block U(k-1:k,k-1:k) is a UNIT
+*              block and not stored)
+*                 A(k-1:k,k-1:k) := D(k-1:k,k-1:k) = W(k-1:k,kw-1:kw)
+*                 A(1:k-2,k-1:k) := U(1:k-2,k:k-1:k) =
+*                 = W(1:k-2,kw-1:kw) * ( D(k-1:k,k-1:k)**(-1) )
+*
+               IF( K.GT.2 ) THEN
+*
+*                 Factor out the columns of the inverse of 2-by-2 pivot
+*                 block D, so that each column contains 1, to reduce the
+*                 number of FLOPS when we multiply panel
+*                 ( W(kw-1) W(kw) ) by this inverse, i.e. by D**(-1).
+*
+*                 D**(-1) = ( d11 cj(d21) )**(-1) =
+*                           ( d21    d22 )
+*
+*                 = 1/(d11*d22-|d21|**2) * ( ( d22) (-cj(d21) ) ) =
+*                                          ( (-d21) (     d11 ) )
+*
+*                 = 1/(|d21|**2) * 1/((d11/cj(d21))*(d22/d21)-1) *
+*
+*                   * ( d21*( d22/d21 ) conj(d21)*(           - 1 ) ) =
+*                     (     (      -1 )           ( d11/conj(d21) ) )
+*
+*                 = 1/(|d21|**2) * 1/(D22*D11-1) *
+*
+*                   * ( d21*( D11 ) conj(d21)*(  -1 ) ) =
+*                     (     (  -1 )           ( D22 ) )
+*
+*                 = (1/|d21|**2) * T * ( d21*( D11 ) conj(d21)*(  -1 ) ) =
+*                                      (     (  -1 )           ( D22 ) )
+*
+*                 = ( (T/conj(d21))*( D11 ) (T/d21)*(  -1 ) ) =
+*                   (               (  -1 )         ( D22 ) )
+*
+*                 Handle division by a small number. (NOTE: order of
+*                 operations is important)
+*
+*                 = ( T*(( D11 )/conj(D21)) T*((  -1 )/D21 ) )
+*                   (   ((  -1 )          )   (( D22 )     ) ),
+*
+*                 where D11 = d22/d21,
+*                       D22 = d11/conj(d21),
+*                       D21 = d21,
+*                       T = 1/(D22*D11-1).
+*
+*                 (NOTE: No need to check for division by ZERO,
+*                  since that was ensured earlier in pivot search:
+*                  (a) d21 != 0 in 2x2 pivot case(4),
+*                      since |d21| should be larger than |d11| and |d22|;
+*                  (b) (D22*D11 - 1) != 0, since from (a),
+*                      both |D11| < 1, |D22| < 1, hence |D22*D11| << 1.)
+*
+                  D21 = W( K-1, KW )
+                  D11 = W( K, KW ) / CONJG( D21 )
+                  D22 = W( K-1, KW-1 ) / D21
+                  T = ONE / ( REAL( D11*D22 )-ONE )
+*
+*                 Update elements in columns A(k-1) and A(k) as
+*                 dot products of rows of ( W(kw-1) W(kw) ) and columns
+*                 of D**(-1)
+*
+                  DO 20 J = 1, K - 2
+                     A( J, K-1 ) = T*( ( D11*W( J, KW-1 )-W( J, KW ) ) /
+     $                             D21 )
+                     A( J, K ) = T*( ( D22*W( J, KW )-W( J, KW-1 ) ) /
+     $                           CONJG( D21 ) )
+   20             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy superdiagonal element of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               A( K-1, K-1 ) = W( K-1, KW-1 )
+               A( K-1, K ) = CZERO
+               A( K, K ) = W( K, KW )
+               E( K ) = W( K-1, KW )
+               E( K-1 ) = CZERO
+*
+*              (2) Conjugate columns W(kw) and W(kw-1)
+*
+               CALL CLACGV( K-1, W( 1, KW ), 1 )
+               CALL CLACGV( K-2, W( 1, KW-1 ), 1 )
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   30    CONTINUE
+*
+*        Update the upper triangle of A11 (= A(1:k,1:k)) as
+*
+*        A11 := A11 - U12*D*U12**H = A11 - U12*W**H
+*
+*        computing blocks of NB columns at a time (note that conjg(W) is
+*        actually stored)
+*
+         DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB
+            JB = MIN( NB, K-J+1 )
+*
+*           Update the upper triangle of the diagonal block
+*
+            DO 40 JJ = J, J + JB - 1
+               A( JJ, JJ ) = REAL( A( JJ, JJ ) )
+               CALL CGEMV( 'No transpose', JJ-J+1, N-K, -CONE,
+     $                     A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE,
+     $                     A( J, JJ ), 1 )
+               A( JJ, JJ ) = REAL( A( JJ, JJ ) )
+   40       CONTINUE
+*
+*           Update the rectangular superdiagonal block
+*
+            IF( J.GE.2 )
+     $         CALL CGEMM( 'No transpose', 'Transpose', J-1, JB, N-K,
+     $                     -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW,
+     $                     CONE, A( 1, J ), LDA )
+   50    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = N - K
+*
+      ELSE
+*
+*        Factorize the leading columns of A using the lower triangle
+*        of A and working forwards, and compute the matrix W = L21*D
+*        for use in updating A22 (note that conjg(W) is actually stored)
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = CZERO
+*
+*        K is the main loop index, increasing from 1 in steps of 1 or 2
+*
+         K = 1
+   70    CONTINUE
+*
+*        Exit from loop
+*
+         IF( ( K.GE.NB .AND. NB.LT.N ) .OR. K.GT.N )
+     $      GO TO 90
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column K of W and update column K of W
+*
+         W( K, K ) = REAL( A( K, K ) )
+         IF( K.LT.N )
+     $      CALL CCOPY( N-K, A( K+1, K ), 1, W( K+1, K ), 1 )
+         IF( K.GT.1 ) THEN
+            CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ),
+     $                  LDA, W( K, 1 ), LDW, CONE, W( K, K ), 1 )
+            W( K, K ) = REAL( W( K, K ) )
+         END IF
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( REAL( W( K, K ) ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + ICAMAX( N-K, W( K+1, K ), 1 )
+            COLMAX = CABS1( W( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            A( K, K ) = REAL( W( K, K ) )
+            IF( K.LT.N )
+     $         CALL CCOPY( N-K, W( K+1, K ), 1, A( K+1, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           BEGIN pivot search
+*
+*           Case(1)
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   72          CONTINUE
+*
+*                 BEGIN pivot search loop body
+*
+*
+*                 Copy column IMAX to column k+1 of W and update it
+*
+                  CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1)
+                  CALL CLACGV( IMAX-K, W( K, K+1 ), 1 )
+                  W( IMAX, K+1 ) = REAL( A( IMAX, IMAX ) )
+*
+                  IF( IMAX.LT.N )
+     $               CALL CCOPY( N-IMAX, A( IMAX+1, IMAX ), 1,
+     $                           W( IMAX+1, K+1 ), 1 )
+*
+                  IF( K.GT.1 ) THEN
+                     CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE,
+     $                            A( K, 1 ), LDA, W( IMAX, 1 ), LDW,
+     $                            CONE, W( K, K+1 ), 1 )
+                     W( IMAX, K+1 ) = REAL( W( IMAX, K+1 ) )
+                  END IF
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + ICAMAX( IMAX-K, W( K, K+1 ), 1 )
+                     ROWMAX = CABS1( W( JMAX, K+1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + ICAMAX( N-IMAX, W( IMAX+1, K+1 ), 1)
+                     STEMP = CABS1( W( ITEMP, K+1 ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Case(2)
+*                 Equivalent to testing for
+*                 ABS( REAL( W( IMAX,K+1 ) ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( ABS( REAL( W( IMAX,K+1 ) ) )
+     $                       .LT.ALPHA*ROWMAX ) ) THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column K+1 of W to column K of W
+*
+                     CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Case(3)
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+*
+*                 Case(4)
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                  END IF
+*
+*
+*                 End pivot search loop body
+*
+               IF( .NOT.DONE ) GOTO 72
+*
+            END IF
+*
+*           END pivot search
+*
+*           ============================================================
+*
+*           KK is the column of A where pivoting step stopped
+*
+            KK = K + KSTEP - 1
+*
+*           Interchange rows and columns P and K (only for 2-by-2 pivot).
+*           Updated column P is already stored in column K of W.
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column KK-1 to column P of submatrix A
+*              at step K. No need to copy element into columns
+*              K and K+1 of A for 2-by-2 pivot, since these columns
+*              will be later overwritten.
+*
+               A( P, P ) = REAL( A( K, K ) )
+               CALL CCOPY( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA )
+               CALL CLACGV( P-K-1, A( P, K+1 ), LDA )
+               IF( P.LT.N )
+     $            CALL CCOPY( N-P, A( P+1, K ), 1, A( P+1, P ), 1 )
+*
+*              Interchange rows K and P in first K-1 columns of A
+*              (columns K and K+1 of A for 2-by-2 pivot will be
+*              later overwritten). Interchange rows K and P
+*              in first KK columns of W.
+*
+               IF( K.GT.1 )
+     $            CALL CSWAP( K-1, A( K, 1 ), LDA, A( P, 1 ), LDA )
+               CALL CSWAP( KK, W( K, 1 ), LDW, W( P, 1 ), LDW )
+            END IF
+*
+*           Interchange rows and columns KP and KK.
+*           Updated column KP is already stored in column KK of W.
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP of submatrix A
+*              at step K. No need to copy element into column K
+*              (or K and K+1 for 2-by-2 pivot) of A, since these columns
+*              will be later overwritten.
+*
+               A( KP, KP ) = REAL( A( KK, KK ) )
+               CALL CCOPY( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
+     $                     LDA )
+               CALL CLACGV( KP-KK-1, A( KP, KK+1 ), LDA )
+               IF( KP.LT.N )
+     $            CALL CCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+*
+*              Interchange rows KK and KP in first K-1 columns of A
+*              (column K (or K and K+1 for 2-by-2 pivot) of A will be
+*              later overwritten). Interchange rows KK and KP
+*              in first KK columns of W.
+*
+               IF( K.GT.1 )
+     $            CALL CSWAP( K-1, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+               CALL CSWAP( KK, W( KK, 1 ), LDW, W( KP, 1 ), LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k of W now holds
+*
+*              W(k) = L(k)*D(k),
+*
+*              where L(k) is the k-th column of L
+*
+*              (1) Store subdiag. elements of column L(k)
+*              and 1-by-1 block D(k) in column k of A.
+*              (NOTE: Diagonal element L(k,k) is a UNIT element
+*              and not stored)
+*                 A(k,k) := D(k,k) = W(k,k)
+*                 A(k+1:N,k) := L(k+1:N,k) = W(k+1:N,k)/D(k,k)
+*
+*              (NOTE: No need to use for Hermitian matrix
+*              A( K, K ) = REAL( W( K, K) ) to separately copy diagonal
+*              element D(k,k) from W (potentially saves only one load))
+               CALL CCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
+               IF( K.LT.N ) THEN
+*
+*                 (NOTE: No need to check if A(k,k) is NOT ZERO,
+*                  since that was ensured earlier in pivot search:
+*                  case A(k,k) = 0 falls into 2x2 pivot case(3))
+*
+*                 Handle division by a small number
+*
+                  T = REAL( A( K, K ) )
+                  IF( ABS( T ).GE.SFMIN ) THEN
+                     R1 = ONE / T
+                     CALL CSSCAL( N-K, R1, A( K+1, K ), 1 )
+                  ELSE
+                     DO 74 II = K + 1, N
+                        A( II, K ) = A( II, K ) / T
+   74                CONTINUE
+                  END IF
+*
+*                 (2) Conjugate column W(k)
+*
+                  CALL CLACGV( N-K, W( K+1, K ), 1 )
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 of W now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+*              (1) Store L(k+2:N,k) and L(k+2:N,k+1) and 2-by-2
+*              block D(k:k+1,k:k+1) in columns k and k+1 of A.
+*              NOTE: 2-by-2 diagonal block L(k:k+1,k:k+1) is a UNIT
+*              block and not stored.
+*                 A(k:k+1,k:k+1) := D(k:k+1,k:k+1) = W(k:k+1,k:k+1)
+*                 A(k+2:N,k:k+1) := L(k+2:N,k:k+1) =
+*                 = W(k+2:N,k:k+1) * ( D(k:k+1,k:k+1)**(-1) )
+*
+               IF( K.LT.N-1 ) THEN
+*
+*                 Factor out the columns of the inverse of 2-by-2 pivot
+*                 block D, so that each column contains 1, to reduce the
+*                 number of FLOPS when we multiply panel
+*                 ( W(kw-1) W(kw) ) by this inverse, i.e. by D**(-1).
+*
+*                 D**(-1) = ( d11 cj(d21) )**(-1) =
+*                           ( d21    d22 )
+*
+*                 = 1/(d11*d22-|d21|**2) * ( ( d22) (-cj(d21) ) ) =
+*                                          ( (-d21) (     d11 ) )
+*
+*                 = 1/(|d21|**2) * 1/((d11/cj(d21))*(d22/d21)-1) *
+*
+*                   * ( d21*( d22/d21 ) conj(d21)*(           - 1 ) ) =
+*                     (     (      -1 )           ( d11/conj(d21) ) )
+*
+*                 = 1/(|d21|**2) * 1/(D22*D11-1) *
+*
+*                   * ( d21*( D11 ) conj(d21)*(  -1 ) ) =
+*                     (     (  -1 )           ( D22 ) )
+*
+*                 = (1/|d21|**2) * T * ( d21*( D11 ) conj(d21)*(  -1 ) ) =
+*                                      (     (  -1 )           ( D22 ) )
+*
+*                 = ( (T/conj(d21))*( D11 ) (T/d21)*(  -1 ) ) =
+*                   (               (  -1 )         ( D22 ) )
+*
+*                 Handle division by a small number. (NOTE: order of
+*                 operations is important)
+*
+*                 = ( T*(( D11 )/conj(D21)) T*((  -1 )/D21 ) )
+*                   (   ((  -1 )          )   (( D22 )     ) ),
+*
+*                 where D11 = d22/d21,
+*                       D22 = d11/conj(d21),
+*                       D21 = d21,
+*                       T = 1/(D22*D11-1).
+*
+*                 (NOTE: No need to check for division by ZERO,
+*                  since that was ensured earlier in pivot search:
+*                  (a) d21 != 0 in 2x2 pivot case(4),
+*                      since |d21| should be larger than |d11| and |d22|;
+*                  (b) (D22*D11 - 1) != 0, since from (a),
+*                      both |D11| < 1, |D22| < 1, hence |D22*D11| << 1.)
+*
+                  D21 = W( K+1, K )
+                  D11 = W( K+1, K+1 ) / D21
+                  D22 = W( K, K ) / CONJG( D21 )
+                  T = ONE / ( REAL( D11*D22 )-ONE )
+*
+*                 Update elements in columns A(k) and A(k+1) as
+*                 dot products of rows of ( W(k) W(k+1) ) and columns
+*                 of D**(-1)
+*
+                  DO 80 J = K + 2, N
+                     A( J, K ) = T*( ( D11*W( J, K )-W( J, K+1 ) ) /
+     $                           CONJG( D21 ) )
+                     A( J, K+1 ) = T*( ( D22*W( J, K+1 )-W( J, K ) ) /
+     $                             D21 )
+   80             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy subdiagonal element of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               A( K, K ) = W( K, K )
+               A( K+1, K ) = CZERO
+               A( K+1, K+1 ) = W( K+1, K+1 )
+               E( K ) = W( K+1, K )
+               E( K+1 ) = CZERO
+*
+*              (2) Conjugate columns W(k) and W(k+1)
+*
+               CALL CLACGV( N-K, W( K+1, K ), 1 )
+               CALL CLACGV( N-K-1, W( K+2, K+1 ), 1 )
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 70
+*
+   90    CONTINUE
+*
+*        Update the lower triangle of A22 (= A(k:n,k:n)) as
+*
+*        A22 := A22 - L21*D*L21**H = A22 - L21*W**H
+*
+*        computing blocks of NB columns at a time (note that conjg(W) is
+*        actually stored)
+*
+         DO 110 J = K, N, NB
+            JB = MIN( NB, N-J+1 )
+*
+*           Update the lower triangle of the diagonal block
+*
+            DO 100 JJ = J, J + JB - 1
+               A( JJ, JJ ) = REAL( A( JJ, JJ ) )
+               CALL CGEMV( 'No transpose', J+JB-JJ, K-1, -CONE,
+     $                     A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE,
+     $                     A( JJ, JJ ), 1 )
+               A( JJ, JJ ) = REAL( A( JJ, JJ ) )
+  100       CONTINUE
+*
+*           Update the rectangular subdiagonal block
+*
+            IF( J+JB.LE.N )
+     $         CALL CGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
+     $                     K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ),
+     $                     LDW, CONE, A( J+JB, J ), LDA )
+  110    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = K - 1
+*
+      END IF
+      RETURN
+*
+*     End of CLAHEF_RK
+*
+      END
diff --git a/SRC/clarfy.f b/SRC/clarfy.f
new file mode 100644
index 00000000..572a4723
--- /dev/null
+++ b/SRC/clarfy.f
@@ -0,0 +1,163 @@
+*> \brief \b CLARFY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INCV, LDC, N
+*       COMPLEX            TAU
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX            C( LDC, * ), V( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CLARFY applies an elementary reflector, or Householder matrix, H,
+*> to an n x n Hermitian matrix C, from both the left and the right.
+*>
+*> H is represented in the form
+*>
+*>    H = I - tau * v * v'
+*>
+*> where  tau  is a scalar and  v  is a vector.
+*>
+*> If  tau  is  zero, then  H  is taken to be the unit matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix C is stored.
+*>          = 'U':  Upper triangle
+*>          = 'L':  Lower triangle
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix C.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is COMPLEX array, dimension
+*>                  (1 + (N-1)*abs(INCV))
+*>          The vector v as described above.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*>          INCV is INTEGER
+*>          The increment between successive elements of v.  INCV must
+*>          not be zero.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is COMPLEX
+*>          The value tau as described above.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX array, dimension (LDC, N)
+*>          On entry, the matrix C.
+*>          On exit, C is overwritten by H * C * H'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max( 1, N ).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (N)
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complex_eig
+*
+*  =====================================================================
+      SUBROUTINE CLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK )
+*
+*  -- LAPACK test routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INCV, LDC, N
+      COMPLEX            TAU
+*     ..
+*     .. Array Arguments ..
+      COMPLEX            C( LDC, * ), V( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX            ONE, ZERO, HALF
+      PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ),
+     $                   ZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   HALF = ( 0.5E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      COMPLEX            ALPHA
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CAXPY, CHEMV, CHER2
+*     ..
+*     .. External Functions ..
+      COMPLEX            CDOTC
+      EXTERNAL           CDOTC
+*     ..
+*     .. Executable Statements ..
+*
+      IF( TAU.EQ.ZERO )
+     $   RETURN
+*
+*     Form  w:= C * v
+*
+      CALL CHEMV( UPLO, N, ONE, C, LDC, V, INCV, ZERO, WORK, 1 )
+*
+      ALPHA = -HALF*TAU*CDOTC( N, WORK, 1, V, INCV )
+      CALL CAXPY( N, ALPHA, V, INCV, WORK, 1 )
+*
+*     C := C - v * w' - w * v'
+*
+      CALL CHER2( UPLO, N, -TAU, V, INCV, WORK, 1, C, LDC )
+*
+      RETURN
+*
+*     End of CLARFY
+*
+      END
diff --git a/SRC/claswp.f b/SRC/claswp.f
index 7c347781..bdafc0b7 100644
--- a/SRC/claswp.f
+++ b/SRC/claswp.f
@@ -71,15 +71,15 @@
 *> \param[in] K2
 *> \verbatim
 *>          K2 is INTEGER
-*>          The last element of IPIV for which a row interchange will
-*>          be done.
+*>          (K2-K1+1) is the number of elements of IPIV for which a row
+*>          interchange will be done.
 *> \endverbatim
 *>
 *> \param[in] IPIV
 *> \verbatim
-*>          IPIV is INTEGER array, dimension (K2*abs(INCX))
-*>          The vector of pivot indices.  Only the elements in positions
-*>          K1 through K2 of IPIV are accessed.
+*>          IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
+*>          The vector of pivot indices. Only the elements in positions
+*>          K1 through K1+(K2-K1)*INCX of IPIV are accessed.
 *>          IPIV(K) = L implies rows K and L are to be interchanged.
 *> \endverbatim
 *>
@@ -143,7 +143,7 @@
          I2 = K2
          INC = 1
       ELSE IF( INCX.LT.0 ) THEN
-         IX0 = 1 + ( 1-K2 )*INCX
+         IX0 = K1 + ( K1-K2 )*INCX
          I1 = K2
          I2 = K1
          INC = -1
diff --git a/SRC/clasyf_aa.f b/SRC/clasyf_aa.f
new file mode 100644
index 00000000..b69cc547
--- /dev/null
+++ b/SRC/clasyf_aa.f
@@ -0,0 +1,506 @@
+*> \brief \b CLASYF_AA
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLASYF_AA + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clasyf_aa.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clasyf_aa.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clasyf_aa.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
+*                             H, LDH, WORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            J1, M, NB, LDA, LDH, INFO
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), H( LDH, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DLATRF_AA factorizes a panel of a complex symmetric matrix A using
+*> the Aasen's algorithm. The panel consists of a set of NB rows of A
+*> when UPLO is U, or a set of NB columns when UPLO is L.
+*>
+*> In order to factorize the panel, the Aasen's algorithm requires the
+*> last row, or column, of the previous panel. The first row, or column,
+*> of A is set to be the first row, or column, of an identity matrix,
+*> which is used to factorize the first panel.
+*>
+*> The resulting J-th row of U, or J-th column of L, is stored in the
+*> (J-1)-th row, or column, of A (without the unit diagonals), while
+*> the diagonal and subdiagonal of A are overwritten by those of T.
+*>
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] J1
+*> \verbatim
+*>          J1 is INTEGER
+*>          The location of the first row, or column, of the panel
+*>          within the submatrix of A, passed to this routine, e.g.,
+*>          when called by CSYTRF_AA, for the first panel, J1 is 1,
+*>          while for the remaining panels, J1 is 2.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The dimension of the submatrix. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The dimension of the panel to be facotorized.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,M) for
+*>          the first panel, while dimension (LDA,M+1) for the
+*>          remaining panels.
+*>
+*>          On entry, A contains the last row, or column, of
+*>          the previous panel, and the trailing submatrix of A
+*>          to be factorized, except for the first panel, only
+*>          the panel is passed.
+*>
+*>          On exit, the leading panel is factorized.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the row and column interchanges,
+*>          the row and column k were interchanged with the row and
+*>          column IPIV(k).
+*> \endverbatim
+*>
+*> \param[in,out] H
+*> \verbatim
+*>          H is REAL workspace, dimension (LDH,NB).
+*>
+*> \endverbatim
+*>
+*> \param[in] LDH
+*> \verbatim
+*>          LDH is INTEGER
+*>          The leading dimension of the workspace H. LDH >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL workspace, dimension (M).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, D(i,i) is exactly zero.  The factorization
+*>                has been completed, but the block diagonal matrix D is
+*>                exactly singular, and division by zero will occur if it
+*>                is used to solve a system of equations.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*  =====================================================================
+      SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
+     $                      H, LDH, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+      IMPLICIT NONE
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            M, NB, J1, LDA, LDH, INFO
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), H( LDH, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*     .. Parameters ..
+      COMPLEX            ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+*
+*     .. Local Scalars ..
+      INTEGER            J, K, K1, I1, I2
+      COMPLEX            PIV, ALPHA
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ICAMAX, ILAENV
+      EXTERNAL           LSAME, ILAENV, ICAMAX
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      J = 1
+*
+*     K1 is the first column of the panel to be factorized
+*     i.e.,  K1 is 2 for the first block column, and 1 for the rest of the blocks
+*
+      K1 = (2-J1)+1
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+*
+*        .....................................................
+*        Factorize A as U**T*D*U using the upper triangle of A
+*        .....................................................
+*
+ 10      CONTINUE
+         IF ( J.GT.MIN(M, NB) )
+     $      GO TO 20
+*
+*        K is the column to be factorized
+*         when being called from CSYTRF_AA,
+*         > for the first block column, J1 is 1, hence J1+J-1 is J,
+*         > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
+*
+         K = J1+J-1
+*
+*        H(J:N, J) := A(J, J:N) - H(J:N, 1:(J-1)) * L(J1:(J-1), J),
+*         where H(J:N, J) has been initialized to be A(J, J:N)
+*
+         IF( K.GT.2 ) THEN
+*
+*        K is the column to be factorized
+*         > for the first block column, K is J, skipping the first two
+*           columns
+*         > for the rest of the columns, K is J+1, skipping only the
+*           first column
+*
+            CALL CGEMV( 'No transpose', M-J+1, J-K1,
+     $                 -ONE, H( J, K1 ), LDH,
+     $                       A( 1, J ), 1,
+     $                  ONE, H( J, J ), 1 )
+         END IF
+*
+*        Copy H(i:n, i) into WORK
+*
+         CALL CCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+*
+         IF( J.GT.K1 ) THEN
+*
+*           Compute WORK := WORK - L(J-1, J:N) * T(J-1,J),
+*            where A(J-1, J) stores T(J-1, J) and A(J-2, J:N) stores U(J-1, J:N)
+*
+            ALPHA = -A( K-1, J )
+            CALL CAXPY( M-J+1, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
+         END IF
+*
+*        Set A(J, J) = T(J, J)
+*
+         A( K, J ) = WORK( 1 )
+*
+         IF( J.LT.M ) THEN
+*
+*           Compute WORK(2:N) = T(J, J) L(J, (J+1):N)
+*            where A(J, J) stores T(J, J) and A(J-1, (J+1):N) stores U(J, (J+1):N)
+*
+            IF( K.GT.1 ) THEN
+               ALPHA = -A( K, J )
+               CALL CAXPY( M-J, ALPHA, A( K-1, J+1 ), LDA,
+     $                                 WORK( 2 ), 1 )
+            ENDIF
+*
+*           Find max(|WORK(2:n)|)
+*
+            I2 = ICAMAX( M-J, WORK( 2 ), 1 ) + 1
+            PIV = WORK( I2 )
+*
+*           Apply symmetric pivot
+*
+            IF( (I2.NE.2) .AND. (PIV.NE.0) ) THEN
+*
+*              Swap WORK(I1) and WORK(I2)
+*
+               I1 = 2
+               WORK( I2 ) = WORK( I1 )
+               WORK( I1 ) = PIV
+*
+*              Swap A(I1, I1+1:N) with A(I1+1:N, I2)
+*
+               I1 = I1+J-1
+               I2 = I2+J-1
+               CALL CSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA,
+     $                              A( J1+I1, I2 ), 1 )
+*
+*              Swap A(I1, I2+1:N) with A(I2, I2+1:N)
+*
+               CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
+     $                           A( J1+I2-1, I2+1 ), LDA )
+*
+*              Swap A(I1, I1) with A(I2,I2)
+*
+               PIV = A( I1+J1-1, I1 )
+               A( J1+I1-1, I1 ) = A( J1+I2-1, I2 )
+               A( J1+I2-1, I2 ) = PIV
+*
+*              Swap H(I1, 1:J1) with H(I2, 1:J1)
+*
+               CALL CSWAP( I1-1, H( I1, 1 ), LDH, H( I2, 1 ), LDH )
+               IPIV( I1 ) = I2
+*
+               IF( I1.GT.(K1-1) ) THEN
+*
+*                 Swap L(1:I1-1, I1) with L(1:I1-1, I2),
+*                  skipping the first column
+*
+                  CALL CSWAP( I1-K1+1, A( 1, I1 ), 1,
+     $                                 A( 1, I2 ), 1 )
+               END IF
+            ELSE
+               IPIV( J+1 ) = J+1
+            ENDIF
+*
+*           Set A(J, J+1) = T(J, J+1)
+*
+            A( K, J+1 ) = WORK( 2 )
+            IF( (A( K, J ).EQ.ZERO ) .AND.
+     $        ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
+                IF(INFO .EQ. 0) THEN
+                    INFO = J
+                ENDIF
+            END IF
+*
+            IF( J.LT.NB ) THEN
+*
+*              Copy A(J+1:N, J+1) into H(J:N, J),
+*
+               CALL CCOPY( M-J, A( K+1, J+1 ), LDA,
+     $                          H( J+1, J+1 ), 1 )
+            END IF
+*
+*           Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
+*            where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+*
+            IF( A( K, J+1 ).NE.ZERO ) THEN
+               ALPHA = ONE / A( K, J+1 )
+               CALL CCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA )
+               CALL CSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA )
+            ELSE
+               CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO,
+     $                      A( K, J+2 ), LDA)
+            END IF
+         ELSE
+            IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
+               INFO = J
+            END IF
+         END IF
+         J = J + 1
+         GO TO 10
+ 20      CONTINUE
+*
+      ELSE
+*
+*        .....................................................
+*        Factorize A as L*D*L**T using the lower triangle of A
+*        .....................................................
+*
+ 30      CONTINUE
+         IF( J.GT.MIN( M, NB ) )
+     $      GO TO 40
+*
+*        K is the column to be factorized
+*         when being called from CSYTRF_AA,
+*         > for the first block column, J1 is 1, hence J1+J-1 is J,
+*         > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
+*
+         K = J1+J-1
+*
+*        H(J:N, J) := A(J:N, J) - H(J:N, 1:(J-1)) * L(J, J1:(J-1))^T,
+*         where H(J:N, J) has been initialized to be A(J:N, J)
+*
+         IF( K.GT.2 ) THEN
+*
+*        K is the column to be factorized
+*         > for the first block column, K is J, skipping the first two
+*           columns
+*         > for the rest of the columns, K is J+1, skipping only the
+*           first column
+*
+            CALL CGEMV( 'No transpose', M-J+1, J-K1,
+     $                 -ONE, H( J, K1 ), LDH,
+     $                       A( J, 1 ), LDA,
+     $                  ONE, H( J, J ), 1 )
+         END IF
+*
+*        Copy H(J:N, J) into WORK
+*
+         CALL CCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+*
+         IF( J.GT.K1 ) THEN
+*
+*           Compute WORK := WORK - L(J:N, J-1) * T(J-1,J),
+*            where A(J-1, J) = T(J-1, J) and A(J, J-2) = L(J, J-1)
+*
+            ALPHA = -A( J, K-1 )
+            CALL CAXPY( M-J+1, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
+         END IF
+*
+*        Set A(J, J) = T(J, J)
+*
+         A( J, K ) = WORK( 1 )
+*
+         IF( J.LT.M ) THEN
+*
+*           Compute WORK(2:N) = T(J, J) L((J+1):N, J)
+*            where A(J, J) = T(J, J) and A((J+1):N, J-1) = L((J+1):N, J)
+*
+            IF( K.GT.1 ) THEN
+               ALPHA = -A( J, K )
+               CALL CAXPY( M-J, ALPHA, A( J+1, K-1 ), 1,
+     $                                 WORK( 2 ), 1 )
+            ENDIF
+*
+*           Find max(|WORK(2:n)|)
+*
+            I2 = ICAMAX( M-J, WORK( 2 ), 1 ) + 1
+            PIV = WORK( I2 )
+*
+*           Apply symmetric pivot
+*
+            IF( (I2.NE.2) .AND. (PIV.NE.0) ) THEN
+*
+*              Swap WORK(I1) and WORK(I2)
+*
+               I1 = 2
+               WORK( I2 ) = WORK( I1 )
+               WORK( I1 ) = PIV
+*
+*              Swap A(I1+1:N, I1) with A(I2, I1+1:N)
+*
+               I1 = I1+J-1
+               I2 = I2+J-1
+               CALL CSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1,
+     $                              A( I2, J1+I1 ), LDA )
+*
+*              Swap A(I2+1:N, I1) with A(I2+1:N, I2)
+*
+               CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
+     $                           A( I2+1, J1+I2-1 ), 1 )
+*
+*              Swap A(I1, I1) with A(I2, I2)
+*
+               PIV = A( I1, J1+I1-1 )
+               A( I1, J1+I1-1 ) = A( I2, J1+I2-1 )
+               A( I2, J1+I2-1 ) = PIV
+*
+*              Swap H(I1, I1:J1) with H(I2, I2:J1)
+*
+               CALL CSWAP( I1-1, H( I1, 1 ), LDH, H( I2, 1 ), LDH )
+               IPIV( I1 ) = I2
+*
+               IF( I1.GT.(K1-1) ) THEN
+*
+*                 Swap L(1:I1-1, I1) with L(1:I1-1, I2),
+*                  skipping the first column
+*
+                  CALL CSWAP( I1-K1+1, A( I1, 1 ), LDA,
+     $                                 A( I2, 1 ), LDA )
+               END IF
+            ELSE
+               IPIV( J+1 ) = J+1
+            ENDIF
+*
+*           Set A(J+1, J) = T(J+1, J)
+*
+            A( J+1, K ) = WORK( 2 )
+            IF( (A( J, K ).EQ.ZERO) .AND.
+     $        ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
+                IF (INFO .EQ. 0)
+     $              INFO = J
+            END IF
+*
+            IF( J.LT.NB ) THEN
+*
+*              Copy A(J+1:N, J+1) into H(J+1:N, J),
+*
+               CALL CCOPY( M-J, A( J+1, K+1 ), 1,
+     $                          H( J+1, J+1 ), 1 )
+            END IF
+*
+*           Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
+*            where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+*
+            IF( A( J+1, K ).NE.ZERO ) THEN
+               ALPHA = ONE / A( J+1, K )
+               CALL CCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 )
+               CALL CSCAL( M-J-1, ALPHA, A( J+2, K ), 1 )
+            ELSE
+               CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO,
+     $                      A( J+2, K ), LDA )
+            END IF
+         ELSE
+            IF( (A( J, K ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
+               INFO = J
+            END IF
+         END IF
+         J = J + 1
+         GO TO 30
+ 40      CONTINUE
+      END IF
+      RETURN
+*
+*     End of CLASYF_AA
+*
+      END
diff --git a/SRC/clasyf_rk.f b/SRC/clasyf_rk.f
new file mode 100644
index 00000000..ac181200
--- /dev/null
+++ b/SRC/clasyf_rk.f
@@ -0,0 +1,974 @@
+*> \brief \b CLASYF_RK computes a partial factorization of a complex symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLASYF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clasyf_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clasyf_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clasyf_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, KB, LDA, LDW, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), E( * ), W( LDW, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CLASYF_RK computes a partial factorization of a complex symmetric
+*> matrix A using the bounded Bunch-Kaufman (rook) diagonal
+*> pivoting method. The partial factorization has the form:
+*>
+*> A  =  ( I  U12 ) ( A11  0  ) (  I       0    )  if UPLO = 'U', or:
+*>       ( 0  U22 ) (  0   D  ) ( U12**T U22**T )
+*>
+*> A  =  ( L11  0 ) (  D   0  ) ( L11**T L21**T )  if UPLO = 'L',
+*>       ( L21  I ) (  0  A22 ) (  0       I    )
+*>
+*> where the order of D is at most NB. The actual order is returned in
+*> the argument KB, and is either NB or NB-1, or N if N <= NB.
+*>
+*> CLASYF_RK is an auxiliary routine called by CSYTRF_RK. It uses
+*> blocked code (calling Level 3 BLAS) to update the submatrix
+*> A11 (if UPLO = 'U') or A22 (if UPLO = 'L').
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The maximum number of columns of the matrix A that should be
+*>          factored.  NB should be at least 2 to allow for 2-by-2 pivot
+*>          blocks.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*>          KB is INTEGER
+*>          The number of columns of A that were actually factored.
+*>          KB is either NB-1 or NB, or N if N <= NB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,N-KB+1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,1:KB).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is COMPLEX array, dimension (LDW,NB)
+*> \endverbatim
+*>
+*> \param[in] LDW
+*> \verbatim
+*>          LDW is INTEGER
+*>          The leading dimension of the array W.  LDW >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, KB, LDA, LDW, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * ), W( LDW, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      REAL               EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
+      COMPLEX            CONE, CZERO
+      PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ),
+     $                   CZERO = ( 0.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            DONE
+      INTEGER            IMAX, ITEMP, J, JB, JJ, JMAX, K, KK, KW, KKW,
+     $                   KP, KSTEP, P, II
+      REAL               ABSAKK, ALPHA, COLMAX, ROWMAX, SFMIN, STEMP
+      COMPLEX            D11, D12, D21, D22, R1, T, Z
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ICAMAX
+      REAL               SLAMCH
+      EXTERNAL           LSAME, ICAMAX, SLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CCOPY, CGEMM, CGEMV, CSCAL, CSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, AIMAG, MAX, MIN, REAL, SQRT
+*     ..
+*     .. Statement Functions ..
+      REAL               CABS1
+*     ..
+*     .. Statement Function definitions ..
+      CABS1( Z ) = ABS( REAL( Z ) ) + ABS( AIMAG( Z ) )
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = SLAMCH( 'S' )
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+*
+*        Factorize the trailing columns of A using the upper triangle
+*        of A and working backwards, and compute the matrix W = U12*D
+*        for use in updating A11
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = CZERO
+*
+*        K is the main loop index, decreasing from N in steps of 1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        KW is the column of W which corresponds to column K of A
+*
+         KW = NB + K - N
+*
+*        Exit from loop
+*
+         IF( ( K.LE.N-NB+1 .AND. NB.LT.N ) .OR. K.LT.1 )
+     $      GO TO 30
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column KW of W and update it
+*
+         CALL CCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 )
+         IF( K.LT.N )
+     $      CALL CGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ),
+     $                  LDA, W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 )
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = CABS1( W( K, KW ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = ICAMAX( K-1, W( 1, KW ), 1 )
+            COLMAX = CABS1( W( IMAX, KW ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            CALL CCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           Test for interchange
+*
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   12          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*
+*                 Copy column IMAX to column KW-1 of W and update it
+*
+                  CALL CCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 )
+                  CALL CCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA,
+     $                        W( IMAX+1, KW-1 ), 1 )
+*
+                  IF( K.LT.N )
+     $               CALL CGEMV( 'No transpose', K, N-K, -CONE,
+     $                           A( 1, K+1 ), LDA, W( IMAX, KW+1 ), LDW,
+     $                           CONE, W( 1, KW-1 ), 1 )
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + ICAMAX( K-IMAX, W( IMAX+1, KW-1 ),
+     $                                     1 )
+                     ROWMAX = CABS1( W( JMAX, KW-1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = ICAMAX( IMAX-1, W( 1, KW-1 ), 1 )
+                     STEMP = CABS1( W( ITEMP, KW-1 ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for
+*                 CABS1( W( IMAX, KW-1 ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.(CABS1( W( IMAX, KW-1 ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column KW-1 of W to column KW of W
+*
+                     CALL CCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K-1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL CCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 12
+*
+            END IF
+*
+*           ============================================================
+*
+            KK = K - KSTEP + 1
+*
+*           KKW is the column of W which corresponds to column KK of A
+*
+            KKW = NB + KK - N
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column K to column P
+*
+               CALL CCOPY( K-P, A( P+1, K ), 1, A( P, P+1 ), LDA )
+               CALL CCOPY( P, A( 1, K ), 1, A( 1, P ), 1 )
+*
+*              Interchange rows K and P in last N-K+1 columns of A
+*              and last N-K+2 columns of W
+*
+               CALL CSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA )
+               CALL CSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW )
+            END IF
+*
+*           Updated column KP is already stored in column KKW of W
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP
+*
+               A( KP, K ) = A( KK, K )
+               CALL CCOPY( K-1-KP, A( KP+1, KK ), 1, A( KP, KP+1 ),
+     $                     LDA )
+               CALL CCOPY( KP, A( 1, KK ), 1, A( 1, KP ), 1 )
+*
+*              Interchange rows KK and KP in last N-KK+1 columns
+*              of A and W
+*
+               CALL CSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA )
+               CALL CSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ),
+     $                     LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column KW of W now holds
+*
+*              W(k) = U(k)*D(k)
+*
+*              where U(k) is the k-th column of U
+*
+*              Store U(k) in column k of A
+*
+               CALL CCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
+               IF( K.GT.1 ) THEN
+                  IF( CABS1( A( K, K ) ).GE.SFMIN ) THEN
+                     R1 = CONE / A( K, K )
+                     CALL CSCAL( K-1, R1, A( 1, K ), 1 )
+                  ELSE IF( A( K, K ).NE.CZERO ) THEN
+                     DO 14 II = 1, K - 1
+                        A( II, K ) = A( II, K ) / A( K, K )
+   14                CONTINUE
+                  END IF
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns KW and KW-1 of W now
+*              hold
+*
+*              ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+               IF( K.GT.2 ) THEN
+*
+*                 Store U(k) and U(k-1) in columns k and k-1 of A
+*
+                  D12 = W( K-1, KW )
+                  D11 = W( K, KW ) / D12
+                  D22 = W( K-1, KW-1 ) / D12
+                  T = CONE / ( D11*D22-CONE )
+                  DO 20 J = 1, K - 2
+                     A( J, K-1 ) = T*( (D11*W( J, KW-1 )-W( J, KW ) ) /
+     $                             D12 )
+                     A( J, K ) = T*( ( D22*W( J, KW )-W( J, KW-1 ) ) /
+     $                           D12 )
+   20             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy superdiagonal element of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               A( K-1, K-1 ) = W( K-1, KW-1 )
+               A( K-1, K ) = CZERO
+               A( K, K ) = W( K, KW )
+               E( K ) = W( K-1, KW )
+               E( K-1 ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   30    CONTINUE
+*
+*        Update the upper triangle of A11 (= A(1:k,1:k)) as
+*
+*        A11 := A11 - U12*D*U12**T = A11 - U12*W**T
+*
+*        computing blocks of NB columns at a time
+*
+         DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB
+            JB = MIN( NB, K-J+1 )
+*
+*           Update the upper triangle of the diagonal block
+*
+            DO 40 JJ = J, J + JB - 1
+               CALL CGEMV( 'No transpose', JJ-J+1, N-K, -CONE,
+     $                     A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE,
+     $                     A( J, JJ ), 1 )
+   40       CONTINUE
+*
+*           Update the rectangular superdiagonal block
+*
+            IF( J.GE.2 )
+     $         CALL CGEMM( 'No transpose', 'Transpose', J-1, JB,
+     $                     N-K, -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ),
+     $                     LDW, CONE, A( 1, J ), LDA )
+   50    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = N - K
+*
+      ELSE
+*
+*        Factorize the leading columns of A using the lower triangle
+*        of A and working forwards, and compute the matrix W = L21*D
+*        for use in updating A22
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = CZERO
+*
+*        K is the main loop index, increasing from 1 in steps of 1 or 2
+*
+         K = 1
+   70   CONTINUE
+*
+*        Exit from loop
+*
+         IF( ( K.GE.NB .AND. NB.LT.N ) .OR. K.GT.N )
+     $      GO TO 90
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column K of W and update it
+*
+         CALL CCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 )
+         IF( K.GT.1 )
+     $      CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ),
+     $                  LDA, W( K, 1 ), LDW, CONE, W( K, K ), 1 )
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = CABS1( W( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + ICAMAX( N-K, W( K+1, K ), 1 )
+            COLMAX = CABS1( W( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            CALL CCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           Test for interchange
+*
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   72          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*
+*                 Copy column IMAX to column K+1 of W and update it
+*
+                  CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1)
+                  CALL CCOPY( N-IMAX+1, A( IMAX, IMAX ), 1,
+     $                        W( IMAX, K+1 ), 1 )
+                  IF( K.GT.1 )
+     $               CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE,
+     $                           A( K, 1 ), LDA, W( IMAX, 1 ), LDW,
+     $                           CONE, W( K, K+1 ), 1 )
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + ICAMAX( IMAX-K, W( K, K+1 ), 1 )
+                     ROWMAX = CABS1( W( JMAX, K+1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + ICAMAX( N-IMAX, W( IMAX+1, K+1 ), 1)
+                     STEMP = CABS1( W( ITEMP, K+1 ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for
+*                 CABS1( W( IMAX, K+1 ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( CABS1( W( IMAX, K+1 ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column K+1 of W to column K of W
+*
+                     CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 72
+*
+            END IF
+*
+*           ============================================================
+*
+            KK = K + KSTEP - 1
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column K to column P
+*
+               CALL CCOPY( P-K, A( K, K ), 1, A( P, K ), LDA )
+               CALL CCOPY( N-P+1, A( P, K ), 1, A( P, P ), 1 )
+*
+*              Interchange rows K and P in first K columns of A
+*              and first K+1 columns of W
+*
+               CALL CSWAP( K, A( K, 1 ), LDA, A( P, 1 ), LDA )
+               CALL CSWAP( KK, W( K, 1 ), LDW, W( P, 1 ), LDW )
+            END IF
+*
+*           Updated column KP is already stored in column KK of W
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP
+*
+               A( KP, K ) = A( KK, K )
+               CALL CCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA )
+               CALL CCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 )
+*
+*              Interchange rows KK and KP in first KK columns of A and W
+*
+               CALL CSWAP( KK, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+               CALL CSWAP( KK, W( KK, 1 ), LDW, W( KP, 1 ), LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k of W now holds
+*
+*              W(k) = L(k)*D(k)
+*
+*              where L(k) is the k-th column of L
+*
+*              Store L(k) in column k of A
+*
+               CALL CCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
+               IF( K.LT.N ) THEN
+                  IF( CABS1( A( K, K ) ).GE.SFMIN ) THEN
+                     R1 = CONE / A( K, K )
+                     CALL CSCAL( N-K, R1, A( K+1, K ), 1 )
+                  ELSE IF( A( K, K ).NE.CZERO ) THEN
+                     DO 74 II = K + 1, N
+                        A( II, K ) = A( II, K ) / A( K, K )
+   74                CONTINUE
+                  END IF
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 of W now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+               IF( K.LT.N-1 ) THEN
+*
+*                 Store L(k) and L(k+1) in columns k and k+1 of A
+*
+                  D21 = W( K+1, K )
+                  D11 = W( K+1, K+1 ) / D21
+                  D22 = W( K, K ) / D21
+                  T = CONE / ( D11*D22-CONE )
+                  DO 80 J = K + 2, N
+                     A( J, K ) = T*( ( D11*W( J, K )-W( J, K+1 ) ) /
+     $                           D21 )
+                     A( J, K+1 ) = T*( ( D22*W( J, K+1 )-W( J, K ) ) /
+     $                             D21 )
+   80             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy subdiagonal element of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               A( K, K ) = W( K, K )
+               A( K+1, K ) = CZERO
+               A( K+1, K+1 ) = W( K+1, K+1 )
+               E( K ) = W( K+1, K )
+               E( K+1 ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 70
+*
+   90    CONTINUE
+*
+*        Update the lower triangle of A22 (= A(k:n,k:n)) as
+*
+*        A22 := A22 - L21*D*L21**T = A22 - L21*W**T
+*
+*        computing blocks of NB columns at a time
+*
+         DO 110 J = K, N, NB
+            JB = MIN( NB, N-J+1 )
+*
+*           Update the lower triangle of the diagonal block
+*
+            DO 100 JJ = J, J + JB - 1
+               CALL CGEMV( 'No transpose', J+JB-JJ, K-1, -CONE,
+     $                     A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE,
+     $                     A( JJ, JJ ), 1 )
+  100       CONTINUE
+*
+*           Update the rectangular subdiagonal block
+*
+            IF( J+JB.LE.N )
+     $         CALL CGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
+     $                     K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ),
+     $                     LDW, CONE, A( J+JB, J ), LDA )
+  110    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = K - 1
+*
+      END IF
+*
+      RETURN
+*
+*     End of CLASYF_RK
+*
+      END
diff --git a/SRC/csycon_3.f b/SRC/csycon_3.f
new file mode 100644
index 00000000..91aae29e
--- /dev/null
+++ b/SRC/csycon_3.f
@@ -0,0 +1,287 @@
+*> \brief \b CSYCON_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYCON_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csycon_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csycon_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csycon_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+*                            WORK, IWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       REAL               ANORM, RCOND
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * ), IWORK( * )
+*       COMPLEX            A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CSYCON_3 estimates the reciprocal of the condition number (in the
+*> 1-norm) of a complex symmetric matrix A using the factorization
+*> computed by CSYTRF_RK or CSYTRF_BK:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
+*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+*> This routine uses BLAS3 solver CSYTRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**T)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**T)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by CSYTRF_RK and CSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by CSYTRF_RK or CSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[in] ANORM
+*> \verbatim
+*>          ANORM is REAL
+*>          The 1-norm of the original matrix A.
+*> \endverbatim
+*>
+*> \param[out] RCOND
+*> \verbatim
+*>          RCOND is REAL
+*>          The reciprocal of the condition number of the matrix A,
+*>          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+*>          estimate of the 1-norm of inv(A) computed in this routine.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (2*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+     $                     WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+      REAL               ANORM, RCOND
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+      COMPLEX            CZERO
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, KASE
+      REAL               AINVNM
+*     ..
+*     .. Local Arrays ..
+      INTEGER            ISAVE( 3 )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CLACN2, CSYTRS_3, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( ANORM.LT.ZERO ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYCON_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      RCOND = ZERO
+      IF( N.EQ.0 ) THEN
+         RCOND = ONE
+         RETURN
+      ELSE IF( ANORM.LE.ZERO ) THEN
+         RETURN
+      END IF
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO I = N, 1, -1
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.CZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO I = 1, N
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.CZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+*     Estimate the 1-norm of the inverse.
+*
+      KASE = 0
+   30 CONTINUE
+      CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
+      IF( KASE.NE.0 ) THEN
+*
+*        Multiply by inv(L*D*L**T) or inv(U*D*U**T).
+*
+         CALL CSYTRS_3( UPLO, N, 1, A, LDA, E, IPIV, WORK, N, INFO )
+         GO TO 30
+      END IF
+*
+*     Compute the estimate of the reciprocal condition number.
+*
+      IF( AINVNM.NE.ZERO )
+     $   RCOND = ( ONE / AINVNM ) / ANORM
+*
+      RETURN
+*
+*     End of CSYCON_3
+*
+      END
diff --git a/SRC/csyconvf.f b/SRC/csyconvf.f
new file mode 100644
index 00000000..df36055b
--- /dev/null
+++ b/SRC/csyconvf.f
@@ -0,0 +1,562 @@
+*> \brief \b CSYCONVF
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYCONVF + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csyconvf.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csyconvf.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csyconvf.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYCONVF( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO, WAY
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> If parameter WAY = 'C':
+*> CSYCONVF converts the factorization output format used in
+*> CSYTRF provided on entry in parameter A into the factorization
+*> output format used in CSYTRF_RK (or CSYTRF_BK) that is stored
+*> on exit in parameters A and E. It also coverts in place details of
+*> the intechanges stored in IPIV from the format used in CSYTRF into
+*> the format used in CSYTRF_RK (or CSYTRF_BK).
+*>
+*> If parameter WAY = 'R':
+*> CSYCONVF performs the conversion in reverse direction, i.e.
+*> converts the factorization output format used in CSYTRF_RK
+*> (or CSYTRF_BK) provided on entry in parametes A and E into
+*> the factorization output format used in CSYTRF that is stored
+*> on exit in parameter A. It also coverts in place details of
+*> the intechanges stored in IPIV from the format used in CSYTRF_RK
+*> (or CSYTRF_BK) into the format used in CSYTRF.
+*>
+*> CSYCONVF can also convert in Hermitian matrix case, i.e. between
+*> formats used in CHETRF and CHETRF_RK (or CHETRF_BK).
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix A.
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] WAY
+*> \verbatim
+*>          WAY is CHARACTER*1
+*>          = 'C': Convert
+*>          = 'R': Revert
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, contains factorization details in format used in
+*>          CSYTRF:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          CSYTRF_RK or CSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains factorization details in format used in
+*>          CSYTRF_RK or CSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          CSYTRF:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, just a workspace.
+*>
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          On exit, is not changed
+*> \endverbatim
+*.
+*> \param[in,out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>          On entry, details of the interchanges and the block
+*>          structure of D in the format used in CSYTRF.
+*>          On exit, details of the interchanges and the block
+*>          structure of D in the format used in CSYTRF_RK
+*>          ( or CSYTRF_BK).
+*>
+*>          1) If WAY ='R':
+*>          On entry, details of the interchanges and the block
+*>          structure of D in the format used in CSYTRF_RK
+*>          ( or CSYTRF_BK).
+*>          On exit, details of the interchanges and the block
+*>          structure of D in the format used in CSYTRF.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*  =====================================================================
+      SUBROUTINE CSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO, WAY
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX            ZERO
+      PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*
+*     .. External Subroutines ..
+      EXTERNAL           CSWAP, XERBLA
+*     .. Local Scalars ..
+      LOGICAL            UPPER, CONVERT
+      INTEGER            I, IP
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      CONVERT = LSAME( WAY, 'C' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYCONVF', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin A is UPPER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is upper)
+*
+*
+*           Convert VALUE
+*
+*           Assign superdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = N
+            E( 1 ) = ZERO
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  E( I ) = A( I-1, I )
+                  E( I-1 ) = ZERO
+                  A( I-1, I ) = ZERO
+                  I = I - 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I - 1
+            END DO
+*
+*           Convert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = -IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.(I-1) ) THEN
+                        CALL CSWAP( N-I, A( I-1, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is no interchnge of rows i and and IPIV(i),
+*                 so this should be reflected in IPIV format for
+*                 *SYTRF_RK ( or *SYTRF_BK)
+*
+                  IPIV( I ) = I
+*
+                  I = I - 1
+*
+               END IF
+               I = I - 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is upper)
+*
+*
+*           Revert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in reverse factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
+*
+                  I = I + 1
+                  IP = -IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.(I-1) ) THEN
+                        CALL CSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I-1, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is one interchange of rows i-1 and IPIV(i-1),
+*                 so this should be recorded in two consecutive entries
+*                 in IPIV format for *SYTRF
+*
+                  IPIV( I ) = IPIV( I-1 )
+*
+               END IF
+               I = I + 1
+            END DO
+*
+*           Revert VALUE
+*           Assign superdiagonal entries of D from array E to
+*           superdiagonal entries of A.
+*
+            I = N
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I-1, I ) = E( I )
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*        End A is UPPER
+*
+         END IF
+*
+      ELSE
+*
+*        Begin A is LOWER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is lower)
+*
+*
+*           Convert VALUE
+*           Assign subdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = 1
+            E( N ) = ZERO
+            DO WHILE ( I.LE.N )
+               IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
+                  E( I ) = A( I+1, I )
+                  E( I+1 ) = ZERO
+                  A( I+1, I ) = ZERO
+                  I = I + 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I + 1
+            END DO
+*
+*           Convert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in factorization order where k increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = -IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.(I+1) ) THEN
+                        CALL CSWAP( I-1, A( I+1, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is no interchnge of rows i and and IPIV(i),
+*                 so this should be reflected in IPIV format for
+*                 *SYTRF_RK ( or *SYTRF_BK)
+*
+                  IPIV( I ) = I
+*
+                  I = I + 1
+*
+               END IF
+               I = I + 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is lower)
+*
+*
+*           Revert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in reverse factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
+*
+                  I = I - 1
+                  IP = -IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.(I+1) ) THEN
+                        CALL CSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I+1, 1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is one interchange of rows i+1 and IPIV(i+1),
+*                 so this should be recorded in consecutive entries
+*                 in IPIV format for *SYTRF
+*
+                  IPIV( I ) = IPIV( I+1 )
+*
+               END IF
+               I = I - 1
+            END DO
+*
+*           Revert VALUE
+*           Assign subdiagonal entries of D from array E to
+*           subgiagonal entries of A.
+*
+            I = 1
+            DO WHILE ( I.LE.N-1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I + 1, I ) = E( I )
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+         END IF
+*
+*        End A is LOWER
+*
+      END IF
+
+      RETURN
+*
+*     End of CSYCONVF
+*
+      END
diff --git a/SRC/csyconvf_rook.f b/SRC/csyconvf_rook.f
new file mode 100644
index 00000000..a99678d5
--- /dev/null
+++ b/SRC/csyconvf_rook.f
@@ -0,0 +1,547 @@
+*> \brief \b CSYCONVF_ROOK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYCONVF_ROOK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csyconvf_rook.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csyconvf_rook.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csyconvf_rook.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYCONVF_ROOK( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO, WAY
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> If parameter WAY = 'C':
+*> CSYCONVF_ROOK converts the factorization output format used in
+*> CSYTRF_ROOK provided on entry in parameter A into the factorization
+*> output format used in CSYTRF_RK (or CSYTRF_BK) that is stored
+*> on exit in parameters A and E. IPIV format for CSYTRF_ROOK and
+*> CSYTRF_RK (or CSYTRF_BK) is the same and is not converted.
+*>
+*> If parameter WAY = 'R':
+*> CSYCONVF_ROOK performs the conversion in reverse direction, i.e.
+*> converts the factorization output format used in CSYTRF_RK
+*> (or CSYTRF_BK) provided on entry in parametes A and E into
+*> the factorization output format used in CSYTRF_ROOK that is stored
+*> on exit in parameter A. IPIV format for CSYTRF_ROOK and
+*> CSYTRF_RK (or CSYTRF_BK) is the same and is not converted.
+*>
+*> CSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between
+*> formats used in CHETRF_ROOK and CHETRF_RK (or CHETRF_BK).
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix A.
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] WAY
+*> \verbatim
+*>          WAY is CHARACTER*1
+*>          = 'C': Convert
+*>          = 'R': Revert
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, contains factorization details in format used in
+*>          CSYTRF_ROOK:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          CSYTRF_RK or CSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains factorization details in format used in
+*>          CSYTRF_RK or CSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          CSYTRF_ROOK:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, just a workspace.
+*>
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          On exit, is not changed
+*> \endverbatim
+*.
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          On entry, details of the interchanges and the block
+*>          structure of D as determined:
+*>          1) by CSYTRF_ROOK, if WAY ='C';
+*>          2) by CSYTRF_RK (or CSYTRF_BK), if WAY ='R'.
+*>          The IPIV format is the same for all these routines.
+*>
+*>          On exit, is not changed.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*  =====================================================================
+      SUBROUTINE CSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO, WAY
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX            ZERO
+      PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*
+*     .. External Subroutines ..
+      EXTERNAL           CSWAP, XERBLA
+*     .. Local Scalars ..
+      LOGICAL            UPPER, CONVERT
+      INTEGER            I, IP, IP2
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      CONVERT = LSAME( WAY, 'C' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYCONVF_ROOK', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin A is UPPER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is upper)
+*
+*
+*           Convert VALUE
+*
+*           Assign superdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = N
+            E( 1 ) = ZERO
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  E( I ) = A( I-1, I )
+                  E( I-1 ) = ZERO
+                  A( I-1, I ) = ZERO
+                  I = I - 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I - 1
+            END DO
+*
+*           Convert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
+*                 in A(1:i,N-i:N)
+*
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I-1 )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                     IF( IP2.NE.(I-1) ) THEN
+                        CALL CSWAP( N-I, A( I-1, I+1 ), LDA,
+     $                              A( IP2, I+1 ), LDA )
+                     END IF
+                  END IF
+                  I = I - 1
+*
+               END IF
+               I = I - 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is upper)
+*
+*
+*           Revert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in reverse factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
+*                 in A(1:i,N-i:N)
+*
+                  I = I + 1
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I-1 )
+                  IF( I.LT.N ) THEN
+                     IF( IP2.NE.(I-1) ) THEN
+                        CALL CSWAP( N-I, A( IP2, I+1 ), LDA,
+     $                              A( I-1, I+1 ), LDA )
+                     END IF
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               END IF
+               I = I + 1
+            END DO
+*
+*           Revert VALUE
+*           Assign superdiagonal entries of D from array E to
+*           superdiagonal entries of A.
+*
+            I = N
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I-1, I ) = E( I )
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*        End A is UPPER
+*
+         END IF
+*
+      ELSE
+*
+*        Begin A is LOWER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is lower)
+*
+*
+*           Convert VALUE
+*           Assign subdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = 1
+            E( N ) = ZERO
+            DO WHILE ( I.LE.N )
+               IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
+                  E( I ) = A( I+1, I )
+                  E( I+1 ) = ZERO
+                  A( I+1, I ) = ZERO
+                  I = I + 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I + 1
+            END DO
+*
+*           Convert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
+*                 in A(i:N,1:i-1)
+*
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I+1 )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                     IF( IP2.NE.(I+1) ) THEN
+                        CALL CSWAP( I-1, A( I+1, 1 ), LDA,
+     $                              A( IP2, 1 ), LDA )
+                     END IF
+                  END IF
+                  I = I + 1
+*
+               END IF
+               I = I + 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is lower)
+*
+*
+*           Revert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in reverse factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
+*                 in A(i:N,1:i-1)
+*
+                  I = I - 1
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I+1 )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP2.NE.(I+1) ) THEN
+                        CALL CSWAP( I-1, A( IP2, 1 ), LDA,
+     $                              A( I+1, 1 ), LDA )
+                     END IF
+                     IF( IP.NE.I ) THEN
+                        CALL CSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               END IF
+               I = I - 1
+            END DO
+*
+*           Revert VALUE
+*           Assign subdiagonal entries of D from array E to
+*           subgiagonal entries of A.
+*
+            I = 1
+            DO WHILE ( I.LE.N-1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I + 1, I ) = E( I )
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+         END IF
+*
+*        End A is LOWER
+*
+      END IF
+
+      RETURN
+*
+*     End of CSYCONVF_ROOK
+*
+      END
diff --git a/SRC/csysv_aa.f b/SRC/csysv_aa.f
new file mode 100644
index 00000000..7c82a400
--- /dev/null
+++ b/SRC/csysv_aa.f
@@ -0,0 +1,254 @@
+*> \brief <b> CSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYSV_AA + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csysv_aa.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csysv_aa.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csysv_aa.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
+*                            LWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            N, NRHS, LDA, LDB, LWORK, INFO
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CSYSV computes the solution to a complex system of linear equations
+*>    A * X = B,
+*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+*> matrices.
+*>
+*> Aasen's algorithm is used to factor A as
+*>    A = U * T * U**T,  if UPLO = 'U', or
+*>    A = L * T * L**T,  if UPLO = 'L',
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is symmetric tridiagonal. The factored
+*> form of A is then used to solve the system of equations A * X = B.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of linear equations, i.e., the order of the
+*>          matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>
+*>          On exit, if INFO = 0, the tridiagonal matrix T and the
+*>          multipliers used to obtain the factor U or L from the
+*>          factorization A = U*T*U**T or A = L*T*L**T as computed by
+*>          CSYTRF.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          On exit, it contains the details of the interchanges, i.e.,
+*>          the row and column k of A were interchanged with the
+*>          row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is REAL array, dimension (LDB,NRHS)
+*>          On entry, the N-by-NRHS right hand side matrix B.
+*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >= MAX(2*N, 3*N-2), and for
+*>          the best performance, LWORK >= max(1,N*NB), where NB is
+*>          the optimal blocksize for CSYTRF_AA.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) is exactly zero.  The factorization
+*>               has been completed, but the block diagonal matrix D is
+*>               exactly singular, so the solution could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYsolve
+*
+*  =====================================================================
+      SUBROUTINE CSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
+     $                        LWORK, INFO )
+*
+*  -- LAPACK driver routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV, LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, CSYTRF, CSYTRS, CSYTRS2
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -8
+      ELSE IF( LWORK.LT.MAX(2*N, 3*N-2) .AND. .NOT.LQUERY ) THEN
+         INFO = -10
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         CALL CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
+         LWKOPT_SYTRF = INT( WORK(1) )
+         CALL CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
+     $                   -1, INFO )
+         LWKOPT_SYTRS = INT( WORK(1) )
+         LWKOPT = MAX( LWKOPT_SYTRF, LWKOPT_SYTRS )
+         WORK( 1 ) = LWKOPT
+         IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN
+            INFO = -10
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYSV_AA ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Compute the factorization A = U*T*U**T or A = L*T*L**T.
+*
+      CALL CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
+      IF( INFO.EQ.0 ) THEN
+*
+*        Solve the system A*X = B, overwriting B with X.
+*
+         CALL CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
+     $                      LWORK, INFO )
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of CSYSV_AA
+*
+      END
diff --git a/SRC/csysv_rk.f b/SRC/csysv_rk.f
new file mode 100644
index 00000000..5cfd358b
--- /dev/null
+++ b/SRC/csysv_rk.f
@@ -0,0 +1,316 @@
+*> \brief <b> CSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYSV_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csysv_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csysv_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csysv_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            WORK, LWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CSYSV_RK computes the solution to a complex system of linear
+*> equations A * X = B, where A is an N-by-N symmetric matrix
+*> and X and B are N-by-NRHS matrices.
+*>
+*> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used
+*> to factor A as
+*>    A = P*U*D*(U**T)*(P**T),  if UPLO = 'U', or
+*>    A = P*L*D*(L**T)*(P**T),  if UPLO = 'L',
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> CSYTRF_RK is called to compute the factorization of a complex
+*> symmetric matrix.  The factored form of A is then used to solve
+*> the system of equations A * X = B by calling BLAS3 routine CSYTRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of linear equations, i.e., the order of the
+*>          matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, if INFO = 0, diagonal of the block diagonal
+*>          matrix D and factors U or L  as computed by CSYTRF_RK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          For more info see the description of CSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On exit, contains the output computed by the factorization
+*>          routine CSYTRF_RK, i.e. the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*>
+*>          For more info see the description of CSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D,
+*>          as determined by CSYTRF_RK.
+*>
+*>          For more info see the description of CSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (LDB,NRHS)
+*>          On entry, the N-by-NRHS right hand side matrix B.
+*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension ( MAX(1,LWORK) ).
+*>          Work array used in the factorization stage.
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >= 1. For best performance
+*>          of factorization stage LWORK >= max(1,N*NB), where NB is
+*>          the optimal blocksize for CSYTRF_RK.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array for factorization stage, returns this value as
+*>          the first entry of the WORK array, and no error message
+*>          related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYsolve
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK,
+     $                     LWORK, INFO )
+*
+*  -- LAPACK driver routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            LWKOPT
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, CSYTRF_RK, CSYTRS_3
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -11
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.EQ.0 ) THEN
+            LWKOPT = 1
+         ELSE
+            CALL CSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
+            LWKOPT = WORK(1)
+         END IF
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYSV_RK ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Compute the factorization A = U*D*U**T or A = L*D*L**T.
+*
+      CALL CSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO )
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Solve the system A*X = B with BLAS3 solver, overwriting B with X.
+*
+         CALL CSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO )
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of CSYSV_RK
+*
+      END
diff --git a/SRC/csytf2_rk.f b/SRC/csytf2_rk.f
new file mode 100644
index 00000000..5715de90
--- /dev/null
+++ b/SRC/csytf2_rk.f
@@ -0,0 +1,952 @@
+*> \brief \b CSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYTF2_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csytf2_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csytf2_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csytf2_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), E ( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CSYTF2_RK computes the factorization of a complex symmetric matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put further details
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*>  01-01-96 - Based on modifications by
+*>    J. Lewis, Boeing Computer Services Company
+*>    A. Petitet, Computer Science Dept.,
+*>                Univ. of Tenn., Knoxville abd , USA
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      REAL               EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
+      COMPLEX             CONE, CZERO
+      PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ),
+     $                   CZERO = ( 0.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER, DONE
+      INTEGER            I, IMAX, J, JMAX, ITEMP, K, KK, KP, KSTEP,
+     $                   P, II
+      REAL               ABSAKK, ALPHA, COLMAX, ROWMAX, STEMP, SFMIN
+      COMPLEX            D11, D12, D21, D22, T, WK, WKM1, WKP1, Z
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ICAMAX
+      REAL               SLAMCH
+      EXTERNAL           LSAME, ICAMAX, SLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CSCAL, CSWAP, CSYR, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, SQRT, AIMAG, REAL
+*     ..
+*     .. Statement Functions ..
+      REAL               CABS1
+*     ..
+*     .. Statement Function definitions ..
+      CABS1( Z ) = ABS( REAL( Z ) ) + ABS( AIMAG( Z ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYTF2_RK', -INFO )
+         RETURN
+      END IF
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = SLAMCH( 'S' )
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**T using the upper triangle of A
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = CZERO
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 34
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = CABS1( A( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = ICAMAX( K-1, A( 1, K ), 1 )
+            COLMAX = CABS1( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           Test for interchange
+*
+*           Equivalent to testing for (used to handle NaN and Inf)
+*           ABSAKK.GE.ALPHA*COLMAX
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange,
+*              use 1-by-1 pivot block
+*
+               KP = K
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   12          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + ICAMAX( K-IMAX, A( IMAX, IMAX+1 ),
+     $                                    LDA )
+                     ROWMAX = CABS1( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = ICAMAX( IMAX-1, A( 1, IMAX ), 1 )
+                     STEMP = CABS1( A( ITEMP, IMAX ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for (used to handle NaN and Inf)
+*                 ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX
+*
+                  IF( .NOT.( CABS1( A( IMAX, IMAX ) ).LT.ALPHA*ROWMAX ))
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX .EQ. COLMAX,
+*                 used to handle NaN and Inf
+*
+                  ELSE IF( ( P.EQ.JMAX ).OR.( ROWMAX.LE.COLMAX ) ) THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot NOT found, set variables and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 12
+*
+            END IF
+*
+*           Swap TWO rows and TWO columns
+*
+*           First swap
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Interchange rows and column K and P in the leading
+*              submatrix A(1:k,1:k) if we have a 2-by-2 pivot
+*
+               IF( P.GT.1 )
+     $            CALL CSWAP( P-1, A( 1, K ), 1, A( 1, P ), 1 )
+               IF( P.LT.(K-1) )
+     $            CALL CSWAP( K-P-1, A( P+1, K ), 1, A( P, P+1 ),
+     $                     LDA )
+               T = A( K, K )
+               A( K, K ) = A( P, P )
+               A( P, P ) = T
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL CSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA )
+*
+            END IF
+*
+*           Second swap
+*
+            KK = K - KSTEP + 1
+            IF( KP.NE.KK ) THEN
+*
+*              Interchange rows and columns KK and KP in the leading
+*              submatrix A(1:k,1:k)
+*
+               IF( KP.GT.1 )
+     $            CALL CSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 )
+               IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) )
+     $            CALL CSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ),
+     $                     LDA )
+               T = A( KK, KK )
+               A( KK, KK ) = A( KP, KP )
+               A( KP, KP ) = T
+               IF( KSTEP.EQ.2 ) THEN
+                  T = A( K-1, K )
+                  A( K-1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL CSWAP( N-K, A( KK, K+1 ), LDA, A( KP, K+1 ),
+     $                        LDA )
+*
+            END IF
+*
+*           Update the leading submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k now holds
+*
+*              W(k) = U(k)*D(k)
+*
+*              where U(k) is the k-th column of U
+*
+               IF( K.GT.1 ) THEN
+*
+*                 Perform a rank-1 update of A(1:k-1,1:k-1) and
+*                 store U(k) in column k
+*
+                  IF( CABS1( A( K, K ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(1:k-1,1:k-1) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*1/D(k)*W(k)**T
+*
+                     D11 = CONE / A( K, K )
+                     CALL CSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+*
+*                    Store U(k) in column k
+*
+                     CALL CSCAL( K-1, D11, A( 1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column K
+*
+                     D11 = A( K, K )
+                     DO 16 II = 1, K - 1
+                        A( II, K ) = A( II, K ) / D11
+   16                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL CSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+                  END IF
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k-1 now hold
+*
+*              ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+*              Perform a rank-2 update of A(1:k-2,1:k-2) as
+*
+*              A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )**T
+*                 = A - ( ( A(k-1)A(k) )*inv(D(k)) ) * ( A(k-1)A(k) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.GT.2 ) THEN
+*
+                  D12 = A( K-1, K )
+                  D22 = A( K-1, K-1 ) / D12
+                  D11 = A( K, K ) / D12
+                  T = CONE / ( D11*D22-CONE )
+*
+                  DO 30 J = K - 2, 1, -1
+*
+                     WKM1 = T*( D11*A( J, K-1 )-A( J, K ) )
+                     WK = T*( D22*A( J, K )-A( J, K-1 ) )
+*
+                     DO 20 I = J, 1, -1
+                        A( I, J ) = A( I, J ) - (A( I, K ) / D12 )*WK -
+     $                              ( A( I, K-1 ) / D12 )*WKM1
+   20                CONTINUE
+*
+*                    Store U(k) and U(k-1) in cols k and k-1 for row J
+*
+                     A( J, K ) = WK / D12
+                     A( J, K-1 ) = WKM1 / D12
+*
+   30             CONTINUE
+*
+               END IF
+*
+*              Copy superdiagonal elements of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               E( K ) = A( K-1, K )
+               E( K-1 ) = CZERO
+               A( K-1, K ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   34    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**T using the lower triangle of A
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = CZERO
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        1 or 2
+*
+         K = 1
+   40    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 64
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = CABS1( A( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + ICAMAX( N-K, A( K+1, K ), 1 )
+            COLMAX = CABS1( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( ( MAX( ABSAKK, COLMAX ).EQ.ZERO ) ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           Test for interchange
+*
+*           Equivalent to testing for (used to handle NaN and Inf)
+*           ABSAKK.GE.ALPHA*COLMAX
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   42          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), LDA )
+                     ROWMAX = CABS1( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + ICAMAX( N-IMAX, A( IMAX+1, IMAX ),
+     $                                     1 )
+                     STEMP = CABS1( A( ITEMP, IMAX ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for (used to handle NaN and Inf)
+*                 ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX
+*
+                  IF( .NOT.( CABS1( A( IMAX, IMAX ) ).LT.ALPHA*ROWMAX ))
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX .EQ. COLMAX,
+*                 used to handle NaN and Inf
+*
+                  ELSE IF( ( P.EQ.JMAX ).OR.( ROWMAX.LE.COLMAX ) ) THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot NOT found, set variables and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 42
+*
+            END IF
+*
+*           Swap TWO rows and TWO columns
+*
+*           First swap
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Interchange rows and column K and P in the trailing
+*              submatrix A(k:n,k:n) if we have a 2-by-2 pivot
+*
+               IF( P.LT.N )
+     $            CALL CSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 )
+               IF( P.GT.(K+1) )
+     $            CALL CSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA )
+               T = A( K, K )
+               A( K, K ) = A( P, P )
+               A( P, P ) = T
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL CSWAP( K-1, A( K, 1 ), LDA, A( P, 1 ), LDA )
+*
+            END IF
+*
+*           Second swap
+*
+            KK = K + KSTEP - 1
+            IF( KP.NE.KK ) THEN
+*
+*              Interchange rows and columns KK and KP in the trailing
+*              submatrix A(k:n,k:n)
+*
+               IF( KP.LT.N )
+     $            CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+               IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) )
+     $            CALL CSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
+     $                     LDA )
+               T = A( KK, KK )
+               A( KK, KK ) = A( KP, KP )
+               A( KP, KP ) = T
+               IF( KSTEP.EQ.2 ) THEN
+                  T = A( K+1, K )
+                  A( K+1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL CSWAP( K-1, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+*
+            END IF
+*
+*           Update the trailing submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k now holds
+*
+*              W(k) = L(k)*D(k)
+*
+*              where L(k) is the k-th column of L
+*
+               IF( K.LT.N ) THEN
+*
+*              Perform a rank-1 update of A(k+1:n,k+1:n) and
+*              store L(k) in column k
+*
+                  IF( CABS1( A( K, K ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*
+                     D11 = CONE / A( K, K )
+                     CALL CSYR( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+*
+*                    Store L(k) in column k
+*
+                     CALL CSCAL( N-K, D11, A( K+1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column k
+*
+                     D11 = A( K, K )
+                     DO 46 II = K + 1, N
+                        A( II, K ) = A( II, K ) / D11
+   46                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL CSYR( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+                  END IF
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+*
+*              Perform a rank-2 update of A(k+2:n,k+2:n) as
+*
+*              A := A - ( L(k) L(k+1) ) * D(k) * ( L(k) L(k+1) )**T
+*                 = A - ( ( A(k)A(k+1) )*inv(D(k) ) * ( A(k)A(k+1) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.LT.N-1 ) THEN
+*
+                  D21 = A( K+1, K )
+                  D11 = A( K+1, K+1 ) / D21
+                  D22 = A( K, K ) / D21
+                  T = CONE / ( D11*D22-CONE )
+*
+                  DO 60 J = K + 2, N
+*
+*                    Compute  D21 * ( W(k)W(k+1) ) * inv(D(k)) for row J
+*
+                     WK = T*( D11*A( J, K )-A( J, K+1 ) )
+                     WKP1 = T*( D22*A( J, K+1 )-A( J, K ) )
+*
+*                    Perform a rank-2 update of A(k+2:n,k+2:n)
+*
+                     DO 50 I = J, N
+                        A( I, J ) = A( I, J ) - ( A( I, K ) / D21 )*WK -
+     $                              ( A( I, K+1 ) / D21 )*WKP1
+   50                CONTINUE
+*
+*                    Store L(k) and L(k+1) in cols k and k+1 for row J
+*
+                     A( J, K ) = WK / D21
+                     A( J, K+1 ) = WKP1 / D21
+*
+   60             CONTINUE
+*
+               END IF
+*
+*              Copy subdiagonal elements of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               E( K ) = A( K+1, K )
+               E( K+1 ) = CZERO
+               A( K+1, K ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 40
+*
+   64    CONTINUE
+*
+      END IF
+*
+      RETURN
+*
+*     End of CSYTF2_RK
+*
+      END
diff --git a/SRC/csytrf_aa.f b/SRC/csytrf_aa.f
new file mode 100644
index 00000000..c6b76137
--- /dev/null
+++ b/SRC/csytrf_aa.f
@@ -0,0 +1,480 @@
+*> \brief \b CSYTRF_AA
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYTRF_AA + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csytrf_aa.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csytrf_aa.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csytrf_aa.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            N, LDA, LWORK, INFO
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), WORK( * )
+*       ..
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CSYTRF_AA computes the factorization of a complex symmetric matrix A
+*> using the Aasen's algorithm.  The form of the factorization is
+*>
+*>    A = U*T*U**T  or  A = L*T*L**T
+*>
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is a complex symmetric tridiagonal matrix.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>
+*>          On exit, the tridiagonal matrix is stored in the diagonals
+*>          and the subdiagonals of A just below (or above) the diagonals,
+*>          and L is stored below (or above) the subdiaonals, when UPLO
+*>          is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          On exit, it contains the details of the interchanges, i.e.,
+*>          the row and column k of A were interchanged with the
+*>          row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK. LWORK >= MAX(1,2*N). For optimum performance
+*>          LWORK >= N*(1+NB), where NB is the optimal blocksize.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, D(i,i) is exactly zero.  The factorization
+*>                has been completed, but the block diagonal matrix D is
+*>                exactly singular, and division by zero will occur if it
+*>                is used to solve a system of equations.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*  =====================================================================
+      SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+      IMPLICIT NONE
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            N, LDA, LWORK, INFO
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*     .. Parameters ..
+      COMPLEX            ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            J, LWKOPT, IINFO
+      INTEGER            NB, MJ, NJ, K1, K2, J1, J2, J3, JB
+      COMPLEX            ALPHA
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Determine the block size
+*
+      NB = ILAENV( 1, 'CSYTRF', UPLO, N, -1, -1, -1 )
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
+         INFO = -7
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         LWKOPT = (NB+1)*N
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYTRF_AA', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return
+*
+      IF ( N.EQ.0 ) THEN
+          RETURN
+      ENDIF
+      IPIV( 1 ) = 1
+      IF ( N.EQ.1 ) THEN
+         IF ( A( 1, 1 ).EQ.ZERO ) THEN
+            INFO = 1
+         END IF
+         RETURN
+      END IF
+*
+*     Adjubst block size based on the workspace size
+*
+      IF( LWORK.LT.((1+NB)*N) ) THEN
+         NB = ( LWORK-N ) / N
+      END IF
+*
+      IF( UPPER ) THEN
+*
+*        .....................................................
+*        Factorize A as L*D*L**T using the upper triangle of A
+*        .....................................................
+*
+*        Copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N))
+*
+         CALL CCOPY( N, A( 1, 1 ), LDA, WORK( 1 ), 1 )
+*
+*        J is the main loop index, increasing from 1 to N in steps of
+*        JB, where JB is the number of columns factorized by CLASYF;
+*        JB is either NB, or N-J+1 for the last block
+*
+         J = 0
+ 10      CONTINUE
+         IF( J.GE.N )
+     $      GO TO 20
+*
+*        each step of the main loop
+*         J is the last column of the previous panel
+*         J1 is the first column of the current panel
+*         K1 identifies if the previous column of the panel has been
+*          explicitly stored, e.g., K1=1 for the first panel, and
+*          K1=0 for the rest
+*
+         J1 = J + 1
+         JB = MIN( N-J1+1, NB )
+         K1 = MAX(1, J)-J
+*
+*        Panel factorization
+*
+         CALL CLASYF_AA( UPLO, 2-K1, N-J, JB,
+     $                   A( MAX(1, J), J+1 ), LDA,
+     $                   IPIV( J+1 ), WORK, N, WORK( N*NB+1 ),
+     $                   IINFO )
+         IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
+             INFO = IINFO+J
+         ENDIF
+*
+*        Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
+*
+         DO J2 = J+2, MIN(N, J+JB+1)
+            IPIV( J2 ) = IPIV( J2 ) + J
+            IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN
+               CALL CSWAP( J1-K1-2, A( 1, J2 ), 1,
+     $                              A( 1, IPIV(J2) ), 1 )
+            END IF
+         END DO
+         J = J + JB
+*
+*        Trailing submatrix update, where
+*         the row A(J1-1, J2-1:N) stores U(J1, J2+1:N) and
+*         WORK stores the current block of the auxiriarly matrix H
+*
+         IF( J.LT.N ) THEN
+*
+*           If first panel and JB=1 (NB=1), then nothing to do
+*
+            IF( J1.GT.1 .OR. JB.GT.1 ) THEN
+*
+*              Merge rank-1 update with BLAS-3 update
+*
+               ALPHA = A( J, J+1 )
+               A( J, J+1 ) = ONE
+               CALL CCOPY( N-J, A( J-1, J+1 ), LDA,
+     $                          WORK( (J+1-J1+1)+JB*N ), 1 )
+               CALL CSCAL( N-J, ALPHA, WORK( (J+1-J1+1)+JB*N ), 1 )
+*
+*              K1 identifies if the previous column of the panel has been
+*               explicitly stored, e.g., K1=1 and K2= 0 for the first panel,
+*               while K1=0 and K2=1 for the rest
+*
+               IF( J1.GT.1 ) THEN
+*
+*                 Not first panel
+*
+                  K2 = 1
+               ELSE
+*
+*                 First panel
+*
+                  K2 = 0
+*
+*                 First update skips the first column
+*
+                  JB = JB - 1
+               END IF
+*
+               DO J2 = J+1, N, NB
+                  NJ = MIN( NB, N-J2+1 )
+*
+*                 Update (J2, J2) diagonal block with CGEMV
+*
+                  J3 = J2
+                  DO MJ = NJ-1, 1, -1
+                     CALL CGEMV( 'No transpose', MJ, JB+1,
+     $                          -ONE, WORK( J3-J1+1+K1*N ), N,
+     $                                A( J1-K2, J3 ), 1,
+     $                           ONE, A( J3, J3 ), LDA )
+                     J3 = J3 + 1
+                  END DO
+*
+*                 Update off-diagonal block of J2-th block row with CGEMM
+*
+                  CALL CGEMM( 'Transpose', 'Transpose',
+     $                        NJ, N-J3+1, JB+1,
+     $                       -ONE, A( J1-K2, J2 ), LDA,
+     $                             WORK( J3-J1+1+K1*N ), N,
+     $                        ONE, A( J2, J3 ), LDA )
+               END DO
+*
+*              Recover T( J, J+1 )
+*
+               A( J, J+1 ) = ALPHA
+            END IF
+*
+*           WORK(J+1, 1) stores H(J+1, 1)
+*
+            CALL CCOPY( N-J, A( J+1, J+1 ), LDA, WORK( 1 ), 1 )
+         END IF
+         GO TO 10
+      ELSE
+*
+*        .....................................................
+*        Factorize A as L*D*L**T using the lower triangle of A
+*        .....................................................
+*
+*        copy first column A(1:N, 1) into H(1:N, 1)
+*         (stored in WORK(1:N))
+*
+         CALL CCOPY( N, A( 1, 1 ), 1, WORK( 1 ), 1 )
+*
+*        J is the main loop index, increasing from 1 to N in steps of
+*        JB, where JB is the number of columns factorized by CLASYF;
+*        JB is either NB, or N-J+1 for the last block
+*
+         J = 0
+ 11      CONTINUE
+         IF( J.GE.N )
+     $      GO TO 20
+*
+*        each step of the main loop
+*         J is the last column of the previous panel
+*         J1 is the first column of the current panel
+*         K1 identifies if the previous column of the panel has been
+*          explicitly stored, e.g., K1=1 for the first panel, and
+*          K1=0 for the rest
+*
+         J1 = J+1
+         JB = MIN( N-J1+1, NB )
+         K1 = MAX(1, J)-J
+*
+*        Panel factorization
+*
+         CALL CLASYF_AA( UPLO, 2-K1, N-J, JB,
+     $                   A( J+1, MAX(1, J) ), LDA,
+     $                   IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO)
+         IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
+            INFO = IINFO+J
+         ENDIF
+*
+*        Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
+*
+         DO J2 = J+2, MIN(N, J+JB+1)
+            IPIV( J2 ) = IPIV( J2 ) + J
+            IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN
+               CALL CSWAP( J1-K1-2, A( J2, 1 ), LDA,
+     $                              A( IPIV(J2), 1 ), LDA )
+            END IF
+         END DO
+         J = J + JB
+*
+*        Trailing submatrix update, where
+*          A(J2+1, J1-1) stores L(J2+1, J1) and
+*          WORK(J2+1, 1) stores H(J2+1, 1)
+*
+         IF( J.LT.N ) THEN
+*
+*           if first panel and JB=1 (NB=1), then nothing to do
+*
+            IF( J1.GT.1 .OR. JB.GT.1 ) THEN
+*
+*              Merge rank-1 update with BLAS-3 update
+*
+               ALPHA = A( J+1, J )
+               A( J+1, J ) = ONE
+               CALL CCOPY( N-J, A( J+1, J-1 ), 1,
+     $                          WORK( (J+1-J1+1)+JB*N ), 1 )
+               CALL CSCAL( N-J, ALPHA, WORK( (J+1-J1+1)+JB*N ), 1 )
+*
+*              K1 identifies if the previous column of the panel has been
+*               explicitly stored, e.g., K1=1 and K2= 0 for the first panel,
+*               while K1=0 and K2=1 for the rest
+*
+               IF( J1.GT.1 ) THEN
+*
+*                 Not first panel
+*
+                  K2 = 1
+               ELSE
+*
+*                 First panel
+*
+                  K2 = 0
+*
+*                 First update skips the first column
+*
+                  JB = JB - 1
+               END IF
+*
+               DO J2 = J+1, N, NB
+                  NJ = MIN( NB, N-J2+1 )
+*
+*                 Update (J2, J2) diagonal block with CGEMV
+*
+                  J3 = J2
+                  DO MJ = NJ-1, 1, -1
+                     CALL CGEMV( 'No transpose', MJ, JB+1,
+     $                          -ONE, WORK( J3-J1+1+K1*N ), N,
+     $                                A( J3, J1-K2 ), LDA,
+     $                           ONE, A( J3, J3 ), 1 )
+                     J3 = J3 + 1
+                  END DO
+*
+*                 Update off-diagonal block in J2-th block column with CGEMM
+*
+                  CALL CGEMM( 'No transpose', 'Transpose',
+     $                        N-J3+1, NJ, JB+1,
+     $                       -ONE, WORK( J3-J1+1+K1*N ), N,
+     $                             A( J2, J1-K2 ), LDA,
+     $                        ONE, A( J3, J2 ), LDA )
+               END DO
+*
+*              Recover T( J+1, J )
+*
+               A( J+1, J ) = ALPHA
+            END IF
+*
+*           WORK(J+1, 1) stores H(J+1, 1)
+*
+            CALL CCOPY( N-J, A( J+1, J+1 ), 1, WORK( 1 ), 1 )
+         END IF
+         GO TO 11
+      END IF
+*
+   20 CONTINUE
+      RETURN
+*
+*     End of CSYTRF_AA
+*
+      END
diff --git a/SRC/csytrf_rk.f b/SRC/csytrf_rk.f
new file mode 100644
index 00000000..953f6bee
--- /dev/null
+++ b/SRC/csytrf_rk.f
@@ -0,0 +1,498 @@
+*> \brief \b CSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYTRF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csytrf_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csytrf_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csytrf_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CSYTRF_RK computes the factorization of a complex symmetric matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension ( MAX(1,LWORK) ).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >=1.  For best performance
+*>          LWORK >= N*NB, where NB is the block size returned
+*>          by ILAENV.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array, returns this value as the first entry of the WORK
+*>          array, and no error message related to LWORK is issued
+*>          by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put correct description
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, IINFO, IP, IWS, K, KB, LDWORK, LWKOPT,
+     $                   NB, NBMIN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CLASYF_RK, CSYTF2_RK, CSWAP, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size
+*
+         NB = ILAENV( 1, 'CSYTRF_RK', UPLO, N, -1, -1, -1 )
+         LWKOPT = N*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYTRF_RK', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+      NBMIN = 2
+      LDWORK = N
+      IF( NB.GT.1 .AND. NB.LT.N ) THEN
+         IWS = LDWORK*NB
+         IF( LWORK.LT.IWS ) THEN
+            NB = MAX( LWORK / LDWORK, 1 )
+            NBMIN = MAX( 2, ILAENV( 2, 'CSYTRF_RK',
+     $                              UPLO, N, -1, -1, -1 ) )
+         END IF
+      ELSE
+         IWS = 1
+      END IF
+      IF( NB.LT.NBMIN )
+     $   NB = N
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**T using the upper triangle of A
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        KB, where KB is the number of columns factorized by CLASYF_RK;
+*        KB is either NB or NB-1, or K for the last block
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 15
+*
+         IF( K.GT.NB ) THEN
+*
+*           Factorize columns k-kb+1:k of A and use blocked code to
+*           update columns 1:k-kb
+*
+            CALL CLASYF_RK( UPLO, K, NB, KB, A, LDA, E,
+     $                      IPIV, WORK, LDWORK, IINFO )
+         ELSE
+*
+*           Use unblocked code to factorize columns 1:k of A
+*
+            CALL CSYTF2_RK( UPLO, K, A, LDA, E, IPIV, IINFO )
+            KB = K
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO
+*
+*        No need to adjust IPIV
+*
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k-kb+1:k and apply row permutations to the
+*        last k+1 colunms k+1:N after that block
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.LT.N ) THEN
+            DO I = K, ( K - KB + 1 ), -1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL CSWAP( N-K, A( I, K+1 ), LDA,
+     $                        A( IP, K+1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KB
+         GO TO 10
+*
+*        This label is the exit from main loop over K decreasing
+*        from N to 1 in steps of KB
+*
+   15    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**T using the lower triangle of A
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        KB, where KB is the number of columns factorized by CLASYF_RK;
+*        KB is either NB or NB-1, or N-K+1 for the last block
+*
+         K = 1
+   20    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 35
+*
+         IF( K.LE.N-NB ) THEN
+*
+*           Factorize columns k:k+kb-1 of A and use blocked code to
+*           update columns k+kb:n
+*
+            CALL CLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ),
+     $                        IPIV( K ), WORK, LDWORK, IINFO )
+
+
+         ELSE
+*
+*           Use unblocked code to factorize columns k:n of A
+*
+            CALL CSYTF2_RK( UPLO, N-K+1, A( K, K ), LDA, E( K ),
+     $                      IPIV( K ), IINFO )
+            KB = N - K + 1
+*
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO + K - 1
+*
+*        Adjust IPIV
+*
+         DO I = K, K + KB - 1
+            IF( IPIV( I ).GT.0 ) THEN
+               IPIV( I ) = IPIV( I ) + K - 1
+            ELSE
+               IPIV( I ) = IPIV( I ) - K + 1
+            END IF
+         END DO
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k:k+kb-1 and apply row permutations to the
+*        first k-1 colunms 1:k-1 before that block
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.GT.1 ) THEN
+            DO I = K, ( K + KB - 1 ), 1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL CSWAP( K-1, A( I, 1 ), LDA,
+     $                        A( IP, 1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KB
+         GO TO 20
+*
+*        This label is the exit from main loop over K increasing
+*        from 1 to N in steps of KB
+*
+   35    CONTINUE
+*
+*     End Lower
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+      RETURN
+*
+*     End of CSYTRF_RK
+*
+      END
diff --git a/SRC/csytri_3.f b/SRC/csytri_3.f
new file mode 100644
index 00000000..953c994a
--- /dev/null
+++ b/SRC/csytri_3.f
@@ -0,0 +1,248 @@
+*> \brief \b CSYTRI_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYTRI_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csytri_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csytri_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csytri_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CSYTRI_3 computes the inverse of a complex symmetric indefinite
+*> matrix A using the factorization computed by CSYTRF_RK or CSYTRF_BK:
+*>
+*>     A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> CSYTRI_3 sets the leading dimension of the workspace  before calling
+*> CSYTRI_3X that actually computes the inverse.  This is the blocked
+*> version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by CSYTRF_RK and CSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the symmetric inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by CSYTRF_RK or CSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (N+NB+1)*(NB+3).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK. LWORK >= (N+NB+1)*(NB+3).
+*>
+*>          If LDWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the optimal
+*>          size of the WORK array, returns this value as the first
+*>          entry of the WORK array, and no error message related to
+*>          LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            UPPER, LQUERY
+      INTEGER            LWKOPT, NB
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CSYTRI_3X
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+*     Determine the block size
+*
+      NB = MAX( 1, ILAENV( 1, 'CSYTRI_3', UPLO, N, -1, -1, -1 ) )
+      LWKOPT = ( N+NB+1 ) * ( NB+3 )
+*
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYTRI_3', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         WORK( 1 ) = LWKOPT
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      CALL CSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of CSYTRI_3
+*
+      END
diff --git a/SRC/csytri_3x.f b/SRC/csytri_3x.f
new file mode 100644
index 00000000..7e04d97c
--- /dev/null
+++ b/SRC/csytri_3x.f
@@ -0,0 +1,647 @@
+*> \brief \b CSYTRI_3X
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYTRI_3X + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csytri_3x.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csytri_3x.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csytri_3x.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ),  E( * ), WORK( N+NB+1, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CSYTRI_3X computes the inverse of a complex symmetric indefinite
+*> matrix A using the factorization computed by CSYTRF_RK or CSYTRF_BK:
+*>
+*>     A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by CSYTRF_RK and CSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the symmetric inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by CSYTRF_RK or CSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (N+NB+1,NB+3).
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          Block size.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), E( * ), WORK( N+NB+1, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX            CONE, CZERO
+      PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ),
+     $                     CZERO = ( 0.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            CUT, I, ICOUNT, INVD, IP, K, NNB, J, U11
+      COMPLEX            AK, AKKP1, AKP1, D, T, U01_I_J, U01_IP1_J,
+     $                   U11_I_J, U11_IP1_J
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CGEMM, CSYSWAPR, CTRTRI, CTRMM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+*
+*     Quick return if possible
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYTRI_3X', -INFO )
+         RETURN
+      END IF
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Workspace got Non-diag elements of D
+*
+      DO K = 1, N
+         WORK( K, 1 ) = E( K )
+      END DO
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO INFO = N, 1, -1
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.CZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO INFO = 1, N
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.CZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+      INFO = 0
+*
+*     Splitting Workspace
+*     U01 is a block ( N, NB+1 )
+*     The first element of U01 is in WORK( 1, 1 )
+*     U11 is a block ( NB+1, NB+1 )
+*     The first element of U11 is in WORK( N+1, 1 )
+*
+      U11 = N
+*
+*     INVD is a block ( N, 2 )
+*     The first element of INVD is in WORK( 1, INVD )
+*
+      INVD = NB + 2
+
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        invA = P * inv(U**T) * inv(D) * inv(U) * P**T.
+*
+         CALL CTRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(U)
+*
+         K = 1
+         DO WHILE( K.LE.N )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = CONE /  A( K, K )
+               WORK( K, INVD+1 ) = CZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = WORK( K+1, 1 )
+               AK = A( K, K ) / T
+               AKP1 = A( K+1, K+1 ) / T
+               AKKP1 = WORK( K+1, 1 )  / T
+               D = T*( AK*AKP1-CONE )
+               WORK( K, INVD ) = AKP1 / D
+               WORK( K+1, INVD+1 ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K+1, INVD ) = WORK( K, INVD+1 )
+               K = K + 1
+            END IF
+            K = K + 1
+         END DO
+*
+*        inv(U**T) = (inv(U))**T
+*
+*        inv(U**T) * inv(D) * inv(U)
+*
+         CUT = N
+         DO WHILE( CUT.GT.0 )
+            NNB = NB
+            IF( CUT.LE.NNB ) THEN
+               NNB = CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT+1-NNB, CUT
+                  IF( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+
+            CUT = CUT - NNB
+*
+*           U01 Block
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  WORK( I, J ) = A( I, CUT+J )
+               END DO
+            END DO
+*
+*           U11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I ) = CONE
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = CZERO
+                END DO
+                DO J = I+1, NNB
+                   WORK( U11+I, J ) = A( CUT+I, CUT+J )
+                END DO
+            END DO
+*
+*           invD * U01
+*
+            I = 1
+            DO WHILE( I.LE.CUT )
+               IF( IPIV( I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( I, INVD ) * WORK( I, J )
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK( I, J )
+                     U01_IP1_J = WORK( I+1, J )
+                     WORK( I, J ) = WORK( I, INVD ) * U01_I_J
+     $                            + WORK( I, INVD+1 ) * U01_IP1_J
+                     WORK( I+1, J ) = WORK( I+1, INVD ) * U01_I_J
+     $                              + WORK( I+1, INVD+1 ) * U01_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           invD1 * U11
+*
+            I = 1
+            DO WHILE ( I.LE.NNB )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = I, NNB
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+                  END DO
+               ELSE
+                  DO J = I, NNB
+                     U11_I_J = WORK(U11+I,J)
+                     U11_IP1_J = WORK(U11+I+1,J)
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                            + WORK(CUT+I,INVD+1) * WORK(U11+I+1,J)
+                     WORK( U11+I+1, J ) = WORK(CUT+I+1,INVD) * U11_I_J
+     $                               + WORK(CUT+I+1,INVD+1) * U11_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           U11**T * invD1 * U11 -> U11
+*
+            CALL CTRMM( 'L', 'U', 'T', 'U', NNB, NNB,
+     $                 CONE, A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                 N+NB+1 )
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+*           U01**T * invD * U01 -> A( CUT+I, CUT+J )
+*
+            CALL CGEMM( 'T', 'N', NNB, NNB, CUT, CONE, A( 1, CUT+1 ),
+     $                  LDA, WORK, N+NB+1, CZERO, WORK(U11+1,1),
+     $                  N+NB+1 )
+
+*
+*           U11 =  U11**T * invD1 * U11 + U01**T * invD * U01
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = A( CUT+I, CUT+J ) + WORK(U11+I,J)
+               END DO
+            END DO
+*
+*           U01 =  U00**T * invD0 * U01
+*
+            CALL CTRMM( 'L', UPLO, 'T', 'U', CUT, NNB,
+     $                  CONE, A, LDA, WORK, N+NB+1 )
+
+*
+*           Update U01
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  A( I, CUT+J ) = WORK( I, J )
+               END DO
+            END DO
+*
+*           Next Block
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(U**T) * inv(D) * inv(U) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Upper case.
+*
+*        ( We can use a loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = 1, N
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        inv A = P * inv(L**T) * inv(D) * inv(L) * P**T.
+*
+         CALL CTRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(L)
+*
+         K = N
+         DO WHILE ( K .GE. 1 )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = CONE /  A( K, K )
+               WORK( K, INVD+1 ) = CZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = WORK( K-1, 1 )
+               AK = A( K-1, K-1 ) / T
+               AKP1 = A( K, K ) / T
+               AKKP1 = WORK( K-1, 1 ) / T
+               D = T*( AK*AKP1-CONE )
+               WORK( K-1, INVD ) = AKP1 / D
+               WORK( K, INVD ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K-1, INVD+1 ) = WORK( K, INVD+1 )
+               K = K - 1
+            END IF
+            K = K - 1
+         END DO
+*
+*        inv(L**T) = (inv(L))**T
+*
+*        inv(L**T) * inv(D) * inv(L)
+*
+         CUT = 0
+         DO WHILE( CUT.LT.N )
+            NNB = NB
+            IF( (CUT + NNB).GT.N ) THEN
+               NNB = N - CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT + 1, CUT+NNB
+                  IF ( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+*
+*           L21 Block
+*
+            DO I = 1, N-CUT-NNB
+               DO J = 1, NNB
+                 WORK( I, J ) = A( CUT+NNB+I, CUT+J )
+               END DO
+            END DO
+*
+*           L11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I) = CONE
+               DO J = I+1, NNB
+                  WORK( U11+I, J ) = CZERO
+               END DO
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = A( CUT+I, CUT+J )
+               END DO
+            END DO
+*
+*           invD*L21
+*
+            I = N-CUT-NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+NNB+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( CUT+NNB+I, INVD) * WORK( I, J)
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK(I,J)
+                     U01_IP1_J = WORK(I-1,J)
+                     WORK(I,J)=WORK(CUT+NNB+I,INVD)*U01_I_J+
+     $                        WORK(CUT+NNB+I,INVD+1)*U01_IP1_J
+                     WORK(I-1,J)=WORK(CUT+NNB+I-1,INVD+1)*U01_I_J+
+     $                        WORK(CUT+NNB+I-1,INVD)*U01_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           invD1*L11
+*
+            I = NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( U11+I, J ) = WORK( CUT+I, INVD)*WORK(U11+I,J)
+                  END DO
+
+               ELSE
+                  DO J = 1, NNB
+                     U11_I_J = WORK( U11+I, J )
+                     U11_IP1_J = WORK( U11+I-1, J )
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                                + WORK(CUT+I,INVD+1) * U11_IP1_J
+                     WORK( U11+I-1, J ) = WORK(CUT+I-1,INVD+1) * U11_I_J
+     $                                  + WORK(CUT+I-1,INVD) * U11_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           L11**T * invD1 * L11 -> L11
+*
+            CALL CTRMM( 'L', UPLO, 'T', 'U', NNB, NNB, CONE,
+     $                   A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                   N+NB+1 )
+
+*
+            DO I = 1, NNB
+               DO J = 1, I
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+            IF( (CUT+NNB).LT.N ) THEN
+*
+*              L21**T * invD2*L21 -> A( CUT+I, CUT+J )
+*
+               CALL CGEMM( 'T', 'N', NNB, NNB, N-NNB-CUT, CONE,
+     $                     A( CUT+NNB+1, CUT+1 ), LDA, WORK, N+NB+1,
+     $                     CZERO, WORK( U11+1, 1 ), N+NB+1 )
+
+*
+*              L11 =  L11**T * invD1 * L11 + U01**T * invD * U01
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = A( CUT+I, CUT+J )+WORK(U11+I,J)
+                  END DO
+               END DO
+*
+*              L01 =  L22**T * invD2 * L21
+*
+               CALL CTRMM( 'L', UPLO, 'T', 'U', N-NNB-CUT, NNB, CONE,
+     $                     A( CUT+NNB+1, CUT+NNB+1 ), LDA, WORK,
+     $                     N+NB+1 )
+*
+*              Update L21
+*
+               DO I = 1, N-CUT-NNB
+                  DO J = 1, NNB
+                     A( CUT+NNB+I, CUT+J ) = WORK( I, J )
+                  END DO
+               END DO
+*
+            ELSE
+*
+*              L11 =  L11**T * invD1 * L11
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = WORK( U11+I, J )
+                  END DO
+               END DO
+            END IF
+*
+*           Next Block
+*
+            CUT = CUT + NNB
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(L**T) * inv(D) * inv(L) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Lower case.
+*
+*        ( We can use a loop over IPIV with increment -1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = N, 1, -1
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of CSYTRI_3X
+*
+      END
+
diff --git a/SRC/csytrs_3.f b/SRC/csytrs_3.f
new file mode 100644
index 00000000..17e54aad
--- /dev/null
+++ b/SRC/csytrs_3.f
@@ -0,0 +1,371 @@
+*> \brief \b CSYTRS_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYTRS_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csytrs_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csytrs_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csytrs_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX            A( LDA, * ), B( LDB, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> CSYTRS_3 solves a system of linear equations A * X = B with a complex
+*> symmetric matrix A using the factorization computed
+*> by CSYTRF_RK or CSYTRF_BK:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This algorithm is using Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**T)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**T)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by CSYTRF_RK and CSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by CSYTRF_RK or CSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (LDB,NRHS)
+*>          On entry, the right hand side matrix B.
+*>          On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complexSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE CSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), B( LDB, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX            ONE
+      PARAMETER          ( ONE = ( 1.0E+0,0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, J, K, KP
+      COMPLEX            AK, AKM1, AKM1K, BK, BKM1, DENOM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CSCAL, CSWAP, CTRSM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CSYTRS_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. NRHS.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        Solve A*X = B, where A = U*D*U**T.
+*
+*        P**T * B
+*
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]
+*
+         CALL CTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (U \P**T * B) ]
+*
+         I = N
+         DO WHILE ( I.GE.1 )
+            IF( IPIV( I ).GT.0 ) THEN
+               CALL CSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
+            ELSE IF ( I.GT.1 ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I-1, I-1 ) / AKM1K
+               AK = A( I, I ) / AKM1K
+               DENOM = AKM1*AK - ONE
+               DO J = 1, NRHS
+                  BKM1 = B( I-1, J ) / AKM1K
+                  BK = B( I, J ) / AKM1K
+                  B( I-1, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I - 1
+            END IF
+            I = I - 1
+         END DO
+*
+*        Compute (U**T \ B) -> B   [ U**T \ (D \ (U \P**T * B) ) ]
+*
+         CALL CTRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (U**T \ (D \ (U \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N, 1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        Solve A*X = B, where A = L*D*L**T.
+*
+*        P**T * B
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N, 1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]
+*
+         CALL CTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (L \P**T * B) ]
+*
+         I = 1
+         DO WHILE ( I.LE.N )
+            IF( IPIV( I ).GT.0 ) THEN
+               CALL CSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
+            ELSE IF( I.LT.N ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I, I ) / AKM1K
+               AK = A( I+1, I+1 ) / AKM1K
+               DENOM = AKM1*AK - ONE
+               DO  J = 1, NRHS
+                  BKM1 = B( I, J ) / AKM1K
+                  BK = B( I+1, J ) / AKM1K
+                  B( I, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I + 1
+            END IF
+            I = I + 1
+         END DO
+*
+*        Compute (L**T \ B) -> B   [ L**T \ (D \ (L \P**T * B) ) ]
+*
+         CALL CTRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (L**T \ (D \ (L \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        END Lower
+*
+      END IF
+*
+      RETURN
+*
+*     End of CSYTRS_3
+*
+      END
diff --git a/SRC/chetrs_aa_REMOTE_88628.f b/SRC/csytrs_aa.f
index 33f32fac..fd75ba4c 100644
--- a/SRC/chetrs_aa_REMOTE_88628.f
+++ b/SRC/csytrs_aa.f
@@ -1,4 +1,4 @@
-*> \brief \b CHETRS_AASEN
+*> \brief \b CSYTRS_AA
 *
 *  =========== DOCUMENTATION ===========
 *
@@ -6,20 +6,20 @@
 *            http://www.netlib.org/lapack/explore-html/
 *
 *> \htmlonly
-*> Download CHETRS_AASEN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrs_aasen.f">
+*> Download CSYTRS_AA + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csytrs_aa.f">
 *> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrs_aasen.f">
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csytrs_aa.f">
 *> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrs_aasen.f">
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csytrs_aa.f">
 *> [TXT]</a>
 *> \endhtmlonly
 *
 *  Definition:
 *  ===========
 *
-*       SUBROUTINE CHETRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
-*                                WORK, LWORK, INFO )
+*       SUBROUTINE CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
+*                             WORK, LWORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
@@ -27,7 +27,7 @@
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * )
-*       COMPLEX   A( LDA, * ), B( LDB, * ), WORK( * )
+*       COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
 *       ..
 *
 *
@@ -36,9 +36,9 @@
 *>
 *> \verbatim
 *>
-*> CHETRS_AASEN solves a system of linear equations A*X = B with a real
-*> hermitian matrix A using the factorization A = U*T*U**T or
-*> A = L*T*L**T computed by CHETRF_AASEN.
+*> CSYTRS_AA solves a system of linear equations A*X = B with a complex
+*> symmetric matrix A using the factorization A = U*T*U**T or
+*> A = L*T*L**T computed by CSYTRF_AA.
 *> \endverbatim
 *
 *  Arguments:
@@ -68,8 +68,8 @@
 *>
 *> \param[in,out] A
 *> \verbatim
-*>          A is COMPLEX array, dimension (LDA,N)
-*>          Details of factors computed by CHETRF_AASEN.
+*>          A is REAL array, dimension (LDA,N)
+*>          Details of factors computed by CSYTRF_AA.
 *> \endverbatim
 *>
 *> \param[in] LDA
@@ -81,12 +81,12 @@
 *> \param[in] IPIV
 *> \verbatim
 *>          IPIV is INTEGER array, dimension (N)
-*>          Details of the interchanges as computed by CHETRF_AASEN.
+*>          Details of the interchanges as computed by CSYTRF_AA.
 *> \endverbatim
 *>
 *> \param[in,out] B
 *> \verbatim
-*>          B is COMPLEX array, dimension (LDB,NRHS)
+*>          B is REAL array, dimension (LDB,NRHS)
 *>          On entry, the right hand side matrix B.
 *>          On exit, the solution matrix X.
 *> \endverbatim
@@ -104,7 +104,7 @@
 *>
 *> \param[in] LWORK
 *> \verbatim
-*>          LWORK is INTEGER, LWORK >= 3*N-2.
+*>          LWORK is INTEGER, LWORK >= MAX(1,3*N-2).
 *>
 *> \param[out] INFO
 *> \verbatim
@@ -125,13 +125,11 @@
 *
 *> \ingroup complexSYcomputational
 *
-*  @generated from zhetrs_aasen.f, fortran z -> c, Fri Sep 23 00:09:52 2016
-*
 *  =====================================================================
-      SUBROUTINE CHETRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
-     $                         WORK, LWORK, INFO )
+      SUBROUTINE CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
+     $                      WORK, LWORK, INFO )
 *
-*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK computational routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     November 2016
@@ -144,17 +142,17 @@
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * )
-      COMPLEX   A( LDA, * ), B( LDB, * ), WORK( * )
+      COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
 *     ..
 *
 *  =====================================================================
 *
-      COMPLEX   ONE
+      COMPLEX            ONE
       PARAMETER          ( ONE = 1.0E+0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            K, KP
+      LOGICAL            LQUERY, UPPER
+      INTEGER            K, KP, LWKOPT
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
@@ -170,6 +168,7 @@
 *
       INFO = 0
       UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
@@ -180,11 +179,15 @@
          INFO = -5
       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
          INFO = -8
-      ELSE IF( LWORK.LT.(3*N-2) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
          INFO = -10
       END IF
       IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'CHETRS_AASEN', -INFO )
+         CALL XERBLA( 'CSYTRS_AA', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         LWKOPT = (3*N-2)
+         WORK( 1 ) = LWKOPT
          RETURN
       END IF
 *
@@ -197,45 +200,40 @@
 *
 *        Solve A*X = B, where A = U*T*U**T.
 *
-*        P**T * B
+*        Pivot, P**T * B
 *
-         K = 1
-         DO WHILE ( K.LE.N )
+         DO K = 1, N
             KP = IPIV( K )
             IF( KP.NE.K )
      $          CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K + 1
          END DO
 *
 *        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]
 *
-         CALL CTRSM('L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
+         CALL CTRSM('L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
      $               B( 2, 1 ), LDB)
 *
 *        Compute T \ B -> B   [ T \ (U \P**T * B) ]
 *
-         CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
+         CALL CLACPY( 'F', 1, N, A( 1, 1 ), LDA+1, WORK( N ), 1)
          IF( N.GT.1 ) THEN
-             CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1)
-             CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1)
-             CALL CLACGV( N-1, WORK( 1 ), 1 )
+            CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1 )
+            CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1 )
          END IF
-         CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
-     $              INFO)
+         CALL CGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, LDB,
+     $               INFO )
 *
 *        Compute (U**T \ B) -> B   [ U**T \ (T \ (U \P**T * B) ) ]
 *
          CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
-     $               B(2, 1), LDB)
+     $               B( 2, 1 ), LDB)
 *
 *        Pivot, P * B  [ P * (U**T \ (T \ (U \P**T * B) )) ]
 *
-         K = N
-         DO WHILE ( K.GE.1 )
+         DO K = N, 1, -1
             KP = IPIV( K )
             IF( KP.NE.K )
      $         CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K - 1
          END DO
 *
       ELSE
@@ -244,49 +242,44 @@
 *
 *        Pivot, P**T * B
 *
-         K = 1
-         DO WHILE ( K.LE.N )
+         DO K = 1, N
             KP = IPIV( K )
             IF( KP.NE.K )
      $         CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K + 1
          END DO
 *
 *        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]
 *
-         CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), LDA,
-     $               B(2, 1), LDB)
+         CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
+     $               B( 2, 1 ), LDB)
 *
 *        Compute T \ B -> B   [ T \ (L \P**T * B) ]
 *
          CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
          IF( N.GT.1 ) THEN
-             CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1)
-             CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1)
-             CALL CLACGV( N-1, WORK( 2*N ), 1 )
+            CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1 )
+            CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1 )
          END IF
-         CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
-     $              INFO)
+         CALL CGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, LDB,
+     $               INFO)
 *
 *        Compute (L**T \ B) -> B   [ L**T \ (T \ (L \P**T * B) ) ]
 *
-         CALL CTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
+         CALL CTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
      $              B( 2, 1 ), LDB)
 *
 *        Pivot, P * B  [ P * (L**T \ (T \ (L \P**T * B) )) ]
 *
-         K = N
-         DO WHILE ( K.GE.1 )
+         DO K = N, 1, -1
             KP = IPIV( K )
             IF( KP.NE.K )
      $         CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K - 1
          END DO
 *
       END IF
 *
       RETURN
 *
-*     End of CHETRS_AASEN
+*     End of CSYTRS_AA
 *
       END
diff --git a/SRC/dgejsv.f b/SRC/dgejsv.f
index 3488f262..64f0908f 100644
--- a/SRC/dgejsv.f
+++ b/SRC/dgejsv.f
@@ -87,7 +87,7 @@
 *>             rows, then using this condition number gives too pessimistic
 *>             error bound.
 *>       = 'A': Small singular values are the noise and the matrix is treated
-*>             as numerically rank defficient. The error in the computed
+*>             as numerically rank deficient. The error in the computed
 *>             singular values is bounded by f(m,n)*epsilon*||A||.
 *>             The computed SVD A = U * S * V^t restores A up to
 *>             f(m,n)*epsilon*||A||.
@@ -428,7 +428,7 @@
 *>     The rank revealing QR factorization (in this code: DGEQP3) should be
 *>  implemented as in [3]. We have a new version of DGEQP3 under development
 *>  that is more robust than the current one in LAPACK, with a cleaner cut in
-*>  rank defficient cases. It will be available in the SIGMA library [4].
+*>  rank deficient cases. It will be available in the SIGMA library [4].
 *>  If M is much larger than N, it is obvious that the initial QRF with
 *>  column pivoting can be preprocessed by the QRF without pivoting. That
 *>  well known trick is not used in DGEJSV because in some cases heavy row
@@ -967,7 +967,7 @@
       ELSE IF ( L2RANK ) THEN
 *        .. similarly as above, only slightly more gentle (less agressive).
 *        Sudden drop on the diagonal of R1 is used as the criterion for
-*        close-to-rank-defficient.
+*        close-to-rank-deficient.
          TEMP1 = DSQRT(SFMIN)
          DO 3401 p = 2, N
             IF ( ( DABS(A(p,p)) .LT. (EPSLN*DABS(A(p-1,p-1))) ) .OR.
diff --git a/SRC/dgels.f b/SRC/dgels.f
index e3206f12..d5c9287e 100644
--- a/SRC/dgels.f
+++ b/SRC/dgels.f
@@ -49,7 +49,7 @@
 *>    an underdetermined system A * X = B.
 *>
 *> 3. If TRANS = 'T' and m >= n:  find the minimum norm solution of
-*>    an undetermined system A**T * X = B.
+*>    an underdetermined system A**T * X = B.
 *>
 *> 4. If TRANS = 'T' and m < n:  find the least squares solution of
 *>    an overdetermined system, i.e., solve the least squares problem
@@ -379,7 +379,7 @@
 *
          ELSE
 *
-*           Overdetermined system of equations A**T * X = B
+*           Underdetermined system of equations A**T * X = B
 *
 *           B(1:N,1:NRHS) := inv(R**T) * B(1:N,1:NRHS)
 *
diff --git a/SRC/dgemqr.f b/SRC/dgemqr.f
index 0ceea6fe..f47e6a87 100644
--- a/SRC/dgemqr.f
+++ b/SRC/dgemqr.f
@@ -21,7 +21,7 @@
 *>
 *> \verbatim
 *>
-*>      SGEMQR overwrites the general real M-by-N matrix C with
+*>      DGEMQR overwrites the general real M-by-N matrix C with
 *>
 *>
 *>                      SIDE = 'L'     SIDE = 'R'
diff --git a/SRC/dgetsls.f b/SRC/dgetsls.f
index b619f1d6..f2a7b3a7 100644
--- a/SRC/dgetsls.f
+++ b/SRC/dgetsls.f
@@ -1,8 +1,8 @@
 *  Definition:
 *  ===========
 *
-*       SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
-*     $                   , WORK, LWORK, INFO )
+*       SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
+*     $                     WORK, LWORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          TRANS
@@ -111,7 +111,7 @@
 *>
 *> \param[out] WORK
 *> \verbatim
-*>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*>          WORK is DOUBLE PRECISION array, dimension (MAX(12,LWORK))
 *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK,
 *>          and WORK(2) returns the minimum LWORK.
 *> \endverbatim
@@ -149,8 +149,8 @@
 *> \ingroup doubleGEsolve
 *
 *  =====================================================================
-      SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
-     $                   , WORK, LWORK, INFO )
+      SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
+     $                     WORK, LWORK, INFO )
 *
 *  -- LAPACK driver routine (version 3.4.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -159,7 +159,7 @@
 *
 *     .. Scalar Arguments ..
       CHARACTER          TRANS
-      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, MB
+      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS
 *     ..
 *     .. Array Arguments ..
       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), WORK( * )
@@ -176,7 +176,7 @@
       LOGICAL            LQUERY, TRAN
       INTEGER            I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
      $                   SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2,
-     $                   INFO2, NB
+     $                   INFO2
       DOUBLE PRECISION   ANRM, BIGNUM, BNRM, SMLNUM
 *     ..
 *     .. External Functions ..
@@ -225,8 +225,6 @@
        IF ( M.GE.N ) THEN
         CALL DGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
      $   INFO2)
-        MB = INT(WORK(4))
-        NB = INT(WORK(5))
         LW = INT(WORK(6))
         CALL DGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, WORK(1),
      $        INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
@@ -235,8 +233,6 @@
        ELSE
         CALL DGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
      $   INFO2)
-        MB = INT(WORK(4))
-        NB = INT(WORK(5))
         LW = INT(WORK(6))
         CALL DGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, WORK(1),
      $        INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
@@ -331,8 +327,8 @@
 *
 *        compute QR factorization of A
 *
-        CALL DGEQR( M, N, A, LDA, WORK(LW2+1), LW1
-     $    , WORK(1), LW2, INFO )
+        CALL DGEQR( M, N, A, LDA, WORK(LW2+1), LW1,
+     $              WORK(1), LW2, INFO )
         IF (.NOT.TRAN) THEN
 *
 *           Least-Squares Problem min || A * X - B ||
@@ -385,8 +381,8 @@
 *
 *        Compute LQ factorization of A
 *
-        CALL DGELQ( M, N, A, LDA, WORK(LW2+1), LW1
-     $    , WORK(1), LW2, INFO )
+        CALL DGELQ( M, N, A, LDA, WORK(LW2+1), LW1,
+     $              WORK(1), LW2, INFO )
 *
 *        workspace at least M, optimally M*NB.
 *
diff --git a/SRC/dlarfy.f b/SRC/dlarfy.f
new file mode 100644
index 00000000..089aa94e
--- /dev/null
+++ b/SRC/dlarfy.f
@@ -0,0 +1,161 @@
+*> \brief \b DLARFY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INCV, LDC, N
+*       DOUBLE PRECISION   TAU
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   C( LDC, * ), V( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DLARFY applies an elementary reflector, or Householder matrix, H,
+*> to an n x n symmetric matrix C, from both the left and the right.
+*>
+*> H is represented in the form
+*>
+*>    H = I - tau * v * v'
+*>
+*> where  tau  is a scalar and  v  is a vector.
+*>
+*> If  tau  is  zero, then  H  is taken to be the unit matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix C is stored.
+*>          = 'U':  Upper triangle
+*>          = 'L':  Lower triangle
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix C.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is DOUBLE PRECISION array, dimension
+*>                  (1 + (N-1)*abs(INCV))
+*>          The vector v as described above.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*>          INCV is INTEGER
+*>          The increment between successive elements of v.  INCV must
+*>          not be zero.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is DOUBLE PRECISION
+*>          The value tau as described above.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is DOUBLE PRECISION array, dimension (LDC, N)
+*>          On entry, the matrix C.
+*>          On exit, C is overwritten by H * C * H'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max( 1, N ).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (N)
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup double_eig
+*
+*  =====================================================================
+      SUBROUTINE DLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK )
+*
+*  -- LAPACK test routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INCV, LDC, N
+      DOUBLE PRECISION   TAU
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   C( LDC, * ), V( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE, ZERO, HALF
+      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0, HALF = 0.5D+0 )
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION   ALPHA
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DAXPY, DSYMV, DSYR2
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DDOT
+      EXTERNAL           DDOT
+*     ..
+*     .. Executable Statements ..
+*
+      IF( TAU.EQ.ZERO )
+     $   RETURN
+*
+*     Form  w:= C * v
+*
+      CALL DSYMV( UPLO, N, ONE, C, LDC, V, INCV, ZERO, WORK, 1 )
+*
+      ALPHA = -HALF*TAU*DDOT( N, WORK, 1, V, INCV )
+      CALL DAXPY( N, ALPHA, V, INCV, WORK, 1 )
+*
+*     C := C - v * w' - w * v'
+*
+      CALL DSYR2( UPLO, N, -TAU, V, INCV, WORK, 1, C, LDC )
+*
+      RETURN
+*
+*     End of DLARFY
+*
+      END
diff --git a/SRC/dlaswp.f b/SRC/dlaswp.f
index 1f050dbf..4e4d3d9f 100644
--- a/SRC/dlaswp.f
+++ b/SRC/dlaswp.f
@@ -71,15 +71,15 @@
 *> \param[in] K2
 *> \verbatim
 *>          K2 is INTEGER
-*>          The last element of IPIV for which a row interchange will
-*>          be done.
+*>          (K2-K1+1) is the number of elements of IPIV for which a row
+*>          interchange will be done.
 *> \endverbatim
 *>
 *> \param[in] IPIV
 *> \verbatim
-*>          IPIV is INTEGER array, dimension (K2*abs(INCX))
-*>          The vector of pivot indices.  Only the elements in positions
-*>          K1 through K2 of IPIV are accessed.
+*>          IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
+*>          The vector of pivot indices. Only the elements in positions
+*>          K1 through K1+(K2-K1)*INCX of IPIV are accessed.
 *>          IPIV(K) = L implies rows K and L are to be interchanged.
 *> \endverbatim
 *>
@@ -143,7 +143,7 @@
          I2 = K2
          INC = 1
       ELSE IF( INCX.LT.0 ) THEN
-         IX0 = 1 + ( 1-K2 )*INCX
+         IX0 = K1 + ( K1-K2 )*INCX
          I1 = K2
          I2 = K1
          INC = -1
diff --git a/SRC/dlasyf_aa.f b/SRC/dlasyf_aa.f
index cc0b80f2..393b50a8 100644
--- a/SRC/dlasyf_aa.f
+++ b/SRC/dlasyf_aa.f
@@ -19,7 +19,7 @@
 *  ===========
 *
 *       SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-*                                H, LDH, WORK, INFO )
+*                             H, LDH, WORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
@@ -46,7 +46,7 @@
 *> which is used to factorize the first panel.
 *>
 *> The resulting J-th row of U, or J-th column of L, is stored in the
-*> (J-1)-th row, or column, of A (without the unit diatonals), while
+*> (J-1)-th row, or column, of A (without the unit diagonals), while
 *> the diagonal and subdiagonal of A are overwritten by those of T.
 *>
 *> \endverbatim
@@ -152,7 +152,7 @@
 *
 *  =====================================================================
       SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-     $                         H, LDH, WORK, INFO )
+     $                      H, LDH, WORK, INFO )
 *
 *  -- LAPACK computational routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
diff --git a/SRC/dlasyf_rk.f b/SRC/dlasyf_rk.f
new file mode 100644
index 00000000..cbc13deb
--- /dev/null
+++ b/SRC/dlasyf_rk.f
@@ -0,0 +1,965 @@
+*> \brief \b DLASYF_RK computes a partial factorization of a real symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLASYF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasyf_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasyf_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasyf_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, KB, LDA, LDW, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ), E( * ), W( LDW, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> DLASYF_RK computes a partial factorization of a real symmetric
+*> matrix A using the bounded Bunch-Kaufman (rook) diagonal
+*> pivoting method. The partial factorization has the form:
+*>
+*> A  =  ( I  U12 ) ( A11  0  ) (  I       0    )  if UPLO = 'U', or:
+*>       ( 0  U22 ) (  0   D  ) ( U12**T U22**T )
+*>
+*> A  =  ( L11  0 ) (  D   0  ) ( L11**T L21**T )  if UPLO = 'L',
+*>       ( L21  I ) (  0  A22 ) (  0       I    )
+*>
+*> where the order of D is at most NB. The actual order is returned in
+*> the argument KB, and is either NB or NB-1, or N if N <= NB.
+*>
+*> DLASYF_RK is an auxiliary routine called by DSYTRF_RK. It uses
+*> blocked code (calling Level 3 BLAS) to update the submatrix
+*> A11 (if UPLO = 'U') or A22 (if UPLO = 'L').
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The maximum number of columns of the matrix A that should be
+*>          factored.  NB should be at least 2 to allow for 2-by-2 pivot
+*>          blocks.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*>          KB is INTEGER
+*>          The number of columns of A that were actually factored.
+*>          KB is either NB-1 or NB, or N if N <= NB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,N-KB+1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,1:KB).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (LDW,NB)
+*> \endverbatim
+*>
+*> \param[in] LDW
+*> \verbatim
+*>          LDW is INTEGER
+*>          The leading dimension of the array W.  LDW >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, KB, LDA, LDW, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   A( LDA, * ), E( * ), W( LDW, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      DOUBLE PRECISION   EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            DONE
+      INTEGER            IMAX, ITEMP, J, JB, JJ, JMAX, K, KK, KW, KKW,
+     $                   KP, KSTEP, P, II
+      DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22,
+     $                   DTEMP, R1, ROWMAX, T, SFMIN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            IDAMAX
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           LSAME, IDAMAX, DLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DCOPY, DGEMM, DGEMV, DSCAL, DSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = DLAMCH( 'S' )
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+*
+*        Factorize the trailing columns of A using the upper triangle
+*        of A and working backwards, and compute the matrix W = U12*D
+*        for use in updating A11
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = ZERO
+*
+*        K is the main loop index, decreasing from N in steps of 1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        KW is the column of W which corresponds to column K of A
+*
+         KW = NB + K - N
+*
+*        Exit from loop
+*
+         IF( ( K.LE.N-NB+1 .AND. NB.LT.N ) .OR. K.LT.1 )
+     $      GO TO 30
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column KW of W and update it
+*
+         CALL DCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 )
+         IF( K.LT.N )
+     $      CALL DGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ),
+     $                  LDA, W( K, KW+1 ), LDW, ONE, W( 1, KW ), 1 )
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( W( K, KW ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = IDAMAX( K-1, W( 1, KW ), 1 )
+            COLMAX = ABS( W( IMAX, KW ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            CALL DCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = ZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           Test for interchange
+*
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   12          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*
+*                 Copy column IMAX to column KW-1 of W and update it
+*
+                  CALL DCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 )
+                  CALL DCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA,
+     $                        W( IMAX+1, KW-1 ), 1 )
+*
+                  IF( K.LT.N )
+     $               CALL DGEMV( 'No transpose', K, N-K, -ONE,
+     $                           A( 1, K+1 ), LDA, W( IMAX, KW+1 ), LDW,
+     $                           ONE, W( 1, KW-1 ), 1 )
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + IDAMAX( K-IMAX, W( IMAX+1, KW-1 ),
+     $                                     1 )
+                     ROWMAX = ABS( W( JMAX, KW-1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = IDAMAX( IMAX-1, W( 1, KW-1 ), 1 )
+                     DTEMP = ABS( W( ITEMP, KW-1 ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for
+*                 ABS( W( IMAX, KW-1 ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.(ABS( W( IMAX, KW-1 ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column KW-1 of W to column KW of W
+*
+                     CALL DCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K-1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL DCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 12
+*
+            END IF
+*
+*           ============================================================
+*
+            KK = K - KSTEP + 1
+*
+*           KKW is the column of W which corresponds to column KK of A
+*
+            KKW = NB + KK - N
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column K to column P
+*
+               CALL DCOPY( K-P, A( P+1, K ), 1, A( P, P+1 ), LDA )
+               CALL DCOPY( P, A( 1, K ), 1, A( 1, P ), 1 )
+*
+*              Interchange rows K and P in last N-K+1 columns of A
+*              and last N-K+2 columns of W
+*
+               CALL DSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA )
+               CALL DSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW )
+            END IF
+*
+*           Updated column KP is already stored in column KKW of W
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP
+*
+               A( KP, K ) = A( KK, K )
+               CALL DCOPY( K-1-KP, A( KP+1, KK ), 1, A( KP, KP+1 ),
+     $                     LDA )
+               CALL DCOPY( KP, A( 1, KK ), 1, A( 1, KP ), 1 )
+*
+*              Interchange rows KK and KP in last N-KK+1 columns
+*              of A and W
+*
+               CALL DSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA )
+               CALL DSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ),
+     $                     LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column KW of W now holds
+*
+*              W(k) = U(k)*D(k)
+*
+*              where U(k) is the k-th column of U
+*
+*              Store U(k) in column k of A
+*
+               CALL DCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
+               IF( K.GT.1 ) THEN
+                  IF( ABS( A( K, K ) ).GE.SFMIN ) THEN
+                     R1 = ONE / A( K, K )
+                     CALL DSCAL( K-1, R1, A( 1, K ), 1 )
+                  ELSE IF( A( K, K ).NE.ZERO ) THEN
+                     DO 14 II = 1, K - 1
+                        A( II, K ) = A( II, K ) / A( K, K )
+   14                CONTINUE
+                  END IF
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = ZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns KW and KW-1 of W now
+*              hold
+*
+*              ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+               IF( K.GT.2 ) THEN
+*
+*                 Store U(k) and U(k-1) in columns k and k-1 of A
+*
+                  D12 = W( K-1, KW )
+                  D11 = W( K, KW ) / D12
+                  D22 = W( K-1, KW-1 ) / D12
+                  T = ONE / ( D11*D22-ONE )
+                  DO 20 J = 1, K - 2
+                     A( J, K-1 ) = T*( (D11*W( J, KW-1 )-W( J, KW ) ) /
+     $                             D12 )
+                     A( J, K ) = T*( ( D22*W( J, KW )-W( J, KW-1 ) ) /
+     $                           D12 )
+   20             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy superdiagonal element of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               A( K-1, K-1 ) = W( K-1, KW-1 )
+               A( K-1, K ) = ZERO
+               A( K, K ) = W( K, KW )
+               E( K ) = W( K-1, KW )
+               E( K-1 ) = ZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   30    CONTINUE
+*
+*        Update the upper triangle of A11 (= A(1:k,1:k)) as
+*
+*        A11 := A11 - U12*D*U12**T = A11 - U12*W**T
+*
+*        computing blocks of NB columns at a time
+*
+         DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB
+            JB = MIN( NB, K-J+1 )
+*
+*           Update the upper triangle of the diagonal block
+*
+            DO 40 JJ = J, J + JB - 1
+               CALL DGEMV( 'No transpose', JJ-J+1, N-K, -ONE,
+     $                     A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, ONE,
+     $                     A( J, JJ ), 1 )
+   40       CONTINUE
+*
+*           Update the rectangular superdiagonal block
+*
+            IF( J.GE.2 )
+     $         CALL DGEMM( 'No transpose', 'Transpose', J-1, JB,
+     $                  N-K, -ONE, A( 1, K+1 ), LDA, W( J, KW+1 ),
+     $                  LDW, ONE, A( 1, J ), LDA )
+   50    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = N - K
+*
+      ELSE
+*
+*        Factorize the leading columns of A using the lower triangle
+*        of A and working forwards, and compute the matrix W = L21*D
+*        for use in updating A22
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = ZERO
+*
+*        K is the main loop index, increasing from 1 in steps of 1 or 2
+*
+         K = 1
+   70   CONTINUE
+*
+*        Exit from loop
+*
+         IF( ( K.GE.NB .AND. NB.LT.N ) .OR. K.GT.N )
+     $      GO TO 90
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column K of W and update it
+*
+         CALL DCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 )
+         IF( K.GT.1 )
+     $      CALL DGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ),
+     $                  LDA, W( K, 1 ), LDW, ONE, W( K, K ), 1 )
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( W( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + IDAMAX( N-K, W( K+1, K ), 1 )
+            COLMAX = ABS( W( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            CALL DCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = ZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           Test for interchange
+*
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   72          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*
+*                 Copy column IMAX to column K+1 of W and update it
+*
+                  CALL DCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1)
+                  CALL DCOPY( N-IMAX+1, A( IMAX, IMAX ), 1,
+     $                        W( IMAX, K+1 ), 1 )
+                  IF( K.GT.1 )
+     $               CALL DGEMV( 'No transpose', N-K+1, K-1, -ONE,
+     $                           A( K, 1 ), LDA, W( IMAX, 1 ), LDW,
+     $                           ONE, W( K, K+1 ), 1 )
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + IDAMAX( IMAX-K, W( K, K+1 ), 1 )
+                     ROWMAX = ABS( W( JMAX, K+1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + IDAMAX( N-IMAX, W( IMAX+1, K+1 ), 1)
+                     DTEMP = ABS( W( ITEMP, K+1 ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for
+*                 ABS( W( IMAX, K+1 ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( ABS( W( IMAX, K+1 ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column K+1 of W to column K of W
+*
+                     CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 72
+*
+            END IF
+*
+*           ============================================================
+*
+            KK = K + KSTEP - 1
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column K to column P
+*
+               CALL DCOPY( P-K, A( K, K ), 1, A( P, K ), LDA )
+               CALL DCOPY( N-P+1, A( P, K ), 1, A( P, P ), 1 )
+*
+*              Interchange rows K and P in first K columns of A
+*              and first K+1 columns of W
+*
+               CALL DSWAP( K, A( K, 1 ), LDA, A( P, 1 ), LDA )
+               CALL DSWAP( KK, W( K, 1 ), LDW, W( P, 1 ), LDW )
+            END IF
+*
+*           Updated column KP is already stored in column KK of W
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP
+*
+               A( KP, K ) = A( KK, K )
+               CALL DCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA )
+               CALL DCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 )
+*
+*              Interchange rows KK and KP in first KK columns of A and W
+*
+               CALL DSWAP( KK, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+               CALL DSWAP( KK, W( KK, 1 ), LDW, W( KP, 1 ), LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k of W now holds
+*
+*              W(k) = L(k)*D(k)
+*
+*              where L(k) is the k-th column of L
+*
+*              Store L(k) in column k of A
+*
+               CALL DCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
+               IF( K.LT.N ) THEN
+                  IF( ABS( A( K, K ) ).GE.SFMIN ) THEN
+                     R1 = ONE / A( K, K )
+                     CALL DSCAL( N-K, R1, A( K+1, K ), 1 )
+                  ELSE IF( A( K, K ).NE.ZERO ) THEN
+                     DO 74 II = K + 1, N
+                        A( II, K ) = A( II, K ) / A( K, K )
+   74                CONTINUE
+                  END IF
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = ZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 of W now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+               IF( K.LT.N-1 ) THEN
+*
+*                 Store L(k) and L(k+1) in columns k and k+1 of A
+*
+                  D21 = W( K+1, K )
+                  D11 = W( K+1, K+1 ) / D21
+                  D22 = W( K, K ) / D21
+                  T = ONE / ( D11*D22-ONE )
+                  DO 80 J = K + 2, N
+                     A( J, K ) = T*( ( D11*W( J, K )-W( J, K+1 ) ) /
+     $                           D21 )
+                     A( J, K+1 ) = T*( ( D22*W( J, K+1 )-W( J, K ) ) /
+     $                             D21 )
+   80             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy subdiagonal element of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               A( K, K ) = W( K, K )
+               A( K+1, K ) = ZERO
+               A( K+1, K+1 ) = W( K+1, K+1 )
+               E( K ) = W( K+1, K )
+               E( K+1 ) = ZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 70
+*
+   90    CONTINUE
+*
+*        Update the lower triangle of A22 (= A(k:n,k:n)) as
+*
+*        A22 := A22 - L21*D*L21**T = A22 - L21*W**T
+*
+*        computing blocks of NB columns at a time
+*
+         DO 110 J = K, N, NB
+            JB = MIN( NB, N-J+1 )
+*
+*           Update the lower triangle of the diagonal block
+*
+            DO 100 JJ = J, J + JB - 1
+               CALL DGEMV( 'No transpose', J+JB-JJ, K-1, -ONE,
+     $                     A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, ONE,
+     $                     A( JJ, JJ ), 1 )
+  100       CONTINUE
+*
+*           Update the rectangular subdiagonal block
+*
+            IF( J+JB.LE.N )
+     $         CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
+     $                     K-1, -ONE, A( J+JB, 1 ), LDA, W( J, 1 ),
+     $                     LDW, ONE, A( J+JB, J ), LDA )
+  110    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = K - 1
+*
+      END IF
+*
+      RETURN
+*
+*     End of DLASYF_RK
+*
+      END
diff --git a/SRC/dsb2st_kernels.f b/SRC/dsb2st_kernels.f
new file mode 100644
index 00000000..15d1186e
--- /dev/null
+++ b/SRC/dsb2st_kernels.f
@@ -0,0 +1,320 @@
+*> \brief \b DSB2ST_KERNELS
+*
+*  @generated from zhb2st_kernels.f, fortran z -> d, Sun Nov  6 19:34:06 2016
+*      
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DSB2ST_KERNELS + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsb2st_kernels.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsb2st_kernels.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsb2st_kernels.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE  DSB2ST_KERNELS( UPLO, WANTZ, TTYPE, 
+*                                   ST, ED, SWEEP, N, NB, IB,
+*                                   A, LDA, V, TAU, LDVT, WORK)
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       LOGICAL            WANTZ
+*       INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   A( LDA, * ), V( * ), 
+*                          TAU( * ), WORK( * )
+*  
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSB2ST_KERNELS is an internal routine used by the DSYTRD_SB2ST
+*> subroutine.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> @param[in] n
+*>          The order of the matrix A.
+*>
+*> @param[in] nb
+*>          The size of the band.
+*>
+*> @param[in, out] A
+*>          A pointer to the matrix A.
+*>
+*> @param[in] lda
+*>          The leading dimension of the matrix A.
+*>
+*> @param[out] V
+*>          DOUBLE PRECISION array, dimension 2*n if eigenvalues only are
+*>          requested or to be queried for vectors.
+*>
+*> @param[out] TAU
+*>          DOUBLE PRECISION array, dimension (2*n).
+*>          The scalar factors of the Householder reflectors are stored
+*>          in this array.
+*>
+*> @param[in] st
+*>          internal parameter for indices.
+*>
+*> @param[in] ed
+*>          internal parameter for indices.
+*>
+*> @param[in] sweep
+*>          internal parameter for indices.
+*>
+*> @param[in] Vblksiz
+*>          internal parameter for indices.
+*>
+*> @param[in] wantz
+*>          logical which indicate if Eigenvalue are requested or both
+*>          Eigenvalue/Eigenvectors.
+*>
+*> @param[in] work
+*>          Workspace of size nb.
+*>
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE  DSB2ST_KERNELS( UPLO, WANTZ, TTYPE, 
+     $                            ST, ED, SWEEP, N, NB, IB,
+     $                            A, LDA, V, TAU, LDVT, WORK)
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      LOGICAL            WANTZ
+      INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), V( * ), 
+     $                   TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0,
+     $                   ONE = 1.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, J1, J2, LM, LN, VPOS, TAUPOS,
+     $                   DPOS, OFDPOS, AJETER 
+      DOUBLE PRECISION   CTMP 
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLARFG, DLARFX, DLARFY
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MOD
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     ..
+*     .. Executable Statements ..
+*      
+      AJETER = IB + LDVT
+      UPPER = LSAME( UPLO, 'U' )
+
+      IF( UPPER ) THEN
+          DPOS    = 2 * NB + 1
+          OFDPOS  = 2 * NB
+      ELSE
+          DPOS    = 1
+          OFDPOS  = 2
+      ENDIF
+
+*
+*     Upper case
+*  
+      IF( UPPER ) THEN
+*      
+          IF( WANTZ ) THEN
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ELSE
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ENDIF
+          GO TO ( 101, 102, 103 ) TTYPE
+*
+  101     CONTINUE
+          LM = ED - ST + 1
+*
+          V( VPOS ) = ONE
+          DO 10 I = 1, LM-1
+              V( VPOS+I )         = ( A( OFDPOS-I, ST+I ) )
+              A( OFDPOS-I, ST+I ) = ZERO  
+   10     CONTINUE
+          CTMP = ( A( OFDPOS, ST ) )
+          CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, 
+     $                                   TAU( TAUPOS ) )
+          A( OFDPOS, ST ) = CTMP
+* 
+  103     CONTINUE
+          LM = ED - ST + 1
+          CALL DLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ),
+     $                             A( DPOS, ST ), LDA-1, WORK)
+          GOTO 300
+*
+  102     CONTINUE
+          J1 = ED+1
+          J2 = MIN( ED+NB, N )
+          LN = ED-ST+1
+          LM = J2-J1+1
+          IF( LM.GT.0) THEN
+              CALL DLARFX( 'Left', LN, LM, V( VPOS ),
+     $                     ( TAU( TAUPOS ) ), A( DPOS-NB, J1 ),
+     $                     LDA-1, WORK)
+*
+              IF( WANTZ ) THEN
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ELSE
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ENDIF
+*
+              V( VPOS ) = ONE
+              DO 30 I = 1, LM-1
+                  V( VPOS+I )          = ( A( DPOS-NB-I, J1+I ) )
+                  A( DPOS-NB-I, J1+I ) = ZERO
+   30         CONTINUE
+              CTMP = ( A( DPOS-NB, J1 ) )
+              CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) )
+              A( DPOS-NB, J1 ) = CTMP
+*             
+              CALL DLARFX( 'Right', LN-1, LM, V( VPOS ), 
+     $                     TAU( TAUPOS ),
+     $                     A( DPOS-NB+1, J1 ), LDA-1, WORK)
+          ENDIF
+          GOTO 300
+*
+*     Lower case
+*  
+      ELSE
+*      
+          IF( WANTZ ) THEN
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ELSE
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ENDIF
+          GO TO ( 201, 202, 203 ) TTYPE
+*  
+  201     CONTINUE
+          LM = ED - ST + 1
+*
+          V( VPOS ) = ONE
+          DO 20 I = 1, LM-1
+              V( VPOS+I )         = A( OFDPOS+I, ST-1 )
+              A( OFDPOS+I, ST-1 ) = ZERO  
+   20     CONTINUE
+          CALL DLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, 
+     $                                   TAU( TAUPOS ) )
+*
+  203     CONTINUE
+          LM = ED - ST + 1
+*
+          CALL DLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ),
+     $                                      A( DPOS, ST ), LDA-1, WORK)
+
+          GOTO 300
+*
+  202     CONTINUE
+          J1 = ED+1
+          J2 = MIN( ED+NB, N )
+          LN = ED-ST+1
+          LM = J2-J1+1
+*
+          IF( LM.GT.0) THEN
+              CALL DLARFX( 'Right', LM, LN, V( VPOS ), 
+     $                     TAU( TAUPOS ), A( DPOS+NB, ST ),
+     $                     LDA-1, WORK)
+*
+              IF( WANTZ ) THEN
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ELSE
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ENDIF
+*              
+              V( VPOS ) = ONE
+              DO 40 I = 1, LM-1
+                  V( VPOS+I )        = A( DPOS+NB+I, ST )
+                  A( DPOS+NB+I, ST ) = ZERO
+   40         CONTINUE
+              CALL DLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, 
+     $                                    TAU( TAUPOS ) )
+*                  
+              CALL DLARFX( 'Left', LM, LN-1, V( VPOS ), 
+     $                     ( TAU( TAUPOS ) ),
+     $                     A( DPOS+NB-1, ST+1 ), LDA-1, WORK)
+
+          ENDIF
+          GOTO 300
+      ENDIF
+
+  300 CONTINUE    
+      RETURN
+*
+*     END OF DSB2ST_KERNELS
+*
+      END      
diff --git a/SRC/dsbev_2stage.f b/SRC/dsbev_2stage.f
new file mode 100644
index 00000000..771d29e0
--- /dev/null
+++ b/SRC/dsbev_2stage.f
@@ -0,0 +1,377 @@
+*> \brief <b> DSBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @precisions fortran d -> s
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSBEV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbev_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbev_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbev_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+*                                WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, KD, LDAB, LDZ, N, LWORK
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSBEV_2STAGE computes all the eigenvalues and, optionally, eigenvectors of
+*> a real symmetric band matrix A using the 2stage technique for
+*> the reduction to tridiagonal.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is DOUBLE PRECISION array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the symmetric band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.  If UPLO = 'U', the first
+*>          superdiagonal and the diagonal of the tridiagonal matrix T
+*>          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+*>          the diagonal and first subdiagonal of T are returned in the
+*>          first two rows of AB.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is DOUBLE PRECISION array, dimension (LDZ, N)
+*>          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+*>          eigenvectors of the matrix A, with the i-th column of Z
+*>          holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension LWORK
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS + N
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleOTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+     $                         WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, KD, LDAB, LDZ, N, LWORK
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, WANTZ, LQUERY
+      INTEGER            IINFO, IMAX, INDE, INDWRK, ISCALE,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, IB, INDHOUS
+      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, DLANSB
+      EXTERNAL           LSAME, DLAMCH, DLANSB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLASCL, DSCAL, DSTEQR, DSTERF, XERBLA
+     $                   DSYTRD_SB2ST 
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -6
+      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+         INFO = -9
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            IB    = ILAENV( 18, 'DSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+            LWMIN = N + LHTRD + LWTRD
+            WORK( 1 )  = LWMIN
+         ENDIF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -11
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSBEV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            W( 1 ) = AB( 1, 1 )
+         ELSE
+            W( 1 ) = AB( KD+1, 1 )
+         END IF
+         IF( WANTZ )
+     $      Z( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = DLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+      END IF
+*
+*     Call DSYTRD_SB2ST to reduce symmetric band matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDHOUS = INDE + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL DSYTRD_SB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, W,
+     $                    WORK( INDE ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call DSTERF.  For eigenvectors, call SSTEQR.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL DSTERF( N, W, WORK( INDE ), INFO )
+      ELSE
+         CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ),
+     $                INFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of DSBEV_2STAGE
+*
+      END
diff --git a/SRC/dsbevd_2stage.f b/SRC/dsbevd_2stage.f
new file mode 100644
index 00000000..39074681
--- /dev/null
+++ b/SRC/dsbevd_2stage.f
@@ -0,0 +1,412 @@
+*> \brief <b> DSBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @precisions fortran d -> s
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSBEVD_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbevd_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbevd_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbevd_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+*                                 WORK, LWORK, IWORK, LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IWORK( * )
+*       DOUBLE PRECISION   AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSBEVD_2STAGE computes all the eigenvalues and, optionally, eigenvectors of
+*> a real symmetric band matrix A using the 2stage technique for
+*> the reduction to tridiagonal. If eigenvectors are desired, it uses
+*> a divide and conquer algorithm.
+*>
+*> The divide and conquer algorithm makes very mild assumptions about
+*> floating point arithmetic. It will work on machines with a guard
+*> digit in add/subtract, or on those binary machines without guard
+*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
+*> without guard digits, but we know of none.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is DOUBLE PRECISION array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the symmetric band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.  If UPLO = 'U', the first
+*>          superdiagonal and the diagonal of the tridiagonal matrix T
+*>          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+*>          the diagonal and first subdiagonal of T are returned in the
+*>          first two rows of AB.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is DOUBLE PRECISION array, dimension (LDZ, N)
+*>          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+*>          eigenvectors of the matrix A, with the i-th column of Z
+*>          holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension LWORK
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS + N
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK and IWORK
+*>          arrays, returns these values as the first entries of the WORK
+*>          and IWORK arrays, and no error message related to LWORK or
+*>          LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of the array IWORK.
+*>          If JOBZ  = 'N' or N <= 1, LIWORK must be at least 1.
+*>          If JOBZ  = 'V' and N > 2, LIWORK must be at least 3 + 5*N.
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK and IWORK arrays, and no error message related to
+*>          LWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleOTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+     $                          WORK, LWORK, IWORK, LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IWORK( * )
+      DOUBLE PRECISION   AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, INDE, INDWK2, INDWRK, ISCALE, LIWMIN,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, IB, INDHOUS,
+     $                   LLWRK2
+      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, DLANSB
+      EXTERNAL           LSAME, DLAMCH, DLANSB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DGEMM, DLACPY, DLASCL, DSCAL, DSTEDC,
+     $                   DSTERF, XERBLA, DSYTRD_SB2ST
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( N.LE.1 ) THEN
+         LIWMIN = 1
+         LWMIN = 1
+      ELSE
+         IB    = ILAENV( 18, 'DSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+         IF( WANTZ ) THEN
+            LIWMIN = 3 + 5*N
+            LWMIN = 1 + 5*N + 2*N**2
+         ELSE
+            LIWMIN = 1
+            LWMIN = MAX( 2*N, N+LHTRD+LWTRD )
+         END IF
+      END IF
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -6
+      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+         INFO = -9
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         WORK( 1 )  = LWMIN
+         IWORK( 1 ) = LIWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -11
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -13
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSBEVD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = AB( 1, 1 )
+         IF( WANTZ )
+     $      Z( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = DLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+      END IF
+*
+*     Call DSYTRD_SB2ST to reduce band symmetric matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDHOUS = INDE + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+      INDWK2  = INDWRK + N*N
+      LLWRK2  = LWORK - INDWK2 + 1
+*
+      CALL DSYTRD_SB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, W,
+     $                    WORK( INDE ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call DSTERF.  For eigenvectors, call SSTEDC.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL DSTERF( N, W, WORK( INDE ), INFO )
+      ELSE
+         CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
+     $                WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
+         CALL DGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N,
+     $               ZERO, WORK( INDWK2 ), N )
+         CALL DLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 )
+     $   CALL DSCAL( N, ONE / SIGMA, W, 1 )
+*
+      WORK( 1 ) = LWMIN
+      IWORK( 1 ) = LIWMIN
+      RETURN
+*
+*     End of DSBEVD_2STAGE
+*
+      END
diff --git a/SRC/dsbevx_2stage.f b/SRC/dsbevx_2stage.f
new file mode 100644
index 00000000..3cb3f661
--- /dev/null
+++ b/SRC/dsbevx_2stage.f
@@ -0,0 +1,633 @@
+*> \brief <b> DSBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @precisions fortran d -> s
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSBEVX_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsbevx_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsbevx_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsbevx_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q,
+*                                 LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
+*                                 LDZ, WORK, LWORK, IWORK, IFAIL, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
+*       DOUBLE PRECISION   ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IFAIL( * ), IWORK( * )
+*       DOUBLE PRECISION   AB( LDAB, * ), Q( LDQ, * ), W( * ), WORK( * ),
+*      $                   Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSBEVX_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a real symmetric band matrix A using the 2stage technique for
+*> the reduction to tridiagonal. Eigenvalues and eigenvectors can
+*> be selected by specifying either a range of values or a range of
+*> indices for the desired eigenvalues.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found;
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found;
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is DOUBLE PRECISION array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the symmetric band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.  If UPLO = 'U', the first
+*>          superdiagonal and the diagonal of the tridiagonal matrix T
+*>          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+*>          the diagonal and first subdiagonal of T are returned in the
+*>          first two rows of AB.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] Q
+*> \verbatim
+*>          Q is DOUBLE PRECISION array, dimension (LDQ, N)
+*>          If JOBZ = 'V', the N-by-N orthogonal matrix used in the
+*>                         reduction to tridiagonal form.
+*>          If JOBZ = 'N', the array Q is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDQ
+*> \verbatim
+*>          LDQ is INTEGER
+*>          The leading dimension of the array Q.  If JOBZ = 'V', then
+*>          LDQ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is DOUBLE PRECISION
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is DOUBLE PRECISION
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is DOUBLE PRECISION
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing AB to tridiagonal form.
+*>
+*>          Eigenvalues will be computed most accurately when ABSTOL is
+*>          set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+*>          If this routine returns with INFO>0, indicating that some
+*>          eigenvectors did not converge, try setting ABSTOL to
+*>          2*DLAMCH('S').
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          The first M elements contain the selected eigenvalues in
+*>          ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If an eigenvector fails to converge, then that column of Z
+*>          contains the latest approximation to the eigenvector, and the
+*>          index of the eigenvector is returned in IFAIL.
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (LWORK)
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, 7*N, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS + 2*N
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (5*N)
+*> \endverbatim
+*>
+*> \param[out] IFAIL
+*> \verbatim
+*>          IFAIL is INTEGER array, dimension (N)
+*>          If JOBZ = 'V', then if INFO = 0, the first M elements of
+*>          IFAIL are zero.  If INFO > 0, then IFAIL contains the
+*>          indices of the eigenvectors that failed to converge.
+*>          If JOBZ = 'N', then IFAIL is not referenced.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit.
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value.
+*>          > 0:  if INFO = i, then i eigenvectors failed to converge.
+*>                Their indices are stored in array IFAIL.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup doubleOTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q,
+     $                          LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
+     $                          LDZ, WORK, LWORK, IWORK, IFAIL, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
+      DOUBLE PRECISION   ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IFAIL( * ), IWORK( * )
+      DOUBLE PRECISION   AB( LDAB, * ), Q( LDQ, * ), W( * ), WORK( * ),
+     $                   Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ,
+     $                   LQUERY
+      CHARACTER          ORDER
+      INTEGER            I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
+     $                   INDISP, INDIWO, INDWRK, ISCALE, ITMP1, J, JJ,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, IB, INDHOUS,
+     $                   NSPLIT
+      DOUBLE PRECISION   ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, DLANSB
+      EXTERNAL           LSAME, DLAMCH, DLANSB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DCOPY, DGEMV, DLACPY, DLASCL, DSCAL,
+     $                   DSTEBZ, DSTEIN, DSTEQR, DSTERF, DSWAP, XERBLA,
+     $                   DSYTRD_SB2ST
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -7
+      ELSE IF( WANTZ .AND. LDQ.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -11
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -12
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -13
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) )
+     $      INFO = -18
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            IB    = ILAENV( 18, 'DSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+            LWMIN = 2*N + LHTRD + LWTRD
+            WORK( 1 )  = LWMIN
+         ENDIF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -20
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSBEVX_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         M = 1
+         IF( LOWER ) THEN
+            TMP1 = AB( 1, 1 )
+         ELSE
+            TMP1 = AB( KD+1, 1 )
+         END IF
+         IF( VALEIG ) THEN
+            IF( .NOT.( VL.LT.TMP1 .AND. VU.GE.TMP1 ) )
+     $         M = 0
+         END IF
+         IF( M.EQ.1 ) THEN
+            W( 1 ) = TMP1
+            IF( WANTZ )
+     $         Z( 1, 1 ) = ONE
+         END IF
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF( VALEIG ) THEN
+         VLL = VL
+         VUU = VU
+      ELSE
+         VLL = ZERO
+         VUU = ZERO
+      END IF
+      ANRM = DLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+*
+*     Call DSYTRD_SB2ST to reduce symmetric band matrix to tridiagonal form.
+*
+      INDD    = 1
+      INDE    = INDD + N
+      INDHOUS = INDE + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL DSYTRD_SB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, WORK( INDD ),
+     $                    WORK( INDE ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     If all eigenvalues are desired and ABSTOL is less than or equal
+*     to zero, then call DSTERF or SSTEQR.  If this fails for some
+*     eigenvalue, then try DSTEBZ.
+*
+      TEST = .FALSE.
+      IF (INDEIG) THEN
+         IF (IL.EQ.1 .AND. IU.EQ.N) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF ((ALLEIG .OR. TEST) .AND. (ABSTOL.LE.ZERO)) THEN
+         CALL DCOPY( N, WORK( INDD ), 1, W, 1 )
+         INDEE = INDWRK + 2*N
+         IF( .NOT.WANTZ ) THEN
+            CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL DSTERF( N, W, WORK( INDEE ), INFO )
+         ELSE
+            CALL DLACPY( 'A', N, N, Q, LDQ, Z, LDZ )
+            CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL DSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
+     $                   WORK( INDWRK ), INFO )
+            IF( INFO.EQ.0 ) THEN
+               DO 10 I = 1, N
+                  IFAIL( I ) = 0
+   10          CONTINUE
+            END IF
+         END IF
+         IF( INFO.EQ.0 ) THEN
+            M = N
+            GO TO 30
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call DSTEBZ and, if eigenvectors are desired, SSTEIN.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+      INDIBL = 1
+      INDISP = INDIBL + N
+      INDIWO = INDISP + N
+      CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
+     $             IWORK( INDIWO ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
+*
+*        Apply orthogonal matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by DSTEIN.
+*
+         DO 20 J = 1, M
+            CALL DCOPY( N, Z( 1, J ), 1, WORK( 1 ), 1 )
+            CALL DGEMV( 'N', N, N, ONE, Q, LDQ, WORK, 1, ZERO,
+     $                  Z( 1, J ), 1 )
+   20    CONTINUE
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+   30 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.
+*
+      IF( WANTZ ) THEN
+         DO 50 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 40 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   40       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               ITMP1 = IWORK( INDIBL+I-1 )
+               W( I ) = W( J )
+               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
+               W( J ) = TMP1
+               IWORK( INDIBL+J-1 ) = ITMP1
+               CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+               IF( INFO.NE.0 ) THEN
+                  ITMP1 = IFAIL( I )
+                  IFAIL( I ) = IFAIL( J )
+                  IFAIL( J ) = ITMP1
+               END IF
+            END IF
+   50    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of DSBEVX_2STAGE
+*
+      END
diff --git a/SRC/dsycon_3.f b/SRC/dsycon_3.f
new file mode 100644
index 00000000..b92e2a92
--- /dev/null
+++ b/SRC/dsycon_3.f
@@ -0,0 +1,285 @@
+*> \brief \b DSYCON_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYCON_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsycon_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsycon_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsycon_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+*                            WORK, IWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       DOUBLE PRECISION   ANORM, RCOND
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * ), IWORK( * )
+*       DOUBLE PRECISION   A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> DSYCON_3 estimates the reciprocal of the condition number (in the
+*> 1-norm) of a real symmetric matrix A using the factorization
+*> computed by DSYTRF_RK or DSYTRF_BK:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
+*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+*> This routine uses BLAS3 solver DSYTRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**T)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**T)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by DSYTRF_RK and DSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by DSYTRF_RK or DSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[in] ANORM
+*> \verbatim
+*>          ANORM is DOUBLE PRECISION
+*>          The 1-norm of the original matrix A.
+*> \endverbatim
+*>
+*> \param[out] RCOND
+*> \verbatim
+*>          RCOND is DOUBLE PRECISION
+*>          The reciprocal of the condition number of the matrix A,
+*>          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+*>          estimate of the 1-norm of inv(A) computed in this routine.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (2*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+     $                     WORK, IWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+      DOUBLE PRECISION   ANORM, RCOND
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * ), IWORK( * )
+      DOUBLE PRECISION   A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE, ZERO
+      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, KASE
+      DOUBLE PRECISION   AINVNM
+*     ..
+*     .. Local Arrays ..
+      INTEGER            ISAVE( 3 )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLACN2, DSYTRS_3, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( ANORM.LT.ZERO ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYCON_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      RCOND = ZERO
+      IF( N.EQ.0 ) THEN
+         RCOND = ONE
+         RETURN
+      ELSE IF( ANORM.LE.ZERO ) THEN
+         RETURN
+      END IF
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO I = N, 1, -1
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO I = 1, N
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+*     Estimate the 1-norm of the inverse.
+*
+      KASE = 0
+   30 CONTINUE
+      CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
+      IF( KASE.NE.0 ) THEN
+*
+*        Multiply by inv(L*D*L**T) or inv(U*D*U**T).
+*
+         CALL DSYTRS_3( UPLO, N, 1, A, LDA, E, IPIV, WORK, N, INFO )
+         GO TO 30
+      END IF
+*
+*     Compute the estimate of the reciprocal condition number.
+*
+      IF( AINVNM.NE.ZERO )
+     $   RCOND = ( ONE / AINVNM ) / ANORM
+*
+      RETURN
+*
+*     End of DSYCON_3
+*
+      END
diff --git a/SRC/dsyconvf.f b/SRC/dsyconvf.f
new file mode 100644
index 00000000..529c2327
--- /dev/null
+++ b/SRC/dsyconvf.f
@@ -0,0 +1,559 @@
+*> \brief \b DSYCONVF
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYCONVF + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyconvf.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyconvf.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyconvf.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYCONVF( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO, WAY
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> If parameter WAY = 'C':
+*> DSYCONVF converts the factorization output format used in
+*> DSYTRF provided on entry in parameter A into the factorization
+*> output format used in DSYTRF_RK (or DSYTRF_BK) that is stored
+*> on exit in parameters A and E. It also coverts in place details of
+*> the intechanges stored in IPIV from the format used in DSYTRF into
+*> the format used in DSYTRF_RK (or DSYTRF_BK).
+*>
+*> If parameter WAY = 'R':
+*> DSYCONVF performs the conversion in reverse direction, i.e.
+*> converts the factorization output format used in DSYTRF_RK
+*> (or DSYTRF_BK) provided on entry in parametes A and E into
+*> the factorization output format used in DSYTRF that is stored
+*> on exit in parameter A. It also coverts in place details of
+*> the intechanges stored in IPIV from the format used in DSYTRF_RK
+*> (or DSYTRF_BK) into the format used in DSYTRF.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix A.
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] WAY
+*> \verbatim
+*>          WAY is CHARACTER*1
+*>          = 'C': Convert
+*>          = 'R': Revert
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, contains factorization details in format used in
+*>          DSYTRF:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          DSYTRF_RK or DSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains factorization details in format used in
+*>          DSYTRF_RK or DSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          DSYTRF:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, just a workspace.
+*>
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          On exit, is not changed
+*> \endverbatim
+*.
+*> \param[in,out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>          On entry, details of the interchanges and the block
+*>          structure of D in the format used in DSYTRF.
+*>          On exit, details of the interchanges and the block
+*>          structure of D in the format used in DSYTRF_RK
+*>          ( or DSYTRF_BK).
+*>
+*>          1) If WAY ='R':
+*>          On entry, details of the interchanges and the block
+*>          structure of D in the format used in DSYTRF_RK
+*>          ( or DSYTRF_BK).
+*>          On exit, details of the interchanges and the block
+*>          structure of D in the format used in DSYTRF.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*  =====================================================================
+      SUBROUTINE DSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO, WAY
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D+0 )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*
+*     .. External Subroutines ..
+      EXTERNAL           DSWAP, XERBLA
+*     .. Local Scalars ..
+      LOGICAL            UPPER, CONVERT
+      INTEGER            I, IP
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      CONVERT = LSAME( WAY, 'C' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYCONVF', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin A is UPPER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is upper)
+*
+*
+*           Convert VALUE
+*
+*           Assign superdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = N
+            E( 1 ) = ZERO
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  E( I ) = A( I-1, I )
+                  E( I-1 ) = ZERO
+                  A( I-1, I ) = ZERO
+                  I = I - 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I - 1
+            END DO
+*
+*           Convert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = -IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.(I-1) ) THEN
+                        CALL DSWAP( N-I, A( I-1, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is no interchnge of rows i and and IPIV(i),
+*                 so this should be reflected in IPIV format for
+*                 *SYTRF_RK ( or *SYTRF_BK)
+*
+                  IPIV( I ) = I
+*
+                  I = I - 1
+*
+               END IF
+               I = I - 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is upper)
+*
+*
+*           Revert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in reverse factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
+*
+                  I = I + 1
+                  IP = -IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.(I-1) ) THEN
+                        CALL DSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I-1, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is one interchange of rows i-1 and IPIV(i-1),
+*                 so this should be recorded in two consecutive entries
+*                 in IPIV format for *SYTRF
+*
+                  IPIV( I ) = IPIV( I-1 )
+*
+               END IF
+               I = I + 1
+            END DO
+*
+*           Revert VALUE
+*           Assign superdiagonal entries of D from array E to
+*           superdiagonal entries of A.
+*
+            I = N
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I-1, I ) = E( I )
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*        End A is UPPER
+*
+         END IF
+*
+      ELSE
+*
+*        Begin A is LOWER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is lower)
+*
+*
+*           Convert VALUE
+*           Assign subdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = 1
+            E( N ) = ZERO
+            DO WHILE ( I.LE.N )
+               IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
+                  E( I ) = A( I+1, I )
+                  E( I+1 ) = ZERO
+                  A( I+1, I ) = ZERO
+                  I = I + 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I + 1
+            END DO
+*
+*           Convert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in factorization order where k increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = -IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.(I+1) ) THEN
+                        CALL DSWAP( I-1, A( I+1, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is no interchnge of rows i and and IPIV(i),
+*                 so this should be reflected in IPIV format for
+*                 *SYTRF_RK ( or *SYTRF_BK)
+*
+                  IPIV( I ) = I
+*
+                  I = I + 1
+*
+               END IF
+               I = I + 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is lower)
+*
+*
+*           Revert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in reverse factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
+*
+                  I = I - 1
+                  IP = -IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.(I+1) ) THEN
+                        CALL DSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I+1, 1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is one interchange of rows i+1 and IPIV(i+1),
+*                 so this should be recorded in consecutive entries
+*                 in IPIV format for *SYTRF
+*
+                  IPIV( I ) = IPIV( I+1 )
+*
+               END IF
+               I = I - 1
+            END DO
+*
+*           Revert VALUE
+*           Assign subdiagonal entries of D from array E to
+*           subgiagonal entries of A.
+*
+            I = 1
+            DO WHILE ( I.LE.N-1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I + 1, I ) = E( I )
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+         END IF
+*
+*        End A is LOWER
+*
+      END IF
+
+      RETURN
+*
+*     End of DSYCONVF
+*
+      END
diff --git a/SRC/dsyconvf_rook.f b/SRC/dsyconvf_rook.f
new file mode 100644
index 00000000..12b65167
--- /dev/null
+++ b/SRC/dsyconvf_rook.f
@@ -0,0 +1,544 @@
+*> \brief \b DSYCONVF_ROOK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYCONVF_ROOK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyconvf_rook.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyconvf_rook.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyconvf_rook.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYCONVF_ROOK( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO, WAY
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> If parameter WAY = 'C':
+*> DSYCONVF_ROOK converts the factorization output format used in
+*> DSYTRF_ROOK provided on entry in parameter A into the factorization
+*> output format used in DSYTRF_RK (or DSYTRF_BK) that is stored
+*> on exit in parameters A and E. IPIV format for DSYTRF_ROOK and
+*> DSYTRF_RK (or DSYTRF_BK) is the same and is not converted.
+*>
+*> If parameter WAY = 'R':
+*> DSYCONVF_ROOK performs the conversion in reverse direction, i.e.
+*> converts the factorization output format used in DSYTRF_RK
+*> (or DSYTRF_BK) provided on entry in parametes A and E into
+*> the factorization output format used in DSYTRF_ROOK that is stored
+*> on exit in parameter A. IPIV format for DSYTRF_ROOK and
+*> DSYTRF_RK (or DSYTRF_BK) is the same and is not converted.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix A.
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] WAY
+*> \verbatim
+*>          WAY is CHARACTER*1
+*>          = 'C': Convert
+*>          = 'R': Revert
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, contains factorization details in format used in
+*>          DSYTRF_ROOK:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          DSYTRF_RK or DSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains factorization details in format used in
+*>          DSYTRF_RK or DSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          DSYTRF_ROOK:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, just a workspace.
+*>
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          On exit, is not changed
+*> \endverbatim
+*.
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          On entry, details of the interchanges and the block
+*>          structure of D as determined:
+*>          1) by DSYTRF_ROOK, if WAY ='C';
+*>          2) by DSYTRF_RK (or DSYTRF_BK), if WAY ='R'.
+*>          The IPIV format is the same for all these routines.
+*>
+*>          On exit, is not changed.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*  =====================================================================
+      SUBROUTINE DSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO, WAY
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D+0 )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*
+*     .. External Subroutines ..
+      EXTERNAL           DSWAP, XERBLA
+*     .. Local Scalars ..
+      LOGICAL            UPPER, CONVERT
+      INTEGER            I, IP, IP2
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      CONVERT = LSAME( WAY, 'C' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYCONVF_ROOK', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin A is UPPER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is upper)
+*
+*
+*           Convert VALUE
+*
+*           Assign superdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = N
+            E( 1 ) = ZERO
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  E( I ) = A( I-1, I )
+                  E( I-1 ) = ZERO
+                  A( I-1, I ) = ZERO
+                  I = I - 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I - 1
+            END DO
+*
+*           Convert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
+*                 in A(1:i,N-i:N)
+*
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I-1 )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                     IF( IP2.NE.(I-1) ) THEN
+                        CALL DSWAP( N-I, A( I-1, I+1 ), LDA,
+     $                              A( IP2, I+1 ), LDA )
+                     END IF
+                  END IF
+                  I = I - 1
+*
+               END IF
+               I = I - 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is upper)
+*
+*
+*           Revert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in reverse factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
+*                 in A(1:i,N-i:N)
+*
+                  I = I + 1
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I-1 )
+                  IF( I.LT.N ) THEN
+                     IF( IP2.NE.(I-1) ) THEN
+                        CALL DSWAP( N-I, A( IP2, I+1 ), LDA,
+     $                              A( I-1, I+1 ), LDA )
+                     END IF
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               END IF
+               I = I + 1
+            END DO
+*
+*           Revert VALUE
+*           Assign superdiagonal entries of D from array E to
+*           superdiagonal entries of A.
+*
+            I = N
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I-1, I ) = E( I )
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*        End A is UPPER
+*
+         END IF
+*
+      ELSE
+*
+*        Begin A is LOWER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is lower)
+*
+*
+*           Convert VALUE
+*           Assign subdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = 1
+            E( N ) = ZERO
+            DO WHILE ( I.LE.N )
+               IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
+                  E( I ) = A( I+1, I )
+                  E( I+1 ) = ZERO
+                  A( I+1, I ) = ZERO
+                  I = I + 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I + 1
+            END DO
+*
+*           Convert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
+*                 in A(i:N,1:i-1)
+*
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I+1 )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                     IF( IP2.NE.(I+1) ) THEN
+                        CALL DSWAP( I-1, A( I+1, 1 ), LDA,
+     $                              A( IP2, 1 ), LDA )
+                     END IF
+                  END IF
+                  I = I + 1
+*
+               END IF
+               I = I + 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is lower)
+*
+*
+*           Revert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in reverse factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
+*                 in A(i:N,1:i-1)
+*
+                  I = I - 1
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I+1 )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP2.NE.(I+1) ) THEN
+                        CALL DSWAP( I-1, A( IP2, 1 ), LDA,
+     $                              A( I+1, 1 ), LDA )
+                     END IF
+                     IF( IP.NE.I ) THEN
+                        CALL DSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               END IF
+               I = I - 1
+            END DO
+*
+*           Revert VALUE
+*           Assign subdiagonal entries of D from array E to
+*           subgiagonal entries of A.
+*
+            I = 1
+            DO WHILE ( I.LE.N-1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I + 1, I ) = E( I )
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+         END IF
+*
+*        End A is LOWER
+*
+      END IF
+
+      RETURN
+*
+*     End of DSYCONVF_ROOK
+*
+      END
diff --git a/SRC/dsyev_2stage.f b/SRC/dsyev_2stage.f
new file mode 100644
index 00000000..a42e86d8
--- /dev/null
+++ b/SRC/dsyev_2stage.f
@@ -0,0 +1,348 @@
+*> \brief <b> DSYEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
+*
+*  @precisions fortran d -> s
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYEV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyevd_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyevd_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyevd_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, 
+*                                INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYEV_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
+*> real symmetric matrix A using the 2stage technique for
+*> the reduction to tridiagonal.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA, N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          orthonormal eigenvectors of the matrix A.
+*>          If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+*>          or the upper triangle (if UPLO='U') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension LWORK
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + 2*N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + 2*N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, 
+     $                         INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, KD, IB, INDHOUS
+      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, DLANSY
+      EXTERNAL           LSAME, ILAENV, DLAMCH, DLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLASCL, DORGTR, DSCAL, DSTEQR, DSTERF,
+     $                   XERBLA, DSYTRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         KD    = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+         IB    = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWMIN = 2*N + LHTRD + LWTRD
+         WORK( 1 )  = LWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -8
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYEV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = A( 1, 1 )
+         WORK( 1 ) = 2
+         IF( WANTZ )
+     $      A( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = DLANSY( 'M', UPLO, N, A, LDA, WORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 )
+     $   CALL DLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
+*
+*     Call DSYTRD_2STAGE to reduce symmetric matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDTAU  = INDE + N
+      INDHOUS = INDTAU + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL DSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK( INDE ),
+     $                    WORK( INDTAU ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call DSTERF.  For eigenvectors, first call
+*     DORGTR to generate the orthogonal matrix, then call DSTEQR.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL DSTERF( N, W, WORK( INDE ), INFO )
+      ELSE
+*        Not available in this release, and agrument checking should not
+*        let it getting here
+         RETURN
+         CALL DORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
+     $                LLWORK, IINFO )
+         CALL DSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, WORK( INDTAU ),
+     $                INFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of DSYEV_2STAGE
+*
+      END
diff --git a/SRC/dsyevd_2stage.f b/SRC/dsyevd_2stage.f
new file mode 100644
index 00000000..161f0e9e
--- /dev/null
+++ b/SRC/dsyevd_2stage.f
@@ -0,0 +1,406 @@
+*> \brief <b> DSYEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
+*
+*  @precisions fortran d -> s
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYEVD_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyevd_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyevd_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyevd_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+*                                IWORK, LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, LDA, LIWORK, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IWORK( * )
+*       DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYEVD_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
+*> real symmetric matrix A using the 2stage technique for
+*> the reduction to tridiagonal. If eigenvectors are desired, it uses a
+*> divide and conquer algorithm.
+*>
+*> The divide and conquer algorithm makes very mild assumptions about
+*> floating point arithmetic. It will work on machines with a guard
+*> digit in add/subtract, or on those binary machines without guard
+*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
+*> without guard digits, but we know of none.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA, N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          orthonormal eigenvectors of the matrix A.
+*>          If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+*>          or the upper triangle (if UPLO='U') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array,
+*>                                         dimension (LWORK)
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          If N <= 1,               LWORK must be at least 1.
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + 2*N+1
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + 2*N+1
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be at least
+*>                                                1 + 6*N + 2*N**2.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK and IWORK
+*>          arrays, returns these values as the first entries of the WORK
+*>          and IWORK arrays, and no error message related to LWORK or
+*>          LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of the array IWORK.
+*>          If N <= 1,                LIWORK must be at least 1.
+*>          If JOBZ  = 'N' and N > 1, LIWORK must be at least 1.
+*>          If JOBZ  = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK and IWORK arrays, and no error message related to
+*>          LWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i and JOBZ = 'N', then the algorithm failed
+*>                to converge; i off-diagonal elements of an intermediate
+*>                tridiagonal form did not converge to zero;
+*>                if INFO = i and JOBZ = 'V', then the algorithm failed
+*>                to compute an eigenvalue while working on the submatrix
+*>                lying in rows and columns INFO/(N+1) through
+*>                mod(INFO,N+1).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date September 2012
+*
+*> \ingroup doubleSYeigen
+*
+*> \par Contributors:
+*  ==================
+*>
+*> Jeff Rutter, Computer Science Division, University of California
+*> at Berkeley, USA \n
+*>  Modified by Francoise Tisseur, University of Tennessee \n
+*>  Modified description of INFO. Sven, 16 Feb 05. \n
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+     $                          IWORK, LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.4.2) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     September 2012
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, LDA, LIWORK, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IWORK( * )
+      DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+*     ..
+*     .. Local Scalars ..
+*
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
+     $                   LIWMIN, LLWORK, LLWRK2, LWMIN,
+     $                   LHTRD, LWTRD, KD, IB, INDHOUS
+      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, DLANSY
+      EXTERNAL           LSAME, DLAMCH, DLANSY, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLACPY, DLASCL, DORMTR, DSCAL, DSTEDC, DSTERF,
+     $                   DSYTRD_2STAGE, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LIWMIN = 1
+            LWMIN = 1
+         ELSE
+            KD    = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+            IB    = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            IF( WANTZ ) THEN
+               LIWMIN = 3 + 5*N
+               LWMIN = 1 + 6*N + 2*N**2
+            ELSE
+               LIWMIN = 1
+               LWMIN = 2*N + 1 + LHTRD + LWTRD
+            END IF
+         END IF
+         WORK( 1 )  = LWMIN
+         IWORK( 1 ) = LIWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -8
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -10
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYEVD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = A( 1, 1 )
+         IF( WANTZ )
+     $      A( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = DLANSY( 'M', UPLO, N, A, LDA, WORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 )
+     $   CALL DLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
+*
+*     Call DSYTRD_2STAGE to reduce symmetric matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDTAU  = INDE + N
+      INDHOUS = INDTAU + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+      INDWK2  = INDWRK + N*N
+      LLWRK2  = LWORK - INDWK2 + 1
+*
+      CALL DSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK( INDE ),
+     $                    WORK( INDTAU ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call DSTERF.  For eigenvectors, first call
+*     DSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
+*     tridiagonal matrix, then call DORMTR to multiply it by the
+*     Householder transformations stored in A.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL DSTERF( N, W, WORK( INDE ), INFO )
+      ELSE
+*        Not available in this release, and agrument checking should not
+*        let it getting here
+         RETURN
+         CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
+     $                WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
+         CALL DORMTR( 'L', UPLO, 'N', N, N, A, LDA, WORK( INDTAU ),
+     $                WORK( INDWRK ), N, WORK( INDWK2 ), LLWRK2, IINFO )
+         CALL DLACPY( 'A', N, N, WORK( INDWRK ), N, A, LDA )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 )
+     $   CALL DSCAL( N, ONE / SIGMA, W, 1 )
+*
+      WORK( 1 )  = LWMIN
+      IWORK( 1 ) = LIWMIN
+*
+      RETURN
+*
+*     End of DSYEVD_2STAGE
+*
+      END
diff --git a/SRC/dsyevr_2stage.f b/SRC/dsyevr_2stage.f
new file mode 100644
index 00000000..c1b468dc
--- /dev/null
+++ b/SRC/dsyevr_2stage.f
@@ -0,0 +1,740 @@
+*> \brief <b> DSYEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
+*
+*  @precisions fortran d -> s
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYEVR_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyevr_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyevr_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyevr_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+*                          IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK,
+*                          LWORK, IWORK, LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
+*       DOUBLE PRECISION   ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            ISUPPZ( * ), IWORK( * )
+*       DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYEVR_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a real symmetric matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  Eigenvalues and eigenvectors can be
+*> selected by specifying either a range of values or a range of
+*> indices for the desired eigenvalues.
+*>
+*> DSYEVR_2STAGE first reduces the matrix A to tridiagonal form T with a call
+*> to DSYTRD.  Then, whenever possible, DSYEVR_2STAGE calls DSTEMR to compute
+*> the eigenspectrum using Relatively Robust Representations.  DSTEMR
+*> computes eigenvalues by the dqds algorithm, while orthogonal
+*> eigenvectors are computed from various "good" L D L^T representations
+*> (also known as Relatively Robust Representations). Gram-Schmidt
+*> orthogonalization is avoided as far as possible. More specifically,
+*> the various steps of the algorithm are as follows.
+*>
+*> For each unreduced block (submatrix) of T,
+*>    (a) Compute T - sigma I  = L D L^T, so that L and D
+*>        define all the wanted eigenvalues to high relative accuracy.
+*>        This means that small relative changes in the entries of D and L
+*>        cause only small relative changes in the eigenvalues and
+*>        eigenvectors. The standard (unfactored) representation of the
+*>        tridiagonal matrix T does not have this property in general.
+*>    (b) Compute the eigenvalues to suitable accuracy.
+*>        If the eigenvectors are desired, the algorithm attains full
+*>        accuracy of the computed eigenvalues only right before
+*>        the corresponding vectors have to be computed, see steps c) and d).
+*>    (c) For each cluster of close eigenvalues, select a new
+*>        shift close to the cluster, find a new factorization, and refine
+*>        the shifted eigenvalues to suitable accuracy.
+*>    (d) For each eigenvalue with a large enough relative separation compute
+*>        the corresponding eigenvector by forming a rank revealing twisted
+*>        factorization. Go back to (c) for any clusters that remain.
+*>
+*> The desired accuracy of the output can be specified by the input
+*> parameter ABSTOL.
+*>
+*> For more details, see DSTEMR's documentation and:
+*> - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
+*>   to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
+*>   Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+*> - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
+*>   Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
+*>   2004.  Also LAPACK Working Note 154.
+*> - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+*>   tridiagonal eigenvalue/eigenvector problem",
+*>   Computer Science Division Technical Report No. UCB/CSD-97-971,
+*>   UC Berkeley, May 1997.
+*>
+*>
+*> Note 1 : DSYEVR_2STAGE calls DSTEMR when the full spectrum is requested
+*> on machines which conform to the ieee-754 floating point standard.
+*> DSYEVR_2STAGE calls DSTEBZ and SSTEIN on non-ieee machines and
+*> when partial spectrum requests are made.
+*>
+*> Normal execution of DSTEMR may create NaNs and infinities and
+*> hence may abort due to a floating point exception in environments
+*> which do not handle NaNs and infinities in the ieee standard default
+*> manner.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found.
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found.
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*>          For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and
+*>          DSTEIN are called
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA, N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, the lower triangle (if UPLO='L') or the upper
+*>          triangle (if UPLO='U') of A, including the diagonal, is
+*>          destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is DOUBLE PRECISION
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is DOUBLE PRECISION
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is DOUBLE PRECISION
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing A to tridiagonal form.
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*>
+*>          If high relative accuracy is important, set ABSTOL to
+*>          DLAMCH( 'Safe minimum' ).  Doing so will guarantee that
+*>          eigenvalues are computed to high relative accuracy when
+*>          possible in future releases.  The current code does not
+*>          make any guarantees about high relative accuracy, but
+*>          future releases will. See J. Barlow and J. Demmel,
+*>          "Computing Accurate Eigensystems of Scaled Diagonally
+*>          Dominant Matrices", LAPACK Working Note #7, for a discussion
+*>          of which matrices define their eigenvalues to high relative
+*>          accuracy.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          The first M elements contain the selected eigenvalues in
+*>          ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*>          Supplying N columns is always safe.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] ISUPPZ
+*> \verbatim
+*>          ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
+*>          The support of the eigenvectors in Z, i.e., the indices
+*>          indicating the nonzero elements in Z. The i-th eigenvector
+*>          is nonzero only in elements ISUPPZ( 2*i-1 ) through
+*>          ISUPPZ( 2*i ). This is an output of DSTEMR (tridiagonal
+*>          matrix). The support of the eigenvectors of A is typically 
+*>          1:N because of the orthogonal transformations applied by DORMTR.
+*>          Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, 26*N, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + 5*N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + 5*N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of the array IWORK.  LIWORK >= max(1,10*N).
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal size of the IWORK array,
+*>          returns this value as the first entry of the IWORK array, and
+*>          no error message related to LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  Internal error
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup doubleSYeigen
+*
+*> \par Contributors:
+*  ==================
+*>
+*>     Inderjit Dhillon, IBM Almaden, USA \n
+*>     Osni Marques, LBNL/NERSC, USA \n
+*>     Ken Stanley, Computer Science Division, University of
+*>       California at Berkeley, USA \n
+*>     Jason Riedy, Computer Science Division, University of
+*>       California at Berkeley, USA \n
+*>
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+     $                   IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK,
+     $                   LWORK, IWORK, LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
+      DOUBLE PRECISION   ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            ISUPPZ( * ), IWORK( * )
+      DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+* =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE, TWO
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, LQUERY, VALEIG, WANTZ,
+     $                   TRYRAC
+      CHARACTER          ORDER
+      INTEGER            I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
+     $                   INDEE, INDIBL, INDIFL, INDISP, INDIWO, INDTAU,
+     $                   INDWK, INDWKN, ISCALE, J, JJ, LIWMIN,
+     $                   LLWORK, LLWRKN, LWMIN, NSPLIT,
+     $                   LHTRD, LWTRD, KD, IB, INDHOUS
+      DOUBLE PRECISION   ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, DLANSY
+      EXTERNAL           LSAME, ILAENV, DLAMCH, DLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DCOPY, DORMTR, DSCAL, DSTEBZ, DSTEMR, DSTEIN,
+     $                   DSTERF, DSWAP, DSYTRD_2STAGE, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      IEEEOK = ILAENV( 10, 'DSYEVR', 'N', 1, 2, 3, 4 )
+*
+      LOWER = LSAME( UPLO, 'L' )
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+*
+      LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
+*
+      KD     = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+      IB     = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+      LHTRD  = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+      LWTRD  = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+      LWMIN  = MAX( 26*N, 5*N + LHTRD + LWTRD )
+      LIWMIN = MAX( 1, 10*N )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -8
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -9
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -10
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+            INFO = -15
+         ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -18
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -20
+         END IF
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*         NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
+*         NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) )
+*         LWKOPT = MAX( ( NB+1 )*N, LWMIN )
+         WORK( 1 ) = LWMIN
+         IWORK( 1 ) = LIWMIN
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYEVR_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         WORK( 1 ) = 7
+         IF( ALLEIG .OR. INDEIG ) THEN
+            M = 1
+            W( 1 ) = A( 1, 1 )
+         ELSE
+            IF( VL.LT.A( 1, 1 ) .AND. VU.GE.A( 1, 1 ) ) THEN
+               M = 1
+               W( 1 ) = A( 1, 1 )
+            END IF
+         END IF
+         IF( WANTZ ) THEN
+            Z( 1, 1 ) = ONE
+            ISUPPZ( 1 ) = 1
+            ISUPPZ( 2 ) = 1
+         END IF
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF (VALEIG) THEN
+         VLL = VL
+         VUU = VU
+      END IF
+      ANRM = DLANSY( 'M', UPLO, N, A, LDA, WORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            DO 10 J = 1, N
+               CALL DSCAL( N-J+1, SIGMA, A( J, J ), 1 )
+   10       CONTINUE
+         ELSE
+            DO 20 J = 1, N
+               CALL DSCAL( J, SIGMA, A( 1, J ), 1 )
+   20       CONTINUE
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+
+*     Initialize indices into workspaces.  Note: The IWORK indices are
+*     used only if DSTERF or DSTEMR fail.
+
+*     WORK(INDTAU:INDTAU+N-1) stores the scalar factors of the
+*     elementary reflectors used in DSYTRD.
+      INDTAU = 1
+*     WORK(INDD:INDD+N-1) stores the tridiagonal's diagonal entries.
+      INDD = INDTAU + N
+*     WORK(INDE:INDE+N-1) stores the off-diagonal entries of the
+*     tridiagonal matrix from DSYTRD.
+      INDE = INDD + N
+*     WORK(INDDD:INDDD+N-1) is a copy of the diagonal entries over
+*     -written by DSTEMR (the DSTERF path copies the diagonal to W).
+      INDDD = INDE + N
+*     WORK(INDEE:INDEE+N-1) is a copy of the off-diagonal entries over
+*     -written while computing the eigenvalues in DSTERF and DSTEMR.
+      INDEE = INDDD + N
+*     INDHOUS is the starting offset Householder storage of stage 2
+      INDHOUS = INDEE + N
+*     INDWK is the starting offset of the left-over workspace, and
+*     LLWORK is the remaining workspace size.
+      INDWK  = INDHOUS + LHTRD
+      LLWORK = LWORK - INDWK + 1
+
+
+*     IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in DSTEBZ and
+*     stores the block indices of each of the M<=N eigenvalues.
+      INDIBL = 1
+*     IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in DSTEBZ and
+*     stores the starting and finishing indices of each block.
+      INDISP = INDIBL + N
+*     IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
+*     that corresponding to eigenvectors that fail to converge in
+*     DSTEIN.  This information is discarded; if any fail, the driver
+*     returns INFO > 0.
+      INDIFL = INDISP + N
+*     INDIWO is the offset of the remaining integer workspace.
+      INDIWO = INDIFL + N
+
+*
+*     Call DSYTRD_2STAGE to reduce symmetric matrix to tridiagonal form.
+*
+*
+      CALL DSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, WORK( INDD ), 
+     $                    WORK( INDE ), WORK( INDTAU ), WORK( INDHOUS ),
+     $                    LHTRD, WORK( INDWK ), LLWORK, IINFO )
+*
+*     If all eigenvalues are desired
+*     then call DSTERF or DSTEMR and DORMTR.
+*
+      IF( ( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) .AND.
+     $    IEEEOK.EQ.1 ) THEN
+         IF( .NOT.WANTZ ) THEN
+            CALL DCOPY( N, WORK( INDD ), 1, W, 1 )
+            CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL DSTERF( N, W, WORK( INDEE ), INFO )
+         ELSE
+            CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL DCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 1 )
+*
+            IF (ABSTOL .LE. TWO*N*EPS) THEN
+               TRYRAC = .TRUE.
+            ELSE
+               TRYRAC = .FALSE.
+            END IF
+            CALL DSTEMR( JOBZ, 'A', N, WORK( INDDD ), WORK( INDEE ),
+     $                   VL, VU, IL, IU, M, W, Z, LDZ, N, ISUPPZ,
+     $                   TRYRAC, WORK( INDWK ), LWORK, IWORK, LIWORK,
+     $                   INFO )
+*
+*
+*
+*        Apply orthogonal matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by DSTEMR.
+*
+            IF( WANTZ .AND. INFO.EQ.0 ) THEN
+               INDWKN = INDE
+               LLWRKN = LWORK - INDWKN + 1
+               CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA,
+     $                      WORK( INDTAU ), Z, LDZ, WORK( INDWKN ),
+     $                      LLWRKN, IINFO )
+            END IF
+         END IF
+*
+*
+         IF( INFO.EQ.0 ) THEN
+*           Everything worked.  Skip DSTEBZ/DSTEIN.  IWORK(:) are
+*           undefined.
+            M = N
+            GO TO 30
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call DSTEBZ and, if eigenvectors are desired, DSTEIN.
+*     Also call DSTEBZ and DSTEIN if DSTEMR fails.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+
+      CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWK ),
+     $             IWORK( INDIWO ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                WORK( INDWK ), IWORK( INDIWO ), IWORK( INDIFL ),
+     $                INFO )
+*
+*        Apply orthogonal matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by DSTEIN.
+*
+         INDWKN = INDE
+         LLWRKN = LWORK - INDWKN + 1
+         CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
+     $                LDZ, WORK( INDWKN ), LLWRKN, IINFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+*  Jump here if DSTEMR/DSTEIN succeeded.
+   30 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.  Note: We do not sort the IFAIL portion of IWORK.
+*     It may not be initialized (if DSTEMR/DSTEIN succeeded), and we do
+*     not return this detailed information to the user.
+*
+      IF( WANTZ ) THEN
+         DO 50 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 40 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   40       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               W( I ) = W( J )
+               W( J ) = TMP1
+               CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+            END IF
+   50    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+      IWORK( 1 ) = LIWMIN
+*
+      RETURN
+*
+*     End of DSYEVR_2STAGE
+*
+      END
diff --git a/SRC/dsyevx_2stage.f b/SRC/dsyevx_2stage.f
new file mode 100644
index 00000000..2c52e9e3
--- /dev/null
+++ b/SRC/dsyevx_2stage.f
@@ -0,0 +1,608 @@
+*> \brief <b> DSYEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
+*
+*  @precisions fortran d -> s
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYEVX_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyevx_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyevx_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyevx_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+*                                 IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
+*                                 LWORK, IWORK, IFAIL, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, LDA, LDZ, LWORK, M, N
+*       DOUBLE PRECISION   ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IFAIL( * ), IWORK( * )
+*       DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYEVX_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a real symmetric matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  Eigenvalues and eigenvectors can be
+*> selected by specifying either a range of values or a range of indices
+*> for the desired eigenvalues.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found.
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found.
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA, N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, the lower triangle (if UPLO='L') or the upper
+*>          triangle (if UPLO='U') of A, including the diagonal, is
+*>          destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is DOUBLE PRECISION
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is DOUBLE PRECISION
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is DOUBLE PRECISION
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing A to tridiagonal form.
+*>
+*>          Eigenvalues will be computed most accurately when ABSTOL is
+*>          set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+*>          If this routine returns with INFO>0, indicating that some
+*>          eigenvectors did not converge, try setting ABSTOL to
+*>          2*DLAMCH('S').
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          On normal exit, the first M elements contain the selected
+*>          eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is DOUBLE PRECISION array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If an eigenvector fails to converge, then that column of Z
+*>          contains the latest approximation to the eigenvector, and the
+*>          index of the eigenvector is returned in IFAIL.
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, 8*N, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + 3*N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + 3*N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (5*N)
+*> \endverbatim
+*>
+*> \param[out] IFAIL
+*> \verbatim
+*>          IFAIL is INTEGER array, dimension (N)
+*>          If JOBZ = 'V', then if INFO = 0, the first M elements of
+*>          IFAIL are zero.  If INFO > 0, then IFAIL contains the
+*>          indices of the eigenvectors that failed to converge.
+*>          If JOBZ = 'N', then IFAIL is not referenced.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, then i eigenvectors failed to converge.
+*>                Their indices are stored in array IFAIL.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup doubleSYeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+     $                          IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
+     $                          LWORK, IWORK, IFAIL, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, LDA, LDZ, LWORK, M, N
+      DOUBLE PRECISION   ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IFAIL( * ), IWORK( * )
+      DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+* =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
+     $                   WANTZ
+      CHARACTER          ORDER
+      INTEGER            I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
+     $                   INDISP, INDIWO, INDTAU, INDWKN, INDWRK, ISCALE,
+     $                   ITMP1, J, JJ, LLWORK, LLWRKN,
+     $                   NSPLIT, LWMIN, LHTRD, LWTRD, KD, IB, INDHOUS
+      DOUBLE PRECISION   ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, DLANSY
+      EXTERNAL           LSAME, ILAENV, DLAMCH, DLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DCOPY, DLACPY, DORGTR, DORMTR, DSCAL, DSTEBZ,
+     $                   DSTEIN, DSTEQR, DSTERF, DSWAP, XERBLA,
+     $                   DSYTRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      LOWER = LSAME( UPLO, 'L' )
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -8
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -9
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -10
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+            INFO = -15
+         END IF
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            KD    = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+            IB    = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWMIN = MAX( 8*N, 3*N + LHTRD + LWTRD )
+            WORK( 1 )  = LWMIN
+         END IF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -17
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYEVX_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 ) THEN
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         IF( ALLEIG .OR. INDEIG ) THEN
+            M = 1
+            W( 1 ) = A( 1, 1 )
+         ELSE
+            IF( VL.LT.A( 1, 1 ) .AND. VU.GE.A( 1, 1 ) ) THEN
+               M = 1
+               W( 1 ) = A( 1, 1 )
+            END IF
+         END IF
+         IF( WANTZ )
+     $      Z( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF( VALEIG ) THEN
+         VLL = VL
+         VUU = VU
+      END IF
+      ANRM = DLANSY( 'M', UPLO, N, A, LDA, WORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            DO 10 J = 1, N
+               CALL DSCAL( N-J+1, SIGMA, A( J, J ), 1 )
+   10       CONTINUE
+         ELSE
+            DO 20 J = 1, N
+               CALL DSCAL( J, SIGMA, A( 1, J ), 1 )
+   20       CONTINUE
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+*
+*     Call DSYTRD_2STAGE to reduce symmetric matrix to tridiagonal form.
+*
+      INDTAU  = 1
+      INDE    = INDTAU + N
+      INDD    = INDE + N
+      INDHOUS = INDD + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL DSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, WORK( INDD ), 
+     $                    WORK( INDE ), WORK( INDTAU ), WORK( INDHOUS ),
+     $                    LHTRD, WORK( INDWRK ), LLWORK, IINFO )
+*
+*     If all eigenvalues are desired and ABSTOL is less than or equal to
+*     zero, then call DSTERF or DORGTR and SSTEQR.  If this fails for
+*     some eigenvalue, then try DSTEBZ.
+*
+      TEST = .FALSE.
+      IF( INDEIG ) THEN
+         IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF( ( ALLEIG .OR. TEST ) .AND. ( ABSTOL.LE.ZERO ) ) THEN
+         CALL DCOPY( N, WORK( INDD ), 1, W, 1 )
+         INDEE = INDWRK + 2*N
+         IF( .NOT.WANTZ ) THEN
+            CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL DSTERF( N, W, WORK( INDEE ), INFO )
+         ELSE
+            CALL DLACPY( 'A', N, N, A, LDA, Z, LDZ )
+            CALL DORGTR( UPLO, N, Z, LDZ, WORK( INDTAU ),
+     $                   WORK( INDWRK ), LLWORK, IINFO )
+            CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL DSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
+     $                   WORK( INDWRK ), INFO )
+            IF( INFO.EQ.0 ) THEN
+               DO 30 I = 1, N
+                  IFAIL( I ) = 0
+   30          CONTINUE
+            END IF
+         END IF
+         IF( INFO.EQ.0 ) THEN
+            M = N
+            GO TO 40
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call DSTEBZ and, if eigenvectors are desired, SSTEIN.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+      INDIBL = 1
+      INDISP = INDIBL + N
+      INDIWO = INDISP + N
+      CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
+     $             IWORK( INDIWO ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
+*
+*        Apply orthogonal matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by DSTEIN.
+*
+         INDWKN = INDE
+         LLWRKN = LWORK - INDWKN + 1
+         CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
+     $                LDZ, WORK( INDWKN ), LLWRKN, IINFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+   40 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.
+*
+      IF( WANTZ ) THEN
+         DO 60 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 50 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   50       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               ITMP1 = IWORK( INDIBL+I-1 )
+               W( I ) = W( J )
+               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
+               W( J ) = TMP1
+               IWORK( INDIBL+J-1 ) = ITMP1
+               CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+               IF( INFO.NE.0 ) THEN
+                  ITMP1 = IFAIL( I )
+                  IFAIL( I ) = IFAIL( J )
+                  IFAIL( J ) = ITMP1
+               END IF
+            END IF
+   60    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of DSYEVX_2STAGE
+*
+      END
diff --git a/SRC/dsygv_2stage.f b/SRC/dsygv_2stage.f
new file mode 100644
index 00000000..2c79ec8a
--- /dev/null
+++ b/SRC/dsygv_2stage.f
@@ -0,0 +1,370 @@
+*> \brief \b DSYGV_2STAGE
+*
+*  @precisions fortran d -> s
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYGV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsygv_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsygv_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsygv_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W,
+*                                WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, ITYPE, LDA, LDB, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYGV_2STAGE computes all the eigenvalues, and optionally, the eigenvectors
+*> of a real generalized symmetric-definite eigenproblem, of the form
+*> A*x=(lambda)*B*x,  A*Bx=(lambda)*x,  or B*A*x=(lambda)*x.
+*> Here A and B are assumed to be symmetric and B is also
+*> positive definite.
+*> This routine use the 2stage technique for the reduction to tridiagonal
+*> which showed higher performance on recent architecture and for large
+*  sizes N>2000.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] ITYPE
+*> \verbatim
+*>          ITYPE is INTEGER
+*>          Specifies the problem type to be solved:
+*>          = 1:  A*x = (lambda)*B*x
+*>          = 2:  A*B*x = (lambda)*x
+*>          = 3:  B*A*x = (lambda)*x
+*> \endverbatim
+*>
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangles of A and B are stored;
+*>          = 'L':  Lower triangles of A and B are stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrices A and B.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA, N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          matrix Z of eigenvectors.  The eigenvectors are normalized
+*>          as follows:
+*>          if ITYPE = 1 or 2, Z**T*B*Z = I;
+*>          if ITYPE = 3, Z**T*inv(B)*Z = I.
+*>          If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+*>          or the lower triangle (if UPLO='L') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array, dimension (LDB, N)
+*>          On entry, the symmetric positive definite matrix B.
+*>          If UPLO = 'U', the leading N-by-N upper triangular part of B
+*>          contains the upper triangular part of the matrix B.
+*>          If UPLO = 'L', the leading N-by-N lower triangular part of B
+*>          contains the lower triangular part of the matrix B.
+*>
+*>          On exit, if INFO <= N, the part of B containing the matrix is
+*>          overwritten by the triangular factor U or L from the Cholesky
+*>          factorization B = U**T*U or B = L*L**T.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + 2*N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + 2*N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  DPOTRF or DSYEV returned an error code:
+*>             <= N:  if INFO = i, DSYEV failed to converge;
+*>                    i off-diagonal elements of an intermediate
+*>                    tridiagonal form did not converge to zero;
+*>             > N:   if INFO = N + i, for 1 <= i <= N, then the leading
+*>                    minor of order i of B is not positive definite.
+*>                    The factorization of B could not be completed and
+*>                    no eigenvalues or eigenvectors were computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W,
+     $                         WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, ITYPE, LDA, LDB, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE
+      PARAMETER          ( ONE = 1.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER, WANTZ
+      CHARACTER          TRANS
+      INTEGER            NEIG, LWMIN, LHTRD, LWTRD, KD, IB 
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DPOTRF, DSYGST, DTRMM, DTRSM, XERBLA,
+     $                   DSYEV_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         KD    = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+         IB    = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWMIN = 2*N + LHTRD + LWTRD
+         WORK( 1 )  = LWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -11
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYGV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Form a Cholesky factorization of B.
+*
+      CALL DPOTRF( UPLO, N, B, LDB, INFO )
+      IF( INFO.NE.0 ) THEN
+         INFO = N + INFO
+         RETURN
+      END IF
+*
+*     Transform problem to standard eigenvalue problem and solve.
+*
+      CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
+      CALL DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
+*
+      IF( WANTZ ) THEN
+*
+*        Backtransform eigenvectors to the original problem.
+*
+         NEIG = N
+         IF( INFO.GT.0 )
+     $      NEIG = INFO - 1
+         IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
+*
+*           For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
+*           backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
+*
+            IF( UPPER ) THEN
+               TRANS = 'N'
+            ELSE
+               TRANS = 'T'
+            END IF
+*
+            CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
+     $                  B, LDB, A, LDA )
+*
+         ELSE IF( ITYPE.EQ.3 ) THEN
+*
+*           For B*A*x=(lambda)*x;
+*           backtransform eigenvectors: x = L*y or U**T*y
+*
+            IF( UPPER ) THEN
+               TRANS = 'T'
+            ELSE
+               TRANS = 'N'
+            END IF
+*
+            CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
+     $                  B, LDB, A, LDA )
+         END IF
+      END IF
+*
+      WORK( 1 ) = LWMIN
+      RETURN
+*
+*     End of DSYGV_2STAGE
+*
+      END
diff --git a/SRC/dsysv_aa.f b/SRC/dsysv_aa.f
index 9f9969fb..055097fb 100644
--- a/SRC/dsysv_aa.f
+++ b/SRC/dsysv_aa.f
@@ -19,7 +19,7 @@
 *  ===========
 *
 *       SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-*                               LWORK, INFO )
+*                            LWORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
@@ -126,8 +126,8 @@
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
-*>          The length of WORK.  LWORK >= MAX(2*N, 3*N-2), and for
-*>          the best performance, LWORK >= max(1,N*NB), where NB is
+*>          The length of WORK.  LWORK >= MAX(1,2*N,3*N-2), and for
+*>          the best performance, LWORK >= MAX(1,N*NB), where NB is
 *>          the optimal blocksize for DSYTRF_AA.
 *>
 *>          If LWORK = -1, then a workspace query is assumed; the routine
@@ -156,11 +156,13 @@
 *
 *> \date November 2016
 *
+*  @precisions fortran d -> z c
+*
 *> \ingroup doubleSYsolve
 *
 *  =====================================================================
       SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-     $                        LWORK, INFO )
+     $                     LWORK, INFO )
 *
 *  -- LAPACK driver routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
diff --git a/SRC/dsysv_rk.f b/SRC/dsysv_rk.f
new file mode 100644
index 00000000..cbedf052
--- /dev/null
+++ b/SRC/dsysv_rk.f
@@ -0,0 +1,317 @@
+*> \brief <b> DSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYSV_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsysv_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsysv_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsysv_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            WORK, LWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> DSYSV_RK computes the solution to a real system of linear
+*> equations A * X = B, where A is an N-by-N symmetric matrix
+*> and X and B are N-by-NRHS matrices.
+*>
+*> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used
+*> to factor A as
+*>    A = P*U*D*(U**T)*(P**T),  if UPLO = 'U', or
+*>    A = P*L*D*(L**T)*(P**T),  if UPLO = 'L',
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> DSYTRF_RK is called to compute the factorization of a real
+*> symmetric matrix.  The factored form of A is then used to solve
+*> the system of equations A * X = B by calling BLAS3 routine DSYTRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of linear equations, i.e., the order of the
+*>          matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, if INFO = 0, diagonal of the block diagonal
+*>          matrix D and factors U or L  as computed by DSYTRF_RK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          For more info see the description of DSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>          On exit, contains the output computed by the factorization
+*>          routine DSYTRF_RK, i.e. the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*>
+*>          For more info see the description of DSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D,
+*>          as determined by DSYTRF_RK.
+*>
+*>          For more info see the description of DSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array, dimension (LDB,NRHS)
+*>          On entry, the N-by-NRHS right hand side matrix B.
+*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension ( MAX(1,LWORK) ).
+*>          Work array used in the factorization stage.
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >= 1. For best performance
+*>          of factorization stage LWORK >= max(1,N*NB), where NB is
+*>          the optimal blocksize for DSYTRF_RK.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array for factorization stage, returns this value as
+*>          the first entry of the WORK array, and no error message
+*>          related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYsolve
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+     $                     WORK, LWORK, INFO )
+*
+*  -- LAPACK driver routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            LWKOPT
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, DSYTRF_RK, DSYTRS_3
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -11
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.EQ.0 ) THEN
+            LWKOPT = 1
+         ELSE
+            CALL DSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
+            LWKOPT = WORK(1)
+         END IF
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYSV_RK ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Compute the factorization A = P*U*D*(U**T)*(P**T) or
+*     A = P*U*D*(U**T)*(P**T).
+*
+      CALL DSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO )
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Solve the system A*X = B with BLAS3 solver, overwriting B with X.
+*
+         CALL DSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO )
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of DSYSV_RK
+*
+      END
diff --git a/SRC/dsytf2_rk.f b/SRC/dsytf2_rk.f
new file mode 100644
index 00000000..78c61fce
--- /dev/null
+++ b/SRC/dsytf2_rk.f
@@ -0,0 +1,943 @@
+*> \brief \b DSYTF2_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYTF2_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytf2_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytf2_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytf2_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ), E ( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> DSYTF2_RK computes the factorization of a real symmetric matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put further details
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*>  01-01-96 - Based on modifications by
+*>    J. Lewis, Boeing Computer Services Company
+*>    A. Petitet, Computer Science Dept.,
+*>                Univ. of Tenn., Knoxville abd , USA
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      DOUBLE PRECISION   EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER, DONE
+      INTEGER            I, IMAX, J, JMAX, ITEMP, K, KK, KP, KSTEP,
+     $                   P, II
+      DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22,
+     $                   ROWMAX, DTEMP, T, WK, WKM1, WKP1, SFMIN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            IDAMAX
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           LSAME, IDAMAX, DLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DSCAL, DSWAP, DSYR, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYTF2_RK', -INFO )
+         RETURN
+      END IF
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = DLAMCH( 'S' )
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**T using the upper triangle of A
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = ZERO
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 34
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( A( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = IDAMAX( K-1, A( 1, K ), 1 )
+            COLMAX = ABS( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = ZERO
+*
+         ELSE
+*
+*           Test for interchange
+*
+*           Equivalent to testing for (used to handle NaN and Inf)
+*           ABSAKK.GE.ALPHA*COLMAX
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange,
+*              use 1-by-1 pivot block
+*
+               KP = K
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   12          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + IDAMAX( K-IMAX, A( IMAX, IMAX+1 ),
+     $                                    LDA )
+                     ROWMAX = ABS( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = IDAMAX( IMAX-1, A( 1, IMAX ), 1 )
+                     DTEMP = ABS( A( ITEMP, IMAX ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for (used to handle NaN and Inf)
+*                 ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX
+*
+                  IF( .NOT.( ABS( A( IMAX, IMAX ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX .EQ. COLMAX,
+*                 used to handle NaN and Inf
+*
+                  ELSE IF( ( P.EQ.JMAX ).OR.( ROWMAX.LE.COLMAX ) ) THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot NOT found, set variables and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 12
+*
+            END IF
+*
+*           Swap TWO rows and TWO columns
+*
+*           First swap
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Interchange rows and column K and P in the leading
+*              submatrix A(1:k,1:k) if we have a 2-by-2 pivot
+*
+               IF( P.GT.1 )
+     $            CALL DSWAP( P-1, A( 1, K ), 1, A( 1, P ), 1 )
+               IF( P.LT.(K-1) )
+     $            CALL DSWAP( K-P-1, A( P+1, K ), 1, A( P, P+1 ),
+     $                     LDA )
+               T = A( K, K )
+               A( K, K ) = A( P, P )
+               A( P, P ) = T
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL DSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA )
+*
+            END IF
+*
+*           Second swap
+*
+            KK = K - KSTEP + 1
+            IF( KP.NE.KK ) THEN
+*
+*              Interchange rows and columns KK and KP in the leading
+*              submatrix A(1:k,1:k)
+*
+               IF( KP.GT.1 )
+     $            CALL DSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 )
+               IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) )
+     $            CALL DSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ),
+     $                     LDA )
+               T = A( KK, KK )
+               A( KK, KK ) = A( KP, KP )
+               A( KP, KP ) = T
+               IF( KSTEP.EQ.2 ) THEN
+                  T = A( K-1, K )
+                  A( K-1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL DSWAP( N-K, A( KK, K+1 ), LDA, A( KP, K+1 ),
+     $                        LDA )
+*
+            END IF
+*
+*           Update the leading submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k now holds
+*
+*              W(k) = U(k)*D(k)
+*
+*              where U(k) is the k-th column of U
+*
+               IF( K.GT.1 ) THEN
+*
+*                 Perform a rank-1 update of A(1:k-1,1:k-1) and
+*                 store U(k) in column k
+*
+                  IF( ABS( A( K, K ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(1:k-1,1:k-1) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*1/D(k)*W(k)**T
+*
+                     D11 = ONE / A( K, K )
+                     CALL DSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+*
+*                    Store U(k) in column k
+*
+                     CALL DSCAL( K-1, D11, A( 1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column K
+*
+                     D11 = A( K, K )
+                     DO 16 II = 1, K - 1
+                        A( II, K ) = A( II, K ) / D11
+   16                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL DSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+                  END IF
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = ZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k-1 now hold
+*
+*              ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+*              Perform a rank-2 update of A(1:k-2,1:k-2) as
+*
+*              A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )**T
+*                 = A - ( ( A(k-1)A(k) )*inv(D(k)) ) * ( A(k-1)A(k) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.GT.2 ) THEN
+*
+                  D12 = A( K-1, K )
+                  D22 = A( K-1, K-1 ) / D12
+                  D11 = A( K, K ) / D12
+                  T = ONE / ( D11*D22-ONE )
+*
+                  DO 30 J = K - 2, 1, -1
+*
+                     WKM1 = T*( D11*A( J, K-1 )-A( J, K ) )
+                     WK = T*( D22*A( J, K )-A( J, K-1 ) )
+*
+                     DO 20 I = J, 1, -1
+                        A( I, J ) = A( I, J ) - (A( I, K ) / D12 )*WK -
+     $                              ( A( I, K-1 ) / D12 )*WKM1
+   20                CONTINUE
+*
+*                    Store U(k) and U(k-1) in cols k and k-1 for row J
+*
+                     A( J, K ) = WK / D12
+                     A( J, K-1 ) = WKM1 / D12
+*
+   30             CONTINUE
+*
+               END IF
+*
+*              Copy superdiagonal elements of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               E( K ) = A( K-1, K )
+               E( K-1 ) = ZERO
+               A( K-1, K ) = ZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   34    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**T using the lower triangle of A
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = ZERO
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        1 or 2
+*
+         K = 1
+   40    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 64
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( A( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + IDAMAX( N-K, A( K+1, K ), 1 )
+            COLMAX = ABS( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( ( MAX( ABSAKK, COLMAX ).EQ.ZERO ) ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = ZERO
+*
+         ELSE
+*
+*           Test for interchange
+*
+*           Equivalent to testing for (used to handle NaN and Inf)
+*           ABSAKK.GE.ALPHA*COLMAX
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   42          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + IDAMAX( IMAX-K, A( IMAX, K ), LDA )
+                     ROWMAX = ABS( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + IDAMAX( N-IMAX, A( IMAX+1, IMAX ),
+     $                                     1 )
+                     DTEMP = ABS( A( ITEMP, IMAX ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for (used to handle NaN and Inf)
+*                 ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX
+*
+                  IF( .NOT.( ABS( A( IMAX, IMAX ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX .EQ. COLMAX,
+*                 used to handle NaN and Inf
+*
+                  ELSE IF( ( P.EQ.JMAX ).OR.( ROWMAX.LE.COLMAX ) ) THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot NOT found, set variables and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 42
+*
+            END IF
+*
+*           Swap TWO rows and TWO columns
+*
+*           First swap
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Interchange rows and column K and P in the trailing
+*              submatrix A(k:n,k:n) if we have a 2-by-2 pivot
+*
+               IF( P.LT.N )
+     $            CALL DSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 )
+               IF( P.GT.(K+1) )
+     $            CALL DSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA )
+               T = A( K, K )
+               A( K, K ) = A( P, P )
+               A( P, P ) = T
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL DSWAP( K-1, A( K, 1 ), LDA, A( P, 1 ), LDA )
+*
+            END IF
+*
+*           Second swap
+*
+            KK = K + KSTEP - 1
+            IF( KP.NE.KK ) THEN
+*
+*              Interchange rows and columns KK and KP in the trailing
+*              submatrix A(k:n,k:n)
+*
+               IF( KP.LT.N )
+     $            CALL DSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+               IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) )
+     $            CALL DSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
+     $                     LDA )
+               T = A( KK, KK )
+               A( KK, KK ) = A( KP, KP )
+               A( KP, KP ) = T
+               IF( KSTEP.EQ.2 ) THEN
+                  T = A( K+1, K )
+                  A( K+1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL DSWAP( K-1, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+*
+            END IF
+*
+*           Update the trailing submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k now holds
+*
+*              W(k) = L(k)*D(k)
+*
+*              where L(k) is the k-th column of L
+*
+               IF( K.LT.N ) THEN
+*
+*              Perform a rank-1 update of A(k+1:n,k+1:n) and
+*              store L(k) in column k
+*
+                  IF( ABS( A( K, K ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*
+                     D11 = ONE / A( K, K )
+                     CALL DSYR( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+*
+*                    Store L(k) in column k
+*
+                     CALL DSCAL( N-K, D11, A( K+1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column k
+*
+                     D11 = A( K, K )
+                     DO 46 II = K + 1, N
+                        A( II, K ) = A( II, K ) / D11
+   46                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL DSYR( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+                  END IF
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = ZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+*
+*              Perform a rank-2 update of A(k+2:n,k+2:n) as
+*
+*              A := A - ( L(k) L(k+1) ) * D(k) * ( L(k) L(k+1) )**T
+*                 = A - ( ( A(k)A(k+1) )*inv(D(k) ) * ( A(k)A(k+1) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.LT.N-1 ) THEN
+*
+                  D21 = A( K+1, K )
+                  D11 = A( K+1, K+1 ) / D21
+                  D22 = A( K, K ) / D21
+                  T = ONE / ( D11*D22-ONE )
+*
+                  DO 60 J = K + 2, N
+*
+*                    Compute  D21 * ( W(k)W(k+1) ) * inv(D(k)) for row J
+*
+                     WK = T*( D11*A( J, K )-A( J, K+1 ) )
+                     WKP1 = T*( D22*A( J, K+1 )-A( J, K ) )
+*
+*                    Perform a rank-2 update of A(k+2:n,k+2:n)
+*
+                     DO 50 I = J, N
+                        A( I, J ) = A( I, J ) - ( A( I, K ) / D21 )*WK -
+     $                              ( A( I, K+1 ) / D21 )*WKP1
+   50                CONTINUE
+*
+*                    Store L(k) and L(k+1) in cols k and k+1 for row J
+*
+                     A( J, K ) = WK / D21
+                     A( J, K+1 ) = WKP1 / D21
+*
+   60             CONTINUE
+*
+               END IF
+*
+*              Copy subdiagonal elements of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               E( K ) = A( K+1, K )
+               E( K+1 ) = ZERO
+               A( K+1, K ) = ZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 40
+*
+   64    CONTINUE
+*
+      END IF
+*
+      RETURN
+*
+*     End of DSYTF2_RK
+*
+      END
diff --git a/SRC/dsytrd_2stage.f b/SRC/dsytrd_2stage.f
new file mode 100644
index 00000000..449a279e
--- /dev/null
+++ b/SRC/dsytrd_2stage.f
@@ -0,0 +1,337 @@
+*> \brief \b DSYTRD_2STAGE
+*
+*  @generated from zhetrd_2stage.f, fortran z -> d, Sun Nov  6 19:34:06 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DSYTRD_2STAGE + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrd_2stage.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrd_2stage.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrd_2stage.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, 
+*                                 HOUS2, LHOUS2, WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*      .. Scalar Arguments ..
+*       CHARACTER          VECT, UPLO
+*       INTEGER            N, LDA, LWORK, LHOUS2, INFO
+*      ..
+*      .. Array Arguments ..
+*       DOUBLE PRECISION   D( * ), E( * )
+*       DOUBLE PRECISION   A( LDA, * ), TAU( * ),
+*                          HOUS2( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYTRD_2STAGE reduces a real symmetric matrix A to real symmetric
+*> tridiagonal form T by a orthogonal similarity transformation:
+*> Q1**T Q2**T* A * Q2 * Q1 = T.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] VECT
+*> \verbatim
+*>          VECT is CHARACTER*1
+*>          = 'N':  No need for the Housholder representation, 
+*>                  in particular for the second stage (Band to
+*>                  tridiagonal) and thus LHOUS2 is of size max(1, 4*N);
+*>          = 'V':  the Householder representation is needed to 
+*>                  either generate Q1 Q2 or to apply Q1 Q2, 
+*>                  then LHOUS2 is to be queried and computed.
+*>                  (NOT AVAILABLE IN THIS RELEASE).
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>          On exit, if UPLO = 'U', the band superdiagonal
+*>          of A are overwritten by the corresponding elements of the
+*>          internal band-diagonal matrix AB, and the elements above 
+*>          the KD superdiagonal, with the array TAU, represent the orthogonal
+*>          matrix Q1 as a product of elementary reflectors; if UPLO
+*>          = 'L', the diagonal and band subdiagonal of A are over-
+*>          written by the corresponding elements of the internal band-diagonal
+*>          matrix AB, and the elements below the KD subdiagonal, with
+*>          the array TAU, represent the orthogonal matrix Q1 as a product
+*>          of elementary reflectors. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] D
+*> \verbatim
+*>          D is DOUBLE PRECISION array, dimension (N)
+*>          The diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N-1)
+*>          The off-diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is DOUBLE PRECISION array, dimension (N-KD)
+*>          The scalar factors of the elementary reflectors of 
+*>          the first stage (see Further Details).
+*> \endverbatim
+*>
+*> \param[out] HOUS2
+*> \verbatim
+*>          HOUS2 is DOUBLE PRECISION array, dimension LHOUS2, that
+*>          store the Householder representation of the stage2
+*>          band to tridiagonal.
+*> \endverbatim
+*>
+*> \param[in] LHOUS2
+*> \verbatim
+*>          LHOUS2 is INTEGER
+*>          The dimension of the array HOUS2. LHOUS2 = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS2=-1,
+*>          then a query is assumed; the routine
+*>          only calculates the optimal size of the HOUS2 array, returns
+*>          this value as the first entry of the HOUS2 array, and no error
+*>          message related to LHOUS2 is issued by XERBLA.
+*>          LHOUS2 = MAX(1, dimension) where
+*>          dimension = 4*N if VECT='N'
+*>          not available now if VECT='H'
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK. LWORK = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS2=-1,
+*>          then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK = MAX(1, dimension) where
+*>          dimension   = max(stage1,stage2) + (KD+1)*N
+*>                      = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                        + max(2*KD*KD, KD*NTHREADS) 
+*>                        + (KD+1)*N 
+*>          where KD is the blocking size of the reduction,
+*>          FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice
+*>          NTHREADS is the number of threads used when
+*>          openMP compilation is enabled, otherwise =1.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, 
+     $                          HOUS2, LHOUS2, WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          VECT, UPLO
+      INTEGER            N, LDA, LWORK, LHOUS2, INFO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   D( * ), E( * )
+      DOUBLE PRECISION   A( LDA, * ), TAU( * ),
+     $                   HOUS2( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER, WANTQ
+      INTEGER            KD, IB, LWMIN, LHMIN, LWRK, LDAB, WPOS, ABPOS
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, DSYTRD_SY2SB, DSYTRD_SB2ST
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters
+*
+      INFO   = 0
+      WANTQ  = LSAME( VECT, 'V' )
+      UPPER  = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 ) .OR. ( LHOUS2.EQ.-1 )
+*
+*     Determine the block size, the workspace size and the hous size.
+*
+      KD     = ILAENV( 17, 'DSYTRD_2STAGE', VECT, N, -1, -1, -1 )
+      IB     = ILAENV( 18, 'DSYTRD_2STAGE', VECT, N, KD, -1, -1 )
+      LHMIN  = ILAENV( 19, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
+      LWMIN  = ILAENV( 20, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
+*      WRITE(*,*),'DSYTRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
+*     $            LHMIN, LWMIN
+*
+      IF( .NOT.LSAME( VECT, 'N' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LHOUS2.LT.LHMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -10
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -12
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         HOUS2( 1 ) = LHMIN
+         WORK( 1 )  = LWMIN
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYTRD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+*     Determine pointer position
+*
+      LDAB  = KD+1
+      LWRK  = LWORK-LDAB*N
+      ABPOS = 1
+      WPOS  = ABPOS + LDAB*N
+      CALL DSYTRD_SY2SB( UPLO, N, KD, A, LDA, WORK( ABPOS ), LDAB, 
+     $                   TAU, WORK( WPOS ), LWRK, INFO )
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYTRD_SY2SB', -INFO )
+         RETURN
+      END IF
+      CALL DSYTRD_SB2ST( 'Y', VECT, UPLO, N, KD, 
+     $                   WORK( ABPOS ), LDAB, D, E, 
+     $                   HOUS2, LHOUS2, WORK( WPOS ), LWRK, INFO )
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYTRD_SB2ST', -INFO )
+         RETURN
+      END IF
+*
+*
+      HOUS2( 1 ) = LHMIN
+      WORK( 1 )  = LWMIN
+      RETURN
+*
+*     End of DSYTRD_2STAGE
+*
+      END
diff --git a/SRC/dsytrd_sb2st.F b/SRC/dsytrd_sb2st.F
new file mode 100644
index 00000000..6925b525
--- /dev/null
+++ b/SRC/dsytrd_sb2st.F
@@ -0,0 +1,549 @@
+*> \brief \b DSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric tridiagonal form T
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYTRD_SB2ST + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrd_sb2st.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrd_sb2st.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrd_sb2st.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 
+*                               D, E, HOUS, LHOUS, WORK, LWORK, INFO )
+*
+*       #if defined(_OPENMP)
+*       use omp_lib
+*       #endif
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          STAGE1, UPLO, VECT
+*       INTEGER            N, KD, IB, LDAB, LHOUS, LWORK, INFO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   D( * ), E( * )
+*       DOUBLE PRECISION   AB( LDAB, * ), HOUS( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric
+*> tridiagonal form T by a orthogonal similarity transformation:
+*> Q**T * A * Q = T.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] STAGE
+*> \verbatim
+*>          STAGE is CHARACTER*1
+*>          = 'N':  "No": to mention that the stage 1 of the reduction  
+*>                  from dense to band using the dsytrd_sy2sb routine
+*>                  was not called before this routine to reproduce AB. 
+*>                  In other term this routine is called as standalone. 
+*>          = 'Y':  "Yes": to mention that the stage 1 of the 
+*>                  reduction from dense to band using the dsytrd_sy2sb 
+*>                  routine has been called to produce AB (e.g., AB is
+*>                  the output of dsytrd_sy2sb.
+*> \endverbatim
+*>
+*> \param[in] VECT
+*> \verbatim
+*>          VECT is CHARACTER*1
+*>          = 'N':  No need for the Housholder representation, 
+*>                  and thus LHOUS is of size max(1, 4*N);
+*>          = 'V':  the Householder representation is needed to 
+*>                  either generate or to apply Q later on, 
+*>                  then LHOUS is to be queried and computed.
+*>                  (NOT AVAILABLE IN THIS RELEASE).
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is DOUBLE PRECISION array, dimension (LDAB,N)
+*>          On entry, the upper or lower triangle of the symmetric band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>          On exit, the diagonal elements of AB are overwritten by the
+*>          diagonal elements of the tridiagonal matrix T; if KD > 0, the
+*>          elements on the first superdiagonal (if UPLO = 'U') or the
+*>          first subdiagonal (if UPLO = 'L') are overwritten by the
+*>          off-diagonal elements of T; the rest of AB is overwritten by
+*>          values generated during the reduction.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD+1.
+*> \endverbatim
+*>
+*> \param[out] D
+*> \verbatim
+*>          D is DOUBLE PRECISION array, dimension (N)
+*>          The diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N-1)
+*>          The off-diagonal elements of the tridiagonal matrix T:
+*>          E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
+*> \endverbatim
+*>
+*> \param[out] HOUS
+*> \verbatim
+*>          HOUS is DOUBLE PRECISION array, dimension LHOUS, that
+*>          store the Householder representation.
+*> \endverbatim
+*>
+*> \param[in] LHOUS
+*> \verbatim
+*>          LHOUS is INTEGER
+*>          The dimension of the array HOUS. LHOUS = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS=-1,
+*>          then a query is assumed; the routine
+*>          only calculates the optimal size of the HOUS array, returns
+*>          this value as the first entry of the HOUS array, and no error
+*>          message related to LHOUS is issued by XERBLA.
+*>          LHOUS = MAX(1, dimension) where
+*>          dimension = 4*N if VECT='N'
+*>          not available now if VECT='H'     
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK. LWORK = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS=-1,
+*>          then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK = MAX(1, dimension) where
+*>          dimension   = (2KD+1)*N + KD*NTHREADS
+*>          where KD is the blocking size of the reduction,
+*>          FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice
+*>          NTHREADS is the number of threads used when
+*>          openMP compilation is enabled, otherwise =1.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup real16OTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 
+     $                         D, E, HOUS, LHOUS, WORK, LWORK, INFO )
+*
+#if defined(_OPENMP)
+      use omp_lib
+#endif
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          STAGE1, UPLO, VECT
+      INTEGER            N, KD, LDAB, LHOUS, LWORK, INFO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   D( * ), E( * )
+      DOUBLE PRECISION   AB( LDAB, * ), HOUS( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   RZERO
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( RZERO = 0.0D+0,
+     $                   ZERO = 0.0D+0,
+     $                   ONE  = 1.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, WANTQ, UPPER, AFTERS1
+      INTEGER            I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST, 
+     $                   ED, STIND, EDIND, BLKLASTIND, COLPT, THED,
+     $                   STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID,
+     $                   NBTILES, TTYPE, TID, NTHREADS, DEBUG,
+     $                   ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS, 
+     $                   INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
+     $                   SIDEV, SIZETAU, LDV, LHMIN, LWMIN
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DSB2ST_KERNELS, DLACPY, DLASET
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN, MAX, CEILING, REAL
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV 
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Determine the minimal workspace size required.
+*     Test the input parameters
+*
+      DEBUG   = 0
+      INFO    = 0
+      AFTERS1 = LSAME( STAGE1, 'Y' )
+      WANTQ   = LSAME( VECT, 'V' )
+      UPPER   = LSAME( UPLO, 'U' )
+      LQUERY  = ( LWORK.EQ.-1 ) .OR. ( LHOUS.EQ.-1 )
+*
+*     Determine the block size, the workspace size and the hous size.
+*
+      IB     = ILAENV( 18, 'DSYTRD_SB2ST', VECT, N, KD, -1, -1 )
+      LHMIN  = ILAENV( 19, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 )
+      LWMIN  = ILAENV( 20, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 )
+*
+      IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.LSAME( VECT, 'N' ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.(KD+1) ) THEN
+         INFO = -7
+      ELSE IF( LHOUS.LT.LHMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -11
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -13
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         HOUS( 1 ) = LHMIN
+         WORK( 1 ) = LWMIN
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYTRD_SB2ST', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+*     Determine pointer position
+*
+      LDV      = KD + IB
+      SIZETAU  = 2 * N
+      SIDEV    = 2 * N
+      INDTAU   = 1
+      INDV     = INDTAU + SIZETAU
+      LDA      = 2 * KD + 1
+      SIZEA    = LDA * N
+      INDA     = 1
+      INDW     = INDA + SIZEA
+      NTHREADS = 1
+      TID      = 0
+*
+      IF( UPPER ) THEN
+          APOS     = INDA + KD
+          AWPOS    = INDA
+          DPOS     = APOS + KD
+          OFDPOS   = DPOS - 1
+          ABDPOS   = KD + 1
+          ABOFDPOS = KD
+      ELSE
+          APOS     = INDA 
+          AWPOS    = INDA + KD + 1
+          DPOS     = APOS
+          OFDPOS   = DPOS + 1
+          ABDPOS   = 1
+          ABOFDPOS = 2
+
+      ENDIF
+*      
+*     Case KD=0: 
+*     The matrix is diagonal. We just copy it (convert to "real" for 
+*     real because D is double and the imaginary part should be 0) 
+*     and store it in D. A sequential code here is better or 
+*     in a parallel environment it might need two cores for D and E
+*
+      IF( KD.EQ.0 ) THEN
+          DO 30 I = 1, N
+              D( I ) = ( AB( ABDPOS, I ) )
+   30     CONTINUE
+          DO 40 I = 1, N-1
+              E( I ) = RZERO
+   40     CONTINUE
+         RETURN
+      END IF
+*      
+*     Case KD=1: 
+*     The matrix is already Tridiagonal. We have to make diagonal 
+*     and offdiagonal elements real, and store them in D and E.
+*     For that, for real precision just copy the diag and offdiag 
+*     to D and E while for the COMPLEX case the bulge chasing is  
+*     performed to convert the hermetian tridiagonal to symmetric 
+*     tridiagonal. A simpler coversion formula might be used, but then 
+*     updating the Q matrix will be required and based if Q is generated
+*     or not this might complicate the story. 
+*      
+      IF( KD.EQ.1 ) THEN
+          DO 50 I = 1, N
+              D( I ) = ( AB( ABDPOS, I ) )
+   50     CONTINUE
+*
+          IF( UPPER ) THEN
+              DO 60 I = 1, N-1
+                 E( I ) = ( AB( ABOFDPOS, I+1 ) )
+   60         CONTINUE
+          ELSE
+              DO 70 I = 1, N-1
+                 E( I ) = ( AB( ABOFDPOS, I ) )
+   70         CONTINUE
+          ENDIF
+          RETURN
+      END IF
+*
+*     Main code start here. 
+*     Reduce the symmetric band of A to a tridiagonal matrix.
+*
+      THGRSIZ   = N
+      GRSIZ     = 1
+      SHIFT     = 3
+      NBTILES   = CEILING( REAL(N)/REAL(KD) )
+      STEPERCOL = CEILING( REAL(SHIFT)/REAL(GRSIZ) )
+      THGRNB    = CEILING( REAL(N-1)/REAL(THGRSIZ) )
+*      
+      CALL DLACPY( "A", KD+1, N, AB, LDAB, WORK( APOS ), LDA )
+      CALL DLASET( "A", KD,   N, ZERO, ZERO, WORK( AWPOS ), LDA )
+*
+*
+*     openMP parallelisation start here
+*
+#if defined(_OPENMP)
+!$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND )
+!$OMP$         PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID ) 
+!$OMP$         PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND )
+!$OMP$         SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK)
+!$OMP$         SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA )
+!$OMP$         SHARED ( STEPERCOL, THGRNB, THGRSIZ, GRSIZ, SHIFT )
+!$OMP MASTER
+#endif
+*
+*     main bulge chasing loop
+*      
+      DO 100 THGRID = 1, THGRNB
+          STT  = (THGRID-1)*THGRSIZ+1
+          THED = MIN( (STT + THGRSIZ -1), (N-1))
+          DO 110 I = STT, N-1
+              ED = MIN( I, THED )
+              IF( STT.GT.ED ) GOTO 100
+              DO 120 M = 1, STEPERCOL
+                  ST = STT
+                  DO 130 SWEEPID = ST, ED
+                      DO 140 K = 1, GRSIZ
+                          MYID  = (I-SWEEPID)*(STEPERCOL*GRSIZ) 
+     $                           + (M-1)*GRSIZ + K
+                          IF ( MYID.EQ.1 ) THEN
+                              TTYPE = 1
+                          ELSE
+                              TTYPE = MOD( MYID, 2 ) + 2
+                          ENDIF
+
+                          IF( TTYPE.EQ.2 ) THEN
+                              COLPT      = (MYID/2)*KD + SWEEPID
+                              STIND      = COLPT-KD+1
+                              EDIND      = MIN(COLPT,N)
+                              BLKLASTIND = COLPT
+                          ELSE
+                              COLPT      = ((MYID+1)/2)*KD + SWEEPID
+                              STIND      = COLPT-KD+1
+                              EDIND      = MIN(COLPT,N)
+                              IF( ( STIND.GE.EDIND-1 ).AND.
+     $                            ( EDIND.EQ.N ) ) THEN
+                                  BLKLASTIND = N
+                              ELSE
+                                  BLKLASTIND = 0
+                              ENDIF
+                          ENDIF
+*
+*                         Call the kernel
+*                             
+#if defined(_OPENMP)
+                          IF( TTYPE.NE.1 ) THEN      
+!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
+!$OMP$     DEPEND(in:WORK(MYID-1))
+!$OMP$     DEPEND(out:WORK(MYID))
+                              TID      = OMP_GET_THREAD_NUM()
+                              CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                             STIND, EDIND, SWEEPID, N, KD, IB,
+     $                             WORK ( INDA ), LDA, 
+     $                             HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                             WORK( INDW + TID*KD ) )
+!$OMP END TASK
+                          ELSE
+!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
+!$OMP$     DEPEND(out:WORK(MYID))
+                              TID      = OMP_GET_THREAD_NUM()
+                              CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                             STIND, EDIND, SWEEPID, N, KD, IB,
+     $                             WORK ( INDA ), LDA, 
+     $                             HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                             WORK( INDW + TID*KD ) )
+!$OMP END TASK
+                          ENDIF
+#else
+                          CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                         STIND, EDIND, SWEEPID, N, KD, IB,
+     $                         WORK ( INDA ), LDA, 
+     $                         HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                         WORK( INDW + TID*KD ) )
+#endif 
+                          IF ( BLKLASTIND.GE.(N-1) ) THEN
+                              STT = STT + 1
+                              GOTO 130
+                          ENDIF
+  140                 CONTINUE
+  130             CONTINUE
+  120         CONTINUE
+  110     CONTINUE
+  100 CONTINUE
+*
+#if defined(_OPENMP)
+!$OMP END MASTER
+!$OMP END PARALLEL
+#endif
+*      
+*     Copy the diagonal from A to D. Note that D is REAL thus only
+*     the Real part is needed, the imaginary part should be zero.
+*
+      DO 150 I = 1, N
+          D( I ) = ( WORK( DPOS+(I-1)*LDA ) )
+  150 CONTINUE
+*      
+*     Copy the off diagonal from A to E. Note that E is REAL thus only
+*     the Real part is needed, the imaginary part should be zero.
+*
+      IF( UPPER ) THEN
+          DO 160 I = 1, N-1
+             E( I ) = ( WORK( OFDPOS+I*LDA ) )
+  160     CONTINUE
+      ELSE
+          DO 170 I = 1, N-1
+             E( I ) = ( WORK( OFDPOS+(I-1)*LDA ) )
+  170     CONTINUE
+      ENDIF
+*
+      HOUS( 1 ) = LHMIN
+      WORK( 1 ) = LWMIN
+      RETURN
+*
+*     End of DSYTRD_SB2ST
+*
+      END
+      
diff --git a/SRC/dsytrd_sy2sb.f b/SRC/dsytrd_sy2sb.f
new file mode 100644
index 00000000..8f0261df
--- /dev/null
+++ b/SRC/dsytrd_sy2sb.f
@@ -0,0 +1,517 @@
+*> \brief \b DSYTRD_SY2SB
+*
+*  @generated from zhetrd_he2hb.f, fortran z -> d, Sun Nov  6 19:34:06 2016
+*      
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DSYTRD_SY2SB + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrd.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrd.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrd.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, 
+*                              WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDAB, LWORK, N, KD
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   A( LDA, * ), AB( LDAB, * ), 
+*                          TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYTRD_SY2SB reduces a real symmetric matrix A to real symmetric
+*> band-diagonal form AB by a orthogonal similarity transformation:
+*> Q**T * A * Q = AB.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the reduced matrix if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*>          The reduced matrix is stored in the array AB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>          On exit, if UPLO = 'U', the diagonal and first superdiagonal
+*>          of A are overwritten by the corresponding elements of the
+*>          tridiagonal matrix T, and the elements above the first
+*>          superdiagonal, with the array TAU, represent the orthogonal
+*>          matrix Q as a product of elementary reflectors; if UPLO
+*>          = 'L', the diagonal and first subdiagonal of A are over-
+*>          written by the corresponding elements of the tridiagonal
+*>          matrix T, and the elements below the first subdiagonal, with
+*>          the array TAU, represent the orthogonal matrix Q as a product
+*>          of elementary reflectors. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] AB
+*> \verbatim
+*>          AB is DOUBLE PRECISION array, dimension (LDAB,N)
+*>          On exit, the upper or lower triangle of the symmetric band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD+1.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is DOUBLE PRECISION array, dimension (N-KD)
+*>          The scalar factors of the elementary reflectors (see Further
+*>          Details).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension LWORK.
+*>          On exit, if INFO = 0, or if LWORK=-1, 
+*>          WORK(1) returns the size of LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK which should be calculated
+*           by a workspace query. LWORK = MAX(1, LWORK_QUERY)
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK_QUERY = N*KD + N*max(KD,FACTOPTNB) + 2*KD*KD
+*>          where FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice otherwise
+*>          putting LWORK=-1 will provide the size of WORK.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*> \verbatim
+*>
+*>  If UPLO = 'U', the matrix Q is represented as a product of elementary
+*>  reflectors
+*>
+*>     Q = H(k)**T . . . H(2)**T H(1)**T, where k = n-kd.
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**T
+*>
+*>  where tau is a real scalar, and v is a real vector with
+*>  v(1:i+kd-1) = 0 and v(i+kd) = 1; conjg(v(i+kd+1:n)) is stored on exit in
+*>  A(i,i+kd+1:n), and tau in TAU(i).
+*>
+*>  If UPLO = 'L', the matrix Q is represented as a product of elementary
+*>  reflectors
+*>
+*>     Q = H(1) H(2) . . . H(k), where k = n-kd.
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**T
+*>
+*>  where tau is a real scalar, and v is a real vector with
+*>  v(kd+1:i) = 0 and v(i+kd+1) = 1; v(i+kd+2:n) is stored on exit in
+*   A(i+kd+2:n,i), and tau in TAU(i).
+*>
+*>  The contents of A on exit are illustrated by the following examples
+*>  with n = 5:
+*>
+*>  if UPLO = 'U':                       if UPLO = 'L':
+*>
+*>    (  ab  ab/v1  v1      v1     v1    )              (  ab                            )
+*>    (      ab     ab/v2   v2     v2    )              (  ab/v1  ab                     )
+*>    (             ab      ab/v3  v3    )              (  v1     ab/v2  ab              )
+*>    (                     ab     ab/v4 )              (  v1     v2     ab/v3  ab       )
+*>    (                            ab    )              (  v1     v2     v3     ab/v4 ab )
+*>
+*>  where d and e denote diagonal and off-diagonal elements of T, and vi
+*>  denotes an element of the vector defining H(i).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, 
+     $                         WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDAB, LWORK, N, KD
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), AB( LDAB, * ), 
+     $                   TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   RONE
+      DOUBLE PRECISION   ZERO, ONE, HALF
+      PARAMETER          ( RONE = 1.0D+0,
+     $                   ZERO = 0.0D+0,
+     $                   ONE = 1.0D+0,
+     $                   HALF = 0.5D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, J, IINFO, LWMIN, PN, PK, LK,
+     $                   LDT, LDW, LDS2, LDS1, 
+     $                   LS2, LS1, LW, LT,
+     $                   TPOS, WPOS, S2POS, S1POS
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, DSYR2K, DSYMM, DGEMM,
+     $                   DLARFT, DGELQF, DGEQRF, DLASET
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN, MAX
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV 
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Determine the minimal workspace size required 
+*     and test the input parameters
+*
+      INFO   = 0
+      UPPER  = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      LWMIN  = ILAENV( 20, 'DSYTRD_SY2SB', '', N, KD, -1, -1 )
+      
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.MAX( 1, KD+1 ) ) THEN
+         INFO = -7
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -10
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYTRD_SY2SB', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         WORK( 1 ) = LWMIN
+         RETURN
+      END IF
+*
+*     Quick return if possible        
+*     Copy the upper/lower portion of A into AB 
+*
+      IF( N.LE.KD+1 ) THEN
+          IF( UPPER ) THEN
+              DO 100 I = 1, N
+                  LK = MIN( KD+1, I )
+                  CALL DCOPY( LK, A( I-LK+1, I ), 1, 
+     $                            AB( KD+1-LK+1, I ), 1 )
+  100         CONTINUE
+          ELSE
+              DO 110 I = 1, N
+                  LK = MIN( KD+1, N-I+1 )
+                  CALL DCOPY( LK, A( I, I ), 1, AB( 1, I ), 1 )
+  110         CONTINUE
+          ENDIF
+          WORK( 1 ) = 1
+          RETURN
+      END IF
+*
+*     Determine the pointer position for the workspace
+*      
+      LDT    = KD
+      LDS1   = KD
+      LT     = LDT*KD
+      LW     = N*KD
+      LS1    = LDS1*KD
+      LS2    = LWMIN - LT - LW - LS1
+*      LS2 = N*MAX(KD,FACTOPTNB) 
+      TPOS   = 1
+      WPOS   = TPOS  + LT
+      S1POS  = WPOS  + LW
+      S2POS  = S1POS + LS1 
+      IF( UPPER ) THEN
+          LDW    = KD
+          LDS2   = KD
+      ELSE
+          LDW    = N
+          LDS2   = N
+      ENDIF
+*
+*
+*     Set the workspace of the triangular matrix T to zero once such a
+*     way everytime T is generated the upper/lower portion will be always zero  
+*   
+      CALL DLASET( "A", LDT, KD, ZERO, ZERO, WORK( TPOS ), LDT )
+*
+      IF( UPPER ) THEN
+          DO 10 I = 1, N - KD, KD
+             PN = N-I-KD+1
+             PK = MIN( N-I-KD+1, KD )
+*        
+*            Compute the LQ factorization of the current block
+*        
+             CALL DGELQF( KD, PN, A( I, I+KD ), LDA,
+     $                    TAU( I ), WORK( S2POS ), LS2, IINFO )
+*        
+*            Copy the upper portion of A into AB
+*        
+             DO 20 J = I, I+PK-1
+                LK = MIN( KD, N-J ) + 1
+                CALL DCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 )
+   20        CONTINUE
+*                
+             CALL DLASET( 'Lower', PK, PK, ZERO, ONE, 
+     $                    A( I, I+KD ), LDA )
+*        
+*            Form the matrix T
+*        
+             CALL DLARFT( 'Forward', 'Rowwise', PN, PK,
+     $                    A( I, I+KD ), LDA, TAU( I ), 
+     $                    WORK( TPOS ), LDT )
+*        
+*            Compute W:
+*             
+             CALL DGEMM( 'Conjugate', 'No transpose', PK, PN, PK,
+     $                   ONE,  WORK( TPOS ), LDT,
+     $                         A( I, I+KD ), LDA,
+     $                   ZERO, WORK( S2POS ), LDS2 )
+*        
+             CALL DSYMM( 'Right', UPLO, PK, PN,
+     $                   ONE,  A( I+KD, I+KD ), LDA,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( WPOS ), LDW )
+*        
+             CALL DGEMM( 'No transpose', 'Conjugate', PK, PK, PN,
+     $                   ONE,  WORK( WPOS ), LDW,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( S1POS ), LDS1 )
+*        
+             CALL DGEMM( 'No transpose', 'No transpose', PK, PN, PK,
+     $                   -HALF, WORK( S1POS ), LDS1, 
+     $                          A( I, I+KD ), LDA,
+     $                   ONE,   WORK( WPOS ), LDW )
+*             
+*        
+*            Update the unreduced submatrix A(i+kd:n,i+kd:n), using
+*            an update of the form:  A := A - V'*W - W'*V
+*        
+             CALL DSYR2K( UPLO, 'Conjugate', PN, PK,
+     $                    -ONE, A( I, I+KD ), LDA,
+     $                          WORK( WPOS ), LDW,
+     $                    RONE, A( I+KD, I+KD ), LDA )
+   10     CONTINUE
+*
+*        Copy the upper band to AB which is the band storage matrix
+*
+         DO 30 J = N-KD+1, N
+            LK = MIN(KD, N-J) + 1
+            CALL DCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 )
+   30    CONTINUE
+*
+      ELSE
+*
+*         Reduce the lower triangle of A to lower band matrix
+*        
+          DO 40 I = 1, N - KD, KD
+             PN = N-I-KD+1
+             PK = MIN( N-I-KD+1, KD )
+*        
+*            Compute the QR factorization of the current block
+*        
+             CALL DGEQRF( PN, KD, A( I+KD, I ), LDA,
+     $                    TAU( I ), WORK( S2POS ), LS2, IINFO )
+*        
+*            Copy the upper portion of A into AB 
+*        
+             DO 50 J = I, I+PK-1
+                LK = MIN( KD, N-J ) + 1
+                CALL DCOPY( LK, A( J, J ), 1, AB( 1, J ), 1 )
+   50        CONTINUE
+*                
+             CALL DLASET( 'Upper', PK, PK, ZERO, ONE, 
+     $                    A( I+KD, I ), LDA )
+*        
+*            Form the matrix T
+*        
+             CALL DLARFT( 'Forward', 'Columnwise', PN, PK,
+     $                    A( I+KD, I ), LDA, TAU( I ), 
+     $                    WORK( TPOS ), LDT )
+*        
+*            Compute W:
+*             
+             CALL DGEMM( 'No transpose', 'No transpose', PN, PK, PK,
+     $                   ONE, A( I+KD, I ), LDA,
+     $                         WORK( TPOS ), LDT,
+     $                   ZERO, WORK( S2POS ), LDS2 )
+*        
+             CALL DSYMM( 'Left', UPLO, PN, PK,
+     $                   ONE, A( I+KD, I+KD ), LDA,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( WPOS ), LDW )
+*        
+             CALL DGEMM( 'Conjugate', 'No transpose', PK, PK, PN,
+     $                   ONE, WORK( S2POS ), LDS2,
+     $                         WORK( WPOS ), LDW,
+     $                   ZERO, WORK( S1POS ), LDS1 )
+*        
+             CALL DGEMM( 'No transpose', 'No transpose', PN, PK, PK,
+     $                   -HALF, A( I+KD, I ), LDA,
+     $                         WORK( S1POS ), LDS1,
+     $                   ONE, WORK( WPOS ), LDW )
+*             
+*        
+*            Update the unreduced submatrix A(i+kd:n,i+kd:n), using
+*            an update of the form:  A := A - V*W' - W*V'
+*        
+             CALL DSYR2K( UPLO, 'No transpose', PN, PK,
+     $                    -ONE, A( I+KD, I ), LDA,
+     $                           WORK( WPOS ), LDW,
+     $                    RONE, A( I+KD, I+KD ), LDA )
+*            ==================================================================
+*            RESTORE A FOR COMPARISON AND CHECKING TO BE REMOVED
+*             DO 45 J = I, I+PK-1
+*                LK = MIN( KD, N-J ) + 1
+*                CALL DCOPY( LK, AB( 1, J ), 1, A( J, J ), 1 )
+*   45        CONTINUE
+*            ==================================================================
+   40     CONTINUE
+*
+*        Copy the lower band to AB which is the band storage matrix
+*
+         DO 60 J = N-KD+1, N
+            LK = MIN(KD, N-J) + 1
+            CALL DCOPY( LK, A( J, J ), 1, AB( 1, J ), 1 )
+   60    CONTINUE
+
+      END IF
+*
+      WORK( 1 ) = LWMIN
+      RETURN
+*
+*     End of DSYTRD_SY2SB
+*
+      END
diff --git a/SRC/dsytrf_aa.f b/SRC/dsytrf_aa.f
index 07919a2c..0e038806 100644
--- a/SRC/dsytrf_aa.f
+++ b/SRC/dsytrf_aa.f
@@ -101,7 +101,7 @@
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
-*>          The length of WORK.  LWORK >=2*N. For optimum performance
+*>          The length of WORK.  LWORK >= MAX(1,2*N). For optimum performance
 *>          LWORK >= N*(1+NB), where NB is the optimal blocksize.
 *>
 *>          If LWORK = -1, then a workspace query is assumed; the routine
@@ -191,7 +191,7 @@
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.( 2*N ) .AND. .NOT.LQUERY ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
 *
diff --git a/SRC/dsytrf_rk.f b/SRC/dsytrf_rk.f
new file mode 100644
index 00000000..0cca75ad
--- /dev/null
+++ b/SRC/dsytrf_rk.f
@@ -0,0 +1,498 @@
+*> \brief \b DSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYTRF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrf_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrf_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrf_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> DSYTRF_RK computes the factorization of a real symmetric matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension ( MAX(1,LWORK) ).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >=1.  For best performance
+*>          LWORK >= N*NB, where NB is the block size returned
+*>          by ILAENV.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array, returns this value as the first entry of the WORK
+*>          array, and no error message related to LWORK is issued
+*>          by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put correct description
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, IINFO, IP, IWS, K, KB, LDWORK, LWKOPT,
+     $                   NB, NBMIN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLASYF_RK, DSYTF2_RK, DSWAP, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size
+*
+         NB = ILAENV( 1, 'DSYTRF_RK', UPLO, N, -1, -1, -1 )
+         LWKOPT = N*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYTRF_RK', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+      NBMIN = 2
+      LDWORK = N
+      IF( NB.GT.1 .AND. NB.LT.N ) THEN
+         IWS = LDWORK*NB
+         IF( LWORK.LT.IWS ) THEN
+            NB = MAX( LWORK / LDWORK, 1 )
+            NBMIN = MAX( 2, ILAENV( 2, 'DSYTRF_RK',
+     $                              UPLO, N, -1, -1, -1 ) )
+         END IF
+      ELSE
+         IWS = 1
+      END IF
+      IF( NB.LT.NBMIN )
+     $   NB = N
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**T using the upper triangle of A
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        KB, where KB is the number of columns factorized by DLASYF_RK;
+*        KB is either NB or NB-1, or K for the last block
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 15
+*
+         IF( K.GT.NB ) THEN
+*
+*           Factorize columns k-kb+1:k of A and use blocked code to
+*           update columns 1:k-kb
+*
+            CALL DLASYF_RK( UPLO, K, NB, KB, A, LDA, E,
+     $                      IPIV, WORK, LDWORK, IINFO )
+         ELSE
+*
+*           Use unblocked code to factorize columns 1:k of A
+*
+            CALL DSYTF2_RK( UPLO, K, A, LDA, E, IPIV, IINFO )
+            KB = K
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO
+*
+*        No need to adjust IPIV
+*
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k-kb+1:k and apply row permutations to the
+*        last k+1 colunms k+1:N after that block
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.LT.N ) THEN
+            DO I = K, ( K - KB + 1 ), -1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL DSWAP( N-K, A( I, K+1 ), LDA,
+     $                        A( IP, K+1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KB
+         GO TO 10
+*
+*        This label is the exit from main loop over K decreasing
+*        from N to 1 in steps of KB
+*
+   15    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**T using the lower triangle of A
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        KB, where KB is the number of columns factorized by DLASYF_RK;
+*        KB is either NB or NB-1, or N-K+1 for the last block
+*
+         K = 1
+   20    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 35
+*
+         IF( K.LE.N-NB ) THEN
+*
+*           Factorize columns k:k+kb-1 of A and use blocked code to
+*           update columns k+kb:n
+*
+            CALL DLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ),
+     $                        IPIV( K ), WORK, LDWORK, IINFO )
+
+
+         ELSE
+*
+*           Use unblocked code to factorize columns k:n of A
+*
+            CALL DSYTF2_RK( UPLO, N-K+1, A( K, K ), LDA, E( K ),
+     $                      IPIV( K ), IINFO )
+            KB = N - K + 1
+*
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO + K - 1
+*
+*        Adjust IPIV
+*
+         DO I = K, K + KB - 1
+            IF( IPIV( I ).GT.0 ) THEN
+               IPIV( I ) = IPIV( I ) + K - 1
+            ELSE
+               IPIV( I ) = IPIV( I ) - K + 1
+            END IF
+         END DO
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k:k+kb-1 and apply row permutations to the
+*        first k-1 colunms 1:k-1 before that block
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.GT.1 ) THEN
+            DO I = K, ( K + KB - 1 ), 1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL DSWAP( K-1, A( I, 1 ), LDA,
+     $                        A( IP, 1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KB
+         GO TO 20
+*
+*        This label is the exit from main loop over K increasing
+*        from 1 to N in steps of KB
+*
+   35    CONTINUE
+*
+*     End Lower
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+      RETURN
+*
+*     End of DSYTRF_RK
+*
+      END
diff --git a/SRC/dsytri_3.f b/SRC/dsytri_3.f
new file mode 100644
index 00000000..51936167
--- /dev/null
+++ b/SRC/dsytri_3.f
@@ -0,0 +1,248 @@
+*> \brief \b DSYTRI_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYTRI_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytri_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytri_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytri_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> DSYTRI_3 computes the inverse of a real symmetric indefinite
+*> matrix A using the factorization computed by DSYTRF_RK or DSYTRF_BK:
+*>
+*>     A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> DSYTRI_3 sets the leading dimension of the workspace  before calling
+*> DSYTRI_3X that actually computes the inverse.  This is the blocked
+*> version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by DSYTRF_RK and DSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the symmetric inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by DSYTRF_RK or DSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (N+NB+1)*(NB+3).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK. LWORK >= (N+NB+1)*(NB+3).
+*>
+*>          If LDWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the optimal
+*>          size of the WORK array, returns this value as the first
+*>          entry of the WORK array, and no error message related to
+*>          LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            UPPER, LQUERY
+      INTEGER            LWKOPT, NB
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DSYTRI_3X
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+*     Determine the block size
+*
+      NB = MAX( 1, ILAENV( 1, 'DSYTRI_3', UPLO, N, -1, -1, -1 ) )
+      LWKOPT = ( N+NB+1 ) * ( NB+3 )
+*
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYTRI_3', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         WORK( 1 ) = LWKOPT
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      CALL DSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of DSYTRI_3
+*
+      END
diff --git a/SRC/dsytri_3x.f b/SRC/dsytri_3x.f
new file mode 100644
index 00000000..7825f584
--- /dev/null
+++ b/SRC/dsytri_3x.f
@@ -0,0 +1,645 @@
+*> \brief \b DSYTRI_3X
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYTRI_3X + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytri_3x.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytri_3x.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytri_3x.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ),  E( * ), WORK( N+NB+1, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> DSYTRI_3X computes the inverse of a real symmetric indefinite
+*> matrix A using the factorization computed by DSYTRF_RK or DSYTRF_BK:
+*>
+*>     A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by DSYTRF_RK and DSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the symmetric inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by DSYTRF_RK or DSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (N+NB+1,NB+3).
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          Block size.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   A( LDA, * ), E( * ), WORK( N+NB+1, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE, ZERO
+      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            CUT, I, ICOUNT, INVD, IP, K, NNB, J, U11
+      DOUBLE PRECISION   AK, AKKP1, AKP1, D, T, U01_I_J, U01_IP1_J,
+     $                   U11_I_J, U11_IP1_J
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DGEMM, DSYSWAPR, DTRTRI, DTRMM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+*
+*     Quick return if possible
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYTRI_3X', -INFO )
+         RETURN
+      END IF
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Workspace got Non-diag elements of D
+*
+      DO K = 1, N
+         WORK( K, 1 ) = E( K )
+      END DO
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO INFO = N, 1, -1
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO INFO = 1, N
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+      INFO = 0
+*
+*     Splitting Workspace
+*     U01 is a block ( N, NB+1 )
+*     The first element of U01 is in WORK( 1, 1 )
+*     U11 is a block ( NB+1, NB+1 )
+*     The first element of U11 is in WORK( N+1, 1 )
+*
+      U11 = N
+*
+*     INVD is a block ( N, 2 )
+*     The first element of INVD is in WORK( 1, INVD )
+*
+      INVD = NB + 2
+
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        invA = P * inv(U**T) * inv(D) * inv(U) * P**T.
+*
+         CALL DTRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(U)
+*
+         K = 1
+         DO WHILE( K.LE.N )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = ONE /  A( K, K )
+               WORK( K, INVD+1 ) = ZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = WORK( K+1, 1 )
+               AK = A( K, K ) / T
+               AKP1 = A( K+1, K+1 ) / T
+               AKKP1 = WORK( K+1, 1 )  / T
+               D = T*( AK*AKP1-ONE )
+               WORK( K, INVD ) = AKP1 / D
+               WORK( K+1, INVD+1 ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K+1, INVD ) = WORK( K, INVD+1 )
+               K = K + 1
+            END IF
+            K = K + 1
+         END DO
+*
+*        inv(U**T) = (inv(U))**T
+*
+*        inv(U**T) * inv(D) * inv(U)
+*
+         CUT = N
+         DO WHILE( CUT.GT.0 )
+            NNB = NB
+            IF( CUT.LE.NNB ) THEN
+               NNB = CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT+1-NNB, CUT
+                  IF( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+
+            CUT = CUT - NNB
+*
+*           U01 Block
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  WORK( I, J ) = A( I, CUT+J )
+               END DO
+            END DO
+*
+*           U11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I ) = ONE
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = ZERO
+                END DO
+                DO J = I+1, NNB
+                   WORK( U11+I, J ) = A( CUT+I, CUT+J )
+                END DO
+            END DO
+*
+*           invD * U01
+*
+            I = 1
+            DO WHILE( I.LE.CUT )
+               IF( IPIV( I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( I, INVD ) * WORK( I, J )
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK( I, J )
+                     U01_IP1_J = WORK( I+1, J )
+                     WORK( I, J ) = WORK( I, INVD ) * U01_I_J
+     $                            + WORK( I, INVD+1 ) * U01_IP1_J
+                     WORK( I+1, J ) = WORK( I+1, INVD ) * U01_I_J
+     $                              + WORK( I+1, INVD+1 ) * U01_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           invD1 * U11
+*
+            I = 1
+            DO WHILE ( I.LE.NNB )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = I, NNB
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+                  END DO
+               ELSE
+                  DO J = I, NNB
+                     U11_I_J = WORK(U11+I,J)
+                     U11_IP1_J = WORK(U11+I+1,J)
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                            + WORK(CUT+I,INVD+1) * WORK(U11+I+1,J)
+                     WORK( U11+I+1, J ) = WORK(CUT+I+1,INVD) * U11_I_J
+     $                               + WORK(CUT+I+1,INVD+1) * U11_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           U11**T * invD1 * U11 -> U11
+*
+            CALL DTRMM( 'L', 'U', 'T', 'U', NNB, NNB,
+     $                 ONE, A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                 N+NB+1 )
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+*           U01**T * invD * U01 -> A( CUT+I, CUT+J )
+*
+            CALL DGEMM( 'T', 'N', NNB, NNB, CUT, ONE, A( 1, CUT+1 ),
+     $                  LDA, WORK, N+NB+1, ZERO, WORK(U11+1,1), N+NB+1 )
+
+*
+*           U11 =  U11**T * invD1 * U11 + U01**T * invD * U01
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = A( CUT+I, CUT+J ) + WORK(U11+I,J)
+               END DO
+            END DO
+*
+*           U01 =  U00**T * invD0 * U01
+*
+            CALL DTRMM( 'L', UPLO, 'T', 'U', CUT, NNB,
+     $                  ONE, A, LDA, WORK, N+NB+1 )
+
+*
+*           Update U01
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  A( I, CUT+J ) = WORK( I, J )
+               END DO
+            END DO
+*
+*           Next Block
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(U**T) * inv(D) * inv(U) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Upper case.
+*
+*        ( We can use a loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = 1, N
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        inv A = P * inv(L**T) * inv(D) * inv(L) * P**T.
+*
+         CALL DTRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(L)
+*
+         K = N
+         DO WHILE ( K .GE. 1 )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = ONE /  A( K, K )
+               WORK( K, INVD+1 ) = ZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = WORK( K-1, 1 )
+               AK = A( K-1, K-1 ) / T
+               AKP1 = A( K, K ) / T
+               AKKP1 = WORK( K-1, 1 ) / T
+               D = T*( AK*AKP1-ONE )
+               WORK( K-1, INVD ) = AKP1 / D
+               WORK( K, INVD ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K-1, INVD+1 ) = WORK( K, INVD+1 )
+               K = K - 1
+            END IF
+            K = K - 1
+         END DO
+*
+*        inv(L**T) = (inv(L))**T
+*
+*        inv(L**T) * inv(D) * inv(L)
+*
+         CUT = 0
+         DO WHILE( CUT.LT.N )
+            NNB = NB
+            IF( (CUT + NNB).GT.N ) THEN
+               NNB = N - CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT + 1, CUT+NNB
+                  IF ( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+*
+*           L21 Block
+*
+            DO I = 1, N-CUT-NNB
+               DO J = 1, NNB
+                 WORK( I, J ) = A( CUT+NNB+I, CUT+J )
+               END DO
+            END DO
+*
+*           L11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I) = ONE
+               DO J = I+1, NNB
+                  WORK( U11+I, J ) = ZERO
+               END DO
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = A( CUT+I, CUT+J )
+               END DO
+            END DO
+*
+*           invD*L21
+*
+            I = N-CUT-NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+NNB+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( CUT+NNB+I, INVD) * WORK( I, J)
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK(I,J)
+                     U01_IP1_J = WORK(I-1,J)
+                     WORK(I,J)=WORK(CUT+NNB+I,INVD)*U01_I_J+
+     $                        WORK(CUT+NNB+I,INVD+1)*U01_IP1_J
+                     WORK(I-1,J)=WORK(CUT+NNB+I-1,INVD+1)*U01_I_J+
+     $                        WORK(CUT+NNB+I-1,INVD)*U01_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           invD1*L11
+*
+            I = NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( U11+I, J ) = WORK( CUT+I, INVD)*WORK(U11+I,J)
+                  END DO
+
+               ELSE
+                  DO J = 1, NNB
+                     U11_I_J = WORK( U11+I, J )
+                     U11_IP1_J = WORK( U11+I-1, J )
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                                + WORK(CUT+I,INVD+1) * U11_IP1_J
+                     WORK( U11+I-1, J ) = WORK(CUT+I-1,INVD+1) * U11_I_J
+     $                                  + WORK(CUT+I-1,INVD) * U11_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           L11**T * invD1 * L11 -> L11
+*
+            CALL DTRMM( 'L', UPLO, 'T', 'U', NNB, NNB, ONE,
+     $                   A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                   N+NB+1 )
+
+*
+            DO I = 1, NNB
+               DO J = 1, I
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+            IF( (CUT+NNB).LT.N ) THEN
+*
+*              L21**T * invD2*L21 -> A( CUT+I, CUT+J )
+*
+               CALL DGEMM( 'T', 'N', NNB, NNB, N-NNB-CUT, ONE,
+     $                     A( CUT+NNB+1, CUT+1 ), LDA, WORK, N+NB+1,
+     $                     ZERO, WORK( U11+1, 1 ), N+NB+1 )
+
+*
+*              L11 =  L11**T * invD1 * L11 + U01**T * invD * U01
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = A( CUT+I, CUT+J )+WORK(U11+I,J)
+                  END DO
+               END DO
+*
+*              L01 =  L22**T * invD2 * L21
+*
+               CALL DTRMM( 'L', UPLO, 'T', 'U', N-NNB-CUT, NNB, ONE,
+     $                     A( CUT+NNB+1, CUT+NNB+1 ), LDA, WORK,
+     $                     N+NB+1 )
+*
+*              Update L21
+*
+               DO I = 1, N-CUT-NNB
+                  DO J = 1, NNB
+                     A( CUT+NNB+I, CUT+J ) = WORK( I, J )
+                  END DO
+               END DO
+*
+            ELSE
+*
+*              L11 =  L11**T * invD1 * L11
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = WORK( U11+I, J )
+                  END DO
+               END DO
+            END IF
+*
+*           Next Block
+*
+            CUT = CUT + NNB
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(L**T) * inv(D) * inv(L) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Lower case.
+*
+*        ( We can use a loop over IPIV with increment -1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = N, 1, -1
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of DSYTRI_3X
+*
+      END
+
diff --git a/SRC/dsytrs_3.f b/SRC/dsytrs_3.f
new file mode 100644
index 00000000..ffef54c5
--- /dev/null
+++ b/SRC/dsytrs_3.f
@@ -0,0 +1,371 @@
+*> \brief \b DSYTRS_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYTRS_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrs_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrs_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrs_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> DSYTRS_3 solves a system of linear equations A * X = B with a real
+*> symmetric matrix A using the factorization computed
+*> by DSYTRF_RK or DSYTRF_BK:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This algorithm is using Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**T)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**T)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by DSYTRF_RK and DSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by DSYTRF_RK or DSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array, dimension (LDB,NRHS)
+*>          On entry, the right hand side matrix B.
+*>          On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup doubleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE DSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE
+      PARAMETER          ( ONE = 1.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, J, K, KP
+      DOUBLE PRECISION   AK, AKM1, AKM1K, BK, BKM1, DENOM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DSCAL, DSWAP, DTRSM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DSYTRS_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. NRHS.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        Solve A*X = B, where A = U*D*U**T.
+*
+*        P**T * B
+*
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]
+*
+         CALL DTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (U \P**T * B) ]
+*
+         I = N
+         DO WHILE ( I.GE.1 )
+            IF( IPIV( I ).GT.0 ) THEN
+               CALL DSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
+            ELSE IF ( I.GT.1 ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I-1, I-1 ) / AKM1K
+               AK = A( I, I ) / AKM1K
+               DENOM = AKM1*AK - ONE
+               DO J = 1, NRHS
+                  BKM1 = B( I-1, J ) / AKM1K
+                  BK = B( I, J ) / AKM1K
+                  B( I-1, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I - 1
+            END IF
+            I = I - 1
+         END DO
+*
+*        Compute (U**T \ B) -> B   [ U**T \ (D \ (U \P**T * B) ) ]
+*
+         CALL DTRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (U**T \ (D \ (U \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        Solve A*X = B, where A = L*D*L**T.
+*
+*        P**T * B
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]
+*
+         CALL DTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (L \P**T * B) ]
+*
+         I = 1
+         DO WHILE ( I.LE.N )
+            IF( IPIV( I ).GT.0 ) THEN
+               CALL DSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
+            ELSE IF( I.LT.N ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I, I ) / AKM1K
+               AK = A( I+1, I+1 ) / AKM1K
+               DENOM = AKM1*AK - ONE
+               DO  J = 1, NRHS
+                  BKM1 = B( I, J ) / AKM1K
+                  BK = B( I+1, J ) / AKM1K
+                  B( I, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I + 1
+            END IF
+            I = I + 1
+         END DO
+*
+*        Compute (L**T \ B) -> B   [ L**T \ (D \ (L \P**T * B) ) ]
+*
+         CALL DTRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (L**T \ (D \ (L \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        END Lower
+*
+      END IF
+*
+      RETURN
+*
+*     End of DSYTRS_3
+*
+      END
diff --git a/SRC/dsytrs_aa.f b/SRC/dsytrs_aa.f
index ddb9d3fc..6c56b919 100644
--- a/SRC/dsytrs_aa.f
+++ b/SRC/dsytrs_aa.f
@@ -104,7 +104,7 @@
 *>
 *> \param[in] LWORK
 *> \verbatim
-*>          LWORK is INTEGER, LWORK >= 3*N-2.
+*>          LWORK is INTEGER, LWORK >= MAX(1,3*N-2).
 *>
 *> \param[out] INFO
 *> \verbatim
@@ -179,7 +179,7 @@
          INFO = -5
       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
          INFO = -8
-      ELSE IF( LWORK.LT.(3*N-2) .AND. .NOT.LQUERY ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
          INFO = -10
       END IF
       IF( INFO.NE.0 ) THEN
diff --git a/SRC/ilaenv.f b/SRC/ilaenv.f
index 42a380cf..8205a75a 100644
--- a/SRC/ilaenv.f
+++ b/SRC/ilaenv.f
@@ -132,7 +132,7 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date June 2016
+*> \date November 2016
 *
 *> \ingroup OTHERauxiliary
 *
@@ -162,10 +162,10 @@
 *  =====================================================================
       INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
 *
-*  -- LAPACK auxiliary routine (version 3.6.1) --
+*  -- LAPACK auxiliary routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     June 2016
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*( * )    NAME, OPTS
@@ -183,13 +183,14 @@
       INTRINSIC          CHAR, ICHAR, INT, MIN, REAL
 *     ..
 *     .. External Functions ..
-      INTEGER            IEEECK, IPARMQ
-      EXTERNAL           IEEECK, IPARMQ
+      INTEGER            IEEECK, IPARMQ, IPARAM2STAGE
+      EXTERNAL           IEEECK, IPARMQ, IPARAM2STAGE
 *     ..
 *     .. Executable Statements ..
 *
       GO TO ( 10, 10, 10, 80, 90, 100, 110, 120,
-     $        130, 140, 150, 160, 160, 160, 160, 160 )ISPEC
+     $        130, 140, 150, 160, 160, 160, 160, 160,
+     $        170, 170, 170, 170, 170 )ISPEC
 *
 *     Invalid value for ISPEC
 *
@@ -690,6 +691,13 @@
       ILAENV = IPARMQ( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
       RETURN
 *
+  170 CONTINUE
+*
+*     17 <= ISPEC <= 21: 2stage eigenvalues and SVD or related subroutines.
+*
+      ILAENV = IPARAM2STAGE( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
+      RETURN
+*
 *     End of ILAENV
 *
       END
diff --git a/SRC/iparam2stage.F b/SRC/iparam2stage.F
new file mode 100644
index 00000000..e725a0ce
--- /dev/null
+++ b/SRC/iparam2stage.F
@@ -0,0 +1,386 @@
+*> \brief \b IPARAM2STAGE
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download IPARAM2STAGE + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/iparam2stage.F"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/iparam2stage.F"> 
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/iparam2stage.F"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       INTEGER FUNCTION IPARAM2STAGE( ISPEC, NAME, OPTS, 
+*                                    NI, NBI, IBI, NXI )
+*       #if defined(_OPENMP)
+*           use omp_lib
+*       #endif
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER*( * )    NAME, OPTS
+*       INTEGER            ISPEC, NI, NBI, IBI, NXI
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>      This program sets problem and machine dependent parameters
+*>      useful for xHETRD_2STAGE, xHETRD_H@2HB, xHETRD_HB2ST,
+*>      xGEBRD_2STAGE, xGEBRD_GE2GB, xGEBRD_GB2BD 
+*>      and related subroutines for eigenvalue problems. 
+*>      It is called whenever ILAENV is called with 17 <= ISPEC <= 21
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] ISPEC
+*> \verbatim
+*>          ISPEC is integer scalar
+*>              ISPEC specifies which tunable parameter IPARAM2STAGE should
+*>              return.
+*>
+*>              ISPEC=17: the optimal blocksize nb for the reduction to
+*                         BAND
+*>
+*>              ISPEC=18: the optimal blocksize ib for the eigenvectors
+*>                        singular vectors update routine
+*>
+*>              ISPEC=19: The length of the array that store the Housholder 
+*>                        representation for the second stage 
+*>                        Band to Tridiagonal or Bidiagonal
+*>
+*>              ISPEC=20: The workspace needed for the routine in input.
+*>
+*>              ISPEC=21: For future release.
+*> \endverbatim
+*>
+*> \param[in] NAME
+*> \verbatim
+*>          NAME is character string
+*>               Name of the calling subroutine
+*> \endverbatim
+*>
+*> \param[in] OPTS
+*> \verbatim
+*>          OPTS is CHARACTER*(*)
+*>          The character options to the subroutine NAME, concatenated
+*>          into a single character string.  For example, UPLO = 'U',
+*>          TRANS = 'T', and DIAG = 'N' for a triangular routine would
+*>          be specified as OPTS = 'UTN'.
+*> \endverbatim
+*>
+*> \param[in] NI
+*> \verbatim
+*>          NI is INTEGER which is the size of the matrix
+*> \endverbatim
+*>
+*> \param[in] NBI
+*> \verbatim
+*>          NBI is INTEGER which is the used in the reduciton, 
+*           (e.g., the size of the band), needed to compute workspace
+*           and LHOUS2.
+*> \endverbatim
+*>
+*> \param[in] IBI
+*> \verbatim
+*>          IBI is INTEGER which represent the IB of the reduciton,
+*           needed to compute workspace and LHOUS2.
+*> \endverbatim
+*>
+*> \param[in] NXI
+*> \verbatim
+*>          NXI is INTEGER needed in the future release.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date June 2016
+*
+*> \ingroup auxOTHERauxiliary
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All detail are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      INTEGER FUNCTION IPARAM2STAGE( ISPEC, NAME, OPTS, 
+     $                              NI, NBI, IBI, NXI )
+#if defined(_OPENMP)
+      use omp_lib
+#endif
+      IMPLICIT NONE
+*
+*  -- LAPACK auxiliary routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER*( * )    NAME, OPTS
+      INTEGER            ISPEC, NI, NBI, IBI, NXI
+*
+*  ================================================================
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, IC, IZ, KD, IB, LHOUS, LWORK, NTHREADS,
+     $                   FACTOPTNB, QROPTNB, LQOPTNB
+      LOGICAL            RPREC, CPREC
+      CHARACTER          PREC*1, ALGO*3, STAG*5, SUBNAM*12, VECT*3
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          CHAR, ICHAR, MAX
+*     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Invalid value for ISPEC
+*
+      IF( (ISPEC.LT.17).OR.(ISPEC.GT.21) ) THEN
+          IPARAM2STAGE = -1
+          RETURN
+      ENDIF
+*
+*     Get the number of threads
+*      
+      NTHREADS = 1
+#if defined(_OPENMP)
+!$OMP PARALLEL 
+      NTHREADS = OMP_GET_NUM_THREADS()
+!$OMP END PARALLEL
+#endif
+*      WRITE(*,*) 'IPARAM VOICI NTHREADS ISPEC ',NTHREADS, ISPEC
+*
+      IF( ISPEC .NE. 19 ) THEN
+*
+*        Convert NAME to upper case if the first character is lower case.
+*
+         IPARAM2STAGE = -1
+         SUBNAM = NAME
+         IC = ICHAR( SUBNAM( 1: 1 ) )
+         IZ = ICHAR( 'Z' )
+         IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN
+*
+*           ASCII character set
+*
+            IF( IC.GE.97 .AND. IC.LE.122 ) THEN
+               SUBNAM( 1: 1 ) = CHAR( IC-32 )
+               DO 100 I = 2, 12
+                  IC = ICHAR( SUBNAM( I: I ) )
+                  IF( IC.GE.97 .AND. IC.LE.122 )
+     $               SUBNAM( I: I ) = CHAR( IC-32 )
+  100          CONTINUE
+            END IF
+*
+         ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN
+*
+*           EBCDIC character set
+*
+            IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
+     $          ( IC.GE.145 .AND. IC.LE.153 ) .OR.
+     $          ( IC.GE.162 .AND. IC.LE.169 ) ) THEN
+               SUBNAM( 1: 1 ) = CHAR( IC+64 )
+               DO 110 I = 2, 12
+                  IC = ICHAR( SUBNAM( I: I ) )
+                  IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
+     $                ( IC.GE.145 .AND. IC.LE.153 ) .OR.
+     $                ( IC.GE.162 .AND. IC.LE.169 ) )SUBNAM( I:
+     $                I ) = CHAR( IC+64 )
+  110          CONTINUE
+            END IF
+*
+         ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN
+*
+*           Prime machines:  ASCII+128
+*
+            IF( IC.GE.225 .AND. IC.LE.250 ) THEN
+               SUBNAM( 1: 1 ) = CHAR( IC-32 )
+               DO 120 I = 2, 12
+                 IC = ICHAR( SUBNAM( I: I ) )
+                 IF( IC.GE.225 .AND. IC.LE.250 )
+     $             SUBNAM( I: I ) = CHAR( IC-32 )
+  120          CONTINUE
+            END IF
+         END IF
+*
+         PREC  = SUBNAM( 1: 1 )
+         ALGO  = SUBNAM( 4: 6 )
+         STAG  = SUBNAM( 8:12 )
+         RPREC = PREC.EQ.'S' .OR. PREC.EQ.'D'
+         CPREC = PREC.EQ.'C' .OR. PREC.EQ.'Z'
+*
+*        Invalid value for PRECISION
+*      
+         IF( .NOT.( RPREC .OR. CPREC ) ) THEN
+             IPARAM2STAGE = -1
+             RETURN
+         ENDIF
+      ENDIF
+*      WRITE(*,*),'RPREC,CPREC ',RPREC,CPREC,
+*     $           '   ALGO ',ALGO,'    STAGE ',STAG
+*      
+*
+      IF (( ISPEC .EQ. 17 ) .OR. ( ISPEC .EQ. 18 )) THEN 
+*
+*     ISPEC = 17, 18:  block size KD, IB
+*     Could be also dependent from N but for now it
+*     depend only on sequential or parallel
+*
+         IF( NTHREADS.GT.4 ) THEN
+            IF( CPREC ) THEN
+               KD = 128
+               IB = 32
+            ELSE
+               KD = 160
+               IB = 40
+            ENDIF
+         ELSE IF( NTHREADS.GT.1 ) THEN
+            IF( CPREC ) THEN
+               KD = 64
+               IB = 32
+            ELSE
+               KD = 64
+               IB = 32
+            ENDIF
+         ELSE
+            IF( CPREC ) THEN
+               KD = 16
+               IB = 16
+            ELSE
+               KD = 32
+               IB = 16
+            ENDIF
+         ENDIF
+         IF( ISPEC.EQ.17 ) IPARAM2STAGE = KD
+         IF( ISPEC.EQ.18 ) IPARAM2STAGE = IB
+*
+      ELSE IF ( ISPEC .EQ. 19 ) THEN
+*
+*     ISPEC = 19:  
+*     LHOUS length of the Houselholder representation
+*     matrix (V,T) of the second stage. should be >= 1.
+*
+*     Will add the VECT OPTION HERE next release
+         VECT  = OPTS(1:1)
+         IF( VECT.EQ.'N' ) THEN
+            LHOUS = MAX( 1, 4*NI )
+         ELSE
+*           This is not correct, it need to call the ALGO and the stage2
+            LHOUS = MAX( 1, 4*NI ) + IBI
+         ENDIF
+         IF( LHOUS.GE.0 ) THEN
+            IPARAM2STAGE = LHOUS
+         ELSE
+            IPARAM2STAGE = -1
+         ENDIF
+*
+      ELSE IF ( ISPEC .EQ. 20 ) THEN
+*
+*     ISPEC = 20: (21 for future use)  
+*     LWORK length of the workspace for 
+*     either or both stages for TRD and BRD. should be >= 1.
+*     TRD:
+*     TRD_stage 1: = LT + LW + LS1 + LS2
+*                  = LDT*KD + N*KD + N*MAX(KD,FACTOPTNB) + LDS2*KD 
+*                    where LDT=LDS2=KD
+*                  = N*KD + N*max(KD,FACTOPTNB) + 2*KD*KD
+*     TRD_stage 2: = (2NB+1)*N + KD*NTHREADS
+*     TRD_both   : = max(stage1,stage2) + AB ( AB=(KD+1)*N )
+*                  = N*KD + N*max(KD+1,FACTOPTNB) 
+*                    + max(2*KD*KD, KD*NTHREADS) 
+*                    + (KD+1)*N
+         LWORK        = -1
+         SUBNAM(1:1)  = PREC
+         SUBNAM(2:6)  = 'GEQRF'
+         QROPTNB      = ILAENV( 1, SUBNAM, ' ', NI, NBI, -1, -1 )
+         SUBNAM(2:6)  = 'GELQF'
+         LQOPTNB      = ILAENV( 1, SUBNAM, ' ', NBI, NI, -1, -1 )
+*        Could be QR or LQ for TRD and the max for BRD
+         FACTOPTNB    = MAX(QROPTNB, LQOPTNB)
+         IF( ALGO.EQ.'TRD' ) THEN
+            IF( STAG.EQ.'2STAG' ) THEN
+               LWORK = NI*NBI + NI*MAX(NBI+1,FACTOPTNB) 
+     $              + MAX(2*NBI*NBI, NBI*NTHREADS) 
+     $              + (NBI+1)*NI
+            ELSE IF( (STAG.EQ.'HE2HB').OR.(STAG.EQ.'SY2SB') ) THEN
+               LWORK = NI*NBI + NI*MAX(NBI,FACTOPTNB) + 2*NBI*NBI
+            ELSE IF( (STAG.EQ.'HB2ST').OR.(STAG.EQ.'SB2ST') ) THEN
+               LWORK = (2*NBI+1)*NI + NBI*NTHREADS
+            ENDIF
+         ELSE IF( ALGO.EQ.'BRD' ) THEN
+            IF( STAG.EQ.'2STAG' ) THEN
+               LWORK = 2*NI*NBI + NI*MAX(NBI+1,FACTOPTNB) 
+     $              + MAX(2*NBI*NBI, NBI*NTHREADS) 
+     $              + (NBI+1)*NI
+            ELSE IF( STAG.EQ.'GE2GB' ) THEN
+               LWORK = NI*NBI + NI*MAX(NBI,FACTOPTNB) + 2*NBI*NBI
+            ELSE IF( STAG.EQ.'GB2BD' ) THEN
+               LWORK = (3*NBI+1)*NI + NBI*NTHREADS
+            ENDIF
+         ENDIF
+         LWORK = MAX ( 1, LWORK )
+
+         IF( LWORK.GT.0 ) THEN
+            IPARAM2STAGE = LWORK
+         ELSE
+            IPARAM2STAGE = -1
+         ENDIF
+*
+      ELSE IF ( ISPEC .EQ. 21 ) THEN
+*
+*     ISPEC = 21 for future use 
+         IPARAM2STAGE = NXI
+      ENDIF
+*
+*     ==== End of IPARAM2STAGE ====
+*
+      END
diff --git a/SRC/sgejsv.f b/SRC/sgejsv.f
index 4054a593..a52e39b3 100644
--- a/SRC/sgejsv.f
+++ b/SRC/sgejsv.f
@@ -87,7 +87,7 @@
 *>              rows, then using this condition number gives too pessimistic
 *>              error bound.
 *>       = 'A': Small singular values are the noise and the matrix is treated
-*>              as numerically rank defficient. The error in the computed
+*>              as numerically rank deficient. The error in the computed
 *>              singular values is bounded by f(m,n)*epsilon*||A||.
 *>              The computed SVD A = U * S * V^t restores A up to
 *>              f(m,n)*epsilon*||A||.
@@ -428,7 +428,7 @@
 *>     The rank revealing QR factorization (in this code: SGEQP3) should be
 *>  implemented as in [3]. We have a new version of SGEQP3 under development
 *>  that is more robust than the current one in LAPACK, with a cleaner cut in
-*>  rank defficient cases. It will be available in the SIGMA library [4].
+*>  rank deficient cases. It will be available in the SIGMA library [4].
 *>  If M is much larger than N, it is obvious that the initial QRF with
 *>  column pivoting can be preprocessed by the QRF without pivoting. That
 *>  well known trick is not used in SGEJSV because in some cases heavy row
@@ -967,7 +967,7 @@
       ELSE IF ( L2RANK ) THEN
 *        .. similarly as above, only slightly more gentle (less agressive).
 *        Sudden drop on the diagonal of R1 is used as the criterion for
-*        close-to-rank-defficient.
+*        close-to-rank-deficient.
          TEMP1 = SQRT(SFMIN)
          DO 3401 p = 2, N
             IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR.
diff --git a/SRC/sgels.f b/SRC/sgels.f
index 08881b55..514d3c91 100644
--- a/SRC/sgels.f
+++ b/SRC/sgels.f
@@ -49,7 +49,7 @@
 *>    an underdetermined system A * X = B.
 *>
 *> 3. If TRANS = 'T' and m >= n:  find the minimum norm solution of
-*>    an undetermined system A**T * X = B.
+*>    an underdetermined system A**T * X = B.
 *>
 *> 4. If TRANS = 'T' and m < n:  find the least squares solution of
 *>    an overdetermined system, i.e., solve the least squares problem
@@ -379,7 +379,7 @@
 *
          ELSE
 *
-*           Overdetermined system of equations A**T * X = B
+*           Underdetermined system of equations A**T * X = B
 *
 *           B(1:N,1:NRHS) := inv(R**T) * B(1:N,1:NRHS)
 *
diff --git a/SRC/slarfy.f b/SRC/slarfy.f
new file mode 100644
index 00000000..19a7fa6d
--- /dev/null
+++ b/SRC/slarfy.f
@@ -0,0 +1,161 @@
+*> \brief \b SLARFY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INCV, LDC, N
+*       REAL               TAU
+*       ..
+*       .. Array Arguments ..
+*       REAL               C( LDC, * ), V( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLARFY applies an elementary reflector, or Householder matrix, H,
+*> to an n x n symmetric matrix C, from both the left and the right.
+*>
+*> H is represented in the form
+*>
+*>    H = I - tau * v * v'
+*>
+*> where  tau  is a scalar and  v  is a vector.
+*>
+*> If  tau  is  zero, then  H  is taken to be the unit matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix C is stored.
+*>          = 'U':  Upper triangle
+*>          = 'L':  Lower triangle
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix C.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is REAL array, dimension
+*>                  (1 + (N-1)*abs(INCV))
+*>          The vector v as described above.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*>          INCV is INTEGER
+*>          The increment between successive elements of v.  INCV must
+*>          not be zero.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is REAL
+*>          The value tau as described above.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is REAL array, dimension (LDC, N)
+*>          On entry, the matrix C.
+*>          On exit, C is overwritten by H * C * H'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max( 1, N ).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (N)
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup single_eig
+*
+*  =====================================================================
+      SUBROUTINE SLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK )
+*
+*  -- LAPACK test routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INCV, LDC, N
+      REAL               TAU
+*     ..
+*     .. Array Arguments ..
+      REAL               C( LDC, * ), V( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO, HALF
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0, HALF = 0.5E+0 )
+*     ..
+*     .. Local Scalars ..
+      REAL               ALPHA
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SAXPY, SSYMV, SSYR2
+*     ..
+*     .. External Functions ..
+      REAL               SDOT
+      EXTERNAL           SDOT
+*     ..
+*     .. Executable Statements ..
+*
+      IF( TAU.EQ.ZERO )
+     $   RETURN
+*
+*     Form  w:= C * v
+*
+      CALL SSYMV( UPLO, N, ONE, C, LDC, V, INCV, ZERO, WORK, 1 )
+*
+      ALPHA = -HALF*TAU*SDOT( N, WORK, 1, V, INCV )
+      CALL SAXPY( N, ALPHA, V, INCV, WORK, 1 )
+*
+*     C := C - v * w' - w * v'
+*
+      CALL SSYR2( UPLO, N, -TAU, V, INCV, WORK, 1, C, LDC )
+*
+      RETURN
+*
+*     End of SLARFY
+*
+      END
diff --git a/SRC/slaswp.f b/SRC/slaswp.f
index 5ea247bc..f3a16ff9 100644
--- a/SRC/slaswp.f
+++ b/SRC/slaswp.f
@@ -71,15 +71,15 @@
 *> \param[in] K2
 *> \verbatim
 *>          K2 is INTEGER
-*>          The last element of IPIV for which a row interchange will
-*>          be done.
+*>          (K2-K1+1) is the number of elements of IPIV for which a row
+*>          interchange will be done.
 *> \endverbatim
 *>
 *> \param[in] IPIV
 *> \verbatim
-*>          IPIV is INTEGER array, dimension (K2*abs(INCX))
-*>          The vector of pivot indices.  Only the elements in positions
-*>          K1 through K2 of IPIV are accessed.
+*>          IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
+*>          The vector of pivot indices. Only the elements in positions
+*>          K1 through K1+(K2-K1)*INCX of IPIV are accessed.
 *>          IPIV(K) = L implies rows K and L are to be interchanged.
 *> \endverbatim
 *>
@@ -143,7 +143,7 @@
          I2 = K2
          INC = 1
       ELSE IF( INCX.LT.0 ) THEN
-         IX0 = 1 + ( 1-K2 )*INCX
+         IX0 = K1 + ( K1-K2 )*INCX
          I1 = K2
          I2 = K1
          INC = -1
diff --git a/SRC/slasyf_aa.f b/SRC/slasyf_aa.f
index 953d574d..3869f2a6 100644
--- a/SRC/slasyf_aa.f
+++ b/SRC/slasyf_aa.f
@@ -19,7 +19,7 @@
 *  ===========
 *
 *       SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-*                                H, LDH, WORK, INFO )
+*                             H, LDH, WORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
@@ -27,7 +27,7 @@
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * )
-*       REAL   A( LDA, * ), H( LDH, * ), WORK( * )
+*       REAL               A( LDA, * ), H( LDH, * ), WORK( * )
 *       ..
 *
 *
@@ -46,7 +46,7 @@
 *> which is used to factorize the first panel.
 *>
 *> The resulting J-th row of U, or J-th column of L, is stored in the
-*> (J-1)-th row, or column, of A (without the unit diatonals), while
+*> (J-1)-th row, or column, of A (without the unit diagonals), while
 *> the diagonal and subdiagonal of A are overwritten by those of T.
 *>
 *> \endverbatim
@@ -152,7 +152,7 @@
 *
 *  =====================================================================
       SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-     $                         H, LDH, WORK, INFO )
+     $                      H, LDH, WORK, INFO )
 *
 *  -- LAPACK computational routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -167,7 +167,7 @@
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * )
-      REAL   A( LDA, * ), H( LDH, * ), WORK( * )
+      REAL               A( LDA, * ), H( LDH, * ), WORK( * )
 *     ..
 *
 *  =====================================================================
@@ -177,7 +177,7 @@
 *
 *     .. Local Scalars ..
       INTEGER            J, K, K1, I1, I2
-      REAL   PIV, ALPHA
+      REAL               PIV, ALPHA
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
diff --git a/SRC/slasyf_rk.f b/SRC/slasyf_rk.f
new file mode 100644
index 00000000..d3c73f98
--- /dev/null
+++ b/SRC/slasyf_rk.f
@@ -0,0 +1,965 @@
+*> \brief \b SLASYF_RK computes a partial factorization of a real symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SLASYF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasyf_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasyf_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasyf_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, KB, LDA, LDW, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               A( LDA, * ), E( * ), W( LDW, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> SLASYF_RK computes a partial factorization of a real symmetric
+*> matrix A using the bounded Bunch-Kaufman (rook) diagonal
+*> pivoting method. The partial factorization has the form:
+*>
+*> A  =  ( I  U12 ) ( A11  0  ) (  I       0    )  if UPLO = 'U', or:
+*>       ( 0  U22 ) (  0   D  ) ( U12**T U22**T )
+*>
+*> A  =  ( L11  0 ) (  D   0  ) ( L11**T L21**T )  if UPLO = 'L',
+*>       ( L21  I ) (  0  A22 ) (  0       I    )
+*>
+*> where the order of D is at most NB. The actual order is returned in
+*> the argument KB, and is either NB or NB-1, or N if N <= NB.
+*>
+*> SLASYF_RK is an auxiliary routine called by SSYTRF_RK. It uses
+*> blocked code (calling Level 3 BLAS) to update the submatrix
+*> A11 (if UPLO = 'U') or A22 (if UPLO = 'L').
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The maximum number of columns of the matrix A that should be
+*>          factored.  NB should be at least 2 to allow for 2-by-2 pivot
+*>          blocks.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*>          KB is INTEGER
+*>          The number of columns of A that were actually factored.
+*>          KB is either NB-1 or NB, or N if N <= NB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is REAL array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,N-KB+1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,1:KB).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (LDW,NB)
+*> \endverbatim
+*>
+*> \param[in] LDW
+*> \verbatim
+*>          LDW is INTEGER
+*>          The leading dimension of the array W.  LDW >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup singleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, KB, LDA, LDW, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               A( LDA, * ), E( * ), W( LDW, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      REAL               EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            DONE
+      INTEGER            IMAX, ITEMP, J, JB, JJ, JMAX, K, KK, KW, KKW,
+     $                   KP, KSTEP, P, II
+      REAL               ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22,
+     $                   STEMP, R1, ROWMAX, T, SFMIN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ISAMAX
+      REAL               SLAMCH
+      EXTERNAL           LSAME, ISAMAX, SLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SGEMM, SGEMV, SSCAL, SSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = SLAMCH( 'S' )
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+*
+*        Factorize the trailing columns of A using the upper triangle
+*        of A and working backwards, and compute the matrix W = U12*D
+*        for use in updating A11
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = ZERO
+*
+*        K is the main loop index, decreasing from N in steps of 1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        KW is the column of W which corresponds to column K of A
+*
+         KW = NB + K - N
+*
+*        Exit from loop
+*
+         IF( ( K.LE.N-NB+1 .AND. NB.LT.N ) .OR. K.LT.1 )
+     $      GO TO 30
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column KW of W and update it
+*
+         CALL SCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 )
+         IF( K.LT.N )
+     $      CALL SGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ),
+     $                  LDA, W( K, KW+1 ), LDW, ONE, W( 1, KW ), 1 )
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( W( K, KW ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = ISAMAX( K-1, W( 1, KW ), 1 )
+            COLMAX = ABS( W( IMAX, KW ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            CALL SCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = ZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           Test for interchange
+*
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   12          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*
+*                 Copy column IMAX to column KW-1 of W and update it
+*
+                  CALL SCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 )
+                  CALL SCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA,
+     $                        W( IMAX+1, KW-1 ), 1 )
+*
+                  IF( K.LT.N )
+     $               CALL SGEMV( 'No transpose', K, N-K, -ONE,
+     $                           A( 1, K+1 ), LDA, W( IMAX, KW+1 ), LDW,
+     $                           ONE, W( 1, KW-1 ), 1 )
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + ISAMAX( K-IMAX, W( IMAX+1, KW-1 ),
+     $                                     1 )
+                     ROWMAX = ABS( W( JMAX, KW-1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = ISAMAX( IMAX-1, W( 1, KW-1 ), 1 )
+                     STEMP = ABS( W( ITEMP, KW-1 ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for
+*                 ABS( W( IMAX, KW-1 ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.(ABS( W( IMAX, KW-1 ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column KW-1 of W to column KW of W
+*
+                     CALL SCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K-1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL SCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 12
+*
+            END IF
+*
+*           ============================================================
+*
+            KK = K - KSTEP + 1
+*
+*           KKW is the column of W which corresponds to column KK of A
+*
+            KKW = NB + KK - N
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column K to column P
+*
+               CALL SCOPY( K-P, A( P+1, K ), 1, A( P, P+1 ), LDA )
+               CALL SCOPY( P, A( 1, K ), 1, A( 1, P ), 1 )
+*
+*              Interchange rows K and P in last N-K+1 columns of A
+*              and last N-K+2 columns of W
+*
+               CALL SSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA )
+               CALL SSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW )
+            END IF
+*
+*           Updated column KP is already stored in column KKW of W
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP
+*
+               A( KP, K ) = A( KK, K )
+               CALL SCOPY( K-1-KP, A( KP+1, KK ), 1, A( KP, KP+1 ),
+     $                     LDA )
+               CALL SCOPY( KP, A( 1, KK ), 1, A( 1, KP ), 1 )
+*
+*              Interchange rows KK and KP in last N-KK+1 columns
+*              of A and W
+*
+               CALL SSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA )
+               CALL SSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ),
+     $                     LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column KW of W now holds
+*
+*              W(k) = U(k)*D(k)
+*
+*              where U(k) is the k-th column of U
+*
+*              Store U(k) in column k of A
+*
+               CALL SCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
+               IF( K.GT.1 ) THEN
+                  IF( ABS( A( K, K ) ).GE.SFMIN ) THEN
+                     R1 = ONE / A( K, K )
+                     CALL SSCAL( K-1, R1, A( 1, K ), 1 )
+                  ELSE IF( A( K, K ).NE.ZERO ) THEN
+                     DO 14 II = 1, K - 1
+                        A( II, K ) = A( II, K ) / A( K, K )
+   14                CONTINUE
+                  END IF
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = ZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns KW and KW-1 of W now
+*              hold
+*
+*              ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+               IF( K.GT.2 ) THEN
+*
+*                 Store U(k) and U(k-1) in columns k and k-1 of A
+*
+                  D12 = W( K-1, KW )
+                  D11 = W( K, KW ) / D12
+                  D22 = W( K-1, KW-1 ) / D12
+                  T = ONE / ( D11*D22-ONE )
+                  DO 20 J = 1, K - 2
+                     A( J, K-1 ) = T*( (D11*W( J, KW-1 )-W( J, KW ) ) /
+     $                             D12 )
+                     A( J, K ) = T*( ( D22*W( J, KW )-W( J, KW-1 ) ) /
+     $                           D12 )
+   20             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy superdiagonal element of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               A( K-1, K-1 ) = W( K-1, KW-1 )
+               A( K-1, K ) = ZERO
+               A( K, K ) = W( K, KW )
+               E( K ) = W( K-1, KW )
+               E( K-1 ) = ZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   30    CONTINUE
+*
+*        Update the upper triangle of A11 (= A(1:k,1:k)) as
+*
+*        A11 := A11 - U12*D*U12**T = A11 - U12*W**T
+*
+*        computing blocks of NB columns at a time
+*
+         DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB
+            JB = MIN( NB, K-J+1 )
+*
+*           Update the upper triangle of the diagonal block
+*
+            DO 40 JJ = J, J + JB - 1
+               CALL SGEMV( 'No transpose', JJ-J+1, N-K, -ONE,
+     $                     A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, ONE,
+     $                     A( J, JJ ), 1 )
+   40       CONTINUE
+*
+*           Update the rectangular superdiagonal block
+*
+            IF( J.GE.2 )
+     $         CALL SGEMM( 'No transpose', 'Transpose', J-1, JB,
+     $                  N-K, -ONE, A( 1, K+1 ), LDA, W( J, KW+1 ),
+     $                  LDW, ONE, A( 1, J ), LDA )
+   50    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = N - K
+*
+      ELSE
+*
+*        Factorize the leading columns of A using the lower triangle
+*        of A and working forwards, and compute the matrix W = L21*D
+*        for use in updating A22
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = ZERO
+*
+*        K is the main loop index, increasing from 1 in steps of 1 or 2
+*
+         K = 1
+   70   CONTINUE
+*
+*        Exit from loop
+*
+         IF( ( K.GE.NB .AND. NB.LT.N ) .OR. K.GT.N )
+     $      GO TO 90
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column K of W and update it
+*
+         CALL SCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 )
+         IF( K.GT.1 )
+     $      CALL SGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ),
+     $                  LDA, W( K, 1 ), LDW, ONE, W( K, K ), 1 )
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( W( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + ISAMAX( N-K, W( K+1, K ), 1 )
+            COLMAX = ABS( W( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            CALL SCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = ZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           Test for interchange
+*
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   72          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*
+*                 Copy column IMAX to column K+1 of W and update it
+*
+                  CALL SCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1)
+                  CALL SCOPY( N-IMAX+1, A( IMAX, IMAX ), 1,
+     $                        W( IMAX, K+1 ), 1 )
+                  IF( K.GT.1 )
+     $               CALL SGEMV( 'No transpose', N-K+1, K-1, -ONE,
+     $                           A( K, 1 ), LDA, W( IMAX, 1 ), LDW,
+     $                           ONE, W( K, K+1 ), 1 )
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + ISAMAX( IMAX-K, W( K, K+1 ), 1 )
+                     ROWMAX = ABS( W( JMAX, K+1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + ISAMAX( N-IMAX, W( IMAX+1, K+1 ), 1)
+                     STEMP = ABS( W( ITEMP, K+1 ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for
+*                 ABS( W( IMAX, K+1 ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( ABS( W( IMAX, K+1 ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column K+1 of W to column K of W
+*
+                     CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 72
+*
+            END IF
+*
+*           ============================================================
+*
+            KK = K + KSTEP - 1
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column K to column P
+*
+               CALL SCOPY( P-K, A( K, K ), 1, A( P, K ), LDA )
+               CALL SCOPY( N-P+1, A( P, K ), 1, A( P, P ), 1 )
+*
+*              Interchange rows K and P in first K columns of A
+*              and first K+1 columns of W
+*
+               CALL SSWAP( K, A( K, 1 ), LDA, A( P, 1 ), LDA )
+               CALL SSWAP( KK, W( K, 1 ), LDW, W( P, 1 ), LDW )
+            END IF
+*
+*           Updated column KP is already stored in column KK of W
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP
+*
+               A( KP, K ) = A( KK, K )
+               CALL SCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA )
+               CALL SCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 )
+*
+*              Interchange rows KK and KP in first KK columns of A and W
+*
+               CALL SSWAP( KK, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+               CALL SSWAP( KK, W( KK, 1 ), LDW, W( KP, 1 ), LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k of W now holds
+*
+*              W(k) = L(k)*D(k)
+*
+*              where L(k) is the k-th column of L
+*
+*              Store L(k) in column k of A
+*
+               CALL SCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
+               IF( K.LT.N ) THEN
+                  IF( ABS( A( K, K ) ).GE.SFMIN ) THEN
+                     R1 = ONE / A( K, K )
+                     CALL SSCAL( N-K, R1, A( K+1, K ), 1 )
+                  ELSE IF( A( K, K ).NE.ZERO ) THEN
+                     DO 74 II = K + 1, N
+                        A( II, K ) = A( II, K ) / A( K, K )
+   74                CONTINUE
+                  END IF
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = ZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 of W now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+               IF( K.LT.N-1 ) THEN
+*
+*                 Store L(k) and L(k+1) in columns k and k+1 of A
+*
+                  D21 = W( K+1, K )
+                  D11 = W( K+1, K+1 ) / D21
+                  D22 = W( K, K ) / D21
+                  T = ONE / ( D11*D22-ONE )
+                  DO 80 J = K + 2, N
+                     A( J, K ) = T*( ( D11*W( J, K )-W( J, K+1 ) ) /
+     $                           D21 )
+                     A( J, K+1 ) = T*( ( D22*W( J, K+1 )-W( J, K ) ) /
+     $                             D21 )
+   80             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy subdiagonal element of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               A( K, K ) = W( K, K )
+               A( K+1, K ) = ZERO
+               A( K+1, K+1 ) = W( K+1, K+1 )
+               E( K ) = W( K+1, K )
+               E( K+1 ) = ZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 70
+*
+   90    CONTINUE
+*
+*        Update the lower triangle of A22 (= A(k:n,k:n)) as
+*
+*        A22 := A22 - L21*D*L21**T = A22 - L21*W**T
+*
+*        computing blocks of NB columns at a time
+*
+         DO 110 J = K, N, NB
+            JB = MIN( NB, N-J+1 )
+*
+*           Update the lower triangle of the diagonal block
+*
+            DO 100 JJ = J, J + JB - 1
+               CALL SGEMV( 'No transpose', J+JB-JJ, K-1, -ONE,
+     $                     A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, ONE,
+     $                     A( JJ, JJ ), 1 )
+  100       CONTINUE
+*
+*           Update the rectangular subdiagonal block
+*
+            IF( J+JB.LE.N )
+     $         CALL SGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
+     $                     K-1, -ONE, A( J+JB, 1 ), LDA, W( J, 1 ),
+     $                     LDW, ONE, A( J+JB, J ), LDA )
+  110    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = K - 1
+*
+      END IF
+*
+      RETURN
+*
+*     End of SLASYF_RK
+*
+      END
diff --git a/SRC/ssb2st_kernels.f b/SRC/ssb2st_kernels.f
new file mode 100644
index 00000000..60058dda
--- /dev/null
+++ b/SRC/ssb2st_kernels.f
@@ -0,0 +1,320 @@
+*> \brief \b SSB2ST_KERNELS
+*
+*  @generated from zhb2st_kernels.f, fortran z -> s, Sun Nov  6 19:34:06 2016
+*      
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SSB2ST_KERNELS + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssb2st_kernels.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssb2st_kernels.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssb2st_kernels.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE  SSB2ST_KERNELS( UPLO, WANTZ, TTYPE, 
+*                                   ST, ED, SWEEP, N, NB, IB,
+*                                   A, LDA, V, TAU, LDVT, WORK)
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       LOGICAL            WANTZ
+*       INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), V( * ), 
+*                          TAU( * ), WORK( * )
+*  
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSB2ST_KERNELS is an internal routine used by the SSYTRD_SB2ST
+*> subroutine.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> @param[in] n
+*>          The order of the matrix A.
+*>
+*> @param[in] nb
+*>          The size of the band.
+*>
+*> @param[in, out] A
+*>          A pointer to the matrix A.
+*>
+*> @param[in] lda
+*>          The leading dimension of the matrix A.
+*>
+*> @param[out] V
+*>          REAL array, dimension 2*n if eigenvalues only are
+*>          requested or to be queried for vectors.
+*>
+*> @param[out] TAU
+*>          REAL array, dimension (2*n).
+*>          The scalar factors of the Householder reflectors are stored
+*>          in this array.
+*>
+*> @param[in] st
+*>          internal parameter for indices.
+*>
+*> @param[in] ed
+*>          internal parameter for indices.
+*>
+*> @param[in] sweep
+*>          internal parameter for indices.
+*>
+*> @param[in] Vblksiz
+*>          internal parameter for indices.
+*>
+*> @param[in] wantz
+*>          logical which indicate if Eigenvalue are requested or both
+*>          Eigenvalue/Eigenvectors.
+*>
+*> @param[in] work
+*>          Workspace of size nb.
+*>
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE  SSB2ST_KERNELS( UPLO, WANTZ, TTYPE, 
+     $                            ST, ED, SWEEP, N, NB, IB,
+     $                            A, LDA, V, TAU, LDVT, WORK)
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      LOGICAL            WANTZ
+      INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), V( * ), 
+     $                   TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0,
+     $                   ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, J1, J2, LM, LN, VPOS, TAUPOS,
+     $                   DPOS, OFDPOS, AJETER 
+      REAL               CTMP 
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLARFG, SLARFX, SLARFY
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MOD
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     ..
+*     .. Executable Statements ..
+*      
+      AJETER = IB + LDVT
+      UPPER = LSAME( UPLO, 'U' )
+
+      IF( UPPER ) THEN
+          DPOS    = 2 * NB + 1
+          OFDPOS  = 2 * NB
+      ELSE
+          DPOS    = 1
+          OFDPOS  = 2
+      ENDIF
+
+*
+*     Upper case
+*  
+      IF( UPPER ) THEN
+*      
+          IF( WANTZ ) THEN
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ELSE
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ENDIF
+          GO TO ( 101, 102, 103 ) TTYPE
+*
+  101     CONTINUE
+          LM = ED - ST + 1
+*
+          V( VPOS ) = ONE
+          DO 10 I = 1, LM-1
+              V( VPOS+I )         = ( A( OFDPOS-I, ST+I ) )
+              A( OFDPOS-I, ST+I ) = ZERO  
+   10     CONTINUE
+          CTMP = ( A( OFDPOS, ST ) )
+          CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, 
+     $                                   TAU( TAUPOS ) )
+          A( OFDPOS, ST ) = CTMP
+* 
+  103     CONTINUE
+          LM = ED - ST + 1
+          CALL SLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ),
+     $                             A( DPOS, ST ), LDA-1, WORK)
+          GOTO 300
+*
+  102     CONTINUE
+          J1 = ED+1
+          J2 = MIN( ED+NB, N )
+          LN = ED-ST+1
+          LM = J2-J1+1
+          IF( LM.GT.0) THEN
+              CALL SLARFX( 'Left', LN, LM, V( VPOS ),
+     $                     ( TAU( TAUPOS ) ), A( DPOS-NB, J1 ),
+     $                     LDA-1, WORK)
+*
+              IF( WANTZ ) THEN
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ELSE
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ENDIF
+*
+              V( VPOS ) = ONE
+              DO 30 I = 1, LM-1
+                  V( VPOS+I )          = ( A( DPOS-NB-I, J1+I ) )
+                  A( DPOS-NB-I, J1+I ) = ZERO
+   30         CONTINUE
+              CTMP = ( A( DPOS-NB, J1 ) )
+              CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) )
+              A( DPOS-NB, J1 ) = CTMP
+*             
+              CALL SLARFX( 'Right', LN-1, LM, V( VPOS ), 
+     $                     TAU( TAUPOS ),
+     $                     A( DPOS-NB+1, J1 ), LDA-1, WORK)
+          ENDIF
+          GOTO 300
+*
+*     Lower case
+*  
+      ELSE
+*      
+          IF( WANTZ ) THEN
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ELSE
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ENDIF
+          GO TO ( 201, 202, 203 ) TTYPE
+*  
+  201     CONTINUE
+          LM = ED - ST + 1
+*
+          V( VPOS ) = ONE
+          DO 20 I = 1, LM-1
+              V( VPOS+I )         = A( OFDPOS+I, ST-1 )
+              A( OFDPOS+I, ST-1 ) = ZERO  
+   20     CONTINUE
+          CALL SLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, 
+     $                                   TAU( TAUPOS ) )
+*
+  203     CONTINUE
+          LM = ED - ST + 1
+*
+          CALL SLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ),
+     $                                      A( DPOS, ST ), LDA-1, WORK)
+
+          GOTO 300
+*
+  202     CONTINUE
+          J1 = ED+1
+          J2 = MIN( ED+NB, N )
+          LN = ED-ST+1
+          LM = J2-J1+1
+*
+          IF( LM.GT.0) THEN
+              CALL SLARFX( 'Right', LM, LN, V( VPOS ), 
+     $                     TAU( TAUPOS ), A( DPOS+NB, ST ),
+     $                     LDA-1, WORK)
+*
+              IF( WANTZ ) THEN
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ELSE
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ENDIF
+*              
+              V( VPOS ) = ONE
+              DO 40 I = 1, LM-1
+                  V( VPOS+I )        = A( DPOS+NB+I, ST )
+                  A( DPOS+NB+I, ST ) = ZERO
+   40         CONTINUE
+              CALL SLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, 
+     $                                    TAU( TAUPOS ) )
+*                  
+              CALL SLARFX( 'Left', LM, LN-1, V( VPOS ), 
+     $                     ( TAU( TAUPOS ) ),
+     $                     A( DPOS+NB-1, ST+1 ), LDA-1, WORK)
+
+          ENDIF
+          GOTO 300
+      ENDIF
+
+  300 CONTINUE    
+      RETURN
+*
+*     END OF SSB2ST_KERNELS
+*
+      END      
diff --git a/SRC/ssbev_2stage.f b/SRC/ssbev_2stage.f
new file mode 100644
index 00000000..821c00a3
--- /dev/null
+++ b/SRC/ssbev_2stage.f
@@ -0,0 +1,377 @@
+*> \brief <b> SSBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @generated from dsbev_2stage.f, fortran d -> s, Sat Nov  5 23:58:09 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSBEV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbev_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbev_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbev_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+*                                WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, KD, LDAB, LDZ, N, LWORK
+*       ..
+*       .. Array Arguments ..
+*       REAL               AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSBEV_2STAGE computes all the eigenvalues and, optionally, eigenvectors of
+*> a real symmetric band matrix A using the 2stage technique for
+*> the reduction to tridiagonal.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is REAL array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the symmetric band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.  If UPLO = 'U', the first
+*>          superdiagonal and the diagonal of the tridiagonal matrix T
+*>          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+*>          the diagonal and first subdiagonal of T are returned in the
+*>          first two rows of AB.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is REAL array, dimension (LDZ, N)
+*>          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+*>          eigenvectors of the matrix A, with the i-th column of Z
+*>          holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension LWORK
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS + N
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup realOTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+     $                         WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, KD, LDAB, LDZ, N, LWORK
+*     ..
+*     .. Array Arguments ..
+      REAL               AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, WANTZ, LQUERY
+      INTEGER            IINFO, IMAX, INDE, INDWRK, ISCALE,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, IB, INDHOUS
+      REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLANSB
+      EXTERNAL           LSAME, SLAMCH, SLANSB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLASCL, SSCAL, SSTEQR, SSTERF, XERBLA
+     $                   SSYTRD_SB2ST 
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -6
+      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+         INFO = -9
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            IB    = ILAENV( 18, 'SSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+            LWMIN = N + LHTRD + LWTRD
+            WORK( 1 )  = LWMIN
+         ENDIF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -11
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSBEV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            W( 1 ) = AB( 1, 1 )
+         ELSE
+            W( 1 ) = AB( KD+1, 1 )
+         END IF
+         IF( WANTZ )
+     $      Z( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = SLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+      END IF
+*
+*     Call SSYTRD_SB2ST to reduce symmetric band matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDHOUS = INDE + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL SSYTRD_SB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, W,
+     $                    WORK( INDE ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call SSTERF.  For eigenvectors, call SSTEQR.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL SSTERF( N, W, WORK( INDE ), INFO )
+      ELSE
+         CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ),
+     $                INFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of SSBEV_2STAGE
+*
+      END
diff --git a/SRC/ssbevd_2stage.f b/SRC/ssbevd_2stage.f
new file mode 100644
index 00000000..8a306306
--- /dev/null
+++ b/SRC/ssbevd_2stage.f
@@ -0,0 +1,412 @@
+*> \brief <b> SSBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @generated from dsbevd_2stage.f, fortran d -> s, Sat Nov  5 23:58:03 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSBEVD_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbevd_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbevd_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbevd_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+*                                 WORK, LWORK, IWORK, LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IWORK( * )
+*       REAL               AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSBEVD_2STAGE computes all the eigenvalues and, optionally, eigenvectors of
+*> a real symmetric band matrix A using the 2stage technique for
+*> the reduction to tridiagonal. If eigenvectors are desired, it uses
+*> a divide and conquer algorithm.
+*>
+*> The divide and conquer algorithm makes very mild assumptions about
+*> floating point arithmetic. It will work on machines with a guard
+*> digit in add/subtract, or on those binary machines without guard
+*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
+*> without guard digits, but we know of none.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is REAL array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the symmetric band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.  If UPLO = 'U', the first
+*>          superdiagonal and the diagonal of the tridiagonal matrix T
+*>          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+*>          the diagonal and first subdiagonal of T are returned in the
+*>          first two rows of AB.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is REAL array, dimension (LDZ, N)
+*>          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+*>          eigenvectors of the matrix A, with the i-th column of Z
+*>          holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension LWORK
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS + N
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK and IWORK
+*>          arrays, returns these values as the first entries of the WORK
+*>          and IWORK arrays, and no error message related to LWORK or
+*>          LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of the array IWORK.
+*>          If JOBZ  = 'N' or N <= 1, LIWORK must be at least 1.
+*>          If JOBZ  = 'V' and N > 2, LIWORK must be at least 3 + 5*N.
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK and IWORK arrays, and no error message related to
+*>          LWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup realOTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+     $                          WORK, LWORK, IWORK, LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IWORK( * )
+      REAL               AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, INDE, INDWK2, INDWRK, ISCALE, LIWMIN,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, IB, INDHOUS,
+     $                   LLWRK2
+      REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLANSB
+      EXTERNAL           LSAME, SLAMCH, SLANSB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SGEMM, SLACPY, SLASCL, SSCAL, SSTEDC,
+     $                   SSTERF, XERBLA, SSYTRD_SB2ST
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( N.LE.1 ) THEN
+         LIWMIN = 1
+         LWMIN = 1
+      ELSE
+         IB    = ILAENV( 18, 'SSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+         IF( WANTZ ) THEN
+            LIWMIN = 3 + 5*N
+            LWMIN = 1 + 5*N + 2*N**2
+         ELSE
+            LIWMIN = 1
+            LWMIN = MAX( 2*N, N+LHTRD+LWTRD )
+         END IF
+      END IF
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -6
+      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+         INFO = -9
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         WORK( 1 )  = LWMIN
+         IWORK( 1 ) = LIWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -11
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -13
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSBEVD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = AB( 1, 1 )
+         IF( WANTZ )
+     $      Z( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = SLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+      END IF
+*
+*     Call SSYTRD_SB2ST to reduce band symmetric matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDHOUS = INDE + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+      INDWK2  = INDWRK + N*N
+      LLWRK2  = LWORK - INDWK2 + 1
+*
+      CALL SSYTRD_SB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, W,
+     $                    WORK( INDE ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call SSTERF.  For eigenvectors, call SSTEDC.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL SSTERF( N, W, WORK( INDE ), INFO )
+      ELSE
+         CALL SSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
+     $                WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
+         CALL SGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N,
+     $               ZERO, WORK( INDWK2 ), N )
+         CALL SLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 )
+     $   CALL SSCAL( N, ONE / SIGMA, W, 1 )
+*
+      WORK( 1 ) = LWMIN
+      IWORK( 1 ) = LIWMIN
+      RETURN
+*
+*     End of SSBEVD_2STAGE
+*
+      END
diff --git a/SRC/ssbevx_2stage.f b/SRC/ssbevx_2stage.f
new file mode 100644
index 00000000..d3a588c4
--- /dev/null
+++ b/SRC/ssbevx_2stage.f
@@ -0,0 +1,633 @@
+*> \brief <b> SSBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @generated from dsbevx_2stage.f, fortran d -> s, Sat Nov  5 23:58:06 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSBEVX_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssbevx_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssbevx_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssbevx_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q,
+*                                 LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
+*                                 LDZ, WORK, LWORK, IWORK, IFAIL, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
+*       REAL               ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IFAIL( * ), IWORK( * )
+*       REAL               AB( LDAB, * ), Q( LDQ, * ), W( * ), WORK( * ),
+*      $                   Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSBEVX_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a real symmetric band matrix A using the 2stage technique for
+*> the reduction to tridiagonal. Eigenvalues and eigenvectors can
+*> be selected by specifying either a range of values or a range of
+*> indices for the desired eigenvalues.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found;
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found;
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is REAL array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the symmetric band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.  If UPLO = 'U', the first
+*>          superdiagonal and the diagonal of the tridiagonal matrix T
+*>          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+*>          the diagonal and first subdiagonal of T are returned in the
+*>          first two rows of AB.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] Q
+*> \verbatim
+*>          Q is REAL array, dimension (LDQ, N)
+*>          If JOBZ = 'V', the N-by-N orthogonal matrix used in the
+*>                         reduction to tridiagonal form.
+*>          If JOBZ = 'N', the array Q is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDQ
+*> \verbatim
+*>          LDQ is INTEGER
+*>          The leading dimension of the array Q.  If JOBZ = 'V', then
+*>          LDQ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is REAL
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is REAL
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is REAL
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing AB to tridiagonal form.
+*>
+*>          Eigenvalues will be computed most accurately when ABSTOL is
+*>          set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+*>          If this routine returns with INFO>0, indicating that some
+*>          eigenvectors did not converge, try setting ABSTOL to
+*>          2*SLAMCH('S').
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          The first M elements contain the selected eigenvalues in
+*>          ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is REAL array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If an eigenvector fails to converge, then that column of Z
+*>          contains the latest approximation to the eigenvector, and the
+*>          index of the eigenvector is returned in IFAIL.
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (LWORK)
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, 7*N, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS + 2*N
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (5*N)
+*> \endverbatim
+*>
+*> \param[out] IFAIL
+*> \verbatim
+*>          IFAIL is INTEGER array, dimension (N)
+*>          If JOBZ = 'V', then if INFO = 0, the first M elements of
+*>          IFAIL are zero.  If INFO > 0, then IFAIL contains the
+*>          indices of the eigenvectors that failed to converge.
+*>          If JOBZ = 'N', then IFAIL is not referenced.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit.
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value.
+*>          > 0:  if INFO = i, then i eigenvectors failed to converge.
+*>                Their indices are stored in array IFAIL.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup realOTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q,
+     $                          LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
+     $                          LDZ, WORK, LWORK, IWORK, IFAIL, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
+      REAL               ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IFAIL( * ), IWORK( * )
+      REAL               AB( LDAB, * ), Q( LDQ, * ), W( * ), WORK( * ),
+     $                   Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ,
+     $                   LQUERY
+      CHARACTER          ORDER
+      INTEGER            I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
+     $                   INDISP, INDIWO, INDWRK, ISCALE, ITMP1, J, JJ,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, IB, INDHOUS,
+     $                   NSPLIT
+      REAL               ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLANSB
+      EXTERNAL           LSAME, SLAMCH, SLANSB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SGEMV, SLACPY, SLASCL, SSCAL,
+     $                   SSTEBZ, SSTEIN, SSTEQR, SSTERF, SSWAP, XERBLA,
+     $                   SSYTRD_SB2ST
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -7
+      ELSE IF( WANTZ .AND. LDQ.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -11
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -12
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -13
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) )
+     $      INFO = -18
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            IB    = ILAENV( 18, 'SSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+            LWMIN = 2*N + LHTRD + LWTRD
+            WORK( 1 )  = LWMIN
+         ENDIF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -20
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSBEVX_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         M = 1
+         IF( LOWER ) THEN
+            TMP1 = AB( 1, 1 )
+         ELSE
+            TMP1 = AB( KD+1, 1 )
+         END IF
+         IF( VALEIG ) THEN
+            IF( .NOT.( VL.LT.TMP1 .AND. VU.GE.TMP1 ) )
+     $         M = 0
+         END IF
+         IF( M.EQ.1 ) THEN
+            W( 1 ) = TMP1
+            IF( WANTZ )
+     $         Z( 1, 1 ) = ONE
+         END IF
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF( VALEIG ) THEN
+         VLL = VL
+         VUU = VU
+      ELSE
+         VLL = ZERO
+         VUU = ZERO
+      END IF
+      ANRM = SLANSB( 'M', UPLO, N, KD, AB, LDAB, WORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+*
+*     Call SSYTRD_SB2ST to reduce symmetric band matrix to tridiagonal form.
+*
+      INDD    = 1
+      INDE    = INDD + N
+      INDHOUS = INDE + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL SSYTRD_SB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, WORK( INDD ),
+     $                    WORK( INDE ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     If all eigenvalues are desired and ABSTOL is less than or equal
+*     to zero, then call SSTERF or SSTEQR.  If this fails for some
+*     eigenvalue, then try SSTEBZ.
+*
+      TEST = .FALSE.
+      IF (INDEIG) THEN
+         IF (IL.EQ.1 .AND. IU.EQ.N) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF ((ALLEIG .OR. TEST) .AND. (ABSTOL.LE.ZERO)) THEN
+         CALL SCOPY( N, WORK( INDD ), 1, W, 1 )
+         INDEE = INDWRK + 2*N
+         IF( .NOT.WANTZ ) THEN
+            CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL SSTERF( N, W, WORK( INDEE ), INFO )
+         ELSE
+            CALL SLACPY( 'A', N, N, Q, LDQ, Z, LDZ )
+            CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL SSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
+     $                   WORK( INDWRK ), INFO )
+            IF( INFO.EQ.0 ) THEN
+               DO 10 I = 1, N
+                  IFAIL( I ) = 0
+   10          CONTINUE
+            END IF
+         END IF
+         IF( INFO.EQ.0 ) THEN
+            M = N
+            GO TO 30
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+      INDIBL = 1
+      INDISP = INDIBL + N
+      INDIWO = INDISP + N
+      CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
+     $             IWORK( INDIWO ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
+*
+*        Apply orthogonal matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by SSTEIN.
+*
+         DO 20 J = 1, M
+            CALL SCOPY( N, Z( 1, J ), 1, WORK( 1 ), 1 )
+            CALL SGEMV( 'N', N, N, ONE, Q, LDQ, WORK, 1, ZERO,
+     $                  Z( 1, J ), 1 )
+   20    CONTINUE
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+   30 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.
+*
+      IF( WANTZ ) THEN
+         DO 50 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 40 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   40       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               ITMP1 = IWORK( INDIBL+I-1 )
+               W( I ) = W( J )
+               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
+               W( J ) = TMP1
+               IWORK( INDIBL+J-1 ) = ITMP1
+               CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+               IF( INFO.NE.0 ) THEN
+                  ITMP1 = IFAIL( I )
+                  IFAIL( I ) = IFAIL( J )
+                  IFAIL( J ) = ITMP1
+               END IF
+            END IF
+   50    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of SSBEVX_2STAGE
+*
+      END
diff --git a/SRC/ssycon_3.f b/SRC/ssycon_3.f
new file mode 100644
index 00000000..b337add2
--- /dev/null
+++ b/SRC/ssycon_3.f
@@ -0,0 +1,285 @@
+*> \brief \b SSYCON_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYCON_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssycon_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssycon_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssycon_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+*                            WORK, IWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       REAL               ANORM, RCOND
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * ), IWORK( * )
+*       REAL               A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> SSYCON_3 estimates the reciprocal of the condition number (in the
+*> 1-norm) of a real symmetric matrix A using the factorization
+*> computed by DSYTRF_RK or DSYTRF_BK:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
+*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+*> This routine uses BLAS3 solver SSYTRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**T)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**T)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by SSYTRF_RK and SSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is REAL array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by SSYTRF_RK or SSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[in] ANORM
+*> \verbatim
+*>          ANORM is REAL
+*>          The 1-norm of the original matrix A.
+*> \endverbatim
+*>
+*> \param[out] RCOND
+*> \verbatim
+*>          RCOND is REAL
+*>          The reciprocal of the condition number of the matrix A,
+*>          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+*>          estimate of the 1-norm of inv(A) computed in this routine.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (2*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup singleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+     $                     WORK, IWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+      REAL               ANORM, RCOND
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * ), IWORK( * )
+      REAL               A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, KASE
+      REAL               AINVNM
+*     ..
+*     .. Local Arrays ..
+      INTEGER            ISAVE( 3 )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLACN2, SSYTRS_3, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( ANORM.LT.ZERO ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYCON_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      RCOND = ZERO
+      IF( N.EQ.0 ) THEN
+         RCOND = ONE
+         RETURN
+      ELSE IF( ANORM.LE.ZERO ) THEN
+         RETURN
+      END IF
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO I = N, 1, -1
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO I = 1, N
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+*     Estimate the 1-norm of the inverse.
+*
+      KASE = 0
+   30 CONTINUE
+      CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
+      IF( KASE.NE.0 ) THEN
+*
+*        Multiply by inv(L*D*L**T) or inv(U*D*U**T).
+*
+         CALL SSYTRS_3( UPLO, N, 1, A, LDA, E, IPIV, WORK, N, INFO )
+         GO TO 30
+      END IF
+*
+*     Compute the estimate of the reciprocal condition number.
+*
+      IF( AINVNM.NE.ZERO )
+     $   RCOND = ( ONE / AINVNM ) / ANORM
+*
+      RETURN
+*
+*     End of DSYCON_3
+*
+      END
diff --git a/SRC/ssyconvf.f b/SRC/ssyconvf.f
new file mode 100644
index 00000000..cf971824
--- /dev/null
+++ b/SRC/ssyconvf.f
@@ -0,0 +1,559 @@
+*> \brief \b SSYCONVF
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYCONVF + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyconvf.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyconvf.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyconvf.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYCONVF( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO, WAY
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               A( LDA, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> If parameter WAY = 'C':
+*> SSYCONVF converts the factorization output format used in
+*> SSYTRF provided on entry in parameter A into the factorization
+*> output format used in SSYTRF_RK (or SSYTRF_BK) that is stored
+*> on exit in parameters A and E. It also coverts in place details of
+*> the intechanges stored in IPIV from the format used in SSYTRF into
+*> the format used in SSYTRF_RK (or SSYTRF_BK).
+*>
+*> If parameter WAY = 'R':
+*> SSYCONVF performs the conversion in reverse direction, i.e.
+*> converts the factorization output format used in SSYTRF_RK
+*> (or SSYTRF_BK) provided on entry in parametes A and E into
+*> the factorization output format used in SSYTRF that is stored
+*> on exit in parameter A. It also coverts in place details of
+*> the intechanges stored in IPIV from the format used in SSYTRF_RK
+*> (or SSYTRF_BK) into the format used in SSYTRF.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix A.
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] WAY
+*> \verbatim
+*>          WAY is CHARACTER*1
+*>          = 'C': Convert
+*>          = 'R': Revert
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, contains factorization details in format used in
+*>          SSYTRF:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          SSYTRF_RK or SSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains factorization details in format used in
+*>          SSYTRF_RK or SSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          SSYTRF:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] E
+*> \verbatim
+*>          E is REAL array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, just a workspace.
+*>
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          On exit, is not changed
+*> \endverbatim
+*.
+*> \param[in,out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>          On entry, details of the interchanges and the block
+*>          structure of D in the format used in SSYTRF.
+*>          On exit, details of the interchanges and the block
+*>          structure of D in the format used in SSYTRF_RK
+*>          ( or SSYTRF_BK).
+*>
+*>          1) If WAY ='R':
+*>          On entry, details of the interchanges and the block
+*>          structure of D in the format used in SSYTRF_RK
+*>          ( or SSYTRF_BK).
+*>          On exit, details of the interchanges and the block
+*>          structure of D in the format used in SSYTRF.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup singleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*  =====================================================================
+      SUBROUTINE SSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO, WAY
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0E+0 )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*
+*     .. External Subroutines ..
+      EXTERNAL           SSWAP, XERBLA
+*     .. Local Scalars ..
+      LOGICAL            UPPER, CONVERT
+      INTEGER            I, IP
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      CONVERT = LSAME( WAY, 'C' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYCONVF', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin A is UPPER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is upper)
+*
+*
+*           Convert VALUE
+*
+*           Assign superdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = N
+            E( 1 ) = ZERO
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  E( I ) = A( I-1, I )
+                  E( I-1 ) = ZERO
+                  A( I-1, I ) = ZERO
+                  I = I - 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I - 1
+            END DO
+*
+*           Convert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = -IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.(I-1) ) THEN
+                        CALL SSWAP( N-I, A( I-1, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is no interchnge of rows i and and IPIV(i),
+*                 so this should be reflected in IPIV format for
+*                 *SYTRF_RK ( or *SYTRF_BK)
+*
+                  IPIV( I ) = I
+*
+                  I = I - 1
+*
+               END IF
+               I = I - 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is upper)
+*
+*
+*           Revert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in reverse factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
+*
+                  I = I + 1
+                  IP = -IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.(I-1) ) THEN
+                        CALL SSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I-1, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is one interchange of rows i-1 and IPIV(i-1),
+*                 so this should be recorded in two consecutive entries
+*                 in IPIV format for *SYTRF
+*
+                  IPIV( I ) = IPIV( I-1 )
+*
+               END IF
+               I = I + 1
+            END DO
+*
+*           Revert VALUE
+*           Assign superdiagonal entries of D from array E to
+*           superdiagonal entries of A.
+*
+            I = N
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I-1, I ) = E( I )
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*        End A is UPPER
+*
+         END IF
+*
+      ELSE
+*
+*        Begin A is LOWER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is lower)
+*
+*
+*           Convert VALUE
+*           Assign subdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = 1
+            E( N ) = ZERO
+            DO WHILE ( I.LE.N )
+               IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
+                  E( I ) = A( I+1, I )
+                  E( I+1 ) = ZERO
+                  A( I+1, I ) = ZERO
+                  I = I + 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I + 1
+            END DO
+*
+*           Convert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in factorization order where k increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = -IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.(I+1) ) THEN
+                        CALL SSWAP( I-1, A( I+1, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is no interchnge of rows i and and IPIV(i),
+*                 so this should be reflected in IPIV format for
+*                 *SYTRF_RK ( or *SYTRF_BK)
+*
+                  IPIV( I ) = I
+*
+                  I = I + 1
+*
+               END IF
+               I = I + 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is lower)
+*
+*
+*           Revert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in reverse factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
+*
+                  I = I - 1
+                  IP = -IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.(I+1) ) THEN
+                        CALL SSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I+1, 1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is one interchange of rows i+1 and IPIV(i+1),
+*                 so this should be recorded in consecutive entries
+*                 in IPIV format for *SYTRF
+*
+                  IPIV( I ) = IPIV( I+1 )
+*
+               END IF
+               I = I - 1
+            END DO
+*
+*           Revert VALUE
+*           Assign subdiagonal entries of D from array E to
+*           subgiagonal entries of A.
+*
+            I = 1
+            DO WHILE ( I.LE.N-1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I + 1, I ) = E( I )
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+         END IF
+*
+*        End A is LOWER
+*
+      END IF
+
+      RETURN
+*
+*     End of SSYCONVF
+*
+      END
diff --git a/SRC/ssyconvf_rook.f b/SRC/ssyconvf_rook.f
new file mode 100644
index 00000000..69f04f6d
--- /dev/null
+++ b/SRC/ssyconvf_rook.f
@@ -0,0 +1,544 @@
+*> \brief \b SSYCONVF_ROOK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYCONVF_ROOK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyconvf_rook.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyconvf_rook.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyconvf_rook.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYCONVF_ROOK( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO, WAY
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               A( LDA, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> If parameter WAY = 'C':
+*> SSYCONVF_ROOK converts the factorization output format used in
+*> SSYTRF_ROOK provided on entry in parameter A into the factorization
+*> output format used in SSYTRF_RK (or SSYTRF_BK) that is stored
+*> on exit in parameters A and E. IPIV format for SSYTRF_ROOK and
+*> SSYTRF_RK (or SSYTRF_BK) is the same and is not converted.
+*>
+*> If parameter WAY = 'R':
+*> SSYCONVF_ROOK performs the conversion in reverse direction, i.e.
+*> converts the factorization output format used in SSYTRF_RK
+*> (or SSYTRF_BK) provided on entry in parametes A and E into
+*> the factorization output format used in SSYTRF_ROOK that is stored
+*> on exit in parameter A. IPIV format for SSYTRF_ROOK and
+*> SSYTRF_RK (or SSYTRF_BK) is the same and is not converted.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix A.
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] WAY
+*> \verbatim
+*>          WAY is CHARACTER*1
+*>          = 'C': Convert
+*>          = 'R': Revert
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, contains factorization details in format used in
+*>          SSYTRF_ROOK:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          SSYTRF_RK or SSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains factorization details in format used in
+*>          SSYTRF_RK or SSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          SSYTRF_ROOK:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] E
+*> \verbatim
+*>          E is REAL array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, just a workspace.
+*>
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          On exit, is not changed
+*> \endverbatim
+*.
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          On entry, details of the interchanges and the block
+*>          structure of D as determined:
+*>          1) by SSYTRF_ROOK, if WAY ='C';
+*>          2) by SSYTRF_RK (or SSYTRF_BK), if WAY ='R'.
+*>          The IPIV format is the same for all these routines.
+*>
+*>          On exit, is not changed.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup singleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*  =====================================================================
+      SUBROUTINE SSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO, WAY
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0E+0 )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*
+*     .. External Subroutines ..
+      EXTERNAL           SSWAP, XERBLA
+*     .. Local Scalars ..
+      LOGICAL            UPPER, CONVERT
+      INTEGER            I, IP, IP2
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      CONVERT = LSAME( WAY, 'C' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYCONVF_ROOK', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin A is UPPER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is upper)
+*
+*
+*           Convert VALUE
+*
+*           Assign superdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = N
+            E( 1 ) = ZERO
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  E( I ) = A( I-1, I )
+                  E( I-1 ) = ZERO
+                  A( I-1, I ) = ZERO
+                  I = I - 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I - 1
+            END DO
+*
+*           Convert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
+*                 in A(1:i,N-i:N)
+*
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I-1 )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                     IF( IP2.NE.(I-1) ) THEN
+                        CALL SSWAP( N-I, A( I-1, I+1 ), LDA,
+     $                              A( IP2, I+1 ), LDA )
+                     END IF
+                  END IF
+                  I = I - 1
+*
+               END IF
+               I = I - 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is upper)
+*
+*
+*           Revert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in reverse factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
+*                 in A(1:i,N-i:N)
+*
+                  I = I + 1
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I-1 )
+                  IF( I.LT.N ) THEN
+                     IF( IP2.NE.(I-1) ) THEN
+                        CALL SSWAP( N-I, A( IP2, I+1 ), LDA,
+     $                              A( I-1, I+1 ), LDA )
+                     END IF
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               END IF
+               I = I + 1
+            END DO
+*
+*           Revert VALUE
+*           Assign superdiagonal entries of D from array E to
+*           superdiagonal entries of A.
+*
+            I = N
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I-1, I ) = E( I )
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*        End A is UPPER
+*
+         END IF
+*
+      ELSE
+*
+*        Begin A is LOWER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is lower)
+*
+*
+*           Convert VALUE
+*           Assign subdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = 1
+            E( N ) = ZERO
+            DO WHILE ( I.LE.N )
+               IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
+                  E( I ) = A( I+1, I )
+                  E( I+1 ) = ZERO
+                  A( I+1, I ) = ZERO
+                  I = I + 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I + 1
+            END DO
+*
+*           Convert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
+*                 in A(i:N,1:i-1)
+*
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I+1 )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                     IF( IP2.NE.(I+1) ) THEN
+                        CALL SSWAP( I-1, A( I+1, 1 ), LDA,
+     $                              A( IP2, 1 ), LDA )
+                     END IF
+                  END IF
+                  I = I + 1
+*
+               END IF
+               I = I + 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is lower)
+*
+*
+*           Revert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in reverse factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
+*                 in A(i:N,1:i-1)
+*
+                  I = I - 1
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I+1 )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP2.NE.(I+1) ) THEN
+                        CALL SSWAP( I-1, A( IP2, 1 ), LDA,
+     $                              A( I+1, 1 ), LDA )
+                     END IF
+                     IF( IP.NE.I ) THEN
+                        CALL SSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               END IF
+               I = I - 1
+            END DO
+*
+*           Revert VALUE
+*           Assign subdiagonal entries of D from array E to
+*           subgiagonal entries of A.
+*
+            I = 1
+            DO WHILE ( I.LE.N-1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I + 1, I ) = E( I )
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+         END IF
+*
+*        End A is LOWER
+*
+      END IF
+
+      RETURN
+*
+*     End of SSYCONVF_ROOK
+*
+      END
diff --git a/SRC/ssyev_2stage.f b/SRC/ssyev_2stage.f
new file mode 100644
index 00000000..52f11c35
--- /dev/null
+++ b/SRC/ssyev_2stage.f
@@ -0,0 +1,348 @@
+*> \brief <b> SSYEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
+*
+*  @generated from dsyev_2stage.f, fortran d -> s, Sat Nov  5 23:55:51 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYEV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyevd_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyevd_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyevd_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, 
+*                                INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), W( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSYEV_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
+*> real symmetric matrix A using the 2stage technique for
+*> the reduction to tridiagonal.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA, N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          orthonormal eigenvectors of the matrix A.
+*>          If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+*>          or the upper triangle (if UPLO='U') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension LWORK
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + 2*N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + 2*N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup realSYeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, 
+     $                         INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), W( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, KD, IB, INDHOUS
+      REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLANSY
+      EXTERNAL           LSAME, ILAENV, SLAMCH, SLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLASCL, SORGTR, SSCAL, SSTEQR, SSTERF,
+     $                   XERBLA, SSYTRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         KD    = ILAENV( 17, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+         IB    = ILAENV( 18, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWMIN = 2*N + LHTRD + LWTRD
+         WORK( 1 )  = LWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -8
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYEV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = A( 1, 1 )
+         WORK( 1 ) = 2
+         IF( WANTZ )
+     $      A( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = SLANSY( 'M', UPLO, N, A, LDA, WORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 )
+     $   CALL SLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
+*
+*     Call SSYTRD_2STAGE to reduce symmetric matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDTAU  = INDE + N
+      INDHOUS = INDTAU + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL SSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK( INDE ),
+     $                    WORK( INDTAU ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call SSTERF.  For eigenvectors, first call
+*     SORGTR to generate the orthogonal matrix, then call SSTEQR.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL SSTERF( N, W, WORK( INDE ), INFO )
+      ELSE
+*        Not available in this release, and agrument checking should not
+*        let it getting here
+         RETURN
+         CALL SORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
+     $                LLWORK, IINFO )
+         CALL SSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, WORK( INDTAU ),
+     $                INFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of SSYEV_2STAGE
+*
+      END
diff --git a/SRC/ssyevd_2stage.f b/SRC/ssyevd_2stage.f
new file mode 100644
index 00000000..8510b645
--- /dev/null
+++ b/SRC/ssyevd_2stage.f
@@ -0,0 +1,406 @@
+*> \brief <b> SSYEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
+*
+*  @generated from dsyevd_2stage.f, fortran d -> s, Sat Nov  5 23:55:54 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYEVD_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyevd_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyevd_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyevd_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+*                                IWORK, LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, LDA, LIWORK, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IWORK( * )
+*       REAL               A( LDA, * ), W( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSYEVD_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
+*> real symmetric matrix A using the 2stage technique for
+*> the reduction to tridiagonal. If eigenvectors are desired, it uses a
+*> divide and conquer algorithm.
+*>
+*> The divide and conquer algorithm makes very mild assumptions about
+*> floating point arithmetic. It will work on machines with a guard
+*> digit in add/subtract, or on those binary machines without guard
+*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
+*> without guard digits, but we know of none.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA, N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          orthonormal eigenvectors of the matrix A.
+*>          If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+*>          or the upper triangle (if UPLO='U') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array,
+*>                                         dimension (LWORK)
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          If N <= 1,               LWORK must be at least 1.
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + 2*N+1
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + 2*N+1
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be at least
+*>                                                1 + 6*N + 2*N**2.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK and IWORK
+*>          arrays, returns these values as the first entries of the WORK
+*>          and IWORK arrays, and no error message related to LWORK or
+*>          LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of the array IWORK.
+*>          If N <= 1,                LIWORK must be at least 1.
+*>          If JOBZ  = 'N' and N > 1, LIWORK must be at least 1.
+*>          If JOBZ  = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK and IWORK arrays, and no error message related to
+*>          LWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i and JOBZ = 'N', then the algorithm failed
+*>                to converge; i off-diagonal elements of an intermediate
+*>                tridiagonal form did not converge to zero;
+*>                if INFO = i and JOBZ = 'V', then the algorithm failed
+*>                to compute an eigenvalue while working on the submatrix
+*>                lying in rows and columns INFO/(N+1) through
+*>                mod(INFO,N+1).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date September 2012
+*
+*> \ingroup realSYeigen
+*
+*> \par Contributors:
+*  ==================
+*>
+*> Jeff Rutter, Computer Science Division, University of California
+*> at Berkeley, USA \n
+*>  Modified by Francoise Tisseur, University of Tennessee \n
+*>  Modified description of INFO. Sven, 16 Feb 05. \n
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+     $                          IWORK, LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.4.2) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     September 2012
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, LDA, LIWORK, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IWORK( * )
+      REAL               A( LDA, * ), W( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+*
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
+     $                   LIWMIN, LLWORK, LLWRK2, LWMIN,
+     $                   LHTRD, LWTRD, KD, IB, INDHOUS
+      REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLANSY
+      EXTERNAL           LSAME, SLAMCH, SLANSY, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLACPY, SLASCL, SORMTR, SSCAL, SSTEDC, SSTERF,
+     $                   SSYTRD_2STAGE, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LIWMIN = 1
+            LWMIN = 1
+         ELSE
+            KD    = ILAENV( 17, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+            IB    = ILAENV( 18, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            IF( WANTZ ) THEN
+               LIWMIN = 3 + 5*N
+               LWMIN = 1 + 6*N + 2*N**2
+            ELSE
+               LIWMIN = 1
+               LWMIN = 2*N + 1 + LHTRD + LWTRD
+            END IF
+         END IF
+         WORK( 1 )  = LWMIN
+         IWORK( 1 ) = LIWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -8
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -10
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYEVD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = A( 1, 1 )
+         IF( WANTZ )
+     $      A( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = SLANSY( 'M', UPLO, N, A, LDA, WORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 )
+     $   CALL SLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
+*
+*     Call SSYTRD_2STAGE to reduce symmetric matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDTAU  = INDE + N
+      INDHOUS = INDTAU + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+      INDWK2  = INDWRK + N*N
+      LLWRK2  = LWORK - INDWK2 + 1
+*
+      CALL SSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK( INDE ),
+     $                    WORK( INDTAU ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call SSTERF.  For eigenvectors, first call
+*     SSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
+*     tridiagonal matrix, then call SORMTR to multiply it by the
+*     Householder transformations stored in A.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL SSTERF( N, W, WORK( INDE ), INFO )
+      ELSE
+*        Not available in this release, and agrument checking should not
+*        let it getting here
+         RETURN
+         CALL SSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
+     $                WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
+         CALL SORMTR( 'L', UPLO, 'N', N, N, A, LDA, WORK( INDTAU ),
+     $                WORK( INDWRK ), N, WORK( INDWK2 ), LLWRK2, IINFO )
+         CALL SLACPY( 'A', N, N, WORK( INDWRK ), N, A, LDA )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 )
+     $   CALL SSCAL( N, ONE / SIGMA, W, 1 )
+*
+      WORK( 1 )  = LWMIN
+      IWORK( 1 ) = LIWMIN
+*
+      RETURN
+*
+*     End of SSYEVD_2STAGE
+*
+      END
diff --git a/SRC/ssyevr_2stage.f b/SRC/ssyevr_2stage.f
new file mode 100644
index 00000000..27b99303
--- /dev/null
+++ b/SRC/ssyevr_2stage.f
@@ -0,0 +1,745 @@
+*> \brief <b> SSYEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
+*
+*  @generated from dsyevr_2stage.f, fortran d -> s, Sat Nov  5 23:50:10 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYEVR_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyevr_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyevr_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyevr_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+*                          IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK,
+*                          LWORK, IWORK, LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
+*       REAL               ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            ISUPPZ( * ), IWORK( * )
+*       REAL               A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSYEVR_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a real symmetric matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  Eigenvalues and eigenvectors can be
+*> selected by specifying either a range of values or a range of
+*> indices for the desired eigenvalues.
+*>
+*> SSYEVR_2STAGE first reduces the matrix A to tridiagonal form T with a call
+*> to SSYTRD.  Then, whenever possible, SSYEVR_2STAGE calls SSTEMR to compute
+*> the eigenspectrum using Relatively Robust Representations.  SSTEMR
+*> computes eigenvalues by the dqds algorithm, while orthogonal
+*> eigenvectors are computed from various "good" L D L^T representations
+*> (also known as Relatively Robust Representations). Gram-Schmidt
+*> orthogonalization is avoided as far as possible. More specifically,
+*> the various steps of the algorithm are as follows.
+*>
+*> For each unreduced block (submatrix) of T,
+*>    (a) Compute T - sigma I  = L D L^T, so that L and D
+*>        define all the wanted eigenvalues to high relative accuracy.
+*>        This means that small relative changes in the entries of D and L
+*>        cause only small relative changes in the eigenvalues and
+*>        eigenvectors. The standard (unfactored) representation of the
+*>        tridiagonal matrix T does not have this property in general.
+*>    (b) Compute the eigenvalues to suitable accuracy.
+*>        If the eigenvectors are desired, the algorithm attains full
+*>        accuracy of the computed eigenvalues only right before
+*>        the corresponding vectors have to be computed, see steps c) and d).
+*>    (c) For each cluster of close eigenvalues, select a new
+*>        shift close to the cluster, find a new factorization, and refine
+*>        the shifted eigenvalues to suitable accuracy.
+*>    (d) For each eigenvalue with a large enough relative separation compute
+*>        the corresponding eigenvector by forming a rank revealing twisted
+*>        factorization. Go back to (c) for any clusters that remain.
+*>
+*> The desired accuracy of the output can be specified by the input
+*> parameter ABSTOL.
+*>
+*> For more details, see SSTEMR's documentation and:
+*> - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
+*>   to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
+*>   Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+*> - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
+*>   Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
+*>   2004.  Also LAPACK Working Note 154.
+*> - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+*>   tridiagonal eigenvalue/eigenvector problem",
+*>   Computer Science Division Technical Report No. UCB/CSD-97-971,
+*>   UC Berkeley, May 1997.
+*>
+*>
+*> Note 1 : SSYEVR_2STAGE calls SSTEMR when the full spectrum is requested
+*> on machines which conform to the ieee-754 floating point standard.
+*> SSYEVR_2STAGE calls SSTEBZ and SSTEIN on non-ieee machines and
+*> when partial spectrum requests are made.
+*>
+*> Normal execution of SSTEMR may create NaNs and infinities and
+*> hence may abort due to a floating point exception in environments
+*> which do not handle NaNs and infinities in the ieee standard default
+*> manner.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found.
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found.
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*>          For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and
+*>          SSTEIN are called
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA, N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, the lower triangle (if UPLO='L') or the upper
+*>          triangle (if UPLO='U') of A, including the diagonal, is
+*>          destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is REAL
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is REAL
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is REAL
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing A to tridiagonal form.
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*>
+*>          If high relative accuracy is important, set ABSTOL to
+*>          SLAMCH( 'Safe minimum' ).  Doing so will guarantee that
+*>          eigenvalues are computed to high relative accuracy when
+*>          possible in future releases.  The current code does not
+*>          make any guarantees about high relative accuracy, but
+*>          future releases will. See J. Barlow and J. Demmel,
+*>          "Computing Accurate Eigensystems of Scaled Diagonally
+*>          Dominant Matrices", LAPACK Working Note #7, for a discussion
+*>          of which matrices define their eigenvalues to high relative
+*>          accuracy.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          The first M elements contain the selected eigenvalues in
+*>          ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is REAL array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*>          Supplying N columns is always safe.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] ISUPPZ
+*> \verbatim
+*>          ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
+*>          The support of the eigenvectors in Z, i.e., the indices
+*>          indicating the nonzero elements in Z. The i-th eigenvector
+*>          is nonzero only in elements ISUPPZ( 2*i-1 ) through
+*>          ISUPPZ( 2*i ). This is an output of SSTEMR (tridiagonal
+*>          matrix). The support of the eigenvectors of A is typically 
+*>          1:N because of the orthogonal transformations applied by SORMTR.
+*>          Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, 26*N, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + 5*N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + 5*N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of the array IWORK.  LIWORK >= max(1,10*N).
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal size of the IWORK array,
+*>          returns this value as the first entry of the IWORK array, and
+*>          no error message related to LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  Internal error
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup realSYeigen
+*
+*> \par Contributors:
+*  ==================
+*>
+*>     Inderjit Dhillon, IBM Almaden, USA \n
+*>     Osni Marques, LBNL/NERSC, USA \n
+*>     Ken Stanley, Computer Science Division, University of
+*>       California at Berkeley, USA \n
+*>     Jason Riedy, Computer Science Division, University of
+*>       California at Berkeley, USA \n
+*>
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+     $                   IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK,
+     $                   LWORK, IWORK, LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
+      REAL               ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            ISUPPZ( * ), IWORK( * )
+      REAL               A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+* =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE, TWO
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, LQUERY, VALEIG, WANTZ,
+     $                   TRYRAC, TEST
+      CHARACTER          ORDER
+      INTEGER            I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
+     $                   INDEE, INDIBL, INDIFL, INDISP, INDIWO, INDTAU,
+     $                   INDWK, INDWKN, ISCALE, J, JJ, LIWMIN,
+     $                   LLWORK, LLWRKN, LWMIN, NSPLIT,
+     $                   LHTRD, LWTRD, KD, IB, INDHOUS
+      REAL               ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLANSY
+      EXTERNAL           LSAME, ILAENV, SLAMCH, SLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SORMTR, SSCAL, SSTEBZ, SSTEMR, SSTEIN,
+     $                   SSTERF, SSWAP, SSYTRD_2STAGE, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      IEEEOK = ILAENV( 10, 'SSYEVR', 'N', 1, 2, 3, 4 )
+*
+      LOWER = LSAME( UPLO, 'L' )
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+*
+      LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
+*
+      KD     = ILAENV( 17, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+      IB     = ILAENV( 18, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+      LHTRD  = ILAENV( 19, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+      LWTRD  = ILAENV( 20, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+      LWMIN  = MAX( 26*N, 5*N + LHTRD + LWTRD )
+      LIWMIN = MAX( 1, 10*N )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -8
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -9
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -10
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+            INFO = -15
+         ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -18
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -20
+         END IF
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*         NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 )
+*         NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) )
+*         LWKOPT = MAX( ( NB+1 )*N, LWMIN )
+         WORK( 1 ) = LWMIN
+         IWORK( 1 ) = LIWMIN
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYEVR_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         WORK( 1 ) = 26
+         IF( ALLEIG .OR. INDEIG ) THEN
+            M = 1
+            W( 1 ) = A( 1, 1 )
+         ELSE
+            IF( VL.LT.A( 1, 1 ) .AND. VU.GE.A( 1, 1 ) ) THEN
+               M = 1
+               W( 1 ) = A( 1, 1 )
+            END IF
+         END IF
+         IF( WANTZ ) THEN
+            Z( 1, 1 ) = ONE
+            ISUPPZ( 1 ) = 1
+            ISUPPZ( 2 ) = 1
+         END IF
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF (VALEIG) THEN
+         VLL = VL
+         VUU = VU
+      END IF
+      ANRM = SLANSY( 'M', UPLO, N, A, LDA, WORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            DO 10 J = 1, N
+               CALL SSCAL( N-J+1, SIGMA, A( J, J ), 1 )
+   10       CONTINUE
+         ELSE
+            DO 20 J = 1, N
+               CALL SSCAL( J, SIGMA, A( 1, J ), 1 )
+   20       CONTINUE
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+
+*     Initialize indices into workspaces.  Note: The IWORK indices are
+*     used only if SSTERF or SSTEMR fail.
+
+*     WORK(INDTAU:INDTAU+N-1) stores the scalar factors of the
+*     elementary reflectors used in SSYTRD.
+      INDTAU = 1
+*     WORK(INDD:INDD+N-1) stores the tridiagonal's diagonal entries.
+      INDD = INDTAU + N
+*     WORK(INDE:INDE+N-1) stores the off-diagonal entries of the
+*     tridiagonal matrix from SSYTRD.
+      INDE = INDD + N
+*     WORK(INDDD:INDDD+N-1) is a copy of the diagonal entries over
+*     -written by SSTEMR (the SSTERF path copies the diagonal to W).
+      INDDD = INDE + N
+*     WORK(INDEE:INDEE+N-1) is a copy of the off-diagonal entries over
+*     -written while computing the eigenvalues in SSTERF and SSTEMR.
+      INDEE = INDDD + N
+*     INDHOUS is the starting offset Householder storage of stage 2
+      INDHOUS = INDEE + N
+*     INDWK is the starting offset of the left-over workspace, and
+*     LLWORK is the remaining workspace size.
+      INDWK  = INDHOUS + LHTRD
+      LLWORK = LWORK - INDWK + 1
+
+
+*     IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in SSTEBZ and
+*     stores the block indices of each of the M<=N eigenvalues.
+      INDIBL = 1
+*     IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in SSTEBZ and
+*     stores the starting and finishing indices of each block.
+      INDISP = INDIBL + N
+*     IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
+*     that corresponding to eigenvectors that fail to converge in
+*     SSTEIN.  This information is discarded; if any fail, the driver
+*     returns INFO > 0.
+      INDIFL = INDISP + N
+*     INDIWO is the offset of the remaining integer workspace.
+      INDIWO = INDIFL + N
+
+*
+*     Call SSYTRD_2STAGE to reduce symmetric matrix to tridiagonal form.
+*
+*
+      CALL SSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, WORK( INDD ), 
+     $                    WORK( INDE ), WORK( INDTAU ), WORK( INDHOUS ),
+     $                    LHTRD, WORK( INDWK ), LLWORK, IINFO )
+*
+*     If all eigenvalues are desired
+*     then call SSTERF or SSTEMR and SORMTR.
+*
+      TEST = .FALSE.
+      IF( INDEIG ) THEN
+         IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN
+         IF( .NOT.WANTZ ) THEN
+            CALL SCOPY( N, WORK( INDD ), 1, W, 1 )
+            CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL SSTERF( N, W, WORK( INDEE ), INFO )
+         ELSE
+            CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL SCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 1 )
+*
+            IF (ABSTOL .LE. TWO*N*EPS) THEN
+               TRYRAC = .TRUE.
+            ELSE
+               TRYRAC = .FALSE.
+            END IF
+            CALL SSTEMR( JOBZ, 'A', N, WORK( INDDD ), WORK( INDEE ),
+     $                   VL, VU, IL, IU, M, W, Z, LDZ, N, ISUPPZ,
+     $                   TRYRAC, WORK( INDWK ), LWORK, IWORK, LIWORK,
+     $                   INFO )
+*
+*
+*
+*        Apply orthogonal matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by SSTEMR.
+*
+            IF( WANTZ .AND. INFO.EQ.0 ) THEN
+               INDWKN = INDE
+               LLWRKN = LWORK - INDWKN + 1
+               CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA,
+     $                      WORK( INDTAU ), Z, LDZ, WORK( INDWKN ),
+     $                      LLWRKN, IINFO )
+            END IF
+         END IF
+*
+*
+         IF( INFO.EQ.0 ) THEN
+*           Everything worked.  Skip SSTEBZ/SSTEIN.  IWORK(:) are
+*           undefined.
+            M = N
+            GO TO 30
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
+*     Also call SSTEBZ and SSTEIN if SSTEMR fails.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+
+      CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWK ),
+     $             IWORK( INDIWO ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                WORK( INDWK ), IWORK( INDIWO ), IWORK( INDIFL ),
+     $                INFO )
+*
+*        Apply orthogonal matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by SSTEIN.
+*
+         INDWKN = INDE
+         LLWRKN = LWORK - INDWKN + 1
+         CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
+     $                LDZ, WORK( INDWKN ), LLWRKN, IINFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+*  Jump here if SSTEMR/SSTEIN succeeded.
+   30 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.  Note: We do not sort the IFAIL portion of IWORK.
+*     It may not be initialized (if SSTEMR/SSTEIN succeeded), and we do
+*     not return this detailed information to the user.
+*
+      IF( WANTZ ) THEN
+         DO 50 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 40 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   40       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               W( I ) = W( J )
+               W( J ) = TMP1
+               CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+            END IF
+   50    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+      IWORK( 1 ) = LIWMIN
+*
+      RETURN
+*
+*     End of SSYEVR_2STAGE
+*
+      END
diff --git a/SRC/ssyevx_2stage.f b/SRC/ssyevx_2stage.f
new file mode 100644
index 00000000..96a73ecd
--- /dev/null
+++ b/SRC/ssyevx_2stage.f
@@ -0,0 +1,608 @@
+*> \brief <b> SSYEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
+*
+*  @generated from dsyevx_2stage.f, fortran d -> s, Sat Nov  5 23:55:46 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYEVX_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyevx_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyevx_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyevx_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+*                                 IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
+*                                 LWORK, IWORK, IFAIL, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, LDA, LDZ, LWORK, M, N
+*       REAL               ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IFAIL( * ), IWORK( * )
+*       REAL               A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSYEVX_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a real symmetric matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  Eigenvalues and eigenvectors can be
+*> selected by specifying either a range of values or a range of indices
+*> for the desired eigenvalues.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found.
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found.
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA, N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, the lower triangle (if UPLO='L') or the upper
+*>          triangle (if UPLO='U') of A, including the diagonal, is
+*>          destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is REAL
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is REAL
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is REAL
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing A to tridiagonal form.
+*>
+*>          Eigenvalues will be computed most accurately when ABSTOL is
+*>          set to twice the underflow threshold 2*SLAMCH('S'), not zero.
+*>          If this routine returns with INFO>0, indicating that some
+*>          eigenvectors did not converge, try setting ABSTOL to
+*>          2*SLAMCH('S').
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          On normal exit, the first M elements contain the selected
+*>          eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is REAL array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If an eigenvector fails to converge, then that column of Z
+*>          contains the latest approximation to the eigenvector, and the
+*>          index of the eigenvector is returned in IFAIL.
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, 8*N, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + 3*N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + 3*N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (5*N)
+*> \endverbatim
+*>
+*> \param[out] IFAIL
+*> \verbatim
+*>          IFAIL is INTEGER array, dimension (N)
+*>          If JOBZ = 'V', then if INFO = 0, the first M elements of
+*>          IFAIL are zero.  If INFO > 0, then IFAIL contains the
+*>          indices of the eigenvectors that failed to converge.
+*>          If JOBZ = 'N', then IFAIL is not referenced.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, then i eigenvectors failed to converge.
+*>                Their indices are stored in array IFAIL.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup realSYeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+     $                          IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
+     $                          LWORK, IWORK, IFAIL, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, LDA, LDZ, LWORK, M, N
+      REAL               ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IFAIL( * ), IWORK( * )
+      REAL               A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+* =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
+     $                   WANTZ
+      CHARACTER          ORDER
+      INTEGER            I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
+     $                   INDISP, INDIWO, INDTAU, INDWKN, INDWRK, ISCALE,
+     $                   ITMP1, J, JJ, LLWORK, LLWRKN,
+     $                   NSPLIT, LWMIN, LHTRD, LWTRD, KD, IB, INDHOUS
+      REAL               ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLANSY
+      EXTERNAL           LSAME, ILAENV, SLAMCH, SLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SLACPY, SORGTR, SORMTR, SSCAL, SSTEBZ,
+     $                   SSTEIN, SSTEQR, SSTERF, SSWAP, XERBLA,
+     $                   SSYTRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      LOWER = LSAME( UPLO, 'L' )
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -8
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -9
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -10
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+            INFO = -15
+         END IF
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            KD    = ILAENV( 17, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+            IB    = ILAENV( 18, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWMIN = MAX( 8*N, 3*N + LHTRD + LWTRD )
+            WORK( 1 )  = LWMIN
+         END IF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -17
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYEVX_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 ) THEN
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         IF( ALLEIG .OR. INDEIG ) THEN
+            M = 1
+            W( 1 ) = A( 1, 1 )
+         ELSE
+            IF( VL.LT.A( 1, 1 ) .AND. VU.GE.A( 1, 1 ) ) THEN
+               M = 1
+               W( 1 ) = A( 1, 1 )
+            END IF
+         END IF
+         IF( WANTZ )
+     $      Z( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = SLAMCH( 'Safe minimum' )
+      EPS    = SLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF( VALEIG ) THEN
+         VLL = VL
+         VUU = VU
+      END IF
+      ANRM = SLANSY( 'M', UPLO, N, A, LDA, WORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            DO 10 J = 1, N
+               CALL SSCAL( N-J+1, SIGMA, A( J, J ), 1 )
+   10       CONTINUE
+         ELSE
+            DO 20 J = 1, N
+               CALL SSCAL( J, SIGMA, A( 1, J ), 1 )
+   20       CONTINUE
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+*
+*     Call SSYTRD_2STAGE to reduce symmetric matrix to tridiagonal form.
+*
+      INDTAU  = 1
+      INDE    = INDTAU + N
+      INDD    = INDE + N
+      INDHOUS = INDD + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL SSYTRD_2STAGE( JOBZ, UPLO, N, A, LDA, WORK( INDD ), 
+     $                    WORK( INDE ), WORK( INDTAU ), WORK( INDHOUS ),
+     $                    LHTRD, WORK( INDWRK ), LLWORK, IINFO )
+*
+*     If all eigenvalues are desired and ABSTOL is less than or equal to
+*     zero, then call SSTERF or SORGTR and SSTEQR.  If this fails for
+*     some eigenvalue, then try SSTEBZ.
+*
+      TEST = .FALSE.
+      IF( INDEIG ) THEN
+         IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF( ( ALLEIG .OR. TEST ) .AND. ( ABSTOL.LE.ZERO ) ) THEN
+         CALL SCOPY( N, WORK( INDD ), 1, W, 1 )
+         INDEE = INDWRK + 2*N
+         IF( .NOT.WANTZ ) THEN
+            CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL SSTERF( N, W, WORK( INDEE ), INFO )
+         ELSE
+            CALL SLACPY( 'A', N, N, A, LDA, Z, LDZ )
+            CALL SORGTR( UPLO, N, Z, LDZ, WORK( INDTAU ),
+     $                   WORK( INDWRK ), LLWORK, IINFO )
+            CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 )
+            CALL SSTEQR( JOBZ, N, W, WORK( INDEE ), Z, LDZ,
+     $                   WORK( INDWRK ), INFO )
+            IF( INFO.EQ.0 ) THEN
+               DO 30 I = 1, N
+                  IFAIL( I ) = 0
+   30          CONTINUE
+            END IF
+         END IF
+         IF( INFO.EQ.0 ) THEN
+            M = N
+            GO TO 40
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+      INDIBL = 1
+      INDISP = INDIBL + N
+      INDIWO = INDISP + N
+      CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
+     $             IWORK( INDIWO ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
+*
+*        Apply orthogonal matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by SSTEIN.
+*
+         INDWKN = INDE
+         LLWRKN = LWORK - INDWKN + 1
+         CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
+     $                LDZ, WORK( INDWKN ), LLWRKN, IINFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+   40 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.
+*
+      IF( WANTZ ) THEN
+         DO 60 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 50 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   50       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               ITMP1 = IWORK( INDIBL+I-1 )
+               W( I ) = W( J )
+               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
+               W( J ) = TMP1
+               IWORK( INDIBL+J-1 ) = ITMP1
+               CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+               IF( INFO.NE.0 ) THEN
+                  ITMP1 = IFAIL( I )
+                  IFAIL( I ) = IFAIL( J )
+                  IFAIL( J ) = ITMP1
+               END IF
+            END IF
+   60    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of SSYEVX_2STAGE
+*
+      END
diff --git a/SRC/ssygv_2stage.f b/SRC/ssygv_2stage.f
new file mode 100644
index 00000000..6eb172e9
--- /dev/null
+++ b/SRC/ssygv_2stage.f
@@ -0,0 +1,371 @@
+*> \brief \b SSYGV_2STAGE
+*
+*  @generated from dsygv_2stage.f, fortran d -> s, Sun Nov  6 12:54:29 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYGV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssygv_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssygv_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssygv_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W,
+*                                WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, ITYPE, LDA, LDB, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSYGV_2STAGE computes all the eigenvalues, and optionally, the eigenvectors
+*> of a real generalized symmetric-definite eigenproblem, of the form
+*> A*x=(lambda)*B*x,  A*Bx=(lambda)*x,  or B*A*x=(lambda)*x.
+*> Here A and B are assumed to be symmetric and B is also
+*> positive definite.
+*> This routine use the 2stage technique for the reduction to tridiagonal
+*> which showed higher performance on recent architecture and for large
+*  sizes N>2000.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] ITYPE
+*> \verbatim
+*>          ITYPE is INTEGER
+*>          Specifies the problem type to be solved:
+*>          = 1:  A*x = (lambda)*B*x
+*>          = 2:  A*B*x = (lambda)*x
+*>          = 3:  B*A*x = (lambda)*x
+*> \endverbatim
+*>
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangles of A and B are stored;
+*>          = 'L':  Lower triangles of A and B are stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrices A and B.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA, N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          matrix Z of eigenvectors.  The eigenvectors are normalized
+*>          as follows:
+*>          if ITYPE = 1 or 2, Z**T*B*Z = I;
+*>          if ITYPE = 3, Z**T*inv(B)*Z = I.
+*>          If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+*>          or the lower triangle (if UPLO='L') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is REAL array, dimension (LDB, N)
+*>          On entry, the symmetric positive definite matrix B.
+*>          If UPLO = 'U', the leading N-by-N upper triangular part of B
+*>          contains the upper triangular part of the matrix B.
+*>          If UPLO = 'L', the leading N-by-N lower triangular part of B
+*>          contains the lower triangular part of the matrix B.
+*>
+*>          On exit, if INFO <= N, the part of B containing the matrix is
+*>          overwritten by the triangular factor U or L from the Cholesky
+*>          factorization B = U**T*U or B = L*L**T.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is REAL array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + 2*N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + 2*N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  SPOTRF or SSYEV returned an error code:
+*>             <= N:  if INFO = i, SSYEV failed to converge;
+*>                    i off-diagonal elements of an intermediate
+*>                    tridiagonal form did not converge to zero;
+*>             > N:   if INFO = N + i, for 1 <= i <= N, then the leading
+*>                    minor of order i of B is not positive definite.
+*>                    The factorization of B could not be completed and
+*>                    no eigenvalues or eigenvectors were computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup realSYeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W,
+     $                         WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, ITYPE, LDA, LDB, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE
+      PARAMETER          ( ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER, WANTZ
+      CHARACTER          TRANS
+      INTEGER            NEIG,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, KD, IB, INDHOUS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SPOTRF, SSYGST, STRMM, STRSM, XERBLA,
+     $                   SSYEV_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         KD    = ILAENV( 17, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+         IB    = ILAENV( 18, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWMIN = 2*N + LHTRD + LWTRD
+         WORK( 1 )  = LWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -11
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYGV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Form a Cholesky factorization of B.
+*
+      CALL SPOTRF( UPLO, N, B, LDB, INFO )
+      IF( INFO.NE.0 ) THEN
+         INFO = N + INFO
+         RETURN
+      END IF
+*
+*     Transform problem to standard eigenvalue problem and solve.
+*
+      CALL SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
+      CALL SSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
+*
+      IF( WANTZ ) THEN
+*
+*        Backtransform eigenvectors to the original problem.
+*
+         NEIG = N
+         IF( INFO.GT.0 )
+     $      NEIG = INFO - 1
+         IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
+*
+*           For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
+*           backtransform eigenvectors: x = inv(L)**T*y or inv(U)*y
+*
+            IF( UPPER ) THEN
+               TRANS = 'N'
+            ELSE
+               TRANS = 'T'
+            END IF
+*
+            CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
+     $                  B, LDB, A, LDA )
+*
+         ELSE IF( ITYPE.EQ.3 ) THEN
+*
+*           For B*A*x=(lambda)*x;
+*           backtransform eigenvectors: x = L*y or U**T*y
+*
+            IF( UPPER ) THEN
+               TRANS = 'T'
+            ELSE
+               TRANS = 'N'
+            END IF
+*
+            CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
+     $                  B, LDB, A, LDA )
+         END IF
+      END IF
+*
+      WORK( 1 ) = LWMIN
+      RETURN
+*
+*     End of SSYGV_2STAGE
+*
+      END
diff --git a/SRC/ssysv_aa.f b/SRC/ssysv_aa.f
index 52f6eb5f..d61a346c 100644
--- a/SRC/ssysv_aa.f
+++ b/SRC/ssysv_aa.f
@@ -19,7 +19,7 @@
 *  ===========
 *
 *       SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-*                               LWORK, INFO )
+*                            LWORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
@@ -27,7 +27,7 @@
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * )
-*       REAL   A( LDA, * ), B( LDB, * ), WORK( * )
+*       REAL               A( LDA, * ), B( LDB, * ), WORK( * )
 *       ..
 *
 *
@@ -126,8 +126,8 @@
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
-*>          The length of WORK.  LWORK >= MAX(2*N, 3*N-2), and for
-*>          the best performance, LWORK >= max(1,N*NB), where NB is
+*>          The length of WORK.  LWORK >= MAX(1,2*N,3*N-2), and for
+*>          the best performance, LWORK >= MAX(1,N*NB), where NB is
 *>          the optimal blocksize for SSYTRF_AA.
 *>
 *>          If LWORK = -1, then a workspace query is assumed; the routine
@@ -160,7 +160,7 @@
 *
 *  =====================================================================
       SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-     $                        LWORK, INFO )
+     $                     LWORK, INFO )
 *
 *  -- LAPACK driver routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -173,7 +173,7 @@
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * )
-      REAL   A( LDA, * ), B( LDB, * ), WORK( * )
+      REAL               A( LDA, * ), B( LDB, * ), WORK( * )
 *     ..
 *
 *  =====================================================================
diff --git a/SRC/ssysv_rk.f b/SRC/ssysv_rk.f
new file mode 100644
index 00000000..06641dbf
--- /dev/null
+++ b/SRC/ssysv_rk.f
@@ -0,0 +1,317 @@
+*> \brief <b> SSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYSV_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssysv_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssysv_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssysv_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            WORK, LWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> SSYSV_RK computes the solution to a real system of linear
+*> equations A * X = B, where A is an N-by-N symmetric matrix
+*> and X and B are N-by-NRHS matrices.
+*>
+*> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used
+*> to factor A as
+*>    A = P*U*D*(U**T)*(P**T),  if UPLO = 'U', or
+*>    A = P*L*D*(L**T)*(P**T),  if UPLO = 'L',
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> SSYTRF_RK is called to compute the factorization of a real
+*> symmetric matrix.  The factored form of A is then used to solve
+*> the system of equations A * X = B by calling BLAS3 routine SSYTRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of linear equations, i.e., the order of the
+*>          matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, if INFO = 0, diagonal of the block diagonal
+*>          matrix D and factors U or L  as computed by SSYTRF_RK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          For more info see the description of DSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is REAL array, dimension (N)
+*>          On exit, contains the output computed by the factorization
+*>          routine DSYTRF_RK, i.e. the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*>
+*>          For more info see the description of DSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D,
+*>          as determined by SSYTRF_RK.
+*>
+*>          For more info see the description of DSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is REAL array, dimension (LDB,NRHS)
+*>          On entry, the N-by-NRHS right hand side matrix B.
+*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension ( MAX(1,LWORK) ).
+*>          Work array used in the factorization stage.
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >= 1. For best performance
+*>          of factorization stage LWORK >= max(1,N*NB), where NB is
+*>          the optimal blocksize for DSYTRF_RK.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array for factorization stage, returns this value as
+*>          the first entry of the WORK array, and no error message
+*>          related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup singleSYsolve
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+     $                     WORK, LWORK, INFO )
+*
+*  -- LAPACK driver routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            LWKOPT
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, SSYTRF_RK, SSYTRS_3
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -11
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.EQ.0 ) THEN
+            LWKOPT = 1
+         ELSE
+            CALL SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
+            LWKOPT = WORK(1)
+         END IF
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYSV_RK ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Compute the factorization A = P*U*D*(U**T)*(P**T) or
+*     A = P*U*D*(U**T)*(P**T).
+*
+      CALL SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO )
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Solve the system A*X = B with BLAS3 solver, overwriting B with X.
+*
+         CALL SSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO )
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of SSYSV_RK
+*
+      END
diff --git a/SRC/ssytf2_rk.f b/SRC/ssytf2_rk.f
new file mode 100644
index 00000000..720a1503
--- /dev/null
+++ b/SRC/ssytf2_rk.f
@@ -0,0 +1,943 @@
+*> \brief \b SSYTF2_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYTF2_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytf2_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytf2_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytf2_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               A( LDA, * ), E ( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> SSYTF2_RK computes the factorization of a real symmetric matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is REAL array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup singleSYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put further details
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*>  01-01-96 - Based on modifications by
+*>    J. Lewis, Boeing Computer Services Company
+*>    A. Petitet, Computer Science Dept.,
+*>                Univ. of Tenn., Knoxville abd , USA
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      REAL               EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER, DONE
+      INTEGER            I, IMAX, J, JMAX, ITEMP, K, KK, KP, KSTEP,
+     $                   P, II
+      REAL               ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22,
+     $                   ROWMAX, STEMP, T, WK, WKM1, WKP1, SFMIN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ISAMAX
+      REAL               SLAMCH
+      EXTERNAL           LSAME, ISAMAX, SLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SSCAL, SSWAP, SSYR, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYTF2_RK', -INFO )
+         RETURN
+      END IF
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = SLAMCH( 'S' )
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**T using the upper triangle of A
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = ZERO
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 34
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( A( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = ISAMAX( K-1, A( 1, K ), 1 )
+            COLMAX = ABS( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = ZERO
+*
+         ELSE
+*
+*           Test for interchange
+*
+*           Equivalent to testing for (used to handle NaN and Inf)
+*           ABSAKK.GE.ALPHA*COLMAX
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange,
+*              use 1-by-1 pivot block
+*
+               KP = K
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   12          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + ISAMAX( K-IMAX, A( IMAX, IMAX+1 ),
+     $                                    LDA )
+                     ROWMAX = ABS( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = ISAMAX( IMAX-1, A( 1, IMAX ), 1 )
+                     STEMP = ABS( A( ITEMP, IMAX ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for (used to handle NaN and Inf)
+*                 ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX
+*
+                  IF( .NOT.( ABS( A( IMAX, IMAX ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX .EQ. COLMAX,
+*                 used to handle NaN and Inf
+*
+                  ELSE IF( ( P.EQ.JMAX ).OR.( ROWMAX.LE.COLMAX ) ) THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot NOT found, set variables and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 12
+*
+            END IF
+*
+*           Swap TWO rows and TWO columns
+*
+*           First swap
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Interchange rows and column K and P in the leading
+*              submatrix A(1:k,1:k) if we have a 2-by-2 pivot
+*
+               IF( P.GT.1 )
+     $            CALL SSWAP( P-1, A( 1, K ), 1, A( 1, P ), 1 )
+               IF( P.LT.(K-1) )
+     $            CALL SSWAP( K-P-1, A( P+1, K ), 1, A( P, P+1 ),
+     $                     LDA )
+               T = A( K, K )
+               A( K, K ) = A( P, P )
+               A( P, P ) = T
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL SSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA )
+*
+            END IF
+*
+*           Second swap
+*
+            KK = K - KSTEP + 1
+            IF( KP.NE.KK ) THEN
+*
+*              Interchange rows and columns KK and KP in the leading
+*              submatrix A(1:k,1:k)
+*
+               IF( KP.GT.1 )
+     $            CALL SSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 )
+               IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) )
+     $            CALL SSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ),
+     $                     LDA )
+               T = A( KK, KK )
+               A( KK, KK ) = A( KP, KP )
+               A( KP, KP ) = T
+               IF( KSTEP.EQ.2 ) THEN
+                  T = A( K-1, K )
+                  A( K-1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL SSWAP( N-K, A( KK, K+1 ), LDA, A( KP, K+1 ),
+     $                        LDA )
+*
+            END IF
+*
+*           Update the leading submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k now holds
+*
+*              W(k) = U(k)*D(k)
+*
+*              where U(k) is the k-th column of U
+*
+               IF( K.GT.1 ) THEN
+*
+*                 Perform a rank-1 update of A(1:k-1,1:k-1) and
+*                 store U(k) in column k
+*
+                  IF( ABS( A( K, K ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(1:k-1,1:k-1) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*1/D(k)*W(k)**T
+*
+                     D11 = ONE / A( K, K )
+                     CALL SSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+*
+*                    Store U(k) in column k
+*
+                     CALL SSCAL( K-1, D11, A( 1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column K
+*
+                     D11 = A( K, K )
+                     DO 16 II = 1, K - 1
+                        A( II, K ) = A( II, K ) / D11
+   16                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL SSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+                  END IF
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = ZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k-1 now hold
+*
+*              ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+*              Perform a rank-2 update of A(1:k-2,1:k-2) as
+*
+*              A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )**T
+*                 = A - ( ( A(k-1)A(k) )*inv(D(k)) ) * ( A(k-1)A(k) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.GT.2 ) THEN
+*
+                  D12 = A( K-1, K )
+                  D22 = A( K-1, K-1 ) / D12
+                  D11 = A( K, K ) / D12
+                  T = ONE / ( D11*D22-ONE )
+*
+                  DO 30 J = K - 2, 1, -1
+*
+                     WKM1 = T*( D11*A( J, K-1 )-A( J, K ) )
+                     WK = T*( D22*A( J, K )-A( J, K-1 ) )
+*
+                     DO 20 I = J, 1, -1
+                        A( I, J ) = A( I, J ) - (A( I, K ) / D12 )*WK -
+     $                              ( A( I, K-1 ) / D12 )*WKM1
+   20                CONTINUE
+*
+*                    Store U(k) and U(k-1) in cols k and k-1 for row J
+*
+                     A( J, K ) = WK / D12
+                     A( J, K-1 ) = WKM1 / D12
+*
+   30             CONTINUE
+*
+               END IF
+*
+*              Copy superdiagonal elements of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               E( K ) = A( K-1, K )
+               E( K-1 ) = ZERO
+               A( K-1, K ) = ZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   34    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**T using the lower triangle of A
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = ZERO
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        1 or 2
+*
+         K = 1
+   40    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 64
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( A( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + ISAMAX( N-K, A( K+1, K ), 1 )
+            COLMAX = ABS( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( ( MAX( ABSAKK, COLMAX ).EQ.ZERO ) ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = ZERO
+*
+         ELSE
+*
+*           Test for interchange
+*
+*           Equivalent to testing for (used to handle NaN and Inf)
+*           ABSAKK.GE.ALPHA*COLMAX
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   42          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + ISAMAX( IMAX-K, A( IMAX, K ), LDA )
+                     ROWMAX = ABS( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + ISAMAX( N-IMAX, A( IMAX+1, IMAX ),
+     $                                     1 )
+                     STEMP = ABS( A( ITEMP, IMAX ) )
+                     IF( STEMP.GT.ROWMAX ) THEN
+                        ROWMAX = STEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for (used to handle NaN and Inf)
+*                 ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX
+*
+                  IF( .NOT.( ABS( A( IMAX, IMAX ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX .EQ. COLMAX,
+*                 used to handle NaN and Inf
+*
+                  ELSE IF( ( P.EQ.JMAX ).OR.( ROWMAX.LE.COLMAX ) ) THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot NOT found, set variables and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 42
+*
+            END IF
+*
+*           Swap TWO rows and TWO columns
+*
+*           First swap
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Interchange rows and column K and P in the trailing
+*              submatrix A(k:n,k:n) if we have a 2-by-2 pivot
+*
+               IF( P.LT.N )
+     $            CALL SSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 )
+               IF( P.GT.(K+1) )
+     $            CALL SSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA )
+               T = A( K, K )
+               A( K, K ) = A( P, P )
+               A( P, P ) = T
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL SSWAP( K-1, A( K, 1 ), LDA, A( P, 1 ), LDA )
+*
+            END IF
+*
+*           Second swap
+*
+            KK = K + KSTEP - 1
+            IF( KP.NE.KK ) THEN
+*
+*              Interchange rows and columns KK and KP in the trailing
+*              submatrix A(k:n,k:n)
+*
+               IF( KP.LT.N )
+     $            CALL SSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+               IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) )
+     $            CALL SSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
+     $                     LDA )
+               T = A( KK, KK )
+               A( KK, KK ) = A( KP, KP )
+               A( KP, KP ) = T
+               IF( KSTEP.EQ.2 ) THEN
+                  T = A( K+1, K )
+                  A( K+1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL SSWAP( K-1, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+*
+            END IF
+*
+*           Update the trailing submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k now holds
+*
+*              W(k) = L(k)*D(k)
+*
+*              where L(k) is the k-th column of L
+*
+               IF( K.LT.N ) THEN
+*
+*              Perform a rank-1 update of A(k+1:n,k+1:n) and
+*              store L(k) in column k
+*
+                  IF( ABS( A( K, K ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*
+                     D11 = ONE / A( K, K )
+                     CALL SSYR( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+*
+*                    Store L(k) in column k
+*
+                     CALL SSCAL( N-K, D11, A( K+1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column k
+*
+                     D11 = A( K, K )
+                     DO 46 II = K + 1, N
+                        A( II, K ) = A( II, K ) / D11
+   46                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL SSYR( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+                  END IF
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = ZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+*
+*              Perform a rank-2 update of A(k+2:n,k+2:n) as
+*
+*              A := A - ( L(k) L(k+1) ) * D(k) * ( L(k) L(k+1) )**T
+*                 = A - ( ( A(k)A(k+1) )*inv(D(k) ) * ( A(k)A(k+1) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.LT.N-1 ) THEN
+*
+                  D21 = A( K+1, K )
+                  D11 = A( K+1, K+1 ) / D21
+                  D22 = A( K, K ) / D21
+                  T = ONE / ( D11*D22-ONE )
+*
+                  DO 60 J = K + 2, N
+*
+*                    Compute  D21 * ( W(k)W(k+1) ) * inv(D(k)) for row J
+*
+                     WK = T*( D11*A( J, K )-A( J, K+1 ) )
+                     WKP1 = T*( D22*A( J, K+1 )-A( J, K ) )
+*
+*                    Perform a rank-2 update of A(k+2:n,k+2:n)
+*
+                     DO 50 I = J, N
+                        A( I, J ) = A( I, J ) - ( A( I, K ) / D21 )*WK -
+     $                              ( A( I, K+1 ) / D21 )*WKP1
+   50                CONTINUE
+*
+*                    Store L(k) and L(k+1) in cols k and k+1 for row J
+*
+                     A( J, K ) = WK / D21
+                     A( J, K+1 ) = WKP1 / D21
+*
+   60             CONTINUE
+*
+               END IF
+*
+*              Copy subdiagonal elements of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               E( K ) = A( K+1, K )
+               E( K+1 ) = ZERO
+               A( K+1, K ) = ZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 40
+*
+   64    CONTINUE
+*
+      END IF
+*
+      RETURN
+*
+*     End of SSYTF2_RK
+*
+      END
diff --git a/SRC/ssytrd_2stage.f b/SRC/ssytrd_2stage.f
new file mode 100644
index 00000000..fba3dd45
--- /dev/null
+++ b/SRC/ssytrd_2stage.f
@@ -0,0 +1,337 @@
+*> \brief \b SSYTRD_2STAGE
+*
+*  @generated from zhetrd_2stage.f, fortran z -> s, Sun Nov  6 19:34:06 2016
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SSYTRD_2STAGE + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrd_2stage.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrd_2stage.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrd_2stage.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, 
+*                                 HOUS2, LHOUS2, WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*      .. Scalar Arguments ..
+*       CHARACTER          VECT, UPLO
+*       INTEGER            N, LDA, LWORK, LHOUS2, INFO
+*      ..
+*      .. Array Arguments ..
+*       REAL               D( * ), E( * )
+*       REAL               A( LDA, * ), TAU( * ),
+*                          HOUS2( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSYTRD_2STAGE reduces a real symmetric matrix A to real symmetric
+*> tridiagonal form T by a orthogonal similarity transformation:
+*> Q1**T Q2**T* A * Q2 * Q1 = T.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] VECT
+*> \verbatim
+*>          VECT is CHARACTER*1
+*>          = 'N':  No need for the Housholder representation, 
+*>                  in particular for the second stage (Band to
+*>                  tridiagonal) and thus LHOUS2 is of size max(1, 4*N);
+*>          = 'V':  the Householder representation is needed to 
+*>                  either generate Q1 Q2 or to apply Q1 Q2, 
+*>                  then LHOUS2 is to be queried and computed.
+*>                  (NOT AVAILABLE IN THIS RELEASE).
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>          On exit, if UPLO = 'U', the band superdiagonal
+*>          of A are overwritten by the corresponding elements of the
+*>          internal band-diagonal matrix AB, and the elements above 
+*>          the KD superdiagonal, with the array TAU, represent the orthogonal
+*>          matrix Q1 as a product of elementary reflectors; if UPLO
+*>          = 'L', the diagonal and band subdiagonal of A are over-
+*>          written by the corresponding elements of the internal band-diagonal
+*>          matrix AB, and the elements below the KD subdiagonal, with
+*>          the array TAU, represent the orthogonal matrix Q1 as a product
+*>          of elementary reflectors. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] D
+*> \verbatim
+*>          D is REAL array, dimension (N)
+*>          The diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is REAL array, dimension (N-1)
+*>          The off-diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (N-KD)
+*>          The scalar factors of the elementary reflectors of 
+*>          the first stage (see Further Details).
+*> \endverbatim
+*>
+*> \param[out] HOUS2
+*> \verbatim
+*>          HOUS2 is REAL array, dimension LHOUS2, that
+*>          store the Householder representation of the stage2
+*>          band to tridiagonal.
+*> \endverbatim
+*>
+*> \param[in] LHOUS2
+*> \verbatim
+*>          LHOUS2 is INTEGER
+*>          The dimension of the array HOUS2. LHOUS2 = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS2=-1,
+*>          then a query is assumed; the routine
+*>          only calculates the optimal size of the HOUS2 array, returns
+*>          this value as the first entry of the HOUS2 array, and no error
+*>          message related to LHOUS2 is issued by XERBLA.
+*>          LHOUS2 = MAX(1, dimension) where
+*>          dimension = 4*N if VECT='N'
+*>          not available now if VECT='H'
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK. LWORK = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS2=-1,
+*>          then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK = MAX(1, dimension) where
+*>          dimension   = max(stage1,stage2) + (KD+1)*N
+*>                      = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                        + max(2*KD*KD, KD*NTHREADS) 
+*>                        + (KD+1)*N 
+*>          where KD is the blocking size of the reduction,
+*>          FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice
+*>          NTHREADS is the number of threads used when
+*>          openMP compilation is enabled, otherwise =1.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2016
+*
+*> \ingroup realSYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, 
+     $                          HOUS2, LHOUS2, WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          VECT, UPLO
+      INTEGER            N, LDA, LWORK, LHOUS2, INFO
+*     ..
+*     .. Array Arguments ..
+      REAL               D( * ), E( * )
+      REAL               A( LDA, * ), TAU( * ),
+     $                   HOUS2( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER, WANTQ
+      INTEGER            KD, IB, LWMIN, LHMIN, LWRK, LDAB, WPOS, ABPOS
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, SSYTRD_SY2SB, SSYTRD_SB2ST
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters
+*
+      INFO   = 0
+      WANTQ  = LSAME( VECT, 'V' )
+      UPPER  = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 ) .OR. ( LHOUS2.EQ.-1 )
+*
+*     Determine the block size, the workspace size and the hous size.
+*
+      KD     = ILAENV( 17, 'SSYTRD_2STAGE', VECT, N, -1, -1, -1 )
+      IB     = ILAENV( 18, 'SSYTRD_2STAGE', VECT, N, KD, -1, -1 )
+      LHMIN  = ILAENV( 19, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 )
+      LWMIN  = ILAENV( 20, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 )
+*      WRITE(*,*),'SSYTRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
+*     $            LHMIN, LWMIN
+*
+      IF( .NOT.LSAME( VECT, 'N' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LHOUS2.LT.LHMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -10
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -12
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         HOUS2( 1 ) = LHMIN
+         WORK( 1 )  = LWMIN
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYTRD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+*     Determine pointer position
+*
+      LDAB  = KD+1
+      LWRK  = LWORK-LDAB*N
+      ABPOS = 1
+      WPOS  = ABPOS + LDAB*N
+      CALL SSYTRD_SY2SB( UPLO, N, KD, A, LDA, WORK( ABPOS ), LDAB, 
+     $                   TAU, WORK( WPOS ), LWRK, INFO )
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYTRD_SY2SB', -INFO )
+         RETURN
+      END IF
+      CALL SSYTRD_SB2ST( 'Y', VECT, UPLO, N, KD, 
+     $                   WORK( ABPOS ), LDAB, D, E, 
+     $                   HOUS2, LHOUS2, WORK( WPOS ), LWRK, INFO )
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYTRD_SB2ST', -INFO )
+         RETURN
+      END IF
+*
+*
+      HOUS2( 1 ) = LHMIN
+      WORK( 1 )  = LWMIN
+      RETURN
+*
+*     End of SSYTRD_2STAGE
+*
+      END
diff --git a/SRC/ssytrd_sb2st.F b/SRC/ssytrd_sb2st.F
new file mode 100644
index 00000000..b3e5d69c
--- /dev/null
+++ b/SRC/ssytrd_sb2st.F
@@ -0,0 +1,549 @@
+*> \brief \b SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric tridiagonal form T
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYTRD_SB2ST + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrd_sb2t.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrd_sb2t.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrd_sb2t.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 
+*                               D, E, HOUS, LHOUS, WORK, LWORK, INFO )
+*
+*       #if defined(_OPENMP)
+*       use omp_lib
+*       #endif
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          STAGE1, UPLO, VECT
+*       INTEGER            N, KD, IB, LDAB, LHOUS, LWORK, INFO
+*       ..
+*       .. Array Arguments ..
+*       REAL               D( * ), E( * )
+*       REAL               AB( LDAB, * ), HOUS( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric
+*> tridiagonal form T by a orthogonal similarity transformation:
+*> Q**T * A * Q = T.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] STAGE
+*> \verbatim
+*>          STAGE is CHARACTER*1
+*>          = 'N':  "No": to mention that the stage 1 of the reduction  
+*>                  from dense to band using the ssytrd_sy2sb routine
+*>                  was not called before this routine to reproduce AB. 
+*>                  In other term this routine is called as standalone. 
+*>          = 'Y':  "Yes": to mention that the stage 1 of the 
+*>                  reduction from dense to band using the ssytrd_sy2sb 
+*>                  routine has been called to produce AB (e.g., AB is
+*>                  the output of ssytrd_sy2sb.
+*> \endverbatim
+*>
+*> \param[in] VECT
+*> \verbatim
+*>          VECT is CHARACTER*1
+*>          = 'N':  No need for the Housholder representation, 
+*>                  and thus LHOUS is of size max(1, 4*N);
+*>          = 'V':  the Householder representation is needed to 
+*>                  either generate or to apply Q later on, 
+*>                  then LHOUS is to be queried and computed.
+*>                  (NOT AVAILABLE IN THIS RELEASE).
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is REAL array, dimension (LDAB,N)
+*>          On entry, the upper or lower triangle of the symmetric band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>          On exit, the diagonal elements of AB are overwritten by the
+*>          diagonal elements of the tridiagonal matrix T; if KD > 0, the
+*>          elements on the first superdiagonal (if UPLO = 'U') or the
+*>          first subdiagonal (if UPLO = 'L') are overwritten by the
+*>          off-diagonal elements of T; the rest of AB is overwritten by
+*>          values generated during the reduction.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD+1.
+*> \endverbatim
+*>
+*> \param[out] D
+*> \verbatim
+*>          D is REAL array, dimension (N)
+*>          The diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is REAL array, dimension (N-1)
+*>          The off-diagonal elements of the tridiagonal matrix T:
+*>          E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
+*> \endverbatim
+*>
+*> \param[out] HOUS
+*> \verbatim
+*>          HOUS is REAL array, dimension LHOUS, that
+*>          store the Householder representation.
+*> \endverbatim
+*>
+*> \param[in] LHOUS
+*> \verbatim
+*>          LHOUS is INTEGER
+*>          The dimension of the array HOUS. LHOUS = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS=-1,
+*>          then a query is assumed; the routine
+*>          only calculates the optimal size of the HOUS array, returns
+*>          this value as the first entry of the HOUS array, and no error
+*>          message related to LHOUS is issued by XERBLA.
+*>          LHOUS = MAX(1, dimension) where
+*>          dimension = 4*N if VECT='N'
+*>          not available now if VECT='H'     
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK. LWORK = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS=-1,
+*>          then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK = MAX(1, dimension) where
+*>          dimension   = (2KD+1)*N + KD*NTHREADS
+*>          where KD is the blocking size of the reduction,
+*>          FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice
+*>          NTHREADS is the number of threads used when
+*>          openMP compilation is enabled, otherwise =1.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup real16OTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 
+     $                         D, E, HOUS, LHOUS, WORK, LWORK, INFO )
+*
+#if defined(_OPENMP)
+      use omp_lib
+#endif
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          STAGE1, UPLO, VECT
+      INTEGER            N, KD, LDAB, LHOUS, LWORK, INFO
+*     ..
+*     .. Array Arguments ..
+      REAL               D( * ), E( * )
+      REAL               AB( LDAB, * ), HOUS( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               RZERO
+      REAL               ZERO, ONE
+      PARAMETER          ( RZERO = 0.0E+0,
+     $                   ZERO = 0.0E+0,
+     $                   ONE  = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, WANTQ, UPPER, AFTERS1
+      INTEGER            I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST, 
+     $                   ED, STIND, EDIND, BLKLASTIND, COLPT, THED,
+     $                   STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID,
+     $                   NBTILES, TTYPE, TID, NTHREADS, DEBUG,
+     $                   ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS, 
+     $                   INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
+     $                   SISEV, SIZETAU, LDV, LHMIN, LWMIN
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SSB2ST_KERNELS, SLACPY, SLASET
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN, MAX, CEILING, REAL
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV 
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Determine the minimal workspace size required.
+*     Test the input parameters
+*
+      DEBUG   = 0
+      INFO    = 0
+      AFTERS1 = LSAME( STAGE1, 'Y' )
+      WANTQ   = LSAME( VECT, 'V' )
+      UPPER   = LSAME( UPLO, 'U' )
+      LQUERY  = ( LWORK.EQ.-1 ) .OR. ( LHOUS.EQ.-1 )
+*
+*     Determine the block size, the workspace size and the hous size.
+*
+      IB     = ILAENV( 18, 'SSYTRD_SB2ST', VECT, N, KD, -1, -1 )
+      LHMIN  = ILAENV( 19, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 )
+      LWMIN  = ILAENV( 20, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 )
+*
+      IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.LSAME( VECT, 'N' ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.(KD+1) ) THEN
+         INFO = -7
+      ELSE IF( LHOUS.LT.LHMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -11
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -13
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         HOUS( 1 ) = LHMIN
+         WORK( 1 ) = LWMIN
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYTRD_SB2ST', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+*     Determine pointer position
+*
+      LDV      = KD + IB
+      SIZETAU  = 2 * N
+      SISEV    = 2 * N
+      INDTAU   = 1
+      INDV     = INDTAU + SIZETAU
+      LDA      = 2 * KD + 1
+      SIZEA    = LDA * N
+      INDA     = 1
+      INDW     = INDA + SIZEA
+      NTHREADS = 1
+      TID      = 0
+*
+      IF( UPPER ) THEN
+          APOS     = INDA + KD
+          AWPOS    = INDA
+          DPOS     = APOS + KD
+          OFDPOS   = DPOS - 1
+          ABDPOS   = KD + 1
+          ABOFDPOS = KD
+      ELSE
+          APOS     = INDA 
+          AWPOS    = INDA + KD + 1
+          DPOS     = APOS
+          OFDPOS   = DPOS + 1
+          ABDPOS   = 1
+          ABOFDPOS = 2
+
+      ENDIF
+*      
+*     Case KD=0: 
+*     The matrix is diagonal. We just copy it (convert to "real" for 
+*     real because D is double and the imaginary part should be 0) 
+*     and store it in D. A sequential code here is better or 
+*     in a parallel environment it might need two cores for D and E
+*
+      IF( KD.EQ.0 ) THEN
+          DO 30 I = 1, N
+              D( I ) = ( AB( ABDPOS, I ) )
+   30     CONTINUE
+          DO 40 I = 1, N-1
+              E( I ) = RZERO
+   40     CONTINUE
+         RETURN
+      END IF
+*      
+*     Case KD=1: 
+*     The matrix is already Tridiagonal. We have to make diagonal 
+*     and offdiagonal elements real, and store them in D and E.
+*     For that, for real precision just copy the diag and offdiag 
+*     to D and E while for the COMPLEX case the bulge chasing is  
+*     performed to convert the hermetian tridiagonal to symmetric 
+*     tridiagonal. A simpler coversion formula might be used, but then 
+*     updating the Q matrix will be required and based if Q is generated
+*     or not this might complicate the story. 
+*      
+      IF( KD.EQ.1 ) THEN
+          DO 50 I = 1, N
+              D( I ) = ( AB( ABDPOS, I ) )
+   50     CONTINUE
+*
+          IF( UPPER ) THEN
+              DO 60 I = 1, N-1
+                 E( I ) = ( AB( ABOFDPOS, I+1 ) )
+   60         CONTINUE
+          ELSE
+              DO 70 I = 1, N-1
+                 E( I ) = ( AB( ABOFDPOS, I ) )
+   70         CONTINUE
+          ENDIF
+          RETURN
+      END IF
+*
+*     Main code start here. 
+*     Reduce the symmetric band of A to a tridiagonal matrix.
+*
+      THGRSIZ   = N
+      GRSIZ     = 1
+      SHIFT     = 3
+      NBTILES   = CEILING( REAL(N)/REAL(KD) )
+      STEPERCOL = CEILING( REAL(SHIFT)/REAL(GRSIZ) )
+      THGRNB    = CEILING( REAL(N-1)/REAL(THGRSIZ) )
+*      
+      CALL SLACPY( "A", KD+1, N, AB, LDAB, WORK( APOS ), LDA )
+      CALL SLASET( "A", KD,   N, ZERO, ZERO, WORK( AWPOS ), LDA )
+*
+*
+*     openMP parallelisation start here
+*
+#if defined(_OPENMP)
+!$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND )
+!$OMP$         PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID ) 
+!$OMP$         PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND )
+!$OMP$         SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK)
+!$OMP$         SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA )
+!$OMP$         SHARED ( STEPERCOL, THGRNB, THGRSIZ, GRSIZ, SHIFT )
+!$OMP MASTER
+#endif
+*
+*     main bulge chasing loop
+*      
+      DO 100 THGRID = 1, THGRNB
+          STT  = (THGRID-1)*THGRSIZ+1
+          THED = MIN( (STT + THGRSIZ -1), (N-1))
+          DO 110 I = STT, N-1
+              ED = MIN( I, THED )
+              IF( STT.GT.ED ) GOTO 100
+              DO 120 M = 1, STEPERCOL
+                  ST = STT
+                  DO 130 SWEEPID = ST, ED
+                      DO 140 K = 1, GRSIZ
+                          MYID  = (I-SWEEPID)*(STEPERCOL*GRSIZ) 
+     $                           + (M-1)*GRSIZ + K
+                          IF ( MYID.EQ.1 ) THEN
+                              TTYPE = 1
+                          ELSE
+                              TTYPE = MOD( MYID, 2 ) + 2
+                          ENDIF
+
+                          IF( TTYPE.EQ.2 ) THEN
+                              COLPT      = (MYID/2)*KD + SWEEPID
+                              STIND      = COLPT-KD+1
+                              EDIND      = MIN(COLPT,N)
+                              BLKLASTIND = COLPT
+                          ELSE
+                              COLPT      = ((MYID+1)/2)*KD + SWEEPID
+                              STIND      = COLPT-KD+1
+                              EDIND      = MIN(COLPT,N)
+                              IF( ( STIND.GE.EDIND-1 ).AND.
+     $                            ( EDIND.EQ.N ) ) THEN
+                                  BLKLASTIND = N
+                              ELSE
+                                  BLKLASTIND = 0
+                              ENDIF
+                          ENDIF
+*
+*                         Call the kernel
+*                             
+#if defined(_OPENMP)
+                          IF( TTYPE.NE.1 ) THEN      
+!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
+!$OMP$     DEPEND(in:WORK(MYID-1))
+!$OMP$     DEPEND(out:WORK(MYID))
+                              TID      = OMP_GET_THREAD_NUM()
+                              CALL SSB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                             STIND, EDIND, SWEEPID, N, KD, IB,
+     $                             WORK ( INDA ), LDA, 
+     $                             HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                             WORK( INDW + TID*KD ) )
+!$OMP END TASK
+                          ELSE
+!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
+!$OMP$     DEPEND(out:WORK(MYID))
+                              TID      = OMP_GET_THREAD_NUM()
+                              CALL SSB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                             STIND, EDIND, SWEEPID, N, KD, IB,
+     $                             WORK ( INDA ), LDA, 
+     $                             HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                             WORK( INDW + TID*KD ) )
+!$OMP END TASK
+                          ENDIF
+#else
+                          CALL SSB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                         STIND, EDIND, SWEEPID, N, KD, IB,
+     $                         WORK ( INDA ), LDA, 
+     $                         HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                         WORK( INDW + TID*KD ) )
+#endif 
+                          IF ( BLKLASTIND.GE.(N-1) ) THEN
+                              STT = STT + 1
+                              GOTO 130
+                          ENDIF
+  140                 CONTINUE
+  130             CONTINUE
+  120         CONTINUE
+  110     CONTINUE
+  100 CONTINUE
+*
+#if defined(_OPENMP)
+!$OMP END MASTER
+!$OMP END PARALLEL
+#endif
+*      
+*     Copy the diagonal from A to D. Note that D is REAL thus only
+*     the Real part is needed, the imaginary part should be zero.
+*
+      DO 150 I = 1, N
+          D( I ) = ( WORK( DPOS+(I-1)*LDA ) )
+  150 CONTINUE
+*      
+*     Copy the off diagonal from A to E. Note that E is REAL thus only
+*     the Real part is needed, the imaginary part should be zero.
+*
+      IF( UPPER ) THEN
+          DO 160 I = 1, N-1
+             E( I ) = ( WORK( OFDPOS+I*LDA ) )
+  160     CONTINUE
+      ELSE
+          DO 170 I = 1, N-1
+             E( I ) = ( WORK( OFDPOS+(I-1)*LDA ) )
+  170     CONTINUE
+      ENDIF
+*
+      HOUS( 1 ) = LHMIN
+      WORK( 1 ) = LWMIN
+      RETURN
+*
+*     End of SSYTRD_SB2ST
+*
+      END
+      
diff --git a/SRC/ssytrd_sy2sb.f b/SRC/ssytrd_sy2sb.f
new file mode 100644
index 00000000..3dbbaf1f
--- /dev/null
+++ b/SRC/ssytrd_sy2sb.f
@@ -0,0 +1,517 @@
+*> \brief \b SSYTRD_SY2SB
+*
+*  @generated from zhetrd_he2hb.f, fortran z -> s, Sun Nov  6 19:34:06 2016
+*      
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SSYTRD_SY2SB + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrd.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrd.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrd.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, 
+*                              WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDAB, LWORK, N, KD
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), AB( LDAB, * ), 
+*                          TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSYTRD_SY2SB reduces a real symmetric matrix A to real symmetric
+*> band-diagonal form AB by a orthogonal similarity transformation:
+*> Q**T * A * Q = AB.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the reduced matrix if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*>          The reduced matrix is stored in the array AB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>          On exit, if UPLO = 'U', the diagonal and first superdiagonal
+*>          of A are overwritten by the corresponding elements of the
+*>          tridiagonal matrix T, and the elements above the first
+*>          superdiagonal, with the array TAU, represent the orthogonal
+*>          matrix Q as a product of elementary reflectors; if UPLO
+*>          = 'L', the diagonal and first subdiagonal of A are over-
+*>          written by the corresponding elements of the tridiagonal
+*>          matrix T, and the elements below the first subdiagonal, with
+*>          the array TAU, represent the orthogonal matrix Q as a product
+*>          of elementary reflectors. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] AB
+*> \verbatim
+*>          AB is REAL array, dimension (LDAB,N)
+*>          On exit, the upper or lower triangle of the symmetric band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD+1.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (N-KD)
+*>          The scalar factors of the elementary reflectors (see Further
+*>          Details).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension LWORK.
+*>          On exit, if INFO = 0, or if LWORK=-1, 
+*>          WORK(1) returns the size of LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK which should be calculated
+*           by a workspace query. LWORK = MAX(1, LWORK_QUERY)
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK_QUERY = N*KD + N*max(KD,FACTOPTNB) + 2*KD*KD
+*>          where FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice otherwise
+*>          putting LWORK=-1 will provide the size of WORK.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2016
+*
+*> \ingroup realSYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*> \verbatim
+*>
+*>  If UPLO = 'U', the matrix Q is represented as a product of elementary
+*>  reflectors
+*>
+*>     Q = H(k)**T . . . H(2)**T H(1)**T, where k = n-kd.
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**T
+*>
+*>  where tau is a real scalar, and v is a real vector with
+*>  v(1:i+kd-1) = 0 and v(i+kd) = 1; conjg(v(i+kd+1:n)) is stored on exit in
+*>  A(i,i+kd+1:n), and tau in TAU(i).
+*>
+*>  If UPLO = 'L', the matrix Q is represented as a product of elementary
+*>  reflectors
+*>
+*>     Q = H(1) H(2) . . . H(k), where k = n-kd.
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**T
+*>
+*>  where tau is a real scalar, and v is a real vector with
+*>  v(kd+1:i) = 0 and v(i+kd+1) = 1; v(i+kd+2:n) is stored on exit in
+*   A(i+kd+2:n,i), and tau in TAU(i).
+*>
+*>  The contents of A on exit are illustrated by the following examples
+*>  with n = 5:
+*>
+*>  if UPLO = 'U':                       if UPLO = 'L':
+*>
+*>    (  ab  ab/v1  v1      v1     v1    )              (  ab                            )
+*>    (      ab     ab/v2   v2     v2    )              (  ab/v1  ab                     )
+*>    (             ab      ab/v3  v3    )              (  v1     ab/v2  ab              )
+*>    (                     ab     ab/v4 )              (  v1     v2     ab/v3  ab       )
+*>    (                            ab    )              (  v1     v2     v3     ab/v4 ab )
+*>
+*>  where d and e denote diagonal and off-diagonal elements of T, and vi
+*>  denotes an element of the vector defining H(i).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, 
+     $                         WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDAB, LWORK, N, KD
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), AB( LDAB, * ), 
+     $                   TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               RONE
+      REAL               ZERO, ONE, HALF
+      PARAMETER          ( RONE = 1.0E+0,
+     $                   ZERO = 0.0E+0,
+     $                   ONE = 1.0E+0,
+     $                   HALF = 0.5E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, J, IINFO, LWMIN, PN, PK, LK,
+     $                   LDT, LDW, LDS2, LDS1, 
+     $                   LS2, LS1, LW, LT,
+     $                   TPOS, WPOS, S2POS, S1POS
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, SSYR2K, SSYMM, SGEMM,
+     $                   SLARFT, SGELQF, SGEQRF, SLASET
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN, MAX
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV 
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Determine the minimal workspace size required 
+*     and test the input parameters
+*
+      INFO   = 0
+      UPPER  = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      LWMIN  = ILAENV( 20, 'SSYTRD_SY2SB', '', N, KD, -1, -1 )
+      
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.MAX( 1, KD+1 ) ) THEN
+         INFO = -7
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -10
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYTRD_SY2SB', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         WORK( 1 ) = LWMIN
+         RETURN
+      END IF
+*
+*     Quick return if possible        
+*     Copy the upper/lower portion of A into AB 
+*
+      IF( N.LE.KD+1 ) THEN
+          IF( UPPER ) THEN
+              DO 100 I = 1, N
+                  LK = MIN( KD+1, I )
+                  CALL SCOPY( LK, A( I-LK+1, I ), 1, 
+     $                            AB( KD+1-LK+1, I ), 1 )
+  100         CONTINUE
+          ELSE
+              DO 110 I = 1, N
+                  LK = MIN( KD+1, N-I+1 )
+                  CALL SCOPY( LK, A( I, I ), 1, AB( 1, I ), 1 )
+  110         CONTINUE
+          ENDIF
+          WORK( 1 ) = 1
+          RETURN
+      END IF
+*
+*     Determine the pointer position for the workspace
+*      
+      LDT    = KD
+      LDS1   = KD
+      LT     = LDT*KD
+      LW     = N*KD
+      LS1    = LDS1*KD
+      LS2    = LWMIN - LT - LW - LS1
+*      LS2 = N*MAX(KD,FACTOPTNB) 
+      TPOS   = 1
+      WPOS   = TPOS  + LT
+      S1POS  = WPOS  + LW
+      S2POS  = S1POS + LS1 
+      IF( UPPER ) THEN
+          LDW    = KD
+          LDS2   = KD
+      ELSE
+          LDW    = N
+          LDS2   = N
+      ENDIF
+*
+*
+*     Set the workspace of the triangular matrix T to zero once such a
+*     way everytime T is generated the upper/lower portion will be always zero  
+*   
+      CALL SLASET( "A", LDT, KD, ZERO, ZERO, WORK( TPOS ), LDT )
+*
+      IF( UPPER ) THEN
+          DO 10 I = 1, N - KD, KD
+             PN = N-I-KD+1
+             PK = MIN( N-I-KD+1, KD )
+*        
+*            Compute the LQ factorization of the current block
+*        
+             CALL SGELQF( KD, PN, A( I, I+KD ), LDA,
+     $                    TAU( I ), WORK( S2POS ), LS2, IINFO )
+*        
+*            Copy the upper portion of A into AB
+*        
+             DO 20 J = I, I+PK-1
+                LK = MIN( KD, N-J ) + 1
+                CALL SCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 )
+   20        CONTINUE
+*                
+             CALL SLASET( 'Lower', PK, PK, ZERO, ONE, 
+     $                    A( I, I+KD ), LDA )
+*        
+*            Form the matrix T
+*        
+             CALL SLARFT( 'Forward', 'Rowwise', PN, PK,
+     $                    A( I, I+KD ), LDA, TAU( I ), 
+     $                    WORK( TPOS ), LDT )
+*        
+*            Compute W:
+*             
+             CALL SGEMM( 'Conjugate', 'No transpose', PK, PN, PK,
+     $                   ONE,  WORK( TPOS ), LDT,
+     $                         A( I, I+KD ), LDA,
+     $                   ZERO, WORK( S2POS ), LDS2 )
+*        
+             CALL SSYMM( 'Right', UPLO, PK, PN,
+     $                   ONE,  A( I+KD, I+KD ), LDA,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( WPOS ), LDW )
+*        
+             CALL SGEMM( 'No transpose', 'Conjugate', PK, PK, PN,
+     $                   ONE,  WORK( WPOS ), LDW,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( S1POS ), LDS1 )
+*        
+             CALL SGEMM( 'No transpose', 'No transpose', PK, PN, PK,
+     $                   -HALF, WORK( S1POS ), LDS1, 
+     $                          A( I, I+KD ), LDA,
+     $                   ONE,   WORK( WPOS ), LDW )
+*             
+*        
+*            Update the unreduced submatrix A(i+kd:n,i+kd:n), using
+*            an update of the form:  A := A - V'*W - W'*V
+*        
+             CALL SSYR2K( UPLO, 'Conjugate', PN, PK,
+     $                    -ONE, A( I, I+KD ), LDA,
+     $                          WORK( WPOS ), LDW,
+     $                    RONE, A( I+KD, I+KD ), LDA )
+   10     CONTINUE
+*
+*        Copy the upper band to AB which is the band storage matrix
+*
+         DO 30 J = N-KD+1, N
+            LK = MIN(KD, N-J) + 1
+            CALL SCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 )
+   30    CONTINUE
+*
+      ELSE
+*
+*         Reduce the lower triangle of A to lower band matrix
+*        
+          DO 40 I = 1, N - KD, KD
+             PN = N-I-KD+1
+             PK = MIN( N-I-KD+1, KD )
+*        
+*            Compute the QR factorization of the current block
+*        
+             CALL SGEQRF( PN, KD, A( I+KD, I ), LDA,
+     $                    TAU( I ), WORK( S2POS ), LS2, IINFO )
+*        
+*            Copy the upper portion of A into AB 
+*        
+             DO 50 J = I, I+PK-1
+                LK = MIN( KD, N-J ) + 1
+                CALL SCOPY( LK, A( J, J ), 1, AB( 1, J ), 1 )
+   50        CONTINUE
+*                
+             CALL SLASET( 'Upper', PK, PK, ZERO, ONE, 
+     $                    A( I+KD, I ), LDA )
+*        
+*            Form the matrix T
+*        
+             CALL SLARFT( 'Forward', 'Columnwise', PN, PK,
+     $                    A( I+KD, I ), LDA, TAU( I ), 
+     $                    WORK( TPOS ), LDT )
+*        
+*            Compute W:
+*             
+             CALL SGEMM( 'No transpose', 'No transpose', PN, PK, PK,
+     $                   ONE, A( I+KD, I ), LDA,
+     $                         WORK( TPOS ), LDT,
+     $                   ZERO, WORK( S2POS ), LDS2 )
+*        
+             CALL SSYMM( 'Left', UPLO, PN, PK,
+     $                   ONE, A( I+KD, I+KD ), LDA,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( WPOS ), LDW )
+*        
+             CALL SGEMM( 'Conjugate', 'No transpose', PK, PK, PN,
+     $                   ONE, WORK( S2POS ), LDS2,
+     $                         WORK( WPOS ), LDW,
+     $                   ZERO, WORK( S1POS ), LDS1 )
+*        
+             CALL SGEMM( 'No transpose', 'No transpose', PN, PK, PK,
+     $                   -HALF, A( I+KD, I ), LDA,
+     $                         WORK( S1POS ), LDS1,
+     $                   ONE, WORK( WPOS ), LDW )
+*             
+*        
+*            Update the unreduced submatrix A(i+kd:n,i+kd:n), using
+*            an update of the form:  A := A - V*W' - W*V'
+*        
+             CALL SSYR2K( UPLO, 'No transpose', PN, PK,
+     $                    -ONE, A( I+KD, I ), LDA,
+     $                           WORK( WPOS ), LDW,
+     $                    RONE, A( I+KD, I+KD ), LDA )
+*            ==================================================================
+*            RESTORE A FOR COMPARISON AND CHECKING TO BE REMOVED
+*             DO 45 J = I, I+PK-1
+*                LK = MIN( KD, N-J ) + 1
+*                CALL SCOPY( LK, AB( 1, J ), 1, A( J, J ), 1 )
+*   45        CONTINUE
+*            ==================================================================
+   40     CONTINUE
+*
+*        Copy the lower band to AB which is the band storage matrix
+*
+         DO 60 J = N-KD+1, N
+            LK = MIN(KD, N-J) + 1
+            CALL SCOPY( LK, A( J, J ), 1, AB( 1, J ), 1 )
+   60    CONTINUE
+
+      END IF
+*
+      WORK( 1 ) = LWMIN
+      RETURN
+*
+*     End of SSYTRD_SY2SB
+*
+      END
diff --git a/SRC/ssytrf_aa.f b/SRC/ssytrf_aa.f
index 13498c9b..a22ff05d 100644
--- a/SRC/ssytrf_aa.f
+++ b/SRC/ssytrf_aa.f
@@ -101,7 +101,7 @@
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
-*>          The length of WORK.  LWORK >=2*N. For optimum performance
+*>          The length of WORK.  LWORK >= MAX(1,2*N). For optimum performance
 *>          LWORK >= N*(1+NB), where NB is the optimal blocksize.
 *>
 *>          If LWORK = -1, then a workspace query is assumed; the routine
@@ -191,7 +191,7 @@
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.( 2*N ) .AND. .NOT.LQUERY ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
 *
diff --git a/SRC/ssytrf_rk.f b/SRC/ssytrf_rk.f
new file mode 100644
index 00000000..df608fc6
--- /dev/null
+++ b/SRC/ssytrf_rk.f
@@ -0,0 +1,498 @@
+*> \brief \b SSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYTRF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrf_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrf_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrf_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> SSYTRF_RK computes the factorization of a real symmetric matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is REAL array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension ( MAX(1,LWORK) ).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >=1.  For best performance
+*>          LWORK >= N*NB, where NB is the block size returned
+*>          by ILAENV.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array, returns this value as the first entry of the WORK
+*>          array, and no error message related to LWORK is issued
+*>          by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup singleSYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put correct description
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, IINFO, IP, IWS, K, KB, LDWORK, LWKOPT,
+     $                   NB, NBMIN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLASYF_RK, SSYTF2_RK, SSWAP,  XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size
+*
+         NB = ILAENV( 1, 'SSYTRF_RK', UPLO, N, -1, -1, -1 )
+         LWKOPT = N*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYTRF_RK', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+      NBMIN = 2
+      LDWORK = N
+      IF( NB.GT.1 .AND. NB.LT.N ) THEN
+         IWS = LDWORK*NB
+         IF( LWORK.LT.IWS ) THEN
+            NB = MAX( LWORK / LDWORK, 1 )
+            NBMIN = MAX( 2, ILAENV( 2, 'SSYTRF_RK',
+     $                              UPLO, N, -1, -1, -1 ) )
+         END IF
+      ELSE
+         IWS = 1
+      END IF
+      IF( NB.LT.NBMIN )
+     $   NB = N
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**T using the upper triangle of A
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        KB, where KB is the number of columns factorized by SLASYF_RK;
+*        KB is either NB or NB-1, or K for the last block
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 15
+*
+         IF( K.GT.NB ) THEN
+*
+*           Factorize columns k-kb+1:k of A and use blocked code to
+*           update columns 1:k-kb
+*
+            CALL SLASYF_RK( UPLO, K, NB, KB, A, LDA, E,
+     $                      IPIV, WORK, LDWORK, IINFO )
+         ELSE
+*
+*           Use unblocked code to factorize columns 1:k of A
+*
+            CALL SSYTF2_RK( UPLO, K, A, LDA, E, IPIV, IINFO )
+            KB = K
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO
+*
+*        No need to adjust IPIV
+*
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k-kb+1:k and apply row permutations to the
+*        last k+1 colunms k+1:N after that block
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.LT.N ) THEN
+            DO I = K, ( K - KB + 1 ), -1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL SSWAP( N-K, A( I, K+1 ), LDA,
+     $                        A( IP, K+1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KB
+         GO TO 10
+*
+*        This label is the exit from main loop over K decreasing
+*        from N to 1 in steps of KB
+*
+   15    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**T using the lower triangle of A
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        KB, where KB is the number of columns factorized by SLASYF_RK;
+*        KB is either NB or NB-1, or N-K+1 for the last block
+*
+         K = 1
+   20    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 35
+*
+         IF( K.LE.N-NB ) THEN
+*
+*           Factorize columns k:k+kb-1 of A and use blocked code to
+*           update columns k+kb:n
+*
+            CALL SLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ),
+     $                        IPIV( K ), WORK, LDWORK, IINFO )
+
+
+         ELSE
+*
+*           Use unblocked code to factorize columns k:n of A
+*
+            CALL SSYTF2_RK( UPLO, N-K+1, A( K, K ), LDA, E( K ),
+     $                      IPIV( K ), IINFO )
+            KB = N - K + 1
+*
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO + K - 1
+*
+*        Adjust IPIV
+*
+         DO I = K, K + KB - 1
+            IF( IPIV( I ).GT.0 ) THEN
+               IPIV( I ) = IPIV( I ) + K - 1
+            ELSE
+               IPIV( I ) = IPIV( I ) - K + 1
+            END IF
+         END DO
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k:k+kb-1 and apply row permutations to the
+*        first k-1 colunms 1:k-1 before that block
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.GT.1 ) THEN
+            DO I = K, ( K + KB - 1 ), 1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL SSWAP( K-1, A( I, 1 ), LDA,
+     $                        A( IP, 1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KB
+         GO TO 20
+*
+*        This label is the exit from main loop over K increasing
+*        from 1 to N in steps of KB
+*
+   35    CONTINUE
+*
+*     End Lower
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+      RETURN
+*
+*     End of SSYTRF_RK
+*
+      END
diff --git a/SRC/ssytri_3.f b/SRC/ssytri_3.f
new file mode 100644
index 00000000..4acad458
--- /dev/null
+++ b/SRC/ssytri_3.f
@@ -0,0 +1,248 @@
+*> \brief \b SSYTRI_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYTRI_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytri_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytri_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytri_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               A( LDA, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> SSYTRI_3 computes the inverse of a real symmetric indefinite
+*> matrix A using the factorization computed by SSYTRF_RK or SSYTRF_BK:
+*>
+*>     A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> SSYTRI_3 sets the leading dimension of the workspace  before calling
+*> SSYTRI_3X that actually computes the inverse.  This is the blocked
+*> version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by SSYTRF_RK and SSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the symmetric inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is REAL array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by SSYTRF_RK or SSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (N+NB+1)*(NB+3).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK. LWORK >= (N+NB+1)*(NB+3).
+*>
+*>          If LDWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the optimal
+*>          size of the WORK array, returns this value as the first
+*>          entry of the WORK array, and no error message related to
+*>          LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup singleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            UPPER, LQUERY
+      INTEGER            LWKOPT, NB
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SSYTRI_3X
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+*     Determine the block size
+*
+      NB = MAX( 1, ILAENV( 1, 'SSYTRI_3', UPLO, N, -1, -1, -1 ) )
+      LWKOPT = ( N+NB+1 ) * ( NB+3 )
+*
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYTRI_3', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         WORK( 1 ) = LWKOPT
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      CALL SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of SSYTRI_3
+*
+      END
diff --git a/SRC/ssytri_3x.f b/SRC/ssytri_3x.f
new file mode 100644
index 00000000..d4a1bcea
--- /dev/null
+++ b/SRC/ssytri_3x.f
@@ -0,0 +1,645 @@
+*> \brief \b SSYTRI_3X
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYTRI_3X + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytri_3x.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytri_3x.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytri_3x.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               A( LDA, * ),  E( * ), WORK( N+NB+1, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> SSYTRI_3X computes the inverse of a real symmetric indefinite
+*> matrix A using the factorization computed by SSYTRF_RK or SSYTRF_BK:
+*>
+*>     A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by SYTRF_RK and SSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the symmetric inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is REAL array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by SSYTRF_RK or SSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (N+NB+1,NB+3).
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          Block size.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup singleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL              A( LDA, * ), E( * ), WORK( N+NB+1, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            CUT, I, ICOUNT, INVD, IP, K, NNB, J, U11
+      REAL               AK, AKKP1, AKP1, D, T, U01_I_J, U01_IP1_J,
+     $                   U11_I_J, U11_IP1_J
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SGEMM, SSYSWAPR, STRTRI, STRMM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+*
+*     Quick return if possible
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYTRI_3X', -INFO )
+         RETURN
+      END IF
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Workspace got Non-diag elements of D
+*
+      DO K = 1, N
+         WORK( K, 1 ) = E( K )
+      END DO
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO INFO = N, 1, -1
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO INFO = 1, N
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+      INFO = 0
+*
+*     Splitting Workspace
+*     U01 is a block ( N, NB+1 )
+*     The first element of U01 is in WORK( 1, 1 )
+*     U11 is a block ( NB+1, NB+1 )
+*     The first element of U11 is in WORK( N+1, 1 )
+*
+      U11 = N
+*
+*     INVD is a block ( N, 2 )
+*     The first element of INVD is in WORK( 1, INVD )
+*
+      INVD = NB + 2
+
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        invA = P * inv(U**T) * inv(D) * inv(U) * P**T.
+*
+         CALL STRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(U)
+*
+         K = 1
+         DO WHILE( K.LE.N )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = ONE /  A( K, K )
+               WORK( K, INVD+1 ) = ZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = WORK( K+1, 1 )
+               AK = A( K, K ) / T
+               AKP1 = A( K+1, K+1 ) / T
+               AKKP1 = WORK( K+1, 1 )  / T
+               D = T*( AK*AKP1-ONE )
+               WORK( K, INVD ) = AKP1 / D
+               WORK( K+1, INVD+1 ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K+1, INVD ) = WORK( K, INVD+1 )
+               K = K + 1
+            END IF
+            K = K + 1
+         END DO
+*
+*        inv(U**T) = (inv(U))**T
+*
+*        inv(U**T) * inv(D) * inv(U)
+*
+         CUT = N
+         DO WHILE( CUT.GT.0 )
+            NNB = NB
+            IF( CUT.LE.NNB ) THEN
+               NNB = CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT+1-NNB, CUT
+                  IF( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+
+            CUT = CUT - NNB
+*
+*           U01 Block
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  WORK( I, J ) = A( I, CUT+J )
+               END DO
+            END DO
+*
+*           U11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I ) = ONE
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = ZERO
+                END DO
+                DO J = I+1, NNB
+                   WORK( U11+I, J ) = A( CUT+I, CUT+J )
+                END DO
+            END DO
+*
+*           invD * U01
+*
+            I = 1
+            DO WHILE( I.LE.CUT )
+               IF( IPIV( I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( I, INVD ) * WORK( I, J )
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK( I, J )
+                     U01_IP1_J = WORK( I+1, J )
+                     WORK( I, J ) = WORK( I, INVD ) * U01_I_J
+     $                            + WORK( I, INVD+1 ) * U01_IP1_J
+                     WORK( I+1, J ) = WORK( I+1, INVD ) * U01_I_J
+     $                              + WORK( I+1, INVD+1 ) * U01_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           invD1 * U11
+*
+            I = 1
+            DO WHILE ( I.LE.NNB )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = I, NNB
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+                  END DO
+               ELSE
+                  DO J = I, NNB
+                     U11_I_J = WORK(U11+I,J)
+                     U11_IP1_J = WORK(U11+I+1,J)
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                            + WORK(CUT+I,INVD+1) * WORK(U11+I+1,J)
+                     WORK( U11+I+1, J ) = WORK(CUT+I+1,INVD) * U11_I_J
+     $                               + WORK(CUT+I+1,INVD+1) * U11_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           U11**T * invD1 * U11 -> U11
+*
+            CALL STRMM( 'L', 'U', 'T', 'U', NNB, NNB,
+     $                 ONE, A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                 N+NB+1 )
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+*           U01**T * invD * U01 -> A( CUT+I, CUT+J )
+*
+            CALL SGEMM( 'T', 'N', NNB, NNB, CUT, ONE, A( 1, CUT+1 ),
+     $                  LDA, WORK, N+NB+1, ZERO, WORK(U11+1,1), N+NB+1 )
+
+*
+*           U11 =  U11**T * invD1 * U11 + U01**T * invD * U01
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = A( CUT+I, CUT+J ) + WORK(U11+I,J)
+               END DO
+            END DO
+*
+*           U01 =  U00**T * invD0 * U01
+*
+            CALL STRMM( 'L', UPLO, 'T', 'U', CUT, NNB,
+     $                  ONE, A, LDA, WORK, N+NB+1 )
+
+*
+*           Update U01
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  A( I, CUT+J ) = WORK( I, J )
+               END DO
+            END DO
+*
+*           Next Block
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(U**T) * inv(D) * inv(U) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Upper case.
+*
+*        ( We can use a loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = 1, N
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        inv A = P * inv(L**T) * inv(D) * inv(L) * P**T.
+*
+         CALL STRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(L)
+*
+         K = N
+         DO WHILE ( K .GE. 1 )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = ONE /  A( K, K )
+               WORK( K, INVD+1 ) = ZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = WORK( K-1, 1 )
+               AK = A( K-1, K-1 ) / T
+               AKP1 = A( K, K ) / T
+               AKKP1 = WORK( K-1, 1 ) / T
+               D = T*( AK*AKP1-ONE )
+               WORK( K-1, INVD ) = AKP1 / D
+               WORK( K, INVD ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K-1, INVD+1 ) = WORK( K, INVD+1 )
+               K = K - 1
+            END IF
+            K = K - 1
+         END DO
+*
+*        inv(L**T) = (inv(L))**T
+*
+*        inv(L**T) * inv(D) * inv(L)
+*
+         CUT = 0
+         DO WHILE( CUT.LT.N )
+            NNB = NB
+            IF( (CUT + NNB).GT.N ) THEN
+               NNB = N - CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT + 1, CUT+NNB
+                  IF ( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+*
+*           L21 Block
+*
+            DO I = 1, N-CUT-NNB
+               DO J = 1, NNB
+                 WORK( I, J ) = A( CUT+NNB+I, CUT+J )
+               END DO
+            END DO
+*
+*           L11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I) = ONE
+               DO J = I+1, NNB
+                  WORK( U11+I, J ) = ZERO
+               END DO
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = A( CUT+I, CUT+J )
+               END DO
+            END DO
+*
+*           invD*L21
+*
+            I = N-CUT-NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+NNB+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( CUT+NNB+I, INVD) * WORK( I, J)
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK(I,J)
+                     U01_IP1_J = WORK(I-1,J)
+                     WORK(I,J)=WORK(CUT+NNB+I,INVD)*U01_I_J+
+     $                        WORK(CUT+NNB+I,INVD+1)*U01_IP1_J
+                     WORK(I-1,J)=WORK(CUT+NNB+I-1,INVD+1)*U01_I_J+
+     $                        WORK(CUT+NNB+I-1,INVD)*U01_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           invD1*L11
+*
+            I = NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( U11+I, J ) = WORK( CUT+I, INVD)*WORK(U11+I,J)
+                  END DO
+
+               ELSE
+                  DO J = 1, NNB
+                     U11_I_J = WORK( U11+I, J )
+                     U11_IP1_J = WORK( U11+I-1, J )
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                                + WORK(CUT+I,INVD+1) * U11_IP1_J
+                     WORK( U11+I-1, J ) = WORK(CUT+I-1,INVD+1) * U11_I_J
+     $                                  + WORK(CUT+I-1,INVD) * U11_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           L11**T * invD1 * L11 -> L11
+*
+            CALL STRMM( 'L', UPLO, 'T', 'U', NNB, NNB, ONE,
+     $                   A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                   N+NB+1 )
+
+*
+            DO I = 1, NNB
+               DO J = 1, I
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+            IF( (CUT+NNB).LT.N ) THEN
+*
+*              L21**T * invD2*L21 -> A( CUT+I, CUT+J )
+*
+               CALL SGEMM( 'T', 'N', NNB, NNB, N-NNB-CUT, ONE,
+     $                     A( CUT+NNB+1, CUT+1 ), LDA, WORK, N+NB+1,
+     $                     ZERO, WORK( U11+1, 1 ), N+NB+1 )
+
+*
+*              L11 =  L11**T * invD1 * L11 + U01**T * invD * U01
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = A( CUT+I, CUT+J )+WORK(U11+I,J)
+                  END DO
+               END DO
+*
+*              L01 =  L22**T * invD2 * L21
+*
+               CALL STRMM( 'L', UPLO, 'T', 'U', N-NNB-CUT, NNB, ONE,
+     $                     A( CUT+NNB+1, CUT+NNB+1 ), LDA, WORK,
+     $                     N+NB+1 )
+*
+*              Update L21
+*
+               DO I = 1, N-CUT-NNB
+                  DO J = 1, NNB
+                     A( CUT+NNB+I, CUT+J ) = WORK( I, J )
+                  END DO
+               END DO
+*
+            ELSE
+*
+*              L11 =  L11**T * invD1 * L11
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = WORK( U11+I, J )
+                  END DO
+               END DO
+            END IF
+*
+*           Next Block
+*
+            CUT = CUT + NNB
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(L**T) * inv(D) * inv(L) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Lower case.
+*
+*        ( We can use a loop over IPIV with increment -1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = N, 1, -1
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of SSYTRI_3X
+*
+      END
+
diff --git a/SRC/ssytrs_3.f b/SRC/ssytrs_3.f
new file mode 100644
index 00000000..453d8380
--- /dev/null
+++ b/SRC/ssytrs_3.f
@@ -0,0 +1,371 @@
+*> \brief \b SSYTRS_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYTRS_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrs_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrs_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrs_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               A( LDA, * ), B( LDB, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> SSYTRS_3 solves a system of linear equations A * X = B with a real
+*> symmetric matrix A using the factorization computed
+*> by SSYTRF_RK or SSYTRF_BK:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This algorithm is using Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**T)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**T)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by SSYTRF_RK and SSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is REAL array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by SSYTRF_RK or SSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is REAL array, dimension (LDB,NRHS)
+*>          On entry, the right hand side matrix B.
+*>          On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup singleSYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  ====================================================================
+      SUBROUTINE SSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               A( LDA, * ), B( LDB, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE
+      PARAMETER          ( ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, J, K, KP
+      REAL               AK, AKM1, AKM1K, BK, BKM1, DENOM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SSCAL, SSWAP, STRSM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SSYTRS_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. NRHS.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        Solve A*X = B, where A = U*D*U**T.
+*
+*        P**T * B
+*
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]
+*
+         CALL STRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (U \P**T * B) ]
+*
+         I = N
+         DO WHILE ( I.GE.1 )
+            IF( IPIV( I ).GT.0 ) THEN
+               CALL SSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
+            ELSE IF ( I.GT.1 ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I-1, I-1 ) / AKM1K
+               AK = A( I, I ) / AKM1K
+               DENOM = AKM1*AK - ONE
+               DO J = 1, NRHS
+                  BKM1 = B( I-1, J ) / AKM1K
+                  BK = B( I, J ) / AKM1K
+                  B( I-1, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I - 1
+            END IF
+            I = I - 1
+         END DO
+*
+*        Compute (U**T \ B) -> B   [ U**T \ (D \ (U \P**T * B) ) ]
+*
+         CALL STRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (U**T \ (D \ (U \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N, 1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        Solve A*X = B, where A = L*D*L**T.
+*
+*        P**T * B
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N, 1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]
+*
+         CALL STRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (L \P**T * B) ]
+*
+         I = 1
+         DO WHILE ( I.LE.N )
+            IF( IPIV( I ).GT.0 ) THEN
+               CALL SSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
+            ELSE IF( I.LT.N ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I, I ) / AKM1K
+               AK = A( I+1, I+1 ) / AKM1K
+               DENOM = AKM1*AK - ONE
+               DO  J = 1, NRHS
+                  BKM1 = B( I, J ) / AKM1K
+                  BK = B( I+1, J ) / AKM1K
+                  B( I, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I + 1
+            END IF
+            I = I + 1
+         END DO
+*
+*        Compute (L**T \ B) -> B   [ L**T \ (D \ (L \P**T * B) ) ]
+*
+         CALL STRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (L**T \ (D \ (L \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        END Lower
+*
+      END IF
+*
+      RETURN
+*
+*     End of SSYTRS_3
+*
+      END
diff --git a/SRC/ssytrs_aa.f b/SRC/ssytrs_aa.f
index 06c793ae..911016e0 100644
--- a/SRC/ssytrs_aa.f
+++ b/SRC/ssytrs_aa.f
@@ -104,7 +104,7 @@
 *>
 *> \param[in] LWORK
 *> \verbatim
-*>          LWORK is INTEGER, LWORK >= 3*N-2.
+*>          LWORK is INTEGER, LWORK >= MAX(1,3*N-2).
 *>
 *> \param[out] INFO
 *> \verbatim
@@ -179,7 +179,7 @@
          INFO = -5
       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
          INFO = -8
-      ELSE IF( LWORK.LT.(3*N-2) .AND. .NOT.LQUERY ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
          INFO = -10
       END IF
       IF( INFO.NE.0 ) THEN
diff --git a/SRC/zgejsv.f b/SRC/zgejsv.f
index 95da5e67..fa85af00 100644
--- a/SRC/zgejsv.f
+++ b/SRC/zgejsv.f
@@ -85,7 +85,7 @@
 *>              rows, then using this condition number gives too pessimistic
 *>              error bound.
 *>       = 'A': Small singular values are the noise and the matrix is treated
-*>              as numerically rank defficient. The error in the computed
+*>              as numerically rank deficient. The error in the computed
 *>              singular values is bounded by f(m,n)*epsilon*||A||.
 *>              The computed SVD A = U * S * V^* restores A up to
 *>              f(m,n)*epsilon*||A||.
@@ -470,7 +470,7 @@
 *>     The rank revealing QR factorization (in this code: ZGEQP3) should be
 *>  implemented as in [3]. We have a new version of ZGEQP3 under development
 *>  that is more robust than the current one in LAPACK, with a cleaner cut in
-*>  rank defficient cases. It will be available in the SIGMA library [4].
+*>  rank deficient cases. It will be available in the SIGMA library [4].
 *>  If M is much larger than N, it is obvious that the initial QRF with
 *>  column pivoting can be preprocessed by the QRF without pivoting. That
 *>  well known trick is not used in ZGEJSV because in some cases heavy row
@@ -1026,7 +1026,7 @@
       ELSE IF ( L2RANK ) THEN
 *        .. similarly as above, only slightly more gentle (less agressive).
 *        Sudden drop on the diagonal of R1 is used as the criterion for
-*        close-to-rank-defficient.
+*        close-to-rank-deficient.
          TEMP1 = DSQRT(SFMIN)
          DO 3401 p = 2, N
             IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR.
diff --git a/SRC/zgels.f b/SRC/zgels.f
index 6814f222..2e0ebc9f 100644
--- a/SRC/zgels.f
+++ b/SRC/zgels.f
@@ -49,7 +49,7 @@
 *>    an underdetermined system A * X = B.
 *>
 *> 3. If TRANS = 'C' and m >= n:  find the minimum norm solution of
-*>    an undetermined system A**H * X = B.
+*>    an underdetermined system A**H * X = B.
 *>
 *> 4. If TRANS = 'C' and m < n:  find the least squares solution of
 *>    an overdetermined system, i.e., solve the least squares problem
@@ -380,7 +380,7 @@
 *
          ELSE
 *
-*           Overdetermined system of equations A**H * X = B
+*           Underdetermined system of equations A**T * X = B
 *
 *           B(1:N,1:NRHS) := inv(R**H) * B(1:N,1:NRHS)
 *
diff --git a/SRC/zgesdd.f b/SRC/zgesdd.f
index 4a59d8aa..77bdb121 100644
--- a/SRC/zgesdd.f
+++ b/SRC/zgesdd.f
@@ -330,8 +330,10 @@
 *       real workspace. NB refers to the optimal block size for the
 *       immediately following subroutine, as returned by ILAENV.)
 *
-      IF( INFO.EQ.0 .AND. M.GT.0 .AND. N.GT.0 ) THEN
-         IF( M.GE.N ) THEN
+      IF( INFO.EQ.0 ) THEN
+         MINWRK = 1
+         MAXWRK = 1
+         IF( M.GE.N .AND. MINMN.GT.0 ) THEN
 *
 *           There is no complex work space needed for bidiagonal SVD
 *           The real work space needed for bidiagonal SVD (dbdsdc) is
@@ -472,7 +474,7 @@
                   MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_PRC_NN )
                END IF
             END IF
-         ELSE
+         ELSE IF( MINMN.GT.0 ) THEN
 *
 *           There is no complex work space needed for bidiagonal SVD
 *           The real work space needed for bidiagonal SVD (dbdsdc) is
diff --git a/SRC/zgetsls.f b/SRC/zgetsls.f
index 9b04227f..d61b88c3 100644
--- a/SRC/zgetsls.f
+++ b/SRC/zgetsls.f
@@ -198,7 +198,7 @@
       LOGICAL            LSAME
       INTEGER            ILAENV
       DOUBLE PRECISION   DLAMCH, ZLANGE
-      EXTERNAL           LSAME, ILAENV, DLABAD, DLAMCH, DLANGE
+      EXTERNAL           LSAME, ILAENV, DLABAD, DLAMCH, ZLANGE
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ZGEQR, ZGEMQR, ZLASCL, ZLASET,
diff --git a/SRC/zhb2st_kernels.f b/SRC/zhb2st_kernels.f
new file mode 100644
index 00000000..ab03b303
--- /dev/null
+++ b/SRC/zhb2st_kernels.f
@@ -0,0 +1,320 @@
+*> \brief \b ZHB2ST_KERNELS
+*
+*  @precisions fortran z -> s d c
+*      
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download ZHB2ST_KERNELS + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhb2st_kernels.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhb2st_kernels.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhb2st_kernels.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE  ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE, 
+*                                   ST, ED, SWEEP, N, NB, IB,
+*                                   A, LDA, V, TAU, LDVT, WORK)
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       LOGICAL            WANTZ
+*       INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16         A( LDA, * ), V( * ), 
+*                          TAU( * ), WORK( * )
+*  
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHB2ST_KERNELS is an internal routine used by the ZHETRD_HB2ST
+*> subroutine.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> @param[in] n
+*>          The order of the matrix A.
+*>
+*> @param[in] nb
+*>          The size of the band.
+*>
+*> @param[in, out] A
+*>          A pointer to the matrix A.
+*>
+*> @param[in] lda
+*>          The leading dimension of the matrix A.
+*>
+*> @param[out] V
+*>          COMPLEX*16 array, dimension 2*n if eigenvalues only are
+*>          requested or to be queried for vectors.
+*>
+*> @param[out] TAU
+*>          COMPLEX*16 array, dimension (2*n).
+*>          The scalar factors of the Householder reflectors are stored
+*>          in this array.
+*>
+*> @param[in] st
+*>          internal parameter for indices.
+*>
+*> @param[in] ed
+*>          internal parameter for indices.
+*>
+*> @param[in] sweep
+*>          internal parameter for indices.
+*>
+*> @param[in] Vblksiz
+*>          internal parameter for indices.
+*>
+*> @param[in] wantz
+*>          logical which indicate if Eigenvalue are requested or both
+*>          Eigenvalue/Eigenvectors.
+*>
+*> @param[in] work
+*>          Workspace of size nb.
+*>
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE  ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE, 
+     $                            ST, ED, SWEEP, N, NB, IB,
+     $                            A, LDA, V, TAU, LDVT, WORK)
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      LOGICAL            WANTZ
+      INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), V( * ), 
+     $                   TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO, ONE
+      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, J1, J2, LM, LN, VPOS, TAUPOS,
+     $                   DPOS, OFDPOS, AJETER 
+      COMPLEX*16         CTMP 
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZLARFG, ZLARFX, ZLARFY
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MOD
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     ..
+*     .. Executable Statements ..
+*      
+      AJETER = IB + LDVT
+      UPPER = LSAME( UPLO, 'U' )
+
+      IF( UPPER ) THEN
+          DPOS    = 2 * NB + 1
+          OFDPOS  = 2 * NB
+      ELSE
+          DPOS    = 1
+          OFDPOS  = 2
+      ENDIF
+
+*
+*     Upper case
+*  
+      IF( UPPER ) THEN
+*      
+          IF( WANTZ ) THEN
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ELSE
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ENDIF
+          GO TO ( 101, 102, 103 ) TTYPE
+*
+  101     CONTINUE
+          LM = ED - ST + 1
+*
+          V( VPOS ) = ONE
+          DO 10 I = 1, LM-1
+              V( VPOS+I )         = DCONJG( A( OFDPOS-I, ST+I ) )
+              A( OFDPOS-I, ST+I ) = ZERO  
+   10     CONTINUE
+          CTMP = DCONJG( A( OFDPOS, ST ) )
+          CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, 
+     $                                   TAU( TAUPOS ) )
+          A( OFDPOS, ST ) = CTMP
+* 
+  103     CONTINUE
+          LM = ED - ST + 1
+          CALL ZLARFY( UPLO, LM, V( VPOS ), 1, DCONJG( TAU( TAUPOS ) ),
+     $                             A( DPOS, ST ), LDA-1, WORK)
+          GOTO 300
+*
+  102     CONTINUE
+          J1 = ED+1
+          J2 = MIN( ED+NB, N )
+          LN = ED-ST+1
+          LM = J2-J1+1
+          IF( LM.GT.0) THEN
+              CALL ZLARFX( 'Left', LN, LM, V( VPOS ),
+     $                     DCONJG( TAU( TAUPOS ) ), A( DPOS-NB, J1 ),
+     $                     LDA-1, WORK)
+*
+              IF( WANTZ ) THEN
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ELSE
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ENDIF
+*
+              V( VPOS ) = ONE
+              DO 30 I = 1, LM-1
+                  V( VPOS+I )          = DCONJG( A( DPOS-NB-I, J1+I ) )
+                  A( DPOS-NB-I, J1+I ) = ZERO
+   30         CONTINUE
+              CTMP = DCONJG( A( DPOS-NB, J1 ) )
+              CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) )
+              A( DPOS-NB, J1 ) = CTMP
+*             
+              CALL ZLARFX( 'Right', LN-1, LM, V( VPOS ), 
+     $                     TAU( TAUPOS ),
+     $                     A( DPOS-NB+1, J1 ), LDA-1, WORK)
+          ENDIF
+          GOTO 300
+*
+*     Lower case
+*  
+      ELSE
+*      
+          IF( WANTZ ) THEN
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ELSE
+              VPOS   = MOD( SWEEP-1, 2 ) * N + ST
+              TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
+          ENDIF
+          GO TO ( 201, 202, 203 ) TTYPE
+*  
+  201     CONTINUE
+          LM = ED - ST + 1
+*
+          V( VPOS ) = ONE
+          DO 20 I = 1, LM-1
+              V( VPOS+I )         = A( OFDPOS+I, ST-1 )
+              A( OFDPOS+I, ST-1 ) = ZERO  
+   20     CONTINUE
+          CALL ZLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, 
+     $                                   TAU( TAUPOS ) )
+*
+  203     CONTINUE
+          LM = ED - ST + 1
+*
+          CALL ZLARFY( UPLO, LM, V( VPOS ), 1, DCONJG( TAU( TAUPOS ) ),
+     $                                      A( DPOS, ST ), LDA-1, WORK)
+
+          GOTO 300
+*
+  202     CONTINUE
+          J1 = ED+1
+          J2 = MIN( ED+NB, N )
+          LN = ED-ST+1
+          LM = J2-J1+1
+*
+          IF( LM.GT.0) THEN
+              CALL ZLARFX( 'Right', LM, LN, V( VPOS ), 
+     $                     TAU( TAUPOS ), A( DPOS+NB, ST ),
+     $                     LDA-1, WORK)
+*
+              IF( WANTZ ) THEN
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ELSE
+                  VPOS   = MOD( SWEEP-1, 2 ) * N + J1
+                  TAUPOS = MOD( SWEEP-1, 2 ) * N + J1
+              ENDIF
+*              
+              V( VPOS ) = ONE
+              DO 40 I = 1, LM-1
+                  V( VPOS+I )        = A( DPOS+NB+I, ST )
+                  A( DPOS+NB+I, ST ) = ZERO
+   40         CONTINUE
+              CALL ZLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, 
+     $                                    TAU( TAUPOS ) )
+*                  
+              CALL ZLARFX( 'Left', LM, LN-1, V( VPOS ), 
+     $                     DCONJG( TAU( TAUPOS ) ),
+     $                     A( DPOS+NB-1, ST+1 ), LDA-1, WORK)
+
+          ENDIF
+          GOTO 300
+      ENDIF
+
+  300 CONTINUE    
+      RETURN
+*
+*     END OF ZHB2ST_KERNELS
+*
+      END      
diff --git a/SRC/zhbev_2stage.f b/SRC/zhbev_2stage.f
new file mode 100644
index 00000000..f1088b87
--- /dev/null
+++ b/SRC/zhbev_2stage.f
@@ -0,0 +1,386 @@
+*> \brief <b> ZHBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @precisions fortran z -> s d c
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHBEV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhbev_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhbev_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhbev_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+*                                WORK, LWORK, RWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, KD, LDAB, LDZ, N, LWORK
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   RWORK( * ), W( * )
+*       COMPLEX*16         AB( LDAB, * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHBEV_2STAGE computes all the eigenvalues and, optionally, eigenvectors of
+*> a complex Hermitian band matrix A using the 2stage technique for
+*> the reduction to tridiagonal.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is COMPLEX*16 array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the Hermitian band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.  If UPLO = 'U', the first
+*>          superdiagonal and the diagonal of the tridiagonal matrix T
+*>          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+*>          the diagonal and first subdiagonal of T are returned in the
+*>          first two rows of AB.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX*16 array, dimension (LDZ, N)
+*>          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+*>          eigenvectors of the matrix A, with the i-th column of Z
+*>          holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension LWORK
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK, RWORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (max(1,3*N-2))
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit.
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value.
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16OTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+     $                         WORK, LWORK, RWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, KD, LDAB, LDZ, N, LWORK
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   RWORK( * ), W( * )
+      COMPLEX*16         AB( LDAB, * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, WANTZ, LQUERY
+      INTEGER            IINFO, IMAX, INDE, INDWRK, INDRWK, ISCALE,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, IB, INDHOUS
+      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, ZLANHB
+      EXTERNAL           LSAME, DLAMCH, ZLANHB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DSCAL, DSTERF, XERBLA, ZLASCL, ZSTEQR
+     $                   ZHETRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -6
+      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+         INFO = -9
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            IB    = ILAENV( 18, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+            LWMIN = LHTRD + LWTRD
+            WORK( 1 )  = LWMIN
+         ENDIF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -11
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHBEV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            W( 1 ) = DBLE( AB( 1, 1 ) )
+         ELSE
+            W( 1 ) = DBLE( AB( KD+1, 1 ) )
+         END IF
+         IF( WANTZ )
+     $      Z( 1, 1 ) = ONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = ZLANHB( 'M', UPLO, N, KD, AB, LDAB, RWORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+      END IF
+*
+*     Call ZHBTRD_HB2ST to reduce Hermitian band matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDHOUS = 1
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL ZHETRD_HB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, W,
+     $                    RWORK( INDE ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call DSTERF.  For eigenvectors, call ZSTEQR.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL DSTERF( N, W, RWORK( INDE ), INFO )
+      ELSE
+         INDRWK = INDE + N
+         CALL ZSTEQR( JOBZ, N, W, RWORK( INDE ), Z, LDZ,
+     $                RWORK( INDRWK ), INFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of ZHBEV_2STAGE
+*
+      END
diff --git a/SRC/zhbevd_2stage.f b/SRC/zhbevd_2stage.f
new file mode 100644
index 00000000..e4daae74
--- /dev/null
+++ b/SRC/zhbevd_2stage.f
@@ -0,0 +1,458 @@
+*> \brief <b> ZHBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @precisions fortran z -> s d c
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHBEVD_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhbevd_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhbevd_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhbevd_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+*                                 WORK, LWORK, RWORK, LRWORK, IWORK, 
+*                                 LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, KD, LDAB, LDZ, LIWORK, LRWORK, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IWORK( * )
+*       DOUBLE PRECISION   RWORK( * ), W( * )
+*       COMPLEX*16         AB( LDAB, * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHBEVD_2STAGE computes all the eigenvalues and, optionally, eigenvectors of
+*> a complex Hermitian band matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  If eigenvectors are desired, it
+*> uses a divide and conquer algorithm.
+*>
+*> The divide and conquer algorithm makes very mild assumptions about
+*> floating point arithmetic. It will work on machines with a guard
+*> digit in add/subtract, or on those binary machines without guard
+*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
+*> without guard digits, but we know of none.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is COMPLEX*16 array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the Hermitian band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.  If UPLO = 'U', the first
+*>          superdiagonal and the diagonal of the tridiagonal matrix T
+*>          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
+*>          the diagonal and first subdiagonal of T are returned in the
+*>          first two rows of AB.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX*16 array, dimension (LDZ, N)
+*>          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
+*>          eigenvectors of the matrix A, with the i-th column of Z
+*>          holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK, RWORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array,
+*>                                         dimension (LRWORK)
+*>          On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
+*> \endverbatim
+*>
+*> \param[in] LRWORK
+*> \verbatim
+*>          LRWORK is INTEGER
+*>          The dimension of array RWORK.
+*>          If N <= 1,               LRWORK must be at least 1.
+*>          If JOBZ = 'N' and N > 1, LRWORK must be at least N.
+*>          If JOBZ = 'V' and N > 1, LRWORK must be at least
+*>                        1 + 5*N + 2*N**2.
+*>
+*>          If LRWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of array IWORK.
+*>          If JOBZ = 'N' or N <= 1, LIWORK must be at least 1.
+*>          If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N .
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit.
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value.
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16OTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
+     $                          WORK, LWORK, RWORK, LRWORK, IWORK, 
+     $                          LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, KD, LDAB, LDZ, LIWORK, LRWORK, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IWORK( * )
+      DOUBLE PRECISION   RWORK( * ), W( * )
+      COMPLEX*16         AB( LDAB, * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+      COMPLEX*16         CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ),
+     $                   CONE = ( 1.0D0, 0.0D0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, IMAX, INDE, INDWK2, INDRWK, ISCALE,
+     $                   LLWORK, INDWK, LHTRD, LWTRD, IB, INDHOUS,
+     $                   LIWMIN, LLRWK, LLWK2, LRWMIN, LWMIN
+      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, ZLANHB
+      EXTERNAL           LSAME, DLAMCH, ZLANHB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DSCAL, DSTERF, XERBLA, ZGEMM, ZLACPY,
+     $                   ZLASCL, ZSTEDC, ZHETRD_HB2ST
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 .OR. LRWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( N.LE.1 ) THEN
+         LWMIN = 1
+         LRWMIN = 1
+         LIWMIN = 1
+      ELSE
+         IB    = ILAENV( 18, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+         IF( WANTZ ) THEN
+            LWMIN = 2*N**2
+            LRWMIN = 1 + 5*N + 2*N**2
+            LIWMIN = 3 + 5*N
+         ELSE
+            LWMIN  = MAX( N, LHTRD + LWTRD )
+            LRWMIN = N
+            LIWMIN = 1
+         END IF
+      END IF
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -6
+      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+         INFO = -9
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         WORK( 1 )  = LWMIN
+         RWORK( 1 ) = LRWMIN
+         IWORK( 1 ) = LIWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -11
+         ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -13
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -15
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHBEVD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = DBLE( AB( 1, 1 ) )
+         IF( WANTZ )
+     $      Z( 1, 1 ) = CONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = ZLANHB( 'M', UPLO, N, KD, AB, LDAB, RWORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+      END IF
+*
+*     Call ZHBTRD_HB2ST to reduce Hermitian band matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDRWK  = INDE + N
+      LLRWK   = LRWORK - INDRWK + 1
+      INDHOUS = 1
+      INDWK   = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWK + 1
+      INDWK2  = INDWK + N*N
+      LLWK2   = LWORK - INDWK2 + 1
+*
+      CALL ZHETRD_HB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, W,
+     $                    RWORK( INDE ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call DSTERF.  For eigenvectors, call ZSTEDC.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL DSTERF( N, W, RWORK( INDE ), INFO )
+      ELSE
+         CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ),
+     $                LLWK2, RWORK( INDRWK ), LLRWK, IWORK, LIWORK,
+     $                INFO )
+         CALL ZGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO,
+     $               WORK( INDWK2 ), N )
+         CALL ZLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+      WORK( 1 )  = LWMIN
+      RWORK( 1 ) = LRWMIN
+      IWORK( 1 ) = LIWMIN
+      RETURN
+*
+*     End of ZHBEVD_2STAGE
+*
+      END
diff --git a/SRC/zhbevx_2stage.f b/SRC/zhbevx_2stage.f
new file mode 100644
index 00000000..3efdcc74
--- /dev/null
+++ b/SRC/zhbevx_2stage.f
@@ -0,0 +1,646 @@
+*> \brief <b> ZHBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
+*
+*  @precisions fortran z -> s d c
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHBEVX_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhbevx_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhbevx_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhbevx_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB,
+*                                 Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W,
+*                                 Z, LDZ, WORK, LWORK, RWORK, IWORK, 
+*                                 IFAIL, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
+*       DOUBLE PRECISION   ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IFAIL( * ), IWORK( * )
+*       DOUBLE PRECISION   RWORK( * ), W( * )
+*       COMPLEX*16         AB( LDAB, * ), Q( LDQ, * ), WORK( * ),
+*      $                   Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHBEVX_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a complex Hermitian band matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  Eigenvalues and eigenvectors
+*> can be selected by specifying either a range of values or a range of
+*> indices for the desired eigenvalues.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found;
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found;
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is COMPLEX*16 array, dimension (LDAB, N)
+*>          On entry, the upper or lower triangle of the Hermitian band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>
+*>          On exit, AB is overwritten by values generated during the
+*>          reduction to tridiagonal form.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD + 1.
+*> \endverbatim
+*>
+*> \param[out] Q
+*> \verbatim
+*>          Q is COMPLEX*16 array, dimension (LDQ, N)
+*>          If JOBZ = 'V', the N-by-N unitary matrix used in the
+*>                          reduction to tridiagonal form.
+*>          If JOBZ = 'N', the array Q is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDQ
+*> \verbatim
+*>          LDQ is INTEGER
+*>          The leading dimension of the array Q.  If JOBZ = 'V', then
+*>          LDQ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is DOUBLE PRECISION
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is DOUBLE PRECISION
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is DOUBLE PRECISION
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing AB to tridiagonal form.
+*>
+*>          Eigenvalues will be computed most accurately when ABSTOL is
+*>          set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+*>          If this routine returns with INFO>0, indicating that some
+*>          eigenvectors did not converge, try setting ABSTOL to
+*>          2*DLAMCH('S').
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          The first M elements contain the selected eigenvalues in
+*>          ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX*16 array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If an eigenvector fails to converge, then that column of Z
+*>          contains the latest approximation to the eigenvector, and the
+*>          index of the eigenvector is returned in IFAIL.
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (LWORK)
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = (2KD+1)*N + KD*NTHREADS
+*>                                   where KD is the size of the band.
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK, RWORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (7*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (5*N)
+*> \endverbatim
+*>
+*> \param[out] IFAIL
+*> \verbatim
+*>          IFAIL is INTEGER array, dimension (N)
+*>          If JOBZ = 'V', then if INFO = 0, the first M elements of
+*>          IFAIL are zero.  If INFO > 0, then IFAIL contains the
+*>          indices of the eigenvectors that failed to converge.
+*>          If JOBZ = 'N', then IFAIL is not referenced.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, then i eigenvectors failed to converge.
+*>                Their indices are stored in array IFAIL.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup complex16OTHEReigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB,
+     $                          Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W,
+     $                          Z, LDZ, WORK, LWORK, RWORK, IWORK, 
+     $                          IFAIL, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
+      DOUBLE PRECISION   ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IFAIL( * ), IWORK( * )
+      DOUBLE PRECISION   RWORK( * ), W( * )
+      COMPLEX*16         AB( LDAB, * ), Q( LDQ, * ), WORK( * ),
+     $                   Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+      COMPLEX*16         CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ),
+     $                   CONE = ( 1.0D0, 0.0D0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ,
+     $                   LQUERY
+      CHARACTER          ORDER
+      INTEGER            I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
+     $                   INDISP, INDIWK, INDRWK, INDWRK, ISCALE, ITMP1,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, IB, INDHOUS,
+     $                   J, JJ, NSPLIT
+      DOUBLE PRECISION   ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+      COMPLEX*16         CTMP1
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, ZLANHB
+      EXTERNAL           LSAME, DLAMCH, ZLANHB, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZCOPY,
+     $                   ZGEMV, ZLACPY, ZLASCL, ZSTEIN, ZSTEQR,
+     $                   ZSWAP, ZHETRD_HB2ST
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.KD+1 ) THEN
+         INFO = -7
+      ELSE IF( WANTZ .AND. LDQ.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -11
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -12
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -13
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) )
+     $      INFO = -18
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            IB    = ILAENV( 18, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+            LWMIN = LHTRD + LWTRD
+            WORK( 1 )  = LWMIN
+         ENDIF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -20
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHBEVX_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         M = 1
+         IF( LOWER ) THEN
+            CTMP1 = AB( 1, 1 )
+         ELSE
+            CTMP1 = AB( KD+1, 1 )
+         END IF
+         TMP1 = DBLE( CTMP1 )
+         IF( VALEIG ) THEN
+            IF( .NOT.( VL.LT.TMP1 .AND. VU.GE.TMP1 ) )
+     $         M = 0
+         END IF
+         IF( M.EQ.1 ) THEN
+            W( 1 ) = DBLE( CTMP1 )
+            IF( WANTZ )
+     $         Z( 1, 1 ) = CONE
+         END IF
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF( VALEIG ) THEN
+         VLL = VL
+         VUU = VU
+      ELSE
+         VLL = ZERO
+         VUU = ZERO
+      END IF
+      ANRM = ZLANHB( 'M', UPLO, N, KD, AB, LDAB, RWORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         ELSE
+            CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+*
+*     Call ZHBTRD_HB2ST to reduce Hermitian band matrix to tridiagonal form.
+*
+      INDD = 1
+      INDE = INDD + N
+      INDRWK = INDE + N
+*
+      INDHOUS = 1
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL ZHETRD_HB2ST( 'N', JOBZ, UPLO, N, KD, AB, LDAB,
+     $                    RWORK( INDD ), RWORK( INDE ), WORK( INDHOUS ),
+     $                    LHTRD, WORK( INDWRK ), LLWORK, IINFO )
+*
+*     If all eigenvalues are desired and ABSTOL is less than or equal
+*     to zero, then call DSTERF or ZSTEQR.  If this fails for some
+*     eigenvalue, then try DSTEBZ.
+*
+      TEST = .FALSE.
+      IF (INDEIG) THEN
+         IF (IL.EQ.1 .AND. IU.EQ.N) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF ((ALLEIG .OR. TEST) .AND. (ABSTOL.LE.ZERO)) THEN
+         CALL DCOPY( N, RWORK( INDD ), 1, W, 1 )
+         INDEE = INDRWK + 2*N
+         IF( .NOT.WANTZ ) THEN
+            CALL DCOPY( N-1, RWORK( INDE ), 1, RWORK( INDEE ), 1 )
+            CALL DSTERF( N, W, RWORK( INDEE ), INFO )
+         ELSE
+            CALL ZLACPY( 'A', N, N, Q, LDQ, Z, LDZ )
+            CALL DCOPY( N-1, RWORK( INDE ), 1, RWORK( INDEE ), 1 )
+            CALL ZSTEQR( JOBZ, N, W, RWORK( INDEE ), Z, LDZ,
+     $                   RWORK( INDRWK ), INFO )
+            IF( INFO.EQ.0 ) THEN
+               DO 10 I = 1, N
+                  IFAIL( I ) = 0
+   10          CONTINUE
+            END IF
+         END IF
+         IF( INFO.EQ.0 ) THEN
+            M = N
+            GO TO 30
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call DSTEBZ and, if eigenvectors are desired, ZSTEIN.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+      INDIBL = 1
+      INDISP = INDIBL + N
+      INDIWK = INDISP + N
+      CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
+     $             IWORK( INDIWK ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL ZSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
+*
+*        Apply unitary matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by ZSTEIN.
+*
+         DO 20 J = 1, M
+            CALL ZCOPY( N, Z( 1, J ), 1, WORK( 1 ), 1 )
+            CALL ZGEMV( 'N', N, N, CONE, Q, LDQ, WORK, 1, CZERO,
+     $                  Z( 1, J ), 1 )
+   20    CONTINUE
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+   30 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.
+*
+      IF( WANTZ ) THEN
+         DO 50 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 40 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   40       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               ITMP1 = IWORK( INDIBL+I-1 )
+               W( I ) = W( J )
+               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
+               W( J ) = TMP1
+               IWORK( INDIBL+J-1 ) = ITMP1
+               CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+               IF( INFO.NE.0 ) THEN
+                  ITMP1 = IFAIL( I )
+                  IFAIL( I ) = IFAIL( J )
+                  IFAIL( J ) = ITMP1
+               END IF
+            END IF
+   50    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of ZHBEVX_2STAGE
+*
+      END
diff --git a/SRC/zhecon_3.f b/SRC/zhecon_3.f
new file mode 100644
index 00000000..8ade0bf4
--- /dev/null
+++ b/SRC/zhecon_3.f
@@ -0,0 +1,285 @@
+*> \brief \b ZHECON_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHECON_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhecon_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhecon_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhecon_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHECON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+*                            WORK, IWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       DOUBLE PRECISION   ANORM, RCOND
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * ), IWORK( * )
+*       COMPLEX*16         A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZHECON_3 estimates the reciprocal of the condition number (in the
+*> 1-norm) of a complex Hermitian matrix A using the factorization
+*> computed by ZHETRF_RK or ZHETRF_BK:
+*>
+*>    A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
+*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+*> This routine uses BLAS3 solver ZHETRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**H)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**H)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by ZHETRF_RK and ZHETRF_BK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by ZHETRF_RK or ZHETRF_BK.
+*> \endverbatim
+*>
+*> \param[in] ANORM
+*> \verbatim
+*>          ANORM is DOUBLE PRECISION
+*>          The 1-norm of the original matrix A.
+*> \endverbatim
+*>
+*> \param[out] RCOND
+*> \verbatim
+*>          RCOND is DOUBLE PRECISION
+*>          The reciprocal of the condition number of the matrix A,
+*>          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+*>          estimate of the 1-norm of inv(A) computed in this routine.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (2*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHECON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+     $                     WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+      DOUBLE PRECISION   ANORM, RCOND
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, KASE
+      DOUBLE PRECISION   AINVNM
+*     ..
+*     .. Local Arrays ..
+      INTEGER            ISAVE( 3 )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZHETRS_3, ZLACN2, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( ANORM.LT.ZERO ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHECON_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      RCOND = ZERO
+      IF( N.EQ.0 ) THEN
+         RCOND = ONE
+         RETURN
+      ELSE IF( ANORM.LE.ZERO ) THEN
+         RETURN
+      END IF
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO I = N, 1, -1
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO I = 1, N
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+*     Estimate the 1-norm of the inverse.
+*
+      KASE = 0
+   30 CONTINUE
+      CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
+      IF( KASE.NE.0 ) THEN
+*
+*        Multiply by inv(L*D*L**H) or inv(U*D*U**H).
+*
+         CALL ZHETRS_3( UPLO, N, 1, A, LDA, E, IPIV, WORK, N, INFO )
+         GO TO 30
+      END IF
+*
+*     Compute the estimate of the reciprocal condition number.
+*
+      IF( AINVNM.NE.ZERO )
+     $   RCOND = ( ONE / AINVNM ) / ANORM
+*
+      RETURN
+*
+*     End of ZHECON_3
+*
+      END
diff --git a/SRC/zheev_2stage.f b/SRC/zheev_2stage.f
new file mode 100644
index 00000000..5aca4da2
--- /dev/null
+++ b/SRC/zheev_2stage.f
@@ -0,0 +1,355 @@
+*> \brief <b> ZHEEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>
+*
+*  @precisions fortran z -> s d c
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHEEV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zheev_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zheev_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zheev_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+*                                RWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   RWORK( * ), W( * )
+*       COMPLEX*16         A( LDA, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHEEV_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
+*> complex Hermitian matrix A using the 2stage technique for
+*> the reduction to tridiagonal.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA, N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          orthonormal eigenvectors of the matrix A.
+*>          If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+*>          or the upper triangle (if UPLO='U') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (max(1, 3*N-2))
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, the algorithm failed to converge; i
+*>                off-diagonal elements of an intermediate tridiagonal
+*>                form did not converge to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+     $                         RWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   RWORK( * ), W( * )
+      COMPLEX*16         A( LDA, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+      COMPLEX*16         CONE
+      PARAMETER          ( CONE = ( 1.0D0, 0.0D0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
+     $                   LLWORK, LWMIN, LHTRD, LWTRD, KD, IB, INDHOUS
+      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, ZLANHE
+      EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANHE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DSCAL, DSTERF, XERBLA, ZLASCL, ZSTEQR,
+     $                   ZUNGTR, ZHETRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, MAX, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         KD    = ILAENV( 17, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+         IB    = ILAENV( 18, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWMIN = N + LHTRD + LWTRD
+         WORK( 1 )  = LWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -8
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHEEV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = DBLE( A( 1, 1 ) )
+         WORK( 1 ) = 1
+         IF( WANTZ )
+     $      A( 1, 1 ) = CONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = ZLANHE( 'M', UPLO, N, A, LDA, RWORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 )
+     $   CALL ZLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
+*
+*     Call ZHETRD_2STAGE to reduce Hermitian matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDTAU  = 1
+      INDHOUS = INDTAU + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL ZHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, RWORK( INDE ),
+     $                    WORK( INDTAU ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call DSTERF.  For eigenvectors, first call
+*     ZUNGTR to generate the unitary matrix, then call ZSTEQR.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL DSTERF( N, W, RWORK( INDE ), INFO )
+      ELSE
+         CALL ZUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
+     $                LLWORK, IINFO )
+         INDWRK = INDE + N
+         CALL ZSTEQR( JOBZ, N, W, RWORK( INDE ), A, LDA,
+     $                RWORK( INDWRK ), INFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     Set WORK(1) to optimal complex workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of ZHEEV_2STAGE
+*
+      END
diff --git a/SRC/zheevd_2stage.f b/SRC/zheevd_2stage.f
new file mode 100644
index 00000000..79a0e886
--- /dev/null
+++ b/SRC/zheevd_2stage.f
@@ -0,0 +1,451 @@
+*> \brief <b> ZHEEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>
+*
+*  @precisions fortran z -> s d c
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHEEVD_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zheevd_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zheevd_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zheevd_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+*                          RWORK, LRWORK, IWORK, LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, LDA, LIWORK, LRWORK, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IWORK( * )
+*       DOUBLE PRECISION   RWORK( * ), W( * )
+*       COMPLEX*16         A( LDA, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHEEVD_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
+*> complex Hermitian matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  If eigenvectors are desired, it uses a
+*> divide and conquer algorithm.
+*>
+*> The divide and conquer algorithm makes very mild assumptions about
+*> floating point arithmetic. It will work on machines with a guard
+*> digit in add/subtract, or on those binary machines without guard
+*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
+*> without guard digits, but we know of none.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA, N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          orthonormal eigenvectors of the matrix A.
+*>          If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+*>          or the upper triangle (if UPLO='U') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          If N <= 1,               LWORK must be at least 1.
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + N+1
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + N+1
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be at least 2*N + N**2
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK, RWORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array,
+*>                                         dimension (LRWORK)
+*>          On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
+*> \endverbatim
+*>
+*> \param[in] LRWORK
+*> \verbatim
+*>          LRWORK is INTEGER
+*>          The dimension of the array RWORK.
+*>          If N <= 1,                LRWORK must be at least 1.
+*>          If JOBZ  = 'N' and N > 1, LRWORK must be at least N.
+*>          If JOBZ  = 'V' and N > 1, LRWORK must be at least
+*>                         1 + 5*N + 2*N**2.
+*>
+*>          If LRWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of the array IWORK.
+*>          If N <= 1,                LIWORK must be at least 1.
+*>          If JOBZ  = 'N' and N > 1, LIWORK must be at least 1.
+*>          If JOBZ  = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i and JOBZ = 'N', then the algorithm failed
+*>                to converge; i off-diagonal elements of an intermediate
+*>                tridiagonal form did not converge to zero;
+*>                if INFO = i and JOBZ = 'V', then the algorithm failed
+*>                to compute an eigenvalue while working on the submatrix
+*>                lying in rows and columns INFO/(N+1) through
+*>                mod(INFO,N+1).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*>  Modified description of INFO. Sven, 16 Feb 05.
+*
+*> \par Contributors:
+*  ==================
+*>
+*> Jeff Rutter, Computer Science Division, University of California
+*> at Berkeley, USA
+*>
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+     $                   RWORK, LRWORK, IWORK, LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, LDA, LIWORK, LRWORK, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IWORK( * )
+      DOUBLE PRECISION   RWORK( * ), W( * )
+      COMPLEX*16         A( LDA, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+      COMPLEX*16         CONE
+      PARAMETER          ( CONE = ( 1.0D0, 0.0D0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LOWER, LQUERY, WANTZ
+      INTEGER            IINFO, IMAX, INDE, INDRWK, INDTAU, INDWK2,
+     $                   INDWRK, ISCALE, LIWMIN, LLRWK, LLWORK,
+     $                   LLWRK2, LRWMIN, LWMIN,
+     $                   LHTRD, LWTRD, KD, IB, INDHOUS
+
+
+      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
+     $                   SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, ZLANHE
+      EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANHE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DSCAL, DSTERF, XERBLA, ZLACPY, ZLASCL,
+     $                   ZSTEDC, ZUNMTR, ZHETRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, MAX, SQRT 
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      LOWER = LSAME( UPLO, 'L' )
+      LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            LRWMIN = 1
+            LIWMIN = 1
+         ELSE
+            KD    = ILAENV( 17, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+            IB    = ILAENV( 18, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            IF( WANTZ ) THEN
+               LWMIN = 2*N + N*N
+               LRWMIN = 1 + 5*N + 2*N**2
+               LIWMIN = 3 + 5*N
+            ELSE
+               LWMIN = N + 1 + LHTRD + LWTRD
+               LRWMIN = N
+               LIWMIN = 1
+            END IF
+         END IF
+         WORK( 1 )  = LWMIN
+         RWORK( 1 ) = LRWMIN
+         IWORK( 1 ) = LIWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -8
+         ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -10
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -12
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHEEVD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( N.EQ.1 ) THEN
+         W( 1 ) = DBLE( A( 1, 1 ) )
+         IF( WANTZ )
+     $      A( 1, 1 ) = CONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = SQRT( BIGNUM )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ANRM = ZLANHE( 'M', UPLO, N, A, LDA, RWORK )
+      ISCALE = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 )
+     $   CALL ZLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
+*
+*     Call ZHETRD_2STAGE to reduce Hermitian matrix to tridiagonal form.
+*
+      INDE    = 1
+      INDRWK  = INDE + N
+      LLRWK   = LRWORK - INDRWK + 1
+      INDTAU  = 1
+      INDHOUS = INDTAU + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+      INDWK2  = INDWRK + N*N
+      LLWRK2  = LWORK - INDWK2 + 1
+*
+      CALL ZHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, W, RWORK( INDE ),
+     $                    WORK( INDTAU ), WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWRK ), LLWORK, IINFO )
+*
+*     For eigenvalues only, call DSTERF.  For eigenvectors, first call
+*     ZSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
+*     tridiagonal matrix, then call ZUNMTR to multiply it to the
+*     Householder transformations represented as Householder vectors in
+*     A.
+*
+      IF( .NOT.WANTZ ) THEN
+         CALL DSTERF( N, W, RWORK( INDE ), INFO )
+      ELSE
+         CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK( INDWRK ), N,
+     $                WORK( INDWK2 ), LLWRK2, RWORK( INDRWK ), LLRWK,
+     $                IWORK, LIWORK, INFO )
+         CALL ZUNMTR( 'L', UPLO, 'N', N, N, A, LDA, WORK( INDTAU ),
+     $                WORK( INDWRK ), N, WORK( INDWK2 ), LLWRK2, IINFO )
+         CALL ZLACPY( 'A', N, N, WORK( INDWRK ), N, A, LDA )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = N
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+      WORK( 1 )  = LWMIN
+      RWORK( 1 ) = LRWMIN
+      IWORK( 1 ) = LIWMIN
+*
+      RETURN
+*
+*     End of ZHEEVD_2STAGE
+*
+      END
diff --git a/SRC/zheevr_2stage.f b/SRC/zheevr_2stage.f
new file mode 100644
index 00000000..bfd43056
--- /dev/null
+++ b/SRC/zheevr_2stage.f
@@ -0,0 +1,779 @@
+*> \brief <b> ZHEEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>
+*
+*  @precisions fortran z -> s d c
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHEEVR_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zheevr_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zheevr_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zheevr_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+*                                 IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ,
+*                                 WORK, LWORK, RWORK, LRWORK, IWORK,
+*                                 LIWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
+*      $                   M, N
+*       DOUBLE PRECISION   ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            ISUPPZ( * ), IWORK( * )
+*       DOUBLE PRECISION   RWORK( * ), W( * )
+*       COMPLEX*16         A( LDA, * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHEEVR_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a complex Hermitian matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  Eigenvalues and eigenvectors can
+*> be selected by specifying either a range of values or a range of
+*> indices for the desired eigenvalues.
+*>
+*> ZHEEVR_2STAGE first reduces the matrix A to tridiagonal form T with a call
+*> to ZHETRD.  Then, whenever possible, ZHEEVR_2STAGE calls ZSTEMR to compute
+*> eigenspectrum using Relatively Robust Representations.  ZSTEMR
+*> computes eigenvalues by the dqds algorithm, while orthogonal
+*> eigenvectors are computed from various "good" L D L^T representations
+*> (also known as Relatively Robust Representations). Gram-Schmidt
+*> orthogonalization is avoided as far as possible. More specifically,
+*> the various steps of the algorithm are as follows.
+*>
+*> For each unreduced block (submatrix) of T,
+*>    (a) Compute T - sigma I  = L D L^T, so that L and D
+*>        define all the wanted eigenvalues to high relative accuracy.
+*>        This means that small relative changes in the entries of D and L
+*>        cause only small relative changes in the eigenvalues and
+*>        eigenvectors. The standard (unfactored) representation of the
+*>        tridiagonal matrix T does not have this property in general.
+*>    (b) Compute the eigenvalues to suitable accuracy.
+*>        If the eigenvectors are desired, the algorithm attains full
+*>        accuracy of the computed eigenvalues only right before
+*>        the corresponding vectors have to be computed, see steps c) and d).
+*>    (c) For each cluster of close eigenvalues, select a new
+*>        shift close to the cluster, find a new factorization, and refine
+*>        the shifted eigenvalues to suitable accuracy.
+*>    (d) For each eigenvalue with a large enough relative separation compute
+*>        the corresponding eigenvector by forming a rank revealing twisted
+*>        factorization. Go back to (c) for any clusters that remain.
+*>
+*> The desired accuracy of the output can be specified by the input
+*> parameter ABSTOL.
+*>
+*> For more details, see DSTEMR's documentation and:
+*> - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
+*>   to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
+*>   Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
+*> - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
+*>   Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
+*>   2004.  Also LAPACK Working Note 154.
+*> - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
+*>   tridiagonal eigenvalue/eigenvector problem",
+*>   Computer Science Division Technical Report No. UCB/CSD-97-971,
+*>   UC Berkeley, May 1997.
+*>
+*>
+*> Note 1 : ZHEEVR_2STAGE calls ZSTEMR when the full spectrum is requested
+*> on machines which conform to the ieee-754 floating point standard.
+*> ZHEEVR_2STAGE calls DSTEBZ and ZSTEIN on non-ieee machines and
+*> when partial spectrum requests are made.
+*>
+*> Normal execution of ZSTEMR may create NaNs and infinities and
+*> hence may abort due to a floating point exception in environments
+*> which do not handle NaNs and infinities in the ieee standard default
+*> manner.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found.
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found.
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*>          For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and
+*>          ZSTEIN are called
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA, N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, the lower triangle (if UPLO='L') or the upper
+*>          triangle (if UPLO='U') of A, including the diagonal, is
+*>          destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is DOUBLE PRECISION
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is DOUBLE PRECISION
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is DOUBLE PRECISION
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing A to tridiagonal form.
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*>
+*>          If high relative accuracy is important, set ABSTOL to
+*>          DLAMCH( 'Safe minimum' ).  Doing so will guarantee that
+*>          eigenvalues are computed to high relative accuracy when
+*>          possible in future releases.  The current code does not
+*>          make any guarantees about high relative accuracy, but
+*>          furutre releases will. See J. Barlow and J. Demmel,
+*>          "Computing Accurate Eigensystems of Scaled Diagonally
+*>          Dominant Matrices", LAPACK Working Note #7, for a discussion
+*>          of which matrices define their eigenvalues to high relative
+*>          accuracy.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          The first M elements contain the selected eigenvalues in
+*>          ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX*16 array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] ISUPPZ
+*> \verbatim
+*>          ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
+*>          The support of the eigenvectors in Z, i.e., the indices
+*>          indicating the nonzero elements in Z. The i-th eigenvector
+*>          is nonzero only in elements ISUPPZ( 2*i-1 ) through
+*>          ISUPPZ( 2*i ). This is an output of ZSTEMR (tridiagonal
+*>          matrix). The support of the eigenvectors of A is typically 
+*>          1:N because of the unitary transformations applied by ZUNMTR.
+*>          Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, 26*N, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal sizes of the WORK, RWORK and
+*>          IWORK arrays, returns these values as the first entries of
+*>          the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK))
+*>          On exit, if INFO = 0, RWORK(1) returns the optimal
+*>          (and minimal) LRWORK.
+*> \endverbatim
+*>
+*> \param[in] LRWORK
+*> \verbatim
+*>          LRWORK is INTEGER
+*>          The length of the array RWORK.  LRWORK >= max(1,24*N).
+*>
+*>          If LRWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
+*>          On exit, if INFO = 0, IWORK(1) returns the optimal
+*>          (and minimal) LIWORK.
+*> \endverbatim
+*>
+*> \param[in] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The dimension of the array IWORK.  LIWORK >= max(1,10*N).
+*>
+*>          If LIWORK = -1, then a workspace query is assumed; the
+*>          routine only calculates the optimal sizes of the WORK, RWORK
+*>          and IWORK arrays, returns these values as the first entries
+*>          of the WORK, RWORK and IWORK arrays, and no error message
+*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  Internal error
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup complex16HEeigen
+*
+*> \par Contributors:
+*  ==================
+*>
+*>     Inderjit Dhillon, IBM Almaden, USA \n
+*>     Osni Marques, LBNL/NERSC, USA \n
+*>     Ken Stanley, Computer Science Division, University of
+*>       California at Berkeley, USA \n
+*>     Jason Riedy, Computer Science Division, University of
+*>       California at Berkeley, USA \n
+*>
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+     $                          IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ,
+     $                          WORK, LWORK, RWORK, LRWORK, IWORK,
+     $                          LIWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
+     $                   M, N
+      DOUBLE PRECISION   ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            ISUPPZ( * ), IWORK( * )
+      DOUBLE PRECISION   RWORK( * ), W( * )
+      COMPLEX*16         A( LDA, * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE, TWO
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
+     $                   WANTZ, TRYRAC
+      CHARACTER          ORDER
+      INTEGER            I, IEEEOK, IINFO, IMAX, INDIBL, INDIFL, INDISP,
+     $                   INDIWO, INDRD, INDRDD, INDRE, INDREE, INDRWK,
+     $                   INDTAU, INDWK, INDWKN, ISCALE, ITMP1, J, JJ,
+     $                   LIWMIN, LLWORK, LLRWORK, LLWRKN, LRWMIN,
+     $                   LWMIN, NSPLIT, LHTRD, LWTRD, KD, IB, INDHOUS
+      DOUBLE PRECISION   ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, ZLANSY
+      EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL,
+     $                   ZHETRD_2STAGE, ZSTEMR, ZSTEIN, ZSWAP, ZUNMTR
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      IEEEOK = ILAENV( 10, 'ZHEEVR', 'N', 1, 2, 3, 4 )
+*
+      LOWER = LSAME( UPLO, 'L' )
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+*
+      LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR.
+     $         ( LIWORK.EQ.-1 ) )
+*
+      KD     = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+      IB     = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+      LHTRD  = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+      LWTRD  = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+      LWMIN  = N + LHTRD + LWTRD
+      LRWMIN = MAX( 1, 24*N )
+      LIWMIN = MAX( 1, 10*N )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -8
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -9
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -10
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+            INFO = -15
+         END IF
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         WORK( 1 )  = LWMIN
+         RWORK( 1 ) = LRWMIN
+         IWORK( 1 ) = LIWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -18
+         ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -20
+         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -22
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHEEVR_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         WORK( 1 ) = 2
+         IF( ALLEIG .OR. INDEIG ) THEN
+            M = 1
+            W( 1 ) = DBLE( A( 1, 1 ) )
+         ELSE
+            IF( VL.LT.DBLE( A( 1, 1 ) ) .AND. VU.GE.DBLE( A( 1, 1 ) ) )
+     $           THEN
+               M = 1
+               W( 1 ) = DBLE( A( 1, 1 ) )
+            END IF
+         END IF
+         IF( WANTZ ) THEN
+            Z( 1, 1 ) = ONE
+            ISUPPZ( 1 ) = 1
+            ISUPPZ( 2 ) = 1
+         END IF
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF (VALEIG) THEN
+         VLL = VL
+         VUU = VU
+      END IF
+      ANRM = ZLANSY( 'M', UPLO, N, A, LDA, RWORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            DO 10 J = 1, N
+               CALL ZDSCAL( N-J+1, SIGMA, A( J, J ), 1 )
+   10       CONTINUE
+         ELSE
+            DO 20 J = 1, N
+               CALL ZDSCAL( J, SIGMA, A( 1, J ), 1 )
+   20       CONTINUE
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+
+*     Initialize indices into workspaces.  Note: The IWORK indices are
+*     used only if DSTERF or ZSTEMR fail.
+
+*     WORK(INDTAU:INDTAU+N-1) stores the complex scalar factors of the
+*     elementary reflectors used in ZHETRD.
+      INDTAU = 1
+*     INDWK is the starting offset of the remaining complex workspace,
+*     and LLWORK is the remaining complex workspace size.
+      INDHOUS = INDTAU + N
+      INDWK   = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWK + 1
+
+*     RWORK(INDRD:INDRD+N-1) stores the real tridiagonal's diagonal
+*     entries.
+      INDRD = 1
+*     RWORK(INDRE:INDRE+N-1) stores the off-diagonal entries of the
+*     tridiagonal matrix from ZHETRD.
+      INDRE = INDRD + N
+*     RWORK(INDRDD:INDRDD+N-1) is a copy of the diagonal entries over
+*     -written by ZSTEMR (the DSTERF path copies the diagonal to W).
+      INDRDD = INDRE + N
+*     RWORK(INDREE:INDREE+N-1) is a copy of the off-diagonal entries over
+*     -written while computing the eigenvalues in DSTERF and ZSTEMR.
+      INDREE = INDRDD + N
+*     INDRWK is the starting offset of the left-over real workspace, and
+*     LLRWORK is the remaining workspace size.
+      INDRWK = INDREE + N
+      LLRWORK = LRWORK - INDRWK + 1
+
+*     IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in DSTEBZ and
+*     stores the block indices of each of the M<=N eigenvalues.
+      INDIBL = 1
+*     IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in DSTEBZ and
+*     stores the starting and finishing indices of each block.
+      INDISP = INDIBL + N
+*     IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
+*     that corresponding to eigenvectors that fail to converge in
+*     ZSTEIN.  This information is discarded; if any fail, the driver
+*     returns INFO > 0.
+      INDIFL = INDISP + N
+*     INDIWO is the offset of the remaining integer workspace.
+      INDIWO = INDIFL + N
+
+*
+*     Call ZHETRD_2STAGE to reduce Hermitian matrix to tridiagonal form.
+*
+      CALL ZHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, RWORK( INDRD ), 
+     $                    RWORK( INDRE ), WORK( INDTAU ),
+     $                    WORK( INDHOUS ), LHTRD, 
+     $                    WORK( INDWK ), LLWORK, IINFO )
+*
+*     If all eigenvalues are desired
+*     then call DSTERF or ZSTEMR and ZUNMTR.
+*
+      TEST = .FALSE.
+      IF( INDEIG ) THEN
+         IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN
+         IF( .NOT.WANTZ ) THEN
+            CALL DCOPY( N, RWORK( INDRD ), 1, W, 1 )
+            CALL DCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
+            CALL DSTERF( N, W, RWORK( INDREE ), INFO )
+         ELSE
+            CALL DCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
+            CALL DCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 )
+*
+            IF (ABSTOL .LE. TWO*N*EPS) THEN
+               TRYRAC = .TRUE.
+            ELSE
+               TRYRAC = .FALSE.
+            END IF
+            CALL ZSTEMR( JOBZ, 'A', N, RWORK( INDRDD ),
+     $                   RWORK( INDREE ), VL, VU, IL, IU, M, W,
+     $                   Z, LDZ, N, ISUPPZ, TRYRAC,
+     $                   RWORK( INDRWK ), LLRWORK,
+     $                   IWORK, LIWORK, INFO )
+*
+*           Apply unitary matrix used in reduction to tridiagonal
+*           form to eigenvectors returned by ZSTEMR.
+*
+            IF( WANTZ .AND. INFO.EQ.0 ) THEN
+               INDWKN = INDWK
+               LLWRKN = LWORK - INDWKN + 1
+               CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA,
+     $                      WORK( INDTAU ), Z, LDZ, WORK( INDWKN ),
+     $                      LLWRKN, IINFO )
+            END IF
+         END IF
+*
+*
+         IF( INFO.EQ.0 ) THEN
+            M = N
+            GO TO 30
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call DSTEBZ and, if eigenvectors are desired, ZSTEIN.
+*     Also call DSTEBZ and ZSTEIN if ZSTEMR fails.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+
+      CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             RWORK( INDRD ), RWORK( INDRE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
+     $             IWORK( INDIWO ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL ZSTEIN( N, RWORK( INDRD ), RWORK( INDRE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                RWORK( INDRWK ), IWORK( INDIWO ), IWORK( INDIFL ),
+     $                INFO )
+*
+*        Apply unitary matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by ZSTEIN.
+*
+         INDWKN = INDWK
+         LLWRKN = LWORK - INDWKN + 1
+         CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
+     $                LDZ, WORK( INDWKN ), LLWRKN, IINFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+   30 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.
+*
+      IF( WANTZ ) THEN
+         DO 50 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 40 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   40       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               ITMP1 = IWORK( INDIBL+I-1 )
+               W( I ) = W( J )
+               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
+               W( J ) = TMP1
+               IWORK( INDIBL+J-1 ) = ITMP1
+               CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+            END IF
+   50    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal workspace size.
+*
+      WORK( 1 )  = LWMIN
+      RWORK( 1 ) = LRWMIN
+      IWORK( 1 ) = LIWMIN
+*
+      RETURN
+*
+*     End of ZHEEVR_2STAGE
+*
+      END
diff --git a/SRC/zheevx_2stage.f b/SRC/zheevx_2stage.f
new file mode 100644
index 00000000..e33d55e0
--- /dev/null
+++ b/SRC/zheevx_2stage.f
@@ -0,0 +1,618 @@
+*> \brief <b> ZHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>
+*
+*  @precisions fortran z -> s d c
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHEEVX_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zheevx_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zheevx_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zheevx_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHEEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+*                                 IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
+*                                 LWORK, RWORK, IWORK, IFAIL, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, RANGE, UPLO
+*       INTEGER            IL, INFO, IU, LDA, LDZ, LWORK, M, N
+*       DOUBLE PRECISION   ABSTOL, VL, VU
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IFAIL( * ), IWORK( * )
+*       DOUBLE PRECISION   RWORK( * ), W( * )
+*       COMPLEX*16         A( LDA, * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHEEVX_2STAGE computes selected eigenvalues and, optionally, eigenvectors
+*> of a complex Hermitian matrix A using the 2stage technique for
+*> the reduction to tridiagonal.  Eigenvalues and eigenvectors can
+*> be selected by specifying either a range of values or a range of
+*> indices for the desired eigenvalues.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] RANGE
+*> \verbatim
+*>          RANGE is CHARACTER*1
+*>          = 'A': all eigenvalues will be found.
+*>          = 'V': all eigenvalues in the half-open interval (VL,VU]
+*>                 will be found.
+*>          = 'I': the IL-th through IU-th eigenvalues will be found.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA, N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>          On exit, the lower triangle (if UPLO='L') or the upper
+*>          triangle (if UPLO='U') of A, including the diagonal, is
+*>          destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] VL
+*> \verbatim
+*>          VL is DOUBLE PRECISION
+*>          If RANGE='V', the lower bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] VU
+*> \verbatim
+*>          VU is DOUBLE PRECISION
+*>          If RANGE='V', the upper bound of the interval to
+*>          be searched for eigenvalues. VL < VU.
+*>          Not referenced if RANGE = 'A' or 'I'.
+*> \endverbatim
+*>
+*> \param[in] IL
+*> \verbatim
+*>          IL is INTEGER
+*>          If RANGE='I', the index of the
+*>          smallest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] IU
+*> \verbatim
+*>          IU is INTEGER
+*>          If RANGE='I', the index of the
+*>          largest eigenvalue to be returned.
+*>          1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
+*>          Not referenced if RANGE = 'A' or 'V'.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*>          ABSTOL is DOUBLE PRECISION
+*>          The absolute error tolerance for the eigenvalues.
+*>          An approximate eigenvalue is accepted as converged
+*>          when it is determined to lie in an interval [a,b]
+*>          of width less than or equal to
+*>
+*>                  ABSTOL + EPS *   max( |a|,|b| ) ,
+*>
+*>          where EPS is the machine precision.  If ABSTOL is less than
+*>          or equal to zero, then  EPS*|T|  will be used in its place,
+*>          where |T| is the 1-norm of the tridiagonal matrix obtained
+*>          by reducing A to tridiagonal form.
+*>
+*>          Eigenvalues will be computed most accurately when ABSTOL is
+*>          set to twice the underflow threshold 2*DLAMCH('S'), not zero.
+*>          If this routine returns with INFO>0, indicating that some
+*>          eigenvectors did not converge, try setting ABSTOL to
+*>          2*DLAMCH('S').
+*>
+*>          See "Computing Small Singular Values of Bidiagonal Matrices
+*>          with Guaranteed High Relative Accuracy," by Demmel and
+*>          Kahan, LAPACK Working Note #3.
+*> \endverbatim
+*>
+*> \param[out] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of eigenvalues found.  0 <= M <= N.
+*>          If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          On normal exit, the first M elements contain the selected
+*>          eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX*16 array, dimension (LDZ, max(1,M))
+*>          If JOBZ = 'V', then if INFO = 0, the first M columns of Z
+*>          contain the orthonormal eigenvectors of the matrix A
+*>          corresponding to the selected eigenvalues, with the i-th
+*>          column of Z holding the eigenvector associated with W(i).
+*>          If an eigenvector fails to converge, then that column of Z
+*>          contains the latest approximation to the eigenvector, and the
+*>          index of the eigenvector is returned in IFAIL.
+*>          If JOBZ = 'N', then Z is not referenced.
+*>          Note: the user must ensure that at least max(1,M) columns are
+*>          supplied in the array Z; if RANGE = 'V', the exact value of M
+*>          is not known in advance and an upper bound must be used.
+*> \endverbatim
+*>
+*> \param[in] LDZ
+*> \verbatim
+*>          LDZ is INTEGER
+*>          The leading dimension of the array Z.  LDZ >= 1, and if
+*>          JOBZ = 'V', LDZ >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, 8*N, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (7*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (5*N)
+*> \endverbatim
+*>
+*> \param[out] IFAIL
+*> \verbatim
+*>          IFAIL is INTEGER array, dimension (N)
+*>          If JOBZ = 'V', then if INFO = 0, the first M elements of
+*>          IFAIL are zero.  If INFO > 0, then IFAIL contains the
+*>          indices of the eigenvectors that failed to converge.
+*>          If JOBZ = 'N', then IFAIL is not referenced.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, then i eigenvectors failed to converge.
+*>                Their indices are stored in array IFAIL.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup complex16HEeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHEEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
+     $                          IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
+     $                          LWORK, RWORK, IWORK, IFAIL, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     June 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, RANGE, UPLO
+      INTEGER            IL, INFO, IU, LDA, LDZ, LWORK, M, N
+      DOUBLE PRECISION   ABSTOL, VL, VU
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IFAIL( * ), IWORK( * )
+      DOUBLE PRECISION   RWORK( * ), W( * )
+      COMPLEX*16         A( LDA, * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      COMPLEX*16         CONE
+      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
+     $                   WANTZ
+      CHARACTER          ORDER
+      INTEGER            I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
+     $                   INDISP, INDIWK, INDRWK, INDTAU, INDWRK, ISCALE,
+     $                   ITMP1, J, JJ, LLWORK, 
+     $                   NSPLIT, LWMIN, LHTRD, LWTRD, KD, IB, INDHOUS
+      DOUBLE PRECISION   ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
+     $                   SIGMA, SMLNUM, TMP1, VLL, VUU
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, ZLANHE
+      EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANHE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL,
+     $                   ZLACPY, ZSTEIN, ZSTEQR, ZSWAP, ZUNGTR, ZUNMTR,
+     $                   ZHETRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      LOWER = LSAME( UPLO, 'L' )
+      WANTZ = LSAME( JOBZ, 'V' )
+      ALLEIG = LSAME( RANGE, 'A' )
+      VALEIG = LSAME( RANGE, 'V' )
+      INDEIG = LSAME( RANGE, 'I' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE
+         IF( VALEIG ) THEN
+            IF( N.GT.0 .AND. VU.LE.VL )
+     $         INFO = -8
+         ELSE IF( INDEIG ) THEN
+            IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
+               INFO = -9
+            ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
+               INFO = -10
+            END IF
+         END IF
+      END IF
+      IF( INFO.EQ.0 ) THEN
+         IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+            INFO = -15
+         END IF
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.LE.1 ) THEN
+            LWMIN = 1
+            WORK( 1 ) = LWMIN
+         ELSE
+            KD    = ILAENV( 17, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+            IB    = ILAENV( 18, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+            LHTRD = ILAENV( 19, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWTRD = ILAENV( 20, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+            LWMIN = N + LHTRD + LWTRD
+            WORK( 1 )  = LWMIN
+         END IF
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY )
+     $      INFO = -17
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHEEVX_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      M = 0
+      IF( N.EQ.0 ) THEN
+         RETURN
+      END IF
+*
+      IF( N.EQ.1 ) THEN
+         IF( ALLEIG .OR. INDEIG ) THEN
+            M = 1
+         W( 1 ) = DBLE( A( 1, 1 ) )
+         ELSE IF( VALEIG ) THEN
+            IF( VL.LT.DBLE( A( 1, 1 ) ) .AND. VU.GE.DBLE( A( 1, 1 ) ) )
+     $           THEN
+               M = 1
+               W( 1 ) = DBLE( A( 1, 1 ) )
+            END IF
+         END IF
+         IF( WANTZ )
+     $      Z( 1, 1 ) = CONE
+         RETURN
+      END IF
+*
+*     Get machine constants.
+*
+      SAFMIN = DLAMCH( 'Safe minimum' )
+      EPS    = DLAMCH( 'Precision' )
+      SMLNUM = SAFMIN / EPS
+      BIGNUM = ONE / SMLNUM
+      RMIN   = SQRT( SMLNUM )
+      RMAX   = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
+*
+*     Scale matrix to allowable range, if necessary.
+*
+      ISCALE = 0
+      ABSTLL = ABSTOL
+      IF( VALEIG ) THEN
+         VLL = VL
+         VUU = VU
+      END IF
+      ANRM = ZLANHE( 'M', UPLO, N, A, LDA, RWORK )
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
+         ISCALE = 1
+         SIGMA = RMIN / ANRM
+      ELSE IF( ANRM.GT.RMAX ) THEN
+         ISCALE = 1
+         SIGMA = RMAX / ANRM
+      END IF
+      IF( ISCALE.EQ.1 ) THEN
+         IF( LOWER ) THEN
+            DO 10 J = 1, N
+               CALL ZDSCAL( N-J+1, SIGMA, A( J, J ), 1 )
+   10       CONTINUE
+         ELSE
+            DO 20 J = 1, N
+               CALL ZDSCAL( J, SIGMA, A( 1, J ), 1 )
+   20       CONTINUE
+         END IF
+         IF( ABSTOL.GT.0 )
+     $      ABSTLL = ABSTOL*SIGMA
+         IF( VALEIG ) THEN
+            VLL = VL*SIGMA
+            VUU = VU*SIGMA
+         END IF
+      END IF
+*
+*     Call ZHETRD_2STAGE to reduce Hermitian matrix to tridiagonal form.
+*
+      INDD    = 1
+      INDE    = INDD + N
+      INDRWK  = INDE + N
+      INDTAU  = 1
+      INDHOUS = INDTAU + N
+      INDWRK  = INDHOUS + LHTRD
+      LLWORK  = LWORK - INDWRK + 1
+*
+      CALL ZHETRD_2STAGE( JOBZ, UPLO, N, A, LDA, RWORK( INDD ),
+     $                    RWORK( INDE ), WORK( INDTAU ), 
+     $                    WORK( INDHOUS ), LHTRD, WORK( INDWRK ),
+     $                    LLWORK, IINFO )
+*
+*     If all eigenvalues are desired and ABSTOL is less than or equal to
+*     zero, then call DSTERF or ZUNGTR and ZSTEQR.  If this fails for
+*     some eigenvalue, then try DSTEBZ.
+*
+      TEST = .FALSE.
+      IF( INDEIG ) THEN
+         IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
+            TEST = .TRUE.
+         END IF
+      END IF
+      IF( ( ALLEIG .OR. TEST ) .AND. ( ABSTOL.LE.ZERO ) ) THEN
+         CALL DCOPY( N, RWORK( INDD ), 1, W, 1 )
+         INDEE = INDRWK + 2*N
+         IF( .NOT.WANTZ ) THEN
+            CALL DCOPY( N-1, RWORK( INDE ), 1, RWORK( INDEE ), 1 )
+            CALL DSTERF( N, W, RWORK( INDEE ), INFO )
+         ELSE
+            CALL ZLACPY( 'A', N, N, A, LDA, Z, LDZ )
+            CALL ZUNGTR( UPLO, N, Z, LDZ, WORK( INDTAU ),
+     $                   WORK( INDWRK ), LLWORK, IINFO )
+            CALL DCOPY( N-1, RWORK( INDE ), 1, RWORK( INDEE ), 1 )
+            CALL ZSTEQR( JOBZ, N, W, RWORK( INDEE ), Z, LDZ,
+     $                   RWORK( INDRWK ), INFO )
+            IF( INFO.EQ.0 ) THEN
+               DO 30 I = 1, N
+                  IFAIL( I ) = 0
+   30          CONTINUE
+            END IF
+         END IF
+         IF( INFO.EQ.0 ) THEN
+            M = N
+            GO TO 40
+         END IF
+         INFO = 0
+      END IF
+*
+*     Otherwise, call DSTEBZ and, if eigenvectors are desired, ZSTEIN.
+*
+      IF( WANTZ ) THEN
+         ORDER = 'B'
+      ELSE
+         ORDER = 'E'
+      END IF
+      INDIBL = 1
+      INDISP = INDIBL + N
+      INDIWK = INDISP + N
+      CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
+     $             RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
+     $             IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
+     $             IWORK( INDIWK ), INFO )
+*
+      IF( WANTZ ) THEN
+         CALL ZSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
+     $                IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
+     $                RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
+*
+*        Apply unitary matrix used in reduction to tridiagonal
+*        form to eigenvectors returned by ZSTEIN.
+*
+         CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
+     $                LDZ, WORK( INDWRK ), LLWORK, IINFO )
+      END IF
+*
+*     If matrix was scaled, then rescale eigenvalues appropriately.
+*
+   40 CONTINUE
+      IF( ISCALE.EQ.1 ) THEN
+         IF( INFO.EQ.0 ) THEN
+            IMAX = M
+         ELSE
+            IMAX = INFO - 1
+         END IF
+         CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
+      END IF
+*
+*     If eigenvalues are not in order, then sort them, along with
+*     eigenvectors.
+*
+      IF( WANTZ ) THEN
+         DO 60 J = 1, M - 1
+            I = 0
+            TMP1 = W( J )
+            DO 50 JJ = J + 1, M
+               IF( W( JJ ).LT.TMP1 ) THEN
+                  I = JJ
+                  TMP1 = W( JJ )
+               END IF
+   50       CONTINUE
+*
+            IF( I.NE.0 ) THEN
+               ITMP1 = IWORK( INDIBL+I-1 )
+               W( I ) = W( J )
+               IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
+               W( J ) = TMP1
+               IWORK( INDIBL+J-1 ) = ITMP1
+               CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
+               IF( INFO.NE.0 ) THEN
+                  ITMP1 = IFAIL( I )
+                  IFAIL( I ) = IFAIL( J )
+                  IFAIL( J ) = ITMP1
+               END IF
+            END IF
+   60    CONTINUE
+      END IF
+*
+*     Set WORK(1) to optimal complex workspace size.
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of ZHEEVX_2STAGE
+*
+      END
diff --git a/SRC/zhegv_2stage.f b/SRC/zhegv_2stage.f
new file mode 100644
index 00000000..5079d240
--- /dev/null
+++ b/SRC/zhegv_2stage.f
@@ -0,0 +1,379 @@
+*> \brief \b ZHEGV_2STAGE
+*
+*  @precisions fortran z -> c
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHEGV_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhegv_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhegv_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhegv_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W,
+*                                WORK, LWORK, RWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          JOBZ, UPLO
+*       INTEGER            INFO, ITYPE, LDA, LDB, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   RWORK( * ), W( * )
+*       COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHEGV_2STAGE computes all the eigenvalues, and optionally, the eigenvectors
+*> of a complex generalized Hermitian-definite eigenproblem, of the form
+*> A*x=(lambda)*B*x,  A*Bx=(lambda)*x,  or B*A*x=(lambda)*x.
+*> Here A and B are assumed to be Hermitian and B is also
+*> positive definite.
+*> This routine use the 2stage technique for the reduction to tridiagonal
+*> which showed higher performance on recent architecture and for large
+*  sizes N>2000.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] ITYPE
+*> \verbatim
+*>          ITYPE is INTEGER
+*>          Specifies the problem type to be solved:
+*>          = 1:  A*x = (lambda)*B*x
+*>          = 2:  A*B*x = (lambda)*x
+*>          = 3:  B*A*x = (lambda)*x
+*> \endverbatim
+*>
+*> \param[in] JOBZ
+*> \verbatim
+*>          JOBZ is CHARACTER*1
+*>          = 'N':  Compute eigenvalues only;
+*>          = 'V':  Compute eigenvalues and eigenvectors.
+*>                  Not available in this release.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangles of A and B are stored;
+*>          = 'L':  Lower triangles of A and B are stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrices A and B.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA, N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the
+*>          leading N-by-N upper triangular part of A contains the
+*>          upper triangular part of the matrix A.  If UPLO = 'L',
+*>          the leading N-by-N lower triangular part of A contains
+*>          the lower triangular part of the matrix A.
+*>
+*>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+*>          matrix Z of eigenvectors.  The eigenvectors are normalized
+*>          as follows:
+*>          if ITYPE = 1 or 2, Z**H*B*Z = I;
+*>          if ITYPE = 3, Z**H*inv(B)*Z = I.
+*>          If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
+*>          or the lower triangle (if UPLO='L') of A, including the
+*>          diagonal, is destroyed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (LDB, N)
+*>          On entry, the Hermitian positive definite matrix B.
+*>          If UPLO = 'U', the leading N-by-N upper triangular part of B
+*>          contains the upper triangular part of the matrix B.
+*>          If UPLO = 'L', the leading N-by-N lower triangular part of B
+*>          contains the lower triangular part of the matrix B.
+*>
+*>          On exit, if INFO <= N, the part of B containing the matrix is
+*>          overwritten by the triangular factor U or L from the Cholesky
+*>          factorization B = U**H*U or B = L*L**H.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is DOUBLE PRECISION array, dimension (N)
+*>          If INFO = 0, the eigenvalues in ascending order.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of the array WORK. LWORK >= 1, when N <= 1;
+*>          otherwise  
+*>          If JOBZ = 'N' and N > 1, LWORK must be queried.
+*>                                   LWORK = MAX(1, dimension) where
+*>                                   dimension = max(stage1,stage2) + (KD+1)*N + N
+*>                                             = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                                               + max(2*KD*KD, KD*NTHREADS) 
+*>                                               + (KD+1)*N + N
+*>                                   where KD is the blocking size of the reduction,
+*>                                   FACTOPTNB is the blocking used by the QR or LQ
+*>                                   algorithm, usually FACTOPTNB=128 is a good choice
+*>                                   NTHREADS is the number of threads used when
+*>                                   openMP compilation is enabled, otherwise =1.
+*>          If JOBZ = 'V' and N > 1, LWORK must be queried. Not yet available
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (max(1, 3*N-2))
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  ZPOTRF or ZHEEV returned an error code:
+*>             <= N:  if INFO = i, ZHEEV failed to converge;
+*>                    i off-diagonal elements of an intermediate
+*>                    tridiagonal form did not converge to zero;
+*>             > N:   if INFO = N + i, for 1 <= i <= N, then the leading
+*>                    minor of order i of B is not positive definite.
+*>                    The factorization of B could not be completed and
+*>                    no eigenvalues or eigenvectors were computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEeigen
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  All details about the 2stage techniques are available in:
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W,
+     $                         WORK, LWORK, RWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK driver routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          JOBZ, UPLO
+      INTEGER            INFO, ITYPE, LDA, LDB, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   RWORK( * ), W( * )
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER, WANTZ
+      CHARACTER          TRANS
+      INTEGER            NEIG, LWMIN, LHTRD, LWTRD, KD, IB
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, ZHEGST, ZPOTRF, ZTRMM, ZTRSM,
+     $                   ZHEEV_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      WANTZ = LSAME( JOBZ, 'V' )
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      INFO = 0
+      IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
+         INFO = -1
+      ELSE IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         KD    = ILAENV( 17, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+         IB    = ILAENV( 18, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+         LHTRD = ILAENV( 19, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWTRD = ILAENV( 20, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+         LWMIN = N + LHTRD + LWTRD
+         WORK( 1 )  = LWMIN
+*
+         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -11
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHEGV_2STAGE ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Form a Cholesky factorization of B.
+*
+      CALL ZPOTRF( UPLO, N, B, LDB, INFO )
+      IF( INFO.NE.0 ) THEN
+         INFO = N + INFO
+         RETURN
+      END IF
+*
+*     Transform problem to standard eigenvalue problem and solve.
+*
+      CALL ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
+      CALL ZHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, 
+     $                   WORK, LWORK, RWORK, INFO )
+*
+      IF( WANTZ ) THEN
+*
+*        Backtransform eigenvectors to the original problem.
+*
+         NEIG = N
+         IF( INFO.GT.0 )
+     $      NEIG = INFO - 1
+         IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
+*
+*           For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
+*           backtransform eigenvectors: x = inv(L)**H *y or inv(U)*y
+*
+            IF( UPPER ) THEN
+               TRANS = 'N'
+            ELSE
+               TRANS = 'C'
+            END IF
+*
+            CALL ZTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
+     $                  B, LDB, A, LDA )
+*
+         ELSE IF( ITYPE.EQ.3 ) THEN
+*
+*           For B*A*x=(lambda)*x;
+*           backtransform eigenvectors: x = L*y or U**H *y
+*
+            IF( UPPER ) THEN
+               TRANS = 'C'
+            ELSE
+               TRANS = 'N'
+            END IF
+*
+            CALL ZTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
+     $                  B, LDB, A, LDA )
+         END IF
+      END IF
+*
+      WORK( 1 ) = LWMIN
+*
+      RETURN
+*
+*     End of ZHEGV_2STAGE
+*
+      END
diff --git a/SRC/zhesv_aa.f b/SRC/zhesv_aa.f
index 50314547..dffa4754 100644
--- a/SRC/zhesv_aa.f
+++ b/SRC/zhesv_aa.f
@@ -19,7 +19,7 @@
 *  ===========
 *
 *       SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-*                               LWORK, INFO )
+*                            LWORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
@@ -126,9 +126,9 @@
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
-*>          The length of WORK.  LWORK >= 1, and for best performance
-*>          LWORK >= max(1,N*NB), where NB is the optimal blocksize for
-*>          ZHETRF.
+*>          The length of WORK.  LWORK >= MAX(1,2*N,3*N-2), and for best 
+*>          performance LWORK >= max(1,N*NB), where NB is the optimal
+*>          blocksize for ZHETRF.
 *>          for LWORK < N, TRS will be done with Level BLAS 2
 *>          for LWORK >= N, TRS will be done with Level BLAS 3
 *>
@@ -162,7 +162,7 @@
 *
 *  =====================================================================
       SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-     $                        LWORK, INFO )
+     $                     LWORK, INFO )
 *
 *  -- LAPACK driver routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
diff --git a/SRC/zhesv_rk.f b/SRC/zhesv_rk.f
new file mode 100644
index 00000000..8a649b27
--- /dev/null
+++ b/SRC/zhesv_rk.f
@@ -0,0 +1,317 @@
+*> \brief <b> ZHESV_RK computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHESV_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhesv_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhesv_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhesv_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            WORK, LWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZHESV_RK computes the solution to a complex system of linear
+*> equations A * X = B, where A is an N-by-N Hermitian matrix
+*> and X and B are N-by-NRHS matrices.
+*>
+*> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used
+*> to factor A as
+*>    A = P*U*D*(U**H)*(P**T),  if UPLO = 'U', or
+*>    A = P*L*D*(L**H)*(P**T),  if UPLO = 'L',
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> ZHETRF_RK is called to compute the factorization of a complex
+*> Hermitian matrix.  The factored form of A is then used to solve
+*> the system of equations A * X = B by calling BLAS3 routine ZHETRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix A is stored:
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of linear equations, i.e., the order of the
+*>          matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, if INFO = 0, diagonal of the block diagonal
+*>          matrix D and factors U or L  as computed by ZHETRF_RK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          For more info see the description of ZHETRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On exit, contains the output computed by the factorization
+*>          routine ZHETRF_RK, i.e. the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*>
+*>          For more info see the description of ZHETRF_RK routine.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D,
+*>          as determined by ZHETRF_RK.
+*>
+*>          For more info see the description of ZHETRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (LDB,NRHS)
+*>          On entry, the N-by-NRHS right hand side matrix B.
+*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension ( MAX(1,LWORK) ).
+*>          Work array used in the factorization stage.
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >= 1. For best performance
+*>          of factorization stage LWORK >= max(1,N*NB), where NB is
+*>          the optimal blocksize for ZHETRF_RK.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array for factorization stage, returns this value as
+*>          the first entry of the WORK array, and no error message
+*>          related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEsolve
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK,
+     $                     LWORK, INFO )
+*
+*  -- LAPACK driver routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            LWKOPT
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, ZHETRF_RK, ZHETRS_3
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -11
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.EQ.0 ) THEN
+            LWKOPT = 1
+         ELSE
+            CALL ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
+            LWKOPT = WORK(1)
+         END IF
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHESV_RK ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Compute the factorization A = P*U*D*(U**H)*(P**T) or
+*     A = P*U*D*(U**H)*(P**T).
+*
+      CALL ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO )
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Solve the system A*X = B with BLAS3 solver, overwriting B with X.
+*
+         CALL ZHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO )
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of ZHESV_RK
+*
+      END
diff --git a/SRC/zhetf2_rk.f b/SRC/zhetf2_rk.f
new file mode 100644
index 00000000..857f1c67
--- /dev/null
+++ b/SRC/zhetf2_rk.f
@@ -0,0 +1,1039 @@
+*> \brief \b ZHETF2_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETF2_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetf2_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetf2_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetf2_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), E ( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZHETF2_RK computes the factorization of a complex Hermitian matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the Hermitian block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put further details
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*>  01-01-96 - Based on modifications by
+*>    J. Lewis, Boeing Computer Services Company
+*>    A. Petitet, Computer Science Dept.,
+*>                Univ. of Tenn., Knoxville abd , USA
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * )
+*     ..
+*
+*  ======================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      DOUBLE PRECISION   EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
+      COMPLEX*16         CZERO
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            DONE, UPPER
+      INTEGER            I, II, IMAX, ITEMP, J, JMAX, K, KK, KP, KSTEP,
+     $                   P
+      DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, D, D11, D22, R1, DTEMP,
+     $                   ROWMAX, TT, SFMIN
+      COMPLEX*16         D12, D21, T, WK, WKM1, WKP1, Z
+*     ..
+*     .. External Functions ..
+*
+      LOGICAL            LSAME
+      INTEGER            IZAMAX
+      DOUBLE PRECISION   DLAMCH, DLAPY2
+      EXTERNAL           LSAME, IZAMAX, DLAMCH, DLAPY2
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, ZDSCAL, ZHER, ZSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, SQRT
+*     ..
+*     .. Statement Functions ..
+      DOUBLE PRECISION   CABS1
+*     ..
+*     .. Statement Function definitions ..
+      CABS1( Z ) = ABS( DBLE( Z ) ) + ABS( DIMAG( Z ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHETF2_RK', -INFO )
+         RETURN
+      END IF
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = DLAMCH( 'S' )
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**H using the upper triangle of A
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = CZERO
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 34
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( DBLE( A( K, K ) ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = IZAMAX( K-1, A( 1, K ), 1 )
+            COLMAX = CABS1( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( ( MAX( ABSAKK, COLMAX ).EQ.ZERO ) ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            A( K, K ) = DBLE( A( K, K ) )
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           BEGIN pivot search
+*
+*           Case(1)
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   12          CONTINUE
+*
+*                 BEGIN pivot search loop body
+*
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + IZAMAX( K-IMAX, A( IMAX, IMAX+1 ),
+     $                                     LDA )
+                     ROWMAX = CABS1( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = IZAMAX( IMAX-1, A( 1, IMAX ), 1 )
+                     DTEMP = CABS1( A( ITEMP, IMAX ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Case(2)
+*                 Equivalent to testing for
+*                 ABS( REAL( W( IMAX,KW-1 ) ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( ABS( DBLE( A( IMAX, IMAX ) ) )
+     $                       .LT.ALPHA*ROWMAX ) ) THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Case(3)
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K-1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+*
+*                 Case(4)
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*                 END pivot search loop body
+*
+               IF( .NOT.DONE ) GOTO 12
+*
+            END IF
+*
+*           END pivot search
+*
+*           ============================================================
+*
+*           KK is the column of A where pivoting step stopped
+*
+            KK = K - KSTEP + 1
+*
+*           For only a 2x2 pivot, interchange rows and columns K and P
+*           in the leading submatrix A(1:k,1:k)
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*              (1) Swap columnar parts
+               IF( P.GT.1 )
+     $            CALL ZSWAP( P-1, A( 1, K ), 1, A( 1, P ), 1 )
+*              (2) Swap and conjugate middle parts
+               DO 14 J = P + 1, K - 1
+                  T = DCONJG( A( J, K ) )
+                  A( J, K ) = DCONJG( A( P, J ) )
+                  A( P, J ) = T
+   14          CONTINUE
+*              (3) Swap and conjugate corner elements at row-col interserction
+               A( P, K ) = DCONJG( A( P, K ) )
+*              (4) Swap diagonal elements at row-col intersection
+               R1 = DBLE( A( K, K ) )
+               A( K, K ) = DBLE( A( P, P ) )
+               A( P, P ) = R1
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL ZSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA )
+*
+            END IF
+*
+*           For both 1x1 and 2x2 pivots, interchange rows and
+*           columns KK and KP in the leading submatrix A(1:k,1:k)
+*
+            IF( KP.NE.KK ) THEN
+*              (1) Swap columnar parts
+               IF( KP.GT.1 )
+     $            CALL ZSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 )
+*              (2) Swap and conjugate middle parts
+               DO 15 J = KP + 1, KK - 1
+                  T = DCONJG( A( J, KK ) )
+                  A( J, KK ) = DCONJG( A( KP, J ) )
+                  A( KP, J ) = T
+   15          CONTINUE
+*              (3) Swap and conjugate corner elements at row-col interserction
+               A( KP, KK ) = DCONJG( A( KP, KK ) )
+*              (4) Swap diagonal elements at row-col intersection
+               R1 = DBLE( A( KK, KK ) )
+               A( KK, KK ) = DBLE( A( KP, KP ) )
+               A( KP, KP ) = R1
+*
+               IF( KSTEP.EQ.2 ) THEN
+*                 (*) Make sure that diagonal element of pivot is real
+                  A( K, K ) = DBLE( A( K, K ) )
+*                 (5) Swap row elements
+                  T = A( K-1, K )
+                  A( K-1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL ZSWAP( N-K, A( KK, K+1 ), LDA, A( KP, K+1 ),
+     $                        LDA )
+*
+            ELSE
+*              (*) Make sure that diagonal element of pivot is real
+               A( K, K ) = DBLE( A( K, K ) )
+               IF( KSTEP.EQ.2 )
+     $            A( K-1, K-1 ) = DBLE( A( K-1, K-1 ) )
+            END IF
+*
+*           Update the leading submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k now holds
+*
+*              W(k) = U(k)*D(k)
+*
+*              where U(k) is the k-th column of U
+*
+               IF( K.GT.1 ) THEN
+*
+*                 Perform a rank-1 update of A(1:k-1,1:k-1) and
+*                 store U(k) in column k
+*
+                  IF( ABS( DBLE( A( K, K ) ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(1:k-1,1:k-1) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*1/D(k)*W(k)**T
+*
+                     D11 = ONE / DBLE( A( K, K ) )
+                     CALL ZHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+*
+*                    Store U(k) in column k
+*
+                     CALL ZDSCAL( K-1, D11, A( 1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column K
+*
+                     D11 = DBLE( A( K, K ) )
+                     DO 16 II = 1, K - 1
+                        A( II, K ) = A( II, K ) / D11
+   16                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL ZHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+                  END IF
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k-1 now hold
+*
+*              ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+*              Perform a rank-2 update of A(1:k-2,1:k-2) as
+*
+*              A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )**T
+*                 = A - ( ( A(k-1)A(k) )*inv(D(k)) ) * ( A(k-1)A(k) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.GT.2 ) THEN
+*                 D = |A12|
+                  D = DLAPY2( DBLE( A( K-1, K ) ),
+     $                DIMAG( A( K-1, K ) ) )
+                  D11 = A( K, K ) / D
+                  D22 = A( K-1, K-1 ) / D
+                  D12 = A( K-1, K ) / D
+                  TT = ONE / ( D11*D22-ONE )
+*
+                  DO 30 J = K - 2, 1, -1
+*
+*                    Compute  D21 * ( W(k)W(k+1) ) * inv(D(k)) for row J
+*
+                     WKM1 = TT*( D11*A( J, K-1 )-DCONJG( D12 )*
+     $                      A( J, K ) )
+                     WK = TT*( D22*A( J, K )-D12*A( J, K-1 ) )
+*
+*                    Perform a rank-2 update of A(1:k-2,1:k-2)
+*
+                     DO 20 I = J, 1, -1
+                        A( I, J ) = A( I, J ) -
+     $                              ( A( I, K ) / D )*DCONJG( WK ) -
+     $                              ( A( I, K-1 ) / D )*DCONJG( WKM1 )
+   20                CONTINUE
+*
+*                    Store U(k) and U(k-1) in cols k and k-1 for row J
+*
+                     A( J, K ) = WK / D
+                     A( J, K-1 ) = WKM1 / D
+*                    (*) Make sure that diagonal element of pivot is real
+                     A( J, J ) = DCMPLX( DBLE( A( J, J ) ), ZERO )
+*
+   30             CONTINUE
+*
+               END IF
+*
+*              Copy superdiagonal elements of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               E( K ) = A( K-1, K )
+               E( K-1 ) = CZERO
+               A( K-1, K ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   34    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**H using the lower triangle of A
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = CZERO
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        1 or 2
+*
+         K = 1
+   40    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 64
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( DBLE( A( K, K ) ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + IZAMAX( N-K, A( K+1, K ), 1 )
+            COLMAX = CABS1( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            A( K, K ) = DBLE( A( K, K ) )
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           BEGIN pivot search
+*
+*           Case(1)
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   42          CONTINUE
+*
+*                 BEGIN pivot search loop body
+*
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA )
+                     ROWMAX = CABS1( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ),
+     $                                     1 )
+                     DTEMP = CABS1( A( ITEMP, IMAX ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Case(2)
+*                 Equivalent to testing for
+*                 ABS( REAL( W( IMAX,KW-1 ) ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( ABS( DBLE( A( IMAX, IMAX ) ) )
+     $                       .LT.ALPHA*ROWMAX ) ) THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Case(3)
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+*
+*                 Case(4)
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*
+*                 END pivot search loop body
+*
+               IF( .NOT.DONE ) GOTO 42
+*
+            END IF
+*
+*           END pivot search
+*
+*           ============================================================
+*
+*           KK is the column of A where pivoting step stopped
+*
+            KK = K + KSTEP - 1
+*
+*           For only a 2x2 pivot, interchange rows and columns K and P
+*           in the trailing submatrix A(k:n,k:n)
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*              (1) Swap columnar parts
+               IF( P.LT.N )
+     $            CALL ZSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 )
+*              (2) Swap and conjugate middle parts
+               DO 44 J = K + 1, P - 1
+                  T = DCONJG( A( J, K ) )
+                  A( J, K ) = DCONJG( A( P, J ) )
+                  A( P, J ) = T
+   44          CONTINUE
+*              (3) Swap and conjugate corner elements at row-col interserction
+               A( P, K ) = DCONJG( A( P, K ) )
+*              (4) Swap diagonal elements at row-col intersection
+               R1 = DBLE( A( K, K ) )
+               A( K, K ) = DBLE( A( P, P ) )
+               A( P, P ) = R1
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL ZSWAP( K-1, A( K, 1 ), LDA, A( P, 1 ), LDA )
+*
+            END IF
+*
+*           For both 1x1 and 2x2 pivots, interchange rows and
+*           columns KK and KP in the trailing submatrix A(k:n,k:n)
+*
+            IF( KP.NE.KK ) THEN
+*              (1) Swap columnar parts
+               IF( KP.LT.N )
+     $            CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+*              (2) Swap and conjugate middle parts
+               DO 45 J = KK + 1, KP - 1
+                  T = DCONJG( A( J, KK ) )
+                  A( J, KK ) = DCONJG( A( KP, J ) )
+                  A( KP, J ) = T
+   45          CONTINUE
+*              (3) Swap and conjugate corner elements at row-col interserction
+               A( KP, KK ) = DCONJG( A( KP, KK ) )
+*              (4) Swap diagonal elements at row-col intersection
+               R1 = DBLE( A( KK, KK ) )
+               A( KK, KK ) = DBLE( A( KP, KP ) )
+               A( KP, KP ) = R1
+*
+               IF( KSTEP.EQ.2 ) THEN
+*                 (*) Make sure that diagonal element of pivot is real
+                  A( K, K ) = DBLE( A( K, K ) )
+*                 (5) Swap row elements
+                  T = A( K+1, K )
+                  A( K+1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL ZSWAP( K-1, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+*
+            ELSE
+*              (*) Make sure that diagonal element of pivot is real
+               A( K, K ) = DBLE( A( K, K ) )
+               IF( KSTEP.EQ.2 )
+     $            A( K+1, K+1 ) = DBLE( A( K+1, K+1 ) )
+            END IF
+*
+*           Update the trailing submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k of A now holds
+*
+*              W(k) = L(k)*D(k),
+*
+*              where L(k) is the k-th column of L
+*
+               IF( K.LT.N ) THEN
+*
+*                 Perform a rank-1 update of A(k+1:n,k+1:n) and
+*                 store L(k) in column k
+*
+*                 Handle division by a small number
+*
+                  IF( ABS( DBLE( A( K, K ) ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*
+                     D11 = ONE / DBLE( A( K, K ) )
+                     CALL ZHER( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+*
+*                    Store L(k) in column k
+*
+                     CALL ZDSCAL( N-K, D11, A( K+1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column k
+*
+                     D11 = DBLE( A( K, K ) )
+                     DO 46 II = K + 1, N
+                        A( II, K ) = A( II, K ) / D11
+   46                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL ZHER( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+                  END IF
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+*
+*              Perform a rank-2 update of A(k+2:n,k+2:n) as
+*
+*              A := A - ( L(k) L(k+1) ) * D(k) * ( L(k) L(k+1) )**T
+*                 = A - ( ( A(k)A(k+1) )*inv(D(k) ) * ( A(k)A(k+1) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.LT.N-1 ) THEN
+*                 D = |A21|
+                  D = DLAPY2( DBLE( A( K+1, K ) ),
+     $                DIMAG( A( K+1, K ) ) )
+                  D11 = DBLE( A( K+1, K+1 ) ) / D
+                  D22 = DBLE( A( K, K ) ) / D
+                  D21 = A( K+1, K ) / D
+                  TT = ONE / ( D11*D22-ONE )
+*
+                  DO 60 J = K + 2, N
+*
+*                    Compute  D21 * ( W(k)W(k+1) ) * inv(D(k)) for row J
+*
+                     WK = TT*( D11*A( J, K )-D21*A( J, K+1 ) )
+                     WKP1 = TT*( D22*A( J, K+1 )-DCONJG( D21 )*
+     $                      A( J, K ) )
+*
+*                    Perform a rank-2 update of A(k+2:n,k+2:n)
+*
+                     DO 50 I = J, N
+                        A( I, J ) = A( I, J ) -
+     $                              ( A( I, K ) / D )*DCONJG( WK ) -
+     $                              ( A( I, K+1 ) / D )*DCONJG( WKP1 )
+   50                CONTINUE
+*
+*                    Store L(k) and L(k+1) in cols k and k+1 for row J
+*
+                     A( J, K ) = WK / D
+                     A( J, K+1 ) = WKP1 / D
+*                    (*) Make sure that diagonal element of pivot is real
+                     A( J, J ) = DCMPLX( DBLE( A( J, J ) ), ZERO )
+*
+   60             CONTINUE
+*
+               END IF
+*
+*              Copy subdiagonal elements of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               E( K ) = A( K+1, K )
+               E( K+1 ) = CZERO
+               A( K+1, K ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 40
+*
+   64    CONTINUE
+*
+      END IF
+*
+      RETURN
+*
+*     End of ZHETF2_RK
+*
+      END
diff --git a/SRC/zhetrd_2stage.f b/SRC/zhetrd_2stage.f
new file mode 100644
index 00000000..62fd7539
--- /dev/null
+++ b/SRC/zhetrd_2stage.f
@@ -0,0 +1,337 @@
+*> \brief \b ZHETRD_2STAGE
+*
+*  @precisions fortran z -> s d c
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download ZHETRD_2STAGE + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrd_2stage.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrd_2stage.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrd_2stage.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, 
+*                                 HOUS2, LHOUS2, WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*      .. Scalar Arguments ..
+*       CHARACTER          VECT, UPLO
+*       INTEGER            N, LDA, LWORK, LHOUS2, INFO
+*      ..
+*      .. Array Arguments ..
+*       DOUBLE PRECISION   D( * ), E( * )
+*       COMPLEX*16         A( LDA, * ), TAU( * ),
+*                          HOUS2( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHETRD_2STAGE reduces a complex Hermitian matrix A to real symmetric
+*> tridiagonal form T by a unitary similarity transformation:
+*> Q1**H Q2**H* A * Q2 * Q1 = T.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] VECT
+*> \verbatim
+*>          VECT is CHARACTER*1
+*>          = 'N':  No need for the Housholder representation, 
+*>                  in particular for the second stage (Band to
+*>                  tridiagonal) and thus LHOUS2 is of size max(1, 4*N);
+*>          = 'V':  the Householder representation is needed to 
+*>                  either generate Q1 Q2 or to apply Q1 Q2, 
+*>                  then LHOUS2 is to be queried and computed.
+*>                  (NOT AVAILABLE IN THIS RELEASE).
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>          On exit, if UPLO = 'U', the band superdiagonal
+*>          of A are overwritten by the corresponding elements of the
+*>          internal band-diagonal matrix AB, and the elements above 
+*>          the KD superdiagonal, with the array TAU, represent the unitary
+*>          matrix Q1 as a product of elementary reflectors; if UPLO
+*>          = 'L', the diagonal and band subdiagonal of A are over-
+*>          written by the corresponding elements of the internal band-diagonal
+*>          matrix AB, and the elements below the KD subdiagonal, with
+*>          the array TAU, represent the unitary matrix Q1 as a product
+*>          of elementary reflectors. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] D
+*> \verbatim
+*>          D is DOUBLE PRECISION array, dimension (N)
+*>          The diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N-1)
+*>          The off-diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is COMPLEX*16 array, dimension (N-KD)
+*>          The scalar factors of the elementary reflectors of 
+*>          the first stage (see Further Details).
+*> \endverbatim
+*>
+*> \param[out] HOUS2
+*> \verbatim
+*>          HOUS2 is COMPLEX*16 array, dimension LHOUS2, that
+*>          store the Householder representation of the stage2
+*>          band to tridiagonal.
+*> \endverbatim
+*>
+*> \param[in] LHOUS2
+*> \verbatim
+*>          LHOUS2 is INTEGER
+*>          The dimension of the array HOUS2. LHOUS2 = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS2=-1,
+*>          then a query is assumed; the routine
+*>          only calculates the optimal size of the HOUS2 array, returns
+*>          this value as the first entry of the HOUS2 array, and no error
+*>          message related to LHOUS2 is issued by XERBLA.
+*>          LHOUS2 = MAX(1, dimension) where
+*>          dimension = 4*N if VECT='N'
+*>          not available now if VECT='H'
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK. LWORK = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS2=-1,
+*>          then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK = MAX(1, dimension) where
+*>          dimension   = max(stage1,stage2) + (KD+1)*N
+*>                      = N*KD + N*max(KD+1,FACTOPTNB) 
+*>                        + max(2*KD*KD, KD*NTHREADS) 
+*>                        + (KD+1)*N 
+*>          where KD is the blocking size of the reduction,
+*>          FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice
+*>          NTHREADS is the number of threads used when
+*>          openMP compilation is enabled, otherwise =1.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, 
+     $                          HOUS2, LHOUS2, WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          VECT, UPLO
+      INTEGER            N, LDA, LWORK, LHOUS2, INFO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   D( * ), E( * )
+      COMPLEX*16         A( LDA, * ), TAU( * ),
+     $                   HOUS2( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER, WANTQ
+      INTEGER            KD, IB, LWMIN, LHMIN, LWRK, LDAB, WPOS, ABPOS
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, ZHETRD_HE2HB, ZHETRD_HB2ST
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters
+*
+      INFO   = 0
+      WANTQ  = LSAME( VECT, 'V' )
+      UPPER  = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 ) .OR. ( LHOUS2.EQ.-1 )
+*
+*     Determine the block size, the workspace size and the hous size.
+*
+      KD     = ILAENV( 17, 'ZHETRD_2STAGE', VECT, N, -1, -1, -1 )
+      IB     = ILAENV( 18, 'ZHETRD_2STAGE', VECT, N, KD, -1, -1 )
+      LHMIN  = ILAENV( 19, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 )
+      LWMIN  = ILAENV( 20, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 )
+*      WRITE(*,*),'ZHETRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
+*     $            LHMIN, LWMIN
+*
+      IF( .NOT.LSAME( VECT, 'N' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LHOUS2.LT.LHMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -10
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -12
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         HOUS2( 1 ) = LHMIN
+         WORK( 1 )  = LWMIN
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHETRD_2STAGE', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+*     Determine pointer position
+*
+      LDAB  = KD+1
+      LWRK  = LWORK-LDAB*N
+      ABPOS = 1
+      WPOS  = ABPOS + LDAB*N
+      CALL ZHETRD_HE2HB( UPLO, N, KD, A, LDA, WORK( ABPOS ), LDAB, 
+     $                   TAU, WORK( WPOS ), LWRK, INFO )
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHETRD_HE2HB', -INFO )
+         RETURN
+      END IF
+      CALL ZHETRD_HB2ST( 'Y', VECT, UPLO, N, KD, 
+     $                   WORK( ABPOS ), LDAB, D, E, 
+     $                   HOUS2, LHOUS2, WORK( WPOS ), LWRK, INFO )
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHETRD_HB2ST', -INFO )
+         RETURN
+      END IF
+*
+*
+      HOUS2( 1 ) = LHMIN
+      WORK( 1 )  = LWMIN
+      RETURN
+*
+*     End of ZHETRD_2STAGE
+*
+      END
diff --git a/SRC/zhetrd_hb2st.F b/SRC/zhetrd_hb2st.F
new file mode 100644
index 00000000..71419481
--- /dev/null
+++ b/SRC/zhetrd_hb2st.F
@@ -0,0 +1,580 @@
+*> \brief \b ZHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric tridiagonal form T
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETRD_HB2ST + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhbtrd_hb2st.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhbtrd_hb2st.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhbtrd_hb2st.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 
+*                               D, E, HOUS, LHOUS, WORK, LWORK, INFO )
+*
+*       #if defined(_OPENMP)
+*       use omp_lib
+*       #endif
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          STAGE1, UPLO, VECT
+*       INTEGER            N, KD, IB, LDAB, LHOUS, LWORK, INFO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   D( * ), E( * )
+*       COMPLEX*16         AB( LDAB, * ), HOUS( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric
+*> tridiagonal form T by a unitary similarity transformation:
+*> Q**H * A * Q = T.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] STAGE
+*> \verbatim
+*>          STAGE is CHARACTER*1
+*>          = 'N':  "No": to mention that the stage 1 of the reduction  
+*>                  from dense to band using the zhetrd_he2hb routine
+*>                  was not called before this routine to reproduce AB. 
+*>                  In other term this routine is called as standalone. 
+*>          = 'Y':  "Yes": to mention that the stage 1 of the 
+*>                  reduction from dense to band using the zhetrd_he2hb 
+*>                  routine has been called to produce AB (e.g., AB is
+*>                  the output of zhetrd_he2hb.
+*> \endverbatim
+*>
+*> \param[in] VECT
+*> \verbatim
+*>          VECT is CHARACTER*1
+*>          = 'N':  No need for the Housholder representation, 
+*>                  and thus LHOUS is of size max(1, 4*N);
+*>          = 'V':  the Householder representation is needed to 
+*>                  either generate or to apply Q later on, 
+*>                  then LHOUS is to be queried and computed.
+*>                  (NOT AVAILABLE IN THIS RELEASE).
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the matrix A if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is COMPLEX*16 array, dimension (LDAB,N)
+*>          On entry, the upper or lower triangle of the Hermitian band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*>          On exit, the diagonal elements of AB are overwritten by the
+*>          diagonal elements of the tridiagonal matrix T; if KD > 0, the
+*>          elements on the first superdiagonal (if UPLO = 'U') or the
+*>          first subdiagonal (if UPLO = 'L') are overwritten by the
+*>          off-diagonal elements of T; the rest of AB is overwritten by
+*>          values generated during the reduction.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD+1.
+*> \endverbatim
+*>
+*> \param[out] D
+*> \verbatim
+*>          D is DOUBLE PRECISION array, dimension (N)
+*>          The diagonal elements of the tridiagonal matrix T.
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N-1)
+*>          The off-diagonal elements of the tridiagonal matrix T:
+*>          E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
+*> \endverbatim
+*>
+*> \param[out] HOUS
+*> \verbatim
+*>          HOUS is COMPLEX*16 array, dimension LHOUS, that
+*>          store the Householder representation.
+*> \endverbatim
+*>
+*> \param[in] LHOUS
+*> \verbatim
+*>          LHOUS is INTEGER
+*>          The dimension of the array HOUS. LHOUS = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS=-1,
+*>          then a query is assumed; the routine
+*>          only calculates the optimal size of the HOUS array, returns
+*>          this value as the first entry of the HOUS array, and no error
+*>          message related to LHOUS is issued by XERBLA.
+*>          LHOUS = MAX(1, dimension) where
+*>          dimension = 4*N if VECT='N'
+*>          not available now if VECT='H'     
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK. LWORK = MAX(1, dimension)
+*>          If LWORK = -1, or LHOUS=-1,
+*>          then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK = MAX(1, dimension) where
+*>          dimension   = (2KD+1)*N + KD*NTHREADS
+*>          where KD is the blocking size of the reduction,
+*>          FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice
+*>          NTHREADS is the number of threads used when
+*>          openMP compilation is enabled, otherwise =1.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16OTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 
+     $                         D, E, HOUS, LHOUS, WORK, LWORK, INFO )
+*
+*
+#if defined(_OPENMP)
+      use omp_lib
+#endif
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          STAGE1, UPLO, VECT
+      INTEGER            N, KD, LDAB, LHOUS, LWORK, INFO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   D( * ), E( * )
+      COMPLEX*16         AB( LDAB, * ), HOUS( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   RZERO
+      COMPLEX*16         ZERO, ONE
+      PARAMETER          ( RZERO = 0.0D+0,
+     $                   ZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   ONE  = ( 1.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, WANTQ, UPPER, AFTERS1
+      INTEGER            I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST, 
+     $                   ED, STIND, EDIND, BLKLASTIND, COLPT, THED,
+     $                   STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID,
+     $                   NBTILES, TTYPE, TID, NTHREADS, DEBUG,
+     $                   ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS, 
+     $                   INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU,
+     $                   SIZEV, SIZETAU, LDV, LHMIN, LWMIN
+      DOUBLE PRECISION   ABSTMP
+      COMPLEX*16         TMP
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZHB2ST_KERNELS, ZLACPY, ZLASET
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN, MAX, CEILING, DBLE, REAL
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV 
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Determine the minimal workspace size required.
+*     Test the input parameters
+*
+      DEBUG   = 0
+      INFO    = 0
+      AFTERS1 = LSAME( STAGE1, 'Y' )
+      WANTQ   = LSAME( VECT, 'V' )
+      UPPER   = LSAME( UPLO, 'U' )
+      LQUERY  = ( LWORK.EQ.-1 ) .OR. ( LHOUS.EQ.-1 )
+*
+*     Determine the block size, the workspace size and the hous size.
+*
+      IB     = ILAENV( 18, 'ZHETRD_HB2ST', VECT, N, KD, -1, -1 )
+      LHMIN  = ILAENV( 19, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 )
+      LWMIN  = ILAENV( 20, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 )
+*
+      IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.LSAME( VECT, 'N' ) ) THEN
+         INFO = -2
+      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.(KD+1) ) THEN
+         INFO = -7
+      ELSE IF( LHOUS.LT.LHMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -11
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -13
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         HOUS( 1 ) = LHMIN
+         WORK( 1 ) = LWMIN
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHETRD_HB2ST', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+*     Determine pointer position
+*
+      LDV      = KD + IB
+      SIZETAU  = 2 * N
+      SIZEV    = 2 * N
+      INDTAU   = 1
+      INDV     = INDTAU + SIZETAU
+      LDA      = 2 * KD + 1
+      SIZEA    = LDA * N
+      INDA     = 1
+      INDW     = INDA + SIZEA
+      NTHREADS = 1
+      TID      = 0
+*
+      IF( UPPER ) THEN
+          APOS     = INDA + KD
+          AWPOS    = INDA
+          DPOS     = APOS + KD
+          OFDPOS   = DPOS - 1
+          ABDPOS   = KD + 1
+          ABOFDPOS = KD
+      ELSE
+          APOS     = INDA 
+          AWPOS    = INDA + KD + 1
+          DPOS     = APOS
+          OFDPOS   = DPOS + 1
+          ABDPOS   = 1
+          ABOFDPOS = 2
+
+      ENDIF
+*      
+*     Case KD=0: 
+*     The matrix is diagonal. We just copy it (convert to "real" for 
+*     complex because D is double and the imaginary part should be 0) 
+*     and store it in D. A sequential code here is better or 
+*     in a parallel environment it might need two cores for D and E
+*
+      IF( KD.EQ.0 ) THEN
+          DO 30 I = 1, N
+              D( I ) = DBLE( AB( ABDPOS, I ) )
+   30     CONTINUE
+          DO 40 I = 1, N-1
+              E( I ) = RZERO
+   40     CONTINUE
+         RETURN
+      END IF
+*      
+*     Case KD=1: 
+*     The matrix is already Tridiagonal. We have to make diagonal 
+*     and offdiagonal elements real, and store them in D and E.
+*     For that, for real precision just copy the diag and offdiag 
+*     to D and E while for the COMPLEX case the bulge chasing is  
+*     performed to convert the hermetian tridiagonal to symmetric 
+*     tridiagonal. A simpler coversion formula might be used, but then 
+*     updating the Q matrix will be required and based if Q is generated
+*     or not this might complicate the story. 
+*      
+      IF( KD.EQ.1 ) THEN
+          DO 50 I = 1, N
+              D( I ) = DBLE( AB( ABDPOS, I ) )
+   50     CONTINUE
+*
+*         make off-diagonal elements real and copy them to E
+*
+          IF( UPPER ) THEN
+              DO 60 I = 1, N - 1
+                  TMP = AB( ABOFDPOS, I+1 )
+                  ABSTMP = ABS( TMP )
+                  AB( ABOFDPOS, I+1 ) = ABSTMP
+                  E( I ) = ABSTMP
+                  IF( ABSTMP.NE.RZERO ) THEN
+                     TMP = TMP / ABSTMP
+                  ELSE
+                     TMP = ONE
+                  END IF
+                  IF( I.LT.N-1 )
+     $               AB( ABOFDPOS, I+2 ) = AB( ABOFDPOS, I+2 )*TMP
+C                  IF( WANTZ ) THEN
+C                     CALL ZSCAL( N, DCONJG( TMP ), Q( 1, I+1 ), 1 )
+C                  END IF
+   60         CONTINUE
+          ELSE
+              DO 70 I = 1, N - 1
+                 TMP = AB( ABOFDPOS, I )
+                 ABSTMP = ABS( TMP )
+                 AB( ABOFDPOS, I ) = ABSTMP
+                 E( I ) = ABSTMP
+                 IF( ABSTMP.NE.RZERO ) THEN
+                    TMP = TMP / ABSTMP
+                 ELSE
+                    TMP = ONE
+                 END IF
+                 IF( I.LT.N-1 )
+     $              AB( ABOFDPOS, I+1 ) = AB( ABOFDPOS, I+1 )*TMP
+C                 IF( WANTQ ) THEN
+C                    CALL ZSCAL( N, TMP, Q( 1, I+1 ), 1 )
+C                 END IF
+   70         CONTINUE
+          ENDIF
+          RETURN
+      END IF
+*
+*     Main code start here. 
+*     Reduce the hermitian band of A to a tridiagonal matrix.
+*
+      THGRSIZ   = N
+      GRSIZ     = 1
+      SHIFT     = 3
+      NBTILES   = CEILING( REAL(N)/REAL(KD) )
+      STEPERCOL = CEILING( REAL(SHIFT)/REAL(GRSIZ) )
+      THGRNB    = CEILING( REAL(N-1)/REAL(THGRSIZ) )
+*      
+      CALL ZLACPY( "A", KD+1, N, AB, LDAB, WORK( APOS ), LDA )
+      CALL ZLASET( "A", KD,   N, ZERO, ZERO, WORK( AWPOS ), LDA )
+*
+*
+*     openMP parallelisation start here
+*
+#if defined(_OPENMP)
+!$OMP PARALLEL PRIVATE( TID, THGRID, BLKLASTIND )
+!$OMP$         PRIVATE( THED, I, M, K, ST, ED, STT, SWEEPID ) 
+!$OMP$         PRIVATE( MYID, TTYPE, COLPT, STIND, EDIND )
+!$OMP$         SHARED ( UPLO, WANTQ, INDV, INDTAU, HOUS, WORK)
+!$OMP$         SHARED ( N, KD, IB, NBTILES, LDA, LDV, INDA )
+!$OMP$         SHARED ( STEPERCOL, THGRNB, THGRSIZ, GRSIZ, SHIFT )
+!$OMP MASTER
+#endif
+*
+*     main bulge chasing loop
+*      
+      DO 100 THGRID = 1, THGRNB
+          STT  = (THGRID-1)*THGRSIZ+1
+          THED = MIN( (STT + THGRSIZ -1), (N-1))
+          DO 110 I = STT, N-1
+              ED = MIN( I, THED )
+              IF( STT.GT.ED ) GOTO 100
+              DO 120 M = 1, STEPERCOL
+                  ST = STT
+                  DO 130 SWEEPID = ST, ED
+                      DO 140 K = 1, GRSIZ
+                          MYID  = (I-SWEEPID)*(STEPERCOL*GRSIZ) 
+     $                           + (M-1)*GRSIZ + K
+                          IF ( MYID.EQ.1 ) THEN
+                              TTYPE = 1
+                          ELSE
+                              TTYPE = MOD( MYID, 2 ) + 2
+                          ENDIF
+
+                          IF( TTYPE.EQ.2 ) THEN
+                              COLPT      = (MYID/2)*KD + SWEEPID
+                              STIND      = COLPT-KD+1
+                              EDIND      = MIN(COLPT,N)
+                              BLKLASTIND = COLPT
+                          ELSE
+                              COLPT      = ((MYID+1)/2)*KD + SWEEPID
+                              STIND      = COLPT-KD+1
+                              EDIND      = MIN(COLPT,N)
+                              IF( ( STIND.GE.EDIND-1 ).AND.
+     $                            ( EDIND.EQ.N ) ) THEN
+                                  BLKLASTIND = N
+                              ELSE
+                                  BLKLASTIND = 0
+                              ENDIF
+                          ENDIF
+*
+*                         Call the kernel
+*                             
+#if defined(_OPENMP)
+                          IF( TTYPE.NE.1 ) THEN      
+!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
+!$OMP$     DEPEND(in:WORK(MYID-1))
+!$OMP$     DEPEND(out:WORK(MYID))
+                              TID      = OMP_GET_THREAD_NUM()
+                              CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                             STIND, EDIND, SWEEPID, N, KD, IB,
+     $                             WORK ( INDA ), LDA, 
+     $                             HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                             WORK( INDW + TID*KD ) )
+!$OMP END TASK
+                          ELSE
+!$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1))
+!$OMP$     DEPEND(out:WORK(MYID))
+                              TID      = OMP_GET_THREAD_NUM()
+                              CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                             STIND, EDIND, SWEEPID, N, KD, IB,
+     $                             WORK ( INDA ), LDA, 
+     $                             HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                             WORK( INDW + TID*KD ) )
+!$OMP END TASK
+                          ENDIF
+#else
+                          CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE, 
+     $                         STIND, EDIND, SWEEPID, N, KD, IB,
+     $                         WORK ( INDA ), LDA, 
+     $                         HOUS( INDV ), HOUS( INDTAU ), LDV,
+     $                         WORK( INDW + TID*KD ) )
+#endif 
+                          IF ( BLKLASTIND.GE.(N-1) ) THEN
+                              STT = STT + 1
+                              GOTO 130
+                          ENDIF
+  140                 CONTINUE
+  130             CONTINUE
+  120         CONTINUE
+  110     CONTINUE
+  100 CONTINUE
+*
+#if defined(_OPENMP)
+!$OMP END MASTER
+!$OMP END PARALLEL
+#endif
+*      
+*     Copy the diagonal from A to D. Note that D is REAL thus only
+*     the Real part is needed, the imaginary part should be zero.
+*
+      DO 150 I = 1, N
+          D( I ) = DBLE( WORK( DPOS+(I-1)*LDA ) )
+  150 CONTINUE
+*      
+*     Copy the off diagonal from A to E. Note that E is REAL thus only
+*     the Real part is needed, the imaginary part should be zero.
+*
+      IF( UPPER ) THEN
+          DO 160 I = 1, N-1
+             E( I ) = DBLE( WORK( OFDPOS+I*LDA ) )
+  160     CONTINUE
+      ELSE
+          DO 170 I = 1, N-1
+             E( I ) = DBLE( WORK( OFDPOS+(I-1)*LDA ) )
+  170     CONTINUE
+      ENDIF
+*
+      HOUS( 1 ) = LHMIN
+      WORK( 1 ) = LWMIN
+      RETURN
+*
+*     End of ZHETRD_HB2ST
+*
+      END
+      
diff --git a/SRC/zhetrd_he2hb.f b/SRC/zhetrd_he2hb.f
new file mode 100644
index 00000000..9403b73e
--- /dev/null
+++ b/SRC/zhetrd_he2hb.f
@@ -0,0 +1,517 @@
+*> \brief \b ZHETRD_HE2HB
+*
+*  @precisions fortran z -> s d c
+*      
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download ZHETRD_HE2HB + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrd.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrd.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrd.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, 
+*                              WORK, LWORK, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDAB, LWORK, N, KD
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16         A( LDA, * ), AB( LDAB, * ), 
+*                          TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHETRD_HE2HB reduces a complex Hermitian matrix A to complex Hermitian
+*> band-diagonal form AB by a unitary similarity transformation:
+*> Q**H * A * Q = AB.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KD
+*> \verbatim
+*>          KD is INTEGER
+*>          The number of superdiagonals of the reduced matrix if UPLO = 'U',
+*>          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
+*>          The reduced matrix is stored in the array AB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>          On exit, if UPLO = 'U', the diagonal and first superdiagonal
+*>          of A are overwritten by the corresponding elements of the
+*>          tridiagonal matrix T, and the elements above the first
+*>          superdiagonal, with the array TAU, represent the unitary
+*>          matrix Q as a product of elementary reflectors; if UPLO
+*>          = 'L', the diagonal and first subdiagonal of A are over-
+*>          written by the corresponding elements of the tridiagonal
+*>          matrix T, and the elements below the first subdiagonal, with
+*>          the array TAU, represent the unitary matrix Q as a product
+*>          of elementary reflectors. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] AB
+*> \verbatim
+*>          AB is COMPLEX*16 array, dimension (LDAB,N)
+*>          On exit, the upper or lower triangle of the Hermitian band
+*>          matrix A, stored in the first KD+1 rows of the array.  The
+*>          j-th column of A is stored in the j-th column of the array AB
+*>          as follows:
+*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
+*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= KD+1.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is COMPLEX*16 array, dimension (N-KD)
+*>          The scalar factors of the elementary reflectors (see Further
+*>          Details).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension LWORK.
+*>          On exit, if INFO = 0, or if LWORK=-1, 
+*>          WORK(1) returns the size of LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK which should be calculated
+*           by a workspace query. LWORK = MAX(1, LWORK_QUERY)
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*>          LWORK_QUERY = N*KD + N*max(KD,FACTOPTNB) + 2*KD*KD
+*>          where FACTOPTNB is the blocking used by the QR or LQ
+*>          algorithm, usually FACTOPTNB=128 is a good choice otherwise
+*>          putting LWORK=-1 will provide the size of WORK.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Implemented by Azzam Haidar.
+*>
+*>  All details are available on technical report, SC11, SC13 papers.
+*>
+*>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
+*>  Parallel reduction to condensed forms for symmetric eigenvalue problems
+*>  using aggregated fine-grained and memory-aware kernels. In Proceedings
+*>  of 2011 International Conference for High Performance Computing,
+*>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
+*>  Article 8 , 11 pages.
+*>  http://doi.acm.org/10.1145/2063384.2063394
+*>
+*>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
+*>  An improved parallel singular value algorithm and its implementation 
+*>  for multicore hardware, In Proceedings of 2013 International Conference
+*>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
+*>  Denver, Colorado, USA, 2013.
+*>  Article 90, 12 pages.
+*>  http://doi.acm.org/10.1145/2503210.2503292
+*>
+*>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
+*>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
+*>  calculations based on fine-grained memory aware tasks.
+*>  International Journal of High Performance Computing Applications.
+*>  Volume 28 Issue 2, Pages 196-209, May 2014.
+*>  http://hpc.sagepub.com/content/28/2/196 
+*>
+*> \endverbatim
+*>
+*> \verbatim
+*>
+*>  If UPLO = 'U', the matrix Q is represented as a product of elementary
+*>  reflectors
+*>
+*>     Q = H(k)**H . . . H(2)**H H(1)**H, where k = n-kd.
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**H
+*>
+*>  where tau is a complex scalar, and v is a complex vector with
+*>  v(1:i+kd-1) = 0 and v(i+kd) = 1; conjg(v(i+kd+1:n)) is stored on exit in
+*>  A(i,i+kd+1:n), and tau in TAU(i).
+*>
+*>  If UPLO = 'L', the matrix Q is represented as a product of elementary
+*>  reflectors
+*>
+*>     Q = H(1) H(2) . . . H(k), where k = n-kd.
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**H
+*>
+*>  where tau is a complex scalar, and v is a complex vector with
+*>  v(kd+1:i) = 0 and v(i+kd+1) = 1; v(i+kd+2:n) is stored on exit in
+*   A(i+kd+2:n,i), and tau in TAU(i).
+*>
+*>  The contents of A on exit are illustrated by the following examples
+*>  with n = 5:
+*>
+*>  if UPLO = 'U':                       if UPLO = 'L':
+*>
+*>    (  ab  ab/v1  v1      v1     v1    )              (  ab                            )
+*>    (      ab     ab/v2   v2     v2    )              (  ab/v1  ab                     )
+*>    (             ab      ab/v3  v3    )              (  v1     ab/v2  ab              )
+*>    (                     ab     ab/v4 )              (  v1     v2     ab/v3  ab       )
+*>    (                            ab    )              (  v1     v2     v3     ab/v4 ab )
+*>
+*>  where d and e denote diagonal and off-diagonal elements of T, and vi
+*>  denotes an element of the vector defining H(i).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, 
+     $                         WORK, LWORK, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDAB, LWORK, N, KD
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16         A( LDA, * ), AB( LDAB, * ), 
+     $                   TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   RONE
+      COMPLEX*16         ZERO, ONE, HALF
+      PARAMETER          ( RONE = 1.0D+0,
+     $                   ZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   ONE = ( 1.0D+0, 0.0D+0 ),
+     $                   HALF = ( 0.5D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, J, IINFO, LWMIN, PN, PK, LK,
+     $                   LDT, LDW, LDS2, LDS1, 
+     $                   LS2, LS1, LW, LT,
+     $                   TPOS, WPOS, S2POS, S1POS
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, ZHER2K, ZHEMM, ZGEMM,
+     $                   ZLARFT, ZGELQF, ZGEQRF, ZLASET
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN, MAX
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV 
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Determine the minimal workspace size required 
+*     and test the input parameters
+*
+      INFO   = 0
+      UPPER  = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      LWMIN  = ILAENV( 20, 'ZHETRD_HE2HB', '', N, KD, -1, -1 )
+      
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( KD.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDAB.LT.MAX( 1, KD+1 ) ) THEN
+         INFO = -7
+      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+         INFO = -10
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHETRD_HE2HB', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         WORK( 1 ) = LWMIN
+         RETURN
+      END IF
+*
+*     Quick return if possible        
+*     Copy the upper/lower portion of A into AB 
+*
+      IF( N.LE.KD+1 ) THEN
+          IF( UPPER ) THEN
+              DO 100 I = 1, N
+                  LK = MIN( KD+1, I )
+                  CALL ZCOPY( LK, A( I-LK+1, I ), 1, 
+     $                            AB( KD+1-LK+1, I ), 1 )
+  100         CONTINUE
+          ELSE
+              DO 110 I = 1, N
+                  LK = MIN( KD+1, N-I+1 )
+                  CALL ZCOPY( LK, A( I, I ), 1, AB( 1, I ), 1 )
+  110         CONTINUE
+          ENDIF
+          WORK( 1 ) = 1
+          RETURN
+      END IF
+*
+*     Determine the pointer position for the workspace
+*      
+      LDT    = KD
+      LDS1   = KD
+      LT     = LDT*KD
+      LW     = N*KD
+      LS1    = LDS1*KD
+      LS2    = LWMIN - LT - LW - LS1
+*      LS2 = N*MAX(KD,FACTOPTNB) 
+      TPOS   = 1
+      WPOS   = TPOS  + LT
+      S1POS  = WPOS  + LW
+      S2POS  = S1POS + LS1 
+      IF( UPPER ) THEN
+          LDW    = KD
+          LDS2   = KD
+      ELSE
+          LDW    = N
+          LDS2   = N
+      ENDIF
+*
+*
+*     Set the workspace of the triangular matrix T to zero once such a
+*     way everytime T is generated the upper/lower portion will be always zero  
+*   
+      CALL ZLASET( "A", LDT, KD, ZERO, ZERO, WORK( TPOS ), LDT )
+*
+      IF( UPPER ) THEN
+          DO 10 I = 1, N - KD, KD
+             PN = N-I-KD+1
+             PK = MIN( N-I-KD+1, KD )
+*        
+*            Compute the LQ factorization of the current block
+*        
+             CALL ZGELQF( KD, PN, A( I, I+KD ), LDA,
+     $                    TAU( I ), WORK( S2POS ), LS2, IINFO )
+*        
+*            Copy the upper portion of A into AB
+*        
+             DO 20 J = I, I+PK-1
+                LK = MIN( KD, N-J ) + 1
+                CALL ZCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 )
+   20        CONTINUE
+*                
+             CALL ZLASET( 'Lower', PK, PK, ZERO, ONE, 
+     $                    A( I, I+KD ), LDA )
+*        
+*            Form the matrix T
+*        
+             CALL ZLARFT( 'Forward', 'Rowwise', PN, PK,
+     $                    A( I, I+KD ), LDA, TAU( I ), 
+     $                    WORK( TPOS ), LDT )
+*        
+*            Compute W:
+*             
+             CALL ZGEMM( 'Conjugate', 'No transpose', PK, PN, PK,
+     $                   ONE,  WORK( TPOS ), LDT,
+     $                         A( I, I+KD ), LDA,
+     $                   ZERO, WORK( S2POS ), LDS2 )
+*        
+             CALL ZHEMM( 'Right', UPLO, PK, PN,
+     $                   ONE,  A( I+KD, I+KD ), LDA,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( WPOS ), LDW )
+*        
+             CALL ZGEMM( 'No transpose', 'Conjugate', PK, PK, PN,
+     $                   ONE,  WORK( WPOS ), LDW,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( S1POS ), LDS1 )
+*        
+             CALL ZGEMM( 'No transpose', 'No transpose', PK, PN, PK,
+     $                   -HALF, WORK( S1POS ), LDS1, 
+     $                          A( I, I+KD ), LDA,
+     $                   ONE,   WORK( WPOS ), LDW )
+*             
+*        
+*            Update the unreduced submatrix A(i+kd:n,i+kd:n), using
+*            an update of the form:  A := A - V'*W - W'*V
+*        
+             CALL ZHER2K( UPLO, 'Conjugate', PN, PK,
+     $                    -ONE, A( I, I+KD ), LDA,
+     $                          WORK( WPOS ), LDW,
+     $                    RONE, A( I+KD, I+KD ), LDA )
+   10     CONTINUE
+*
+*        Copy the upper band to AB which is the band storage matrix
+*
+         DO 30 J = N-KD+1, N
+            LK = MIN(KD, N-J) + 1
+            CALL ZCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 )
+   30    CONTINUE
+*
+      ELSE
+*
+*         Reduce the lower triangle of A to lower band matrix
+*        
+          DO 40 I = 1, N - KD, KD
+             PN = N-I-KD+1
+             PK = MIN( N-I-KD+1, KD )
+*        
+*            Compute the QR factorization of the current block
+*        
+             CALL ZGEQRF( PN, KD, A( I+KD, I ), LDA,
+     $                    TAU( I ), WORK( S2POS ), LS2, IINFO )
+*        
+*            Copy the upper portion of A into AB 
+*        
+             DO 50 J = I, I+PK-1
+                LK = MIN( KD, N-J ) + 1
+                CALL ZCOPY( LK, A( J, J ), 1, AB( 1, J ), 1 )
+   50        CONTINUE
+*                
+             CALL ZLASET( 'Upper', PK, PK, ZERO, ONE, 
+     $                    A( I+KD, I ), LDA )
+*        
+*            Form the matrix T
+*        
+             CALL ZLARFT( 'Forward', 'Columnwise', PN, PK,
+     $                    A( I+KD, I ), LDA, TAU( I ), 
+     $                    WORK( TPOS ), LDT )
+*        
+*            Compute W:
+*             
+             CALL ZGEMM( 'No transpose', 'No transpose', PN, PK, PK,
+     $                   ONE, A( I+KD, I ), LDA,
+     $                         WORK( TPOS ), LDT,
+     $                   ZERO, WORK( S2POS ), LDS2 )
+*        
+             CALL ZHEMM( 'Left', UPLO, PN, PK,
+     $                   ONE, A( I+KD, I+KD ), LDA,
+     $                         WORK( S2POS ), LDS2,
+     $                   ZERO, WORK( WPOS ), LDW )
+*        
+             CALL ZGEMM( 'Conjugate', 'No transpose', PK, PK, PN,
+     $                   ONE, WORK( S2POS ), LDS2,
+     $                         WORK( WPOS ), LDW,
+     $                   ZERO, WORK( S1POS ), LDS1 )
+*        
+             CALL ZGEMM( 'No transpose', 'No transpose', PN, PK, PK,
+     $                   -HALF, A( I+KD, I ), LDA,
+     $                         WORK( S1POS ), LDS1,
+     $                   ONE, WORK( WPOS ), LDW )
+*             
+*        
+*            Update the unreduced submatrix A(i+kd:n,i+kd:n), using
+*            an update of the form:  A := A - V*W' - W*V'
+*        
+             CALL ZHER2K( UPLO, 'No transpose', PN, PK,
+     $                    -ONE, A( I+KD, I ), LDA,
+     $                           WORK( WPOS ), LDW,
+     $                    RONE, A( I+KD, I+KD ), LDA )
+*            ==================================================================
+*            RESTORE A FOR COMPARISON AND CHECKING TO BE REMOVED
+*             DO 45 J = I, I+PK-1
+*                LK = MIN( KD, N-J ) + 1
+*                CALL ZCOPY( LK, AB( 1, J ), 1, A( J, J ), 1 )
+*   45        CONTINUE
+*            ==================================================================
+   40     CONTINUE
+*
+*        Copy the lower band to AB which is the band storage matrix
+*
+         DO 60 J = N-KD+1, N
+            LK = MIN(KD, N-J) + 1
+            CALL ZCOPY( LK, A( J, J ), 1, AB( 1, J ), 1 )
+   60    CONTINUE
+
+      END IF
+*
+      WORK( 1 ) = LWMIN
+      RETURN
+*
+*     End of ZHETRD_HE2HB
+*
+      END
diff --git a/SRC/zhetrf_aa.f b/SRC/zhetrf_aa.f
index 73a8383a..a3dd0950 100644
--- a/SRC/zhetrf_aa.f
+++ b/SRC/zhetrf_aa.f
@@ -37,7 +37,7 @@
 *> ZHETRF_AA computes the factorization of a complex hermitian matrix A
 *> using the Aasen's algorithm.  The form of the factorization is
 *>
-*>    A = U*T*U**T  or  A = L*T*L**T
+*>    A = U*T*U**H  or  A = L*T*L**H
 *>
 *> where U (or L) is a product of permutation and unit upper (lower)
 *> triangular matrices, and T is a hermitian tridiagonal matrix.
@@ -101,7 +101,7 @@
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
-*>          The length of WORK.  LWORK >= 2*N. For optimum performance
+*>          The length of WORK. LWORK >= MAX(1,2*N). For optimum performance
 *>          LWORK >= N*(1+NB), where NB is the optimal blocksize.
 *>
 *>          If LWORK = -1, then a workspace query is assumed; the routine
@@ -191,7 +191,7 @@
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.( 2*N ) .AND. .NOT.LQUERY ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
 *
@@ -230,7 +230,7 @@
       IF( UPPER ) THEN
 *
 *        .....................................................
-*        Factorize A as L*D*L**T using the upper triangle of A
+*        Factorize A as L*D*L**H using the upper triangle of A
 *        .....................................................
 *
 *        copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N))
@@ -353,7 +353,7 @@
       ELSE
 *
 *        .....................................................
-*        Factorize A as L*D*L**T using the lower triangle of A
+*        Factorize A as L*D*L**H using the lower triangle of A
 *        .....................................................
 *
 *        copy first column A(1:N, 1) into H(1:N, 1)
diff --git a/SRC/zhetrf_rk.f b/SRC/zhetrf_rk.f
new file mode 100644
index 00000000..dbf4f9a4
--- /dev/null
+++ b/SRC/zhetrf_rk.f
@@ -0,0 +1,498 @@
+*> \brief \b ZHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETRF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrf_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrf_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrf_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZHETRF_RK computes the factorization of a complex Hermitian matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the Hermitian block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension ( MAX(1,LWORK) ).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >=1.  For best performance
+*>          LWORK >= N*NB, where NB is the block size returned
+*>          by ILAENV.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array, returns this value as the first entry of the WORK
+*>          array, and no error message related to LWORK is issued
+*>          by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put correct description
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, IINFO, IP, IWS, K, KB, LDWORK, LWKOPT,
+     $                   NB, NBMIN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZLAHEF_RK, ZHETF2_RK, ZSWAP, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size
+*
+         NB = ILAENV( 1, 'ZHETRF_RK', UPLO, N, -1, -1, -1 )
+         LWKOPT = N*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHETRF_RK', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+      NBMIN = 2
+      LDWORK = N
+      IF( NB.GT.1 .AND. NB.LT.N ) THEN
+         IWS = LDWORK*NB
+         IF( LWORK.LT.IWS ) THEN
+            NB = MAX( LWORK / LDWORK, 1 )
+            NBMIN = MAX( 2, ILAENV( 2, 'ZHETRF_RK',
+     $                              UPLO, N, -1, -1, -1 ) )
+         END IF
+      ELSE
+         IWS = 1
+      END IF
+      IF( NB.LT.NBMIN )
+     $   NB = N
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**T using the upper triangle of A
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        KB, where KB is the number of columns factorized by ZLAHEF_RK;
+*        KB is either NB or NB-1, or K for the last block
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 15
+*
+         IF( K.GT.NB ) THEN
+*
+*           Factorize columns k-kb+1:k of A and use blocked code to
+*           update columns 1:k-kb
+*
+            CALL ZLAHEF_RK( UPLO, K, NB, KB, A, LDA, E,
+     $                      IPIV, WORK, LDWORK, IINFO )
+         ELSE
+*
+*           Use unblocked code to factorize columns 1:k of A
+*
+            CALL ZHETF2_RK( UPLO, K, A, LDA, E, IPIV, IINFO )
+            KB = K
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO
+*
+*        No need to adjust IPIV
+*
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k-kb+1:k and apply row permutations to the
+*        last k+1 colunms k+1:N after that block
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.LT.N ) THEN
+            DO I = K, ( K - KB + 1 ), -1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL ZSWAP( N-K, A( I, K+1 ), LDA,
+     $                        A( IP, K+1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KB
+         GO TO 10
+*
+*        This label is the exit from main loop over K decreasing
+*        from N to 1 in steps of KB
+*
+   15    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**T using the lower triangle of A
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        KB, where KB is the number of columns factorized by ZLAHEF_RK;
+*        KB is either NB or NB-1, or N-K+1 for the last block
+*
+         K = 1
+   20    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 35
+*
+         IF( K.LE.N-NB ) THEN
+*
+*           Factorize columns k:k+kb-1 of A and use blocked code to
+*           update columns k+kb:n
+*
+            CALL ZLAHEF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ),
+     $                        IPIV( K ), WORK, LDWORK, IINFO )
+
+
+         ELSE
+*
+*           Use unblocked code to factorize columns k:n of A
+*
+            CALL ZHETF2_RK( UPLO, N-K+1, A( K, K ), LDA, E( K ),
+     $                      IPIV( K ), IINFO )
+            KB = N - K + 1
+*
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO + K - 1
+*
+*        Adjust IPIV
+*
+         DO I = K, K + KB - 1
+            IF( IPIV( I ).GT.0 ) THEN
+               IPIV( I ) = IPIV( I ) + K - 1
+            ELSE
+               IPIV( I ) = IPIV( I ) - K + 1
+            END IF
+         END DO
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k:k+kb-1 and apply row permutations to the
+*        first k-1 colunms 1:k-1 before that block
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.GT.1 ) THEN
+            DO I = K, ( K + KB - 1 ), 1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL ZSWAP( K-1, A( I, 1 ), LDA,
+     $                        A( IP, 1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KB
+         GO TO 20
+*
+*        This label is the exit from main loop over K increasing
+*        from 1 to N in steps of KB
+*
+   35    CONTINUE
+*
+*     End Lower
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+      RETURN
+*
+*     End of ZHETRF_RK
+*
+      END
diff --git a/SRC/zhetri_3.f b/SRC/zhetri_3.f
new file mode 100644
index 00000000..4d9b4cb1
--- /dev/null
+++ b/SRC/zhetri_3.f
@@ -0,0 +1,248 @@
+*> \brief \b ZHETRI_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETRI_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetri_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetri_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetri_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZHETRI_3 computes the inverse of a complex Hermitian indefinite
+*> matrix A using the factorization computed by ZHETRF_RK or ZHETRF_BK:
+*>
+*>     A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> ZHETRI_3 sets the leading dimension of the workspace  before calling
+*> ZHETRI_3X that actually computes the inverse.  This is the blocked
+*> version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by ZHETRF_RK and ZHETRF_BK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the Hermitian inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by ZHETRF_RK or ZHETRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (N+NB+1)*(NB+3).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK. LWORK >= (N+NB+1)*(NB+3).
+*>
+*>          If LDWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the optimal
+*>          size of the WORK array, returns this value as the first
+*>          entry of the WORK array, and no error message related to
+*>          LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            UPPER, LQUERY
+      INTEGER            LWKOPT, NB
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZHETRI_3X
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+*     Determine the block size
+*
+      NB = MAX( 1, ILAENV( 1, 'ZHETRI_3', UPLO, N, -1, -1, -1 ) )
+      LWKOPT = ( N+NB+1 ) * ( NB+3 )
+*
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHETRI_3', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         WORK( 1 ) = LWKOPT
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      CALL ZHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of ZHETRI_3
+*
+      END
diff --git a/SRC/zhetri_3x.f b/SRC/zhetri_3x.f
new file mode 100644
index 00000000..9e736dac
--- /dev/null
+++ b/SRC/zhetri_3x.f
@@ -0,0 +1,649 @@
+*> \brief \b ZHETRI_3X
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETRI_3X + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetri_3x.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetri_3x.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetri_3x.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ),  E( * ), WORK( N+NB+1, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZHETRI_3X computes the inverse of a complex Hermitian indefinite
+*> matrix A using the factorization computed by ZHETRF_RK or ZHETRF_BK:
+*>
+*>     A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by ZHETRF_RK and ZHETRF_BK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the Hermitian inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by ZHETRF_RK or ZHETRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (N+NB+1,NB+3).
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          Block size.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * ), WORK( N+NB+1, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE
+      PARAMETER          ( ONE = 1.0D+0 )
+      COMPLEX*16         CONE, CZERO
+      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ),
+     $                     CZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            CUT, I, ICOUNT, INVD, IP, K, NNB, J, U11
+      DOUBLE PRECISION   AK, AKP1, T
+      COMPLEX*16         AKKP1, D, U01_I_J, U01_IP1_J, U11_I_J,
+     $                   U11_IP1_J
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZGEMM, ZHESWAPR, ZTRTRI, ZTRMM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DCONJG, DBLE, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+*
+*     Quick return if possible
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHETRI_3X', -INFO )
+         RETURN
+      END IF
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Workspace got Non-diag elements of D
+*
+      DO K = 1, N
+         WORK( K, 1 ) = E( K )
+      END DO
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO INFO = N, 1, -1
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.CZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO INFO = 1, N
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.CZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+      INFO = 0
+*
+*     Splitting Workspace
+*     U01 is a block ( N, NB+1 )
+*     The first element of U01 is in WORK( 1, 1 )
+*     U11 is a block ( NB+1, NB+1 )
+*     The first element of U11 is in WORK( N+1, 1 )
+*
+      U11 = N
+*
+*     INVD is a block ( N, 2 )
+*     The first element of INVD is in WORK( 1, INVD )
+*
+      INVD = NB + 2
+
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        invA = P * inv(U**H) * inv(D) * inv(U) * P**T.
+*
+         CALL ZTRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(U)
+*
+         K = 1
+         DO WHILE( K.LE.N )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = ONE / DBLE( A( K, K ) )
+               WORK( K, INVD+1 ) = CZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = ABS( WORK( K+1, 1 ) )
+               AK = DBLE( A( K, K ) ) / T
+               AKP1 = DBLE( A( K+1, K+1 ) ) / T
+               AKKP1 = WORK( K+1, 1 )  / T
+               D = T*( AK*AKP1-CONE )
+               WORK( K, INVD ) = AKP1 / D
+               WORK( K+1, INVD+1 ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K+1, INVD ) = DCONJG( WORK( K, INVD+1 ) )
+               K = K + 1
+            END IF
+            K = K + 1
+         END DO
+*
+*        inv(U**H) = (inv(U))**H
+*
+*        inv(U**H) * inv(D) * inv(U)
+*
+         CUT = N
+         DO WHILE( CUT.GT.0 )
+            NNB = NB
+            IF( CUT.LE.NNB ) THEN
+               NNB = CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT+1-NNB, CUT
+                  IF( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+
+            CUT = CUT - NNB
+*
+*           U01 Block
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  WORK( I, J ) = A( I, CUT+J )
+               END DO
+            END DO
+*
+*           U11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I ) = CONE
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = CZERO
+                END DO
+                DO J = I+1, NNB
+                   WORK( U11+I, J ) = A( CUT+I, CUT+J )
+                END DO
+            END DO
+*
+*           invD * U01
+*
+            I = 1
+            DO WHILE( I.LE.CUT )
+               IF( IPIV( I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( I, INVD ) * WORK( I, J )
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK( I, J )
+                     U01_IP1_J = WORK( I+1, J )
+                     WORK( I, J ) = WORK( I, INVD ) * U01_I_J
+     $                            + WORK( I, INVD+1 ) * U01_IP1_J
+                     WORK( I+1, J ) = WORK( I+1, INVD ) * U01_I_J
+     $                              + WORK( I+1, INVD+1 ) * U01_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           invD1 * U11
+*
+            I = 1
+            DO WHILE ( I.LE.NNB )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = I, NNB
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+                  END DO
+               ELSE
+                  DO J = I, NNB
+                     U11_I_J = WORK(U11+I,J)
+                     U11_IP1_J = WORK(U11+I+1,J)
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                            + WORK(CUT+I,INVD+1) * WORK(U11+I+1,J)
+                     WORK( U11+I+1, J ) = WORK(CUT+I+1,INVD) * U11_I_J
+     $                               + WORK(CUT+I+1,INVD+1) * U11_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           U11**H * invD1 * U11 -> U11
+*
+            CALL ZTRMM( 'L', 'U', 'C', 'U', NNB, NNB,
+     $                 CONE, A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                 N+NB+1 )
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+*           U01**H * invD * U01 -> A( CUT+I, CUT+J )
+*
+            CALL ZGEMM( 'C', 'N', NNB, NNB, CUT, CONE, A( 1, CUT+1 ),
+     $                  LDA, WORK, N+NB+1, CZERO, WORK(U11+1,1),
+     $                  N+NB+1 )
+
+*
+*           U11 =  U11**H * invD1 * U11 + U01**H * invD * U01
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = A( CUT+I, CUT+J ) + WORK(U11+I,J)
+               END DO
+            END DO
+*
+*           U01 =  U00**H * invD0 * U01
+*
+            CALL ZTRMM( 'L', UPLO, 'C', 'U', CUT, NNB,
+     $                  CONE, A, LDA, WORK, N+NB+1 )
+
+*
+*           Update U01
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  A( I, CUT+J ) = WORK( I, J )
+               END DO
+            END DO
+*
+*           Next Block
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(U**H) * inv(D) * inv(U) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Upper case.
+*
+*        ( We can use a loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = 1, N
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        inv A = P * inv(L**H) * inv(D) * inv(L) * P**T.
+*
+         CALL ZTRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(L)
+*
+         K = N
+         DO WHILE ( K .GE. 1 )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = ONE / DBLE( A( K, K ) )
+               WORK( K, INVD+1 ) = CZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = ABS( WORK( K-1, 1 ) )
+               AK = DBLE( A( K-1, K-1 ) ) / T
+               AKP1 = DBLE( A( K, K ) ) / T
+               AKKP1 = WORK( K-1, 1 ) / T
+               D = T*( AK*AKP1-CONE )
+               WORK( K-1, INVD ) = AKP1 / D
+               WORK( K, INVD ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K-1, INVD+1 ) = DCONJG( WORK( K, INVD+1 ) )
+               K = K - 1
+            END IF
+            K = K - 1
+         END DO
+*
+*        inv(L**H) = (inv(L))**H
+*
+*        inv(L**H) * inv(D) * inv(L)
+*
+         CUT = 0
+         DO WHILE( CUT.LT.N )
+            NNB = NB
+            IF( (CUT + NNB).GT.N ) THEN
+               NNB = N - CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT + 1, CUT+NNB
+                  IF ( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+*
+*           L21 Block
+*
+            DO I = 1, N-CUT-NNB
+               DO J = 1, NNB
+                 WORK( I, J ) = A( CUT+NNB+I, CUT+J )
+               END DO
+            END DO
+*
+*           L11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I) = CONE
+               DO J = I+1, NNB
+                  WORK( U11+I, J ) = CZERO
+               END DO
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = A( CUT+I, CUT+J )
+               END DO
+            END DO
+*
+*           invD*L21
+*
+            I = N-CUT-NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+NNB+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( CUT+NNB+I, INVD) * WORK( I, J)
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK(I,J)
+                     U01_IP1_J = WORK(I-1,J)
+                     WORK(I,J)=WORK(CUT+NNB+I,INVD)*U01_I_J+
+     $                        WORK(CUT+NNB+I,INVD+1)*U01_IP1_J
+                     WORK(I-1,J)=WORK(CUT+NNB+I-1,INVD+1)*U01_I_J+
+     $                        WORK(CUT+NNB+I-1,INVD)*U01_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           invD1*L11
+*
+            I = NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( U11+I, J ) = WORK( CUT+I, INVD)*WORK(U11+I,J)
+                  END DO
+
+               ELSE
+                  DO J = 1, NNB
+                     U11_I_J = WORK( U11+I, J )
+                     U11_IP1_J = WORK( U11+I-1, J )
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                                + WORK(CUT+I,INVD+1) * U11_IP1_J
+                     WORK( U11+I-1, J ) = WORK(CUT+I-1,INVD+1) * U11_I_J
+     $                                  + WORK(CUT+I-1,INVD) * U11_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           L11**H * invD1 * L11 -> L11
+*
+            CALL ZTRMM( 'L', UPLO, 'C', 'U', NNB, NNB, CONE,
+     $                   A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                   N+NB+1 )
+
+*
+            DO I = 1, NNB
+               DO J = 1, I
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+            IF( (CUT+NNB).LT.N ) THEN
+*
+*              L21**H * invD2*L21 -> A( CUT+I, CUT+J )
+*
+               CALL ZGEMM( 'C', 'N', NNB, NNB, N-NNB-CUT, CONE,
+     $                     A( CUT+NNB+1, CUT+1 ), LDA, WORK, N+NB+1,
+     $                     CZERO, WORK( U11+1, 1 ), N+NB+1 )
+
+*
+*              L11 =  L11**H * invD1 * L11 + U01**H * invD * U01
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = A( CUT+I, CUT+J )+WORK(U11+I,J)
+                  END DO
+               END DO
+*
+*              L01 =  L22**H * invD2 * L21
+*
+               CALL ZTRMM( 'L', UPLO, 'C', 'U', N-NNB-CUT, NNB, CONE,
+     $                     A( CUT+NNB+1, CUT+NNB+1 ), LDA, WORK,
+     $                     N+NB+1 )
+*
+*              Update L21
+*
+               DO I = 1, N-CUT-NNB
+                  DO J = 1, NNB
+                     A( CUT+NNB+I, CUT+J ) = WORK( I, J )
+                  END DO
+               END DO
+*
+            ELSE
+*
+*              L11 =  L11**H * invD1 * L11
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = WORK( U11+I, J )
+                  END DO
+               END DO
+            END IF
+*
+*           Next Block
+*
+            CUT = CUT + NNB
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(L**H) * inv(D) * inv(L) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Lower case.
+*
+*        ( We can use a loop over IPIV with increment -1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = N, 1, -1
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of ZHETRI_3X
+*
+      END
diff --git a/SRC/zhetrs_3.f b/SRC/zhetrs_3.f
new file mode 100644
index 00000000..2239941c
--- /dev/null
+++ b/SRC/zhetrs_3.f
@@ -0,0 +1,374 @@
+*> \brief \b ZHETRS_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETRS_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrs_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrs_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrs_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), B( LDB, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZHETRS_3 solves a system of linear equations A * X = B with a complex
+*> Hermitian matrix A using the factorization computed
+*> by ZHETRF_RK or ZHETRF_BK:
+*>
+*>    A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**H (or L**H) is the conjugate of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is Hermitian and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This algorithm is using Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**H)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**H)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by ZHETRF_RK and ZHETRF_BK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by ZHETRF_RK or ZHETRF_BK.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (LDB,NRHS)
+*>          On entry, the right hand side matrix B.
+*>          On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER          ( ONE = ( 1.0D+0,0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, J, K, KP
+      DOUBLE PRECISION   S
+      COMPLEX*16         AK, AKM1, AKM1K, BK, BKM1, DENOM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZDSCAL, ZSWAP, ZTRSM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, DCONJG, MAX
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZHETRS_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. NRHS.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        Solve A*X = B, where A = U*D*U**H.
+*
+*        P**T * B
+*
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]
+*
+         CALL ZTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (U \P**T * B) ]
+*
+         I = N
+         DO WHILE ( I.GE.1 )
+            IF( IPIV( I ).GT.0 ) THEN
+               S = DBLE( ONE ) / DBLE( A( I, I ) )
+               CALL ZDSCAL( NRHS, S, B( I, 1 ), LDB )
+            ELSE IF ( I.GT.1 ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I-1, I-1 ) / AKM1K
+               AK = A( I, I ) / DCONJG( AKM1K )
+               DENOM = AKM1*AK - ONE
+               DO J = 1, NRHS
+                  BKM1 = B( I-1, J ) / AKM1K
+                  BK = B( I, J ) / DCONJG( AKM1K )
+                  B( I-1, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I - 1
+            END IF
+            I = I - 1
+         END DO
+*
+*        Compute (U**H \ B) -> B   [ U**H \ (D \ (U \P**T * B) ) ]
+*
+         CALL ZTRSM( 'L', 'U', 'C', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (U**H \ (D \ (U \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N, 1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        Solve A*X = B, where A = L*D*L**H.
+*
+*        P**T * B
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N, 1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]
+*
+         CALL ZTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (L \P**T * B) ]
+*
+         I = 1
+         DO WHILE ( I.LE.N )
+            IF( IPIV( I ).GT.0 ) THEN
+               S = DBLE( ONE ) / DBLE( A( I, I ) )
+               CALL ZDSCAL( NRHS, S, B( I, 1 ), LDB )
+            ELSE IF( I.LT.N ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I, I ) / DCONJG( AKM1K )
+               AK = A( I+1, I+1 ) / AKM1K
+               DENOM = AKM1*AK - ONE
+               DO  J = 1, NRHS
+                  BKM1 = B( I, J ) / DCONJG( AKM1K )
+                  BK = B( I+1, J ) / AKM1K
+                  B( I, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I + 1
+            END IF
+            I = I + 1
+         END DO
+*
+*        Compute (L**H \ B) -> B   [ L**H \ (D \ (L \P**T * B) ) ]
+*
+         CALL ZTRSM('L', 'L', 'C', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (L**H \ (D \ (L \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        END Lower
+*
+      END IF
+*
+      RETURN
+*
+*     End of ZHETRS_3
+*
+      END
diff --git a/SRC/zhetrs_aa.f b/SRC/zhetrs_aa.f
index fd819d5a..0a02b8a6 100644
--- a/SRC/zhetrs_aa.f
+++ b/SRC/zhetrs_aa.f
@@ -27,7 +27,7 @@
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * )
-*       COMPLEX*16   A( LDA, * ), B( LDB, * ), WORK( * )
+*       COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
 *       ..
 *
 *
@@ -37,8 +37,8 @@
 *>
 *> \verbatim
 *>
-*> ZHETRS_AA solves a system of linear equations A*X = B with a real
-*> hermitian matrix A using the factorization A = U*T*U**T or
+*> ZHETRS_AA solves a system of linear equations A*X = B with a complex
+*> hermitian matrix A using the factorization A = U*T*U**H or
 *> A = L*T*L**T computed by ZHETRF_AA.
 *> \endverbatim
 *
@@ -50,8 +50,8 @@
 *>          UPLO is CHARACTER*1
 *>          Specifies whether the details of the factorization are stored
 *>          as an upper or lower triangular matrix.
-*>          = 'U':  Upper triangular, form is A = U*T*U**T;
-*>          = 'L':  Lower triangular, form is A = L*T*L**T.
+*>          = 'U':  Upper triangular, form is A = U*T*U**H;
+*>          = 'L':  Lower triangular, form is A = L*T*L**H.
 *> \endverbatim
 *>
 *> \param[in] N
@@ -105,7 +105,7 @@
 *>
 *> \param[in] LWORK
 *> \verbatim
-*>          LWORK is INTEGER, LWORK >= 3*N-2.
+*>          LWORK is INTEGER, LWORK >= MAX(1,3*N-2).
 *>
 *> \param[out] INFO
 *> \verbatim
@@ -143,12 +143,12 @@
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * )
-      COMPLEX*16   A( LDA, * ), B( LDB, * ), WORK( * )
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
 *     ..
 *
 *  =====================================================================
 *
-      COMPLEX*16   ONE
+      COMPLEX*16         ONE
       PARAMETER          ( ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
@@ -180,7 +180,7 @@
          INFO = -5
       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
          INFO = -8
-      ELSE IF( LWORK.LT.(3*N-2) .AND. .NOT.LQUERY ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
          INFO = -10
       END IF
       IF( INFO.NE.0 ) THEN
diff --git a/SRC/zlahef_aa.f b/SRC/zlahef_aa.f
index 45d1b67c..ef42f752 100644
--- a/SRC/zlahef_aa.f
+++ b/SRC/zlahef_aa.f
@@ -19,7 +19,7 @@
 *  ===========
 *
 *       SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-*                                H, LDH, WORK, INFO )
+*                             H, LDH, WORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER    UPLO
@@ -36,7 +36,7 @@
 *>
 *> \verbatim
 *>
-*> DLATRF_AA factorizes a panel of a real hermitian matrix A using
+*> DLAHEF_AA factorizes a panel of a complex hermitian matrix A using
 *> the Aasen's algorithm. The panel consists of a set of NB rows of A
 *> when UPLO is U, or a set of NB columns when UPLO is L.
 *>
@@ -46,7 +46,7 @@
 *> which is used to factorize the first panel.
 *>
 *> The resulting J-th row of U, or J-th column of L, is stored in the
-*> (J-1)-th row, or column, of A (without the unit diatonals), while
+*> (J-1)-th row, or column, of A (without the unit diagonals), while
 *> the diagonal and subdiagonal of A are overwritten by those of T.
 *>
 *> \endverbatim
@@ -152,7 +152,7 @@
 *
 *  =====================================================================
       SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-     $                         H, LDH, WORK, INFO )
+     $                      H, LDH, WORK, INFO )
 *
 *  -- LAPACK computational routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
diff --git a/SRC/zlahef_rk.f b/SRC/zlahef_rk.f
new file mode 100644
index 00000000..cf8c8586
--- /dev/null
+++ b/SRC/zlahef_rk.f
@@ -0,0 +1,1234 @@
+*> \brief \b ZLAHEF_RK computes a partial factorization of a complex Hermitian indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLAHEF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlahef_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlahef_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlahef_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, KB, LDA, LDW, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), E( * ), W( LDW, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZLAHEF_RK computes a partial factorization of a complex Hermitian
+*> matrix A using the bounded Bunch-Kaufman (rook) diagonal
+*> pivoting method. The partial factorization has the form:
+*>
+*> A  =  ( I  U12 ) ( A11  0  ) (  I       0    )  if UPLO = 'U', or:
+*>       ( 0  U22 ) (  0   D  ) ( U12**H U22**H )
+*>
+*> A  =  ( L11  0 ) (  D   0  ) ( L11**H L21**H )  if UPLO = 'L',
+*>       ( L21  I ) (  0  A22 ) (  0       I    )
+*>
+*> where the order of D is at most NB. The actual order is returned in
+*> the argument KB, and is either NB or NB-1, or N if N <= NB.
+*>
+*> ZLAHEF_RK is an auxiliary routine called by ZHETRF_RK. It uses
+*> blocked code (calling Level 3 BLAS) to update the submatrix
+*> A11 (if UPLO = 'U') or A22 (if UPLO = 'L').
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The maximum number of columns of the matrix A that should be
+*>          factored.  NB should be at least 2 to allow for 2-by-2 pivot
+*>          blocks.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*>          KB is INTEGER
+*>          The number of columns of A that were actually factored.
+*>          KB is either NB-1 or NB, or N if N <= NB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the Hermitian matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the Hermitian block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,N-KB+1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,1:KB).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is COMPLEX*16 array, dimension (LDW,NB)
+*> \endverbatim
+*>
+*> \param[in] LDW
+*> \verbatim
+*>          LDW is INTEGER
+*>          The leading dimension of the array W.  LDW >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16HEcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, KB, LDA, LDW, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), W( LDW, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      COMPLEX*16         CONE
+      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
+      DOUBLE PRECISION   EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
+      COMPLEX*16         CZERO
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            DONE
+      INTEGER            IMAX, ITEMP, II, J, JB, JJ, JMAX, K, KK, KKW,
+     $                   KP, KSTEP, KW, P
+      DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, DTEMP, R1, ROWMAX, T,
+     $                   SFMIN
+      COMPLEX*16         D11, D21, D22, Z
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            IZAMAX
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           LSAME, IZAMAX, DLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZCOPY, ZDSCAL, ZGEMM, ZGEMV, ZLACGV, ZSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT
+*     ..
+*     .. Statement Functions ..
+      DOUBLE PRECISION   CABS1
+*     ..
+*     .. Statement Function definitions ..
+      CABS1( Z ) = ABS( DBLE( Z ) ) + ABS( DIMAG( Z ) )
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = DLAMCH( 'S' )
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+*
+*        Factorize the trailing columns of A using the upper triangle
+*        of A and working backwards, and compute the matrix W = U12*D
+*        for use in updating A11 (note that conjg(W) is actually stored)
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = CZERO
+*
+*        K is the main loop index, decreasing from N in steps of 1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        KW is the column of W which corresponds to column K of A
+*
+         KW = NB + K - N
+*
+*        Exit from loop
+*
+         IF( ( K.LE.N-NB+1 .AND. NB.LT.N ) .OR. K.LT.1 )
+     $      GO TO 30
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column KW of W and update it
+*
+         IF( K.GT.1 )
+     $      CALL ZCOPY( K-1, A( 1, K ), 1, W( 1, KW ), 1 )
+         W( K, KW ) = DBLE( A( K, K ) )
+         IF( K.LT.N ) THEN
+            CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA,
+     $                  W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 )
+            W( K, KW ) = DBLE( W( K, KW ) )
+         END IF
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( DBLE( W( K, KW ) ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = IZAMAX( K-1, W( 1, KW ), 1 )
+            COLMAX = CABS1( W( IMAX, KW ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            A( K, K ) = DBLE( W( K, KW ) )
+            IF( K.GT.1 )
+     $         CALL ZCOPY( K-1, W( 1, KW ), 1, A( 1, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           BEGIN pivot search
+*
+*           Case(1)
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+*              Lop until pivot found
+*
+               DONE = .FALSE.
+*
+   12          CONTINUE
+*
+*                 BEGIN pivot search loop body
+*
+*
+*                 Copy column IMAX to column KW-1 of W and update it
+*
+                  IF( IMAX.GT.1 )
+     $               CALL ZCOPY( IMAX-1, A( 1, IMAX ), 1, W( 1, KW-1 ),
+     $                           1 )
+                  W( IMAX, KW-1 ) = DBLE( A( IMAX, IMAX ) )
+*
+                  CALL ZCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA,
+     $                        W( IMAX+1, KW-1 ), 1 )
+                  CALL ZLACGV( K-IMAX, W( IMAX+1, KW-1 ), 1 )
+*
+                  IF( K.LT.N ) THEN
+                     CALL ZGEMV( 'No transpose', K, N-K, -CONE,
+     $                           A( 1, K+1 ), LDA, W( IMAX, KW+1 ), LDW,
+     $                           CONE, W( 1, KW-1 ), 1 )
+                     W( IMAX, KW-1 ) = DBLE( W( IMAX, KW-1 ) )
+                  END IF
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + IZAMAX( K-IMAX, W( IMAX+1, KW-1 ),
+     $                                     1 )
+                     ROWMAX = CABS1( W( JMAX, KW-1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = IZAMAX( IMAX-1, W( 1, KW-1 ), 1 )
+                     DTEMP = CABS1( W( ITEMP, KW-1 ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Case(2)
+*                 Equivalent to testing for
+*                 ABS( REAL( W( IMAX,KW-1 ) ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( ABS( DBLE( W( IMAX,KW-1 ) ) )
+     $                       .LT.ALPHA*ROWMAX ) ) THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column KW-1 of W to column KW of W
+*
+                     CALL ZCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Case(3)
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K-1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+*
+*                 Case(4)
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL ZCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                  END IF
+*
+*
+*                 END pivot search loop body
+*
+               IF( .NOT.DONE ) GOTO 12
+*
+            END IF
+*
+*           END pivot search
+*
+*           ============================================================
+*
+*           KK is the column of A where pivoting step stopped
+*
+            KK = K - KSTEP + 1
+*
+*           KKW is the column of W which corresponds to column KK of A
+*
+            KKW = NB + KK - N
+*
+*           Interchange rows and columns P and K.
+*           Updated column P is already stored in column KW of W.
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column K to column P of submatrix A
+*              at step K. No need to copy element into columns
+*              K and K-1 of A for 2-by-2 pivot, since these columns
+*              will be later overwritten.
+*
+               A( P, P ) = DBLE( A( K, K ) )
+               CALL ZCOPY( K-1-P, A( P+1, K ), 1, A( P, P+1 ),
+     $                     LDA )
+               CALL ZLACGV( K-1-P, A( P, P+1 ), LDA )
+               IF( P.GT.1 )
+     $            CALL ZCOPY( P-1, A( 1, K ), 1, A( 1, P ), 1 )
+*
+*              Interchange rows K and P in the last K+1 to N columns of A
+*              (columns K and K-1 of A for 2-by-2 pivot will be
+*              later overwritten). Interchange rows K and P
+*              in last KKW to NB columns of W.
+*
+               IF( K.LT.N )
+     $            CALL ZSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ),
+     $                        LDA )
+               CALL ZSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ),
+     $                     LDW )
+            END IF
+*
+*           Interchange rows and columns KP and KK.
+*           Updated column KP is already stored in column KKW of W.
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP of submatrix A
+*              at step K. No need to copy element into column K
+*              (or K and K-1 for 2-by-2 pivot) of A, since these columns
+*              will be later overwritten.
+*
+               A( KP, KP ) = DBLE( A( KK, KK ) )
+               CALL ZCOPY( KK-1-KP, A( KP+1, KK ), 1, A( KP, KP+1 ),
+     $                     LDA )
+               CALL ZLACGV( KK-1-KP, A( KP, KP+1 ), LDA )
+               IF( KP.GT.1 )
+     $            CALL ZCOPY( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 )
+*
+*              Interchange rows KK and KP in last K+1 to N columns of A
+*              (columns K (or K and K-1 for 2-by-2 pivot) of A will be
+*              later overwritten). Interchange rows KK and KP
+*              in last KKW to NB columns of W.
+*
+               IF( K.LT.N )
+     $            CALL ZSWAP( N-K, A( KK, K+1 ), LDA, A( KP, K+1 ),
+     $                        LDA )
+               CALL ZSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ),
+     $                     LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column kw of W now holds
+*
+*              W(kw) = U(k)*D(k),
+*
+*              where U(k) is the k-th column of U
+*
+*              (1) Store subdiag. elements of column U(k)
+*              and 1-by-1 block D(k) in column k of A.
+*              (NOTE: Diagonal element U(k,k) is a UNIT element
+*              and not stored)
+*                 A(k,k) := D(k,k) = W(k,kw)
+*                 A(1:k-1,k) := U(1:k-1,k) = W(1:k-1,kw)/D(k,k)
+*
+*              (NOTE: No need to use for Hermitian matrix
+*              A( K, K ) = REAL( W( K, K) ) to separately copy diagonal
+*              element D(k,k) from W (potentially saves only one load))
+               CALL ZCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
+               IF( K.GT.1 ) THEN
+*
+*                 (NOTE: No need to check if A(k,k) is NOT ZERO,
+*                  since that was ensured earlier in pivot search:
+*                  case A(k,k) = 0 falls into 2x2 pivot case(3))
+*
+*                 Handle division by a small number
+*
+                  T = DBLE( A( K, K ) )
+                  IF( ABS( T ).GE.SFMIN ) THEN
+                     R1 = ONE / T
+                     CALL ZDSCAL( K-1, R1, A( 1, K ), 1 )
+                  ELSE
+                     DO 14 II = 1, K-1
+                        A( II, K ) = A( II, K ) / T
+   14                CONTINUE
+                  END IF
+*
+*                 (2) Conjugate column W(kw)
+*
+                  CALL ZLACGV( K-1, W( 1, KW ), 1 )
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns kw and kw-1 of W now hold
+*
+*              ( W(kw-1) W(kw) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+*              (1) Store U(1:k-2,k-1) and U(1:k-2,k) and 2-by-2
+*              block D(k-1:k,k-1:k) in columns k-1 and k of A.
+*              (NOTE: 2-by-2 diagonal block U(k-1:k,k-1:k) is a UNIT
+*              block and not stored)
+*                 A(k-1:k,k-1:k) := D(k-1:k,k-1:k) = W(k-1:k,kw-1:kw)
+*                 A(1:k-2,k-1:k) := U(1:k-2,k:k-1:k) =
+*                 = W(1:k-2,kw-1:kw) * ( D(k-1:k,k-1:k)**(-1) )
+*
+               IF( K.GT.2 ) THEN
+*
+*                 Factor out the columns of the inverse of 2-by-2 pivot
+*                 block D, so that each column contains 1, to reduce the
+*                 number of FLOPS when we multiply panel
+*                 ( W(kw-1) W(kw) ) by this inverse, i.e. by D**(-1).
+*
+*                 D**(-1) = ( d11 cj(d21) )**(-1) =
+*                           ( d21    d22 )
+*
+*                 = 1/(d11*d22-|d21|**2) * ( ( d22) (-cj(d21) ) ) =
+*                                          ( (-d21) (     d11 ) )
+*
+*                 = 1/(|d21|**2) * 1/((d11/cj(d21))*(d22/d21)-1) *
+*
+*                   * ( d21*( d22/d21 ) conj(d21)*(           - 1 ) ) =
+*                     (     (      -1 )           ( d11/conj(d21) ) )
+*
+*                 = 1/(|d21|**2) * 1/(D22*D11-1) *
+*
+*                   * ( d21*( D11 ) conj(d21)*(  -1 ) ) =
+*                     (     (  -1 )           ( D22 ) )
+*
+*                 = (1/|d21|**2) * T * ( d21*( D11 ) conj(d21)*(  -1 ) ) =
+*                                      (     (  -1 )           ( D22 ) )
+*
+*                 = ( (T/conj(d21))*( D11 ) (T/d21)*(  -1 ) ) =
+*                   (               (  -1 )         ( D22 ) )
+*
+*                 Handle division by a small number. (NOTE: order of
+*                 operations is important)
+*
+*                 = ( T*(( D11 )/conj(D21)) T*((  -1 )/D21 ) )
+*                   (   ((  -1 )          )   (( D22 )     ) ),
+*
+*                 where D11 = d22/d21,
+*                       D22 = d11/conj(d21),
+*                       D21 = d21,
+*                       T = 1/(D22*D11-1).
+*
+*                 (NOTE: No need to check for division by ZERO,
+*                  since that was ensured earlier in pivot search:
+*                  (a) d21 != 0 in 2x2 pivot case(4),
+*                      since |d21| should be larger than |d11| and |d22|;
+*                  (b) (D22*D11 - 1) != 0, since from (a),
+*                      both |D11| < 1, |D22| < 1, hence |D22*D11| << 1.)
+*
+                  D21 = W( K-1, KW )
+                  D11 = W( K, KW ) / DCONJG( D21 )
+                  D22 = W( K-1, KW-1 ) / D21
+                  T = ONE / ( DBLE( D11*D22 )-ONE )
+*
+*                 Update elements in columns A(k-1) and A(k) as
+*                 dot products of rows of ( W(kw-1) W(kw) ) and columns
+*                 of D**(-1)
+*
+                  DO 20 J = 1, K - 2
+                     A( J, K-1 ) = T*( ( D11*W( J, KW-1 )-W( J, KW ) ) /
+     $                             D21 )
+                     A( J, K ) = T*( ( D22*W( J, KW )-W( J, KW-1 ) ) /
+     $                           DCONJG( D21 ) )
+   20             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy superdiagonal element of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               A( K-1, K-1 ) = W( K-1, KW-1 )
+               A( K-1, K ) = CZERO
+               A( K, K ) = W( K, KW )
+               E( K ) = W( K-1, KW )
+               E( K-1 ) = CZERO
+*
+*              (2) Conjugate columns W(kw) and W(kw-1)
+*
+               CALL ZLACGV( K-1, W( 1, KW ), 1 )
+               CALL ZLACGV( K-2, W( 1, KW-1 ), 1 )
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   30    CONTINUE
+*
+*        Update the upper triangle of A11 (= A(1:k,1:k)) as
+*
+*        A11 := A11 - U12*D*U12**H = A11 - U12*W**H
+*
+*        computing blocks of NB columns at a time (note that conjg(W) is
+*        actually stored)
+*
+         DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB
+            JB = MIN( NB, K-J+1 )
+*
+*           Update the upper triangle of the diagonal block
+*
+            DO 40 JJ = J, J + JB - 1
+               A( JJ, JJ ) = DBLE( A( JJ, JJ ) )
+               CALL ZGEMV( 'No transpose', JJ-J+1, N-K, -CONE,
+     $                     A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE,
+     $                     A( J, JJ ), 1 )
+               A( JJ, JJ ) = DBLE( A( JJ, JJ ) )
+   40       CONTINUE
+*
+*           Update the rectangular superdiagonal block
+*
+            IF( J.GE.2 )
+     $         CALL ZGEMM( 'No transpose', 'Transpose', J-1, JB, N-K,
+     $                     -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW,
+     $                     CONE, A( 1, J ), LDA )
+   50    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = N - K
+*
+      ELSE
+*
+*        Factorize the leading columns of A using the lower triangle
+*        of A and working forwards, and compute the matrix W = L21*D
+*        for use in updating A22 (note that conjg(W) is actually stored)
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = CZERO
+*
+*        K is the main loop index, increasing from 1 in steps of 1 or 2
+*
+         K = 1
+   70    CONTINUE
+*
+*        Exit from loop
+*
+         IF( ( K.GE.NB .AND. NB.LT.N ) .OR. K.GT.N )
+     $      GO TO 90
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column K of W and update column K of W
+*
+         W( K, K ) = DBLE( A( K, K ) )
+         IF( K.LT.N )
+     $      CALL ZCOPY( N-K, A( K+1, K ), 1, W( K+1, K ), 1 )
+         IF( K.GT.1 ) THEN
+            CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ),
+     $                  LDA, W( K, 1 ), LDW, CONE, W( K, K ), 1 )
+            W( K, K ) = DBLE( W( K, K ) )
+         END IF
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = ABS( DBLE( W( K, K ) ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + IZAMAX( N-K, W( K+1, K ), 1 )
+            COLMAX = CABS1( W( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            A( K, K ) = DBLE( W( K, K ) )
+            IF( K.LT.N )
+     $         CALL ZCOPY( N-K, W( K+1, K ), 1, A( K+1, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           BEGIN pivot search
+*
+*           Case(1)
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   72          CONTINUE
+*
+*                 BEGIN pivot search loop body
+*
+*
+*                 Copy column IMAX to column k+1 of W and update it
+*
+                  CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1)
+                  CALL ZLACGV( IMAX-K, W( K, K+1 ), 1 )
+                  W( IMAX, K+1 ) = DBLE( A( IMAX, IMAX ) )
+*
+                  IF( IMAX.LT.N )
+     $               CALL ZCOPY( N-IMAX, A( IMAX+1, IMAX ), 1,
+     $                           W( IMAX+1, K+1 ), 1 )
+*
+                  IF( K.GT.1 ) THEN
+                     CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE,
+     $                            A( K, 1 ), LDA, W( IMAX, 1 ), LDW,
+     $                            CONE, W( K, K+1 ), 1 )
+                     W( IMAX, K+1 ) = DBLE( W( IMAX, K+1 ) )
+                  END IF
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + IZAMAX( IMAX-K, W( K, K+1 ), 1 )
+                     ROWMAX = CABS1( W( JMAX, K+1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + IZAMAX( N-IMAX, W( IMAX+1, K+1 ), 1)
+                     DTEMP = CABS1( W( ITEMP, K+1 ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Case(2)
+*                 Equivalent to testing for
+*                 ABS( REAL( W( IMAX,K+1 ) ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( ABS( DBLE( W( IMAX,K+1 ) ) )
+     $                       .LT.ALPHA*ROWMAX ) ) THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column K+1 of W to column K of W
+*
+                     CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Case(3)
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+*
+*                 Case(4)
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                  END IF
+*
+*
+*                 End pivot search loop body
+*
+               IF( .NOT.DONE ) GOTO 72
+*
+            END IF
+*
+*           END pivot search
+*
+*           ============================================================
+*
+*           KK is the column of A where pivoting step stopped
+*
+            KK = K + KSTEP - 1
+*
+*           Interchange rows and columns P and K (only for 2-by-2 pivot).
+*           Updated column P is already stored in column K of W.
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column KK-1 to column P of submatrix A
+*              at step K. No need to copy element into columns
+*              K and K+1 of A for 2-by-2 pivot, since these columns
+*              will be later overwritten.
+*
+               A( P, P ) = DBLE( A( K, K ) )
+               CALL ZCOPY( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA )
+               CALL ZLACGV( P-K-1, A( P, K+1 ), LDA )
+               IF( P.LT.N )
+     $            CALL ZCOPY( N-P, A( P+1, K ), 1, A( P+1, P ), 1 )
+*
+*              Interchange rows K and P in first K-1 columns of A
+*              (columns K and K+1 of A for 2-by-2 pivot will be
+*              later overwritten). Interchange rows K and P
+*              in first KK columns of W.
+*
+               IF( K.GT.1 )
+     $            CALL ZSWAP( K-1, A( K, 1 ), LDA, A( P, 1 ), LDA )
+               CALL ZSWAP( KK, W( K, 1 ), LDW, W( P, 1 ), LDW )
+            END IF
+*
+*           Interchange rows and columns KP and KK.
+*           Updated column KP is already stored in column KK of W.
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP of submatrix A
+*              at step K. No need to copy element into column K
+*              (or K and K+1 for 2-by-2 pivot) of A, since these columns
+*              will be later overwritten.
+*
+               A( KP, KP ) = DBLE( A( KK, KK ) )
+               CALL ZCOPY( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
+     $                     LDA )
+               CALL ZLACGV( KP-KK-1, A( KP, KK+1 ), LDA )
+               IF( KP.LT.N )
+     $            CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+*
+*              Interchange rows KK and KP in first K-1 columns of A
+*              (column K (or K and K+1 for 2-by-2 pivot) of A will be
+*              later overwritten). Interchange rows KK and KP
+*              in first KK columns of W.
+*
+               IF( K.GT.1 )
+     $            CALL ZSWAP( K-1, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+               CALL ZSWAP( KK, W( KK, 1 ), LDW, W( KP, 1 ), LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k of W now holds
+*
+*              W(k) = L(k)*D(k),
+*
+*              where L(k) is the k-th column of L
+*
+*              (1) Store subdiag. elements of column L(k)
+*              and 1-by-1 block D(k) in column k of A.
+*              (NOTE: Diagonal element L(k,k) is a UNIT element
+*              and not stored)
+*                 A(k,k) := D(k,k) = W(k,k)
+*                 A(k+1:N,k) := L(k+1:N,k) = W(k+1:N,k)/D(k,k)
+*
+*              (NOTE: No need to use for Hermitian matrix
+*              A( K, K ) = REAL( W( K, K) ) to separately copy diagonal
+*              element D(k,k) from W (potentially saves only one load))
+               CALL ZCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
+               IF( K.LT.N ) THEN
+*
+*                 (NOTE: No need to check if A(k,k) is NOT ZERO,
+*                  since that was ensured earlier in pivot search:
+*                  case A(k,k) = 0 falls into 2x2 pivot case(3))
+*
+*                 Handle division by a small number
+*
+                  T = DBLE( A( K, K ) )
+                  IF( ABS( T ).GE.SFMIN ) THEN
+                     R1 = ONE / T
+                     CALL ZDSCAL( N-K, R1, A( K+1, K ), 1 )
+                  ELSE
+                     DO 74 II = K + 1, N
+                        A( II, K ) = A( II, K ) / T
+   74                CONTINUE
+                  END IF
+*
+*                 (2) Conjugate column W(k)
+*
+                  CALL ZLACGV( N-K, W( K+1, K ), 1 )
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 of W now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+*              (1) Store L(k+2:N,k) and L(k+2:N,k+1) and 2-by-2
+*              block D(k:k+1,k:k+1) in columns k and k+1 of A.
+*              NOTE: 2-by-2 diagonal block L(k:k+1,k:k+1) is a UNIT
+*              block and not stored.
+*                 A(k:k+1,k:k+1) := D(k:k+1,k:k+1) = W(k:k+1,k:k+1)
+*                 A(k+2:N,k:k+1) := L(k+2:N,k:k+1) =
+*                 = W(k+2:N,k:k+1) * ( D(k:k+1,k:k+1)**(-1) )
+*
+               IF( K.LT.N-1 ) THEN
+*
+*                 Factor out the columns of the inverse of 2-by-2 pivot
+*                 block D, so that each column contains 1, to reduce the
+*                 number of FLOPS when we multiply panel
+*                 ( W(kw-1) W(kw) ) by this inverse, i.e. by D**(-1).
+*
+*                 D**(-1) = ( d11 cj(d21) )**(-1) =
+*                           ( d21    d22 )
+*
+*                 = 1/(d11*d22-|d21|**2) * ( ( d22) (-cj(d21) ) ) =
+*                                          ( (-d21) (     d11 ) )
+*
+*                 = 1/(|d21|**2) * 1/((d11/cj(d21))*(d22/d21)-1) *
+*
+*                   * ( d21*( d22/d21 ) conj(d21)*(           - 1 ) ) =
+*                     (     (      -1 )           ( d11/conj(d21) ) )
+*
+*                 = 1/(|d21|**2) * 1/(D22*D11-1) *
+*
+*                   * ( d21*( D11 ) conj(d21)*(  -1 ) ) =
+*                     (     (  -1 )           ( D22 ) )
+*
+*                 = (1/|d21|**2) * T * ( d21*( D11 ) conj(d21)*(  -1 ) ) =
+*                                      (     (  -1 )           ( D22 ) )
+*
+*                 = ( (T/conj(d21))*( D11 ) (T/d21)*(  -1 ) ) =
+*                   (               (  -1 )         ( D22 ) )
+*
+*                 Handle division by a small number. (NOTE: order of
+*                 operations is important)
+*
+*                 = ( T*(( D11 )/conj(D21)) T*((  -1 )/D21 ) )
+*                   (   ((  -1 )          )   (( D22 )     ) ),
+*
+*                 where D11 = d22/d21,
+*                       D22 = d11/conj(d21),
+*                       D21 = d21,
+*                       T = 1/(D22*D11-1).
+*
+*                 (NOTE: No need to check for division by ZERO,
+*                  since that was ensured earlier in pivot search:
+*                  (a) d21 != 0 in 2x2 pivot case(4),
+*                      since |d21| should be larger than |d11| and |d22|;
+*                  (b) (D22*D11 - 1) != 0, since from (a),
+*                      both |D11| < 1, |D22| < 1, hence |D22*D11| << 1.)
+*
+                  D21 = W( K+1, K )
+                  D11 = W( K+1, K+1 ) / D21
+                  D22 = W( K, K ) / DCONJG( D21 )
+                  T = ONE / ( DBLE( D11*D22 )-ONE )
+*
+*                 Update elements in columns A(k) and A(k+1) as
+*                 dot products of rows of ( W(k) W(k+1) ) and columns
+*                 of D**(-1)
+*
+                  DO 80 J = K + 2, N
+                     A( J, K ) = T*( ( D11*W( J, K )-W( J, K+1 ) ) /
+     $                           DCONJG( D21 ) )
+                     A( J, K+1 ) = T*( ( D22*W( J, K+1 )-W( J, K ) ) /
+     $                             D21 )
+   80             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy subdiagonal element of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               A( K, K ) = W( K, K )
+               A( K+1, K ) = CZERO
+               A( K+1, K+1 ) = W( K+1, K+1 )
+               E( K ) = W( K+1, K )
+               E( K+1 ) = CZERO
+*
+*              (2) Conjugate columns W(k) and W(k+1)
+*
+               CALL ZLACGV( N-K, W( K+1, K ), 1 )
+               CALL ZLACGV( N-K-1, W( K+2, K+1 ), 1 )
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 70
+*
+   90    CONTINUE
+*
+*        Update the lower triangle of A22 (= A(k:n,k:n)) as
+*
+*        A22 := A22 - L21*D*L21**H = A22 - L21*W**H
+*
+*        computing blocks of NB columns at a time (note that conjg(W) is
+*        actually stored)
+*
+         DO 110 J = K, N, NB
+            JB = MIN( NB, N-J+1 )
+*
+*           Update the lower triangle of the diagonal block
+*
+            DO 100 JJ = J, J + JB - 1
+               A( JJ, JJ ) = DBLE( A( JJ, JJ ) )
+               CALL ZGEMV( 'No transpose', J+JB-JJ, K-1, -CONE,
+     $                     A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE,
+     $                     A( JJ, JJ ), 1 )
+               A( JJ, JJ ) = DBLE( A( JJ, JJ ) )
+  100       CONTINUE
+*
+*           Update the rectangular subdiagonal block
+*
+            IF( J+JB.LE.N )
+     $         CALL ZGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
+     $                     K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ),
+     $                     LDW, CONE, A( J+JB, J ), LDA )
+  110    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = K - 1
+*
+      END IF
+      RETURN
+*
+*     End of ZLAHEF_RK
+*
+      END
diff --git a/SRC/zlarfy.f b/SRC/zlarfy.f
new file mode 100644
index 00000000..39b795f0
--- /dev/null
+++ b/SRC/zlarfy.f
@@ -0,0 +1,163 @@
+*> \brief \b ZLARFY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INCV, LDC, N
+*       COMPLEX*16         TAU
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZLARFY applies an elementary reflector, or Householder matrix, H,
+*> to an n x n Hermitian matrix C, from both the left and the right.
+*>
+*> H is represented in the form
+*>
+*>    H = I - tau * v * v'
+*>
+*> where  tau  is a scalar and  v  is a vector.
+*>
+*> If  tau  is  zero, then  H  is taken to be the unit matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix C is stored.
+*>          = 'U':  Upper triangle
+*>          = 'L':  Lower triangle
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix C.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is COMPLEX*16 array, dimension
+*>                  (1 + (N-1)*abs(INCV))
+*>          The vector v as described above.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*>          INCV is INTEGER
+*>          The increment between successive elements of v.  INCV must
+*>          not be zero.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is COMPLEX*16
+*>          The value tau as described above.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX*16 array, dimension (LDC, N)
+*>          On entry, the matrix C.
+*>          On exit, C is overwritten by H * C * H'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max( 1, N ).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (N)
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complex16_eig
+*
+*  =====================================================================
+      SUBROUTINE ZLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK )
+*
+*  -- LAPACK test routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INCV, LDC, N
+      COMPLEX*16         TAU
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE, ZERO, HALF
+      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
+     $                   ZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   HALF = ( 0.5D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      COMPLEX*16         ALPHA
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZAXPY, ZHEMV, ZHER2
+*     ..
+*     .. External Functions ..
+      COMPLEX*16         ZDOTC
+      EXTERNAL           ZDOTC
+*     ..
+*     .. Executable Statements ..
+*
+      IF( TAU.EQ.ZERO )
+     $   RETURN
+*
+*     Form  w:= C * v
+*
+      CALL ZHEMV( UPLO, N, ONE, C, LDC, V, INCV, ZERO, WORK, 1 )
+*
+      ALPHA = -HALF*TAU*ZDOTC( N, WORK, 1, V, INCV )
+      CALL ZAXPY( N, ALPHA, V, INCV, WORK, 1 )
+*
+*     C := C - v * w' - w * v'
+*
+      CALL ZHER2( UPLO, N, -TAU, V, INCV, WORK, 1, C, LDC )
+*
+      RETURN
+*
+*     End of ZLARFY
+*
+      END
diff --git a/SRC/zlaswp.f b/SRC/zlaswp.f
index 82244efb..b695d944 100644
--- a/SRC/zlaswp.f
+++ b/SRC/zlaswp.f
@@ -71,15 +71,15 @@
 *> \param[in] K2
 *> \verbatim
 *>          K2 is INTEGER
-*>          The last element of IPIV for which a row interchange will
-*>          be done.
+*>          (K2-K1+1) is the number of elements of IPIV for which a row
+*>          interchange will be done.
 *> \endverbatim
 *>
 *> \param[in] IPIV
 *> \verbatim
-*>          IPIV is INTEGER array, dimension (K2*abs(INCX))
-*>          The vector of pivot indices.  Only the elements in positions
-*>          K1 through K2 of IPIV are accessed.
+*>          IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
+*>          The vector of pivot indices. Only the elements in positions
+*>          K1 through K1+(K2-K1)*INCX of IPIV are accessed.
 *>          IPIV(K) = L implies rows K and L are to be interchanged.
 *> \endverbatim
 *>
@@ -143,7 +143,7 @@
          I2 = K2
          INC = 1
       ELSE IF( INCX.LT.0 ) THEN
-         IX0 = 1 + ( 1-K2 )*INCX
+         IX0 = K1 + ( K1-K2 )*INCX
          I1 = K2
          I2 = K1
          INC = -1
diff --git a/SRC/zlasyf_aa.f b/SRC/zlasyf_aa.f
new file mode 100644
index 00000000..fb914662
--- /dev/null
+++ b/SRC/zlasyf_aa.f
@@ -0,0 +1,506 @@
+*> \brief \b ZLASYF_AA
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLASYF_AA + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlasyf_aa.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlasyf_aa.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlasyf_aa.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
+*                             H, LDH, WORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            J1, M, NB, LDA, LDH, INFO
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), H( LDH, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DLATRF_AA factorizes a panel of a complex symmetric matrix A using
+*> the Aasen's algorithm. The panel consists of a set of NB rows of A
+*> when UPLO is U, or a set of NB columns when UPLO is L.
+*>
+*> In order to factorize the panel, the Aasen's algorithm requires the
+*> last row, or column, of the previous panel. The first row, or column,
+*> of A is set to be the first row, or column, of an identity matrix,
+*> which is used to factorize the first panel.
+*>
+*> The resulting J-th row of U, or J-th column of L, is stored in the
+*> (J-1)-th row, or column, of A (without the unit diagonals), while
+*> the diagonal and subdiagonal of A are overwritten by those of T.
+*>
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] J1
+*> \verbatim
+*>          J1 is INTEGER
+*>          The location of the first row, or column, of the panel
+*>          within the submatrix of A, passed to this routine, e.g.,
+*>          when called by ZSYTRF_AA, for the first panel, J1 is 1,
+*>          while for the remaining panels, J1 is 2.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The dimension of the submatrix. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The dimension of the panel to be facotorized.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,M) for
+*>          the first panel, while dimension (LDA,M+1) for the
+*>          remaining panels.
+*>
+*>          On entry, A contains the last row, or column, of
+*>          the previous panel, and the trailing submatrix of A
+*>          to be factorized, except for the first panel, only
+*>          the panel is passed.
+*>
+*>          On exit, the leading panel is factorized.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the row and column interchanges,
+*>          the row and column k were interchanged with the row and
+*>          column IPIV(k).
+*> \endverbatim
+*>
+*> \param[in,out] H
+*> \verbatim
+*>          H is COMPLEX*16 workspace, dimension (LDH,NB).
+*>
+*> \endverbatim
+*>
+*> \param[in] LDH
+*> \verbatim
+*>          LDH is INTEGER
+*>          The leading dimension of the workspace H. LDH >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 workspace, dimension (M).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, D(i,i) is exactly zero.  The factorization
+*>                has been completed, but the block diagonal matrix D is
+*>                exactly singular, and division by zero will occur if it
+*>                is used to solve a system of equations.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*  =====================================================================
+      SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
+     $                         H, LDH, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+      IMPLICIT NONE
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            M, NB, J1, LDA, LDH, INFO
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), H( LDH, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*     .. Parameters ..
+      COMPLEX*16         ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+*
+*     .. Local Scalars ..
+      INTEGER            J, K, K1, I1, I2
+      COMPLEX*16         PIV, ALPHA
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            IZAMAX, ILAENV
+      EXTERNAL           LSAME, ILAENV, IZAMAX
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      J = 1
+*
+*     K1 is the first column of the panel to be factorized
+*     i.e.,  K1 is 2 for the first block column, and 1 for the rest of the blocks
+*
+      K1 = (2-J1)+1
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+*
+*        .....................................................
+*        Factorize A as U**T*D*U using the upper triangle of A
+*        .....................................................
+*
+ 10      CONTINUE
+         IF ( J.GT.MIN(M, NB) )
+     $      GO TO 20
+*
+*        K is the column to be factorized
+*         when being called from ZSYTRF_AA,
+*         > for the first block column, J1 is 1, hence J1+J-1 is J,
+*         > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
+*
+         K = J1+J-1
+*
+*        H(J:N, J) := A(J, J:N) - H(J:N, 1:(J-1)) * L(J1:(J-1), J),
+*         where H(J:N, J) has been initialized to be A(J, J:N)
+*
+         IF( K.GT.2 ) THEN
+*
+*        K is the column to be factorized
+*         > for the first block column, K is J, skipping the first two
+*           columns
+*         > for the rest of the columns, K is J+1, skipping only the
+*           first column
+*
+            CALL ZGEMV( 'No transpose', M-J+1, J-K1,
+     $                 -ONE, H( J, K1 ), LDH,
+     $                       A( 1, J ), 1,
+     $                  ONE, H( J, J ), 1 )
+         END IF
+*
+*        Copy H(i:n, i) into WORK
+*
+         CALL ZCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+*
+         IF( J.GT.K1 ) THEN
+*
+*           Compute WORK := WORK - L(J-1, J:N) * T(J-1,J),
+*            where A(J-1, J) stores T(J-1, J) and A(J-2, J:N) stores U(J-1, J:N)
+*
+            ALPHA = -A( K-1, J )
+            CALL ZAXPY( M-J+1, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
+         END IF
+*
+*        Set A(J, J) = T(J, J)
+*
+         A( K, J ) = WORK( 1 )
+*
+         IF( J.LT.M ) THEN
+*
+*           Compute WORK(2:N) = T(J, J) L(J, (J+1):N)
+*            where A(J, J) stores T(J, J) and A(J-1, (J+1):N) stores U(J, (J+1):N)
+*
+            IF( K.GT.1 ) THEN
+               ALPHA = -A( K, J )
+               CALL ZAXPY( M-J, ALPHA, A( K-1, J+1 ), LDA,
+     $                                 WORK( 2 ), 1 )
+            ENDIF
+*
+*           Find max(|WORK(2:n)|)
+*
+            I2 = IZAMAX( M-J, WORK( 2 ), 1 ) + 1
+            PIV = WORK( I2 )
+*
+*           Apply symmetric pivot
+*
+            IF( (I2.NE.2) .AND. (PIV.NE.0) ) THEN
+*
+*              Swap WORK(I1) and WORK(I2)
+*
+               I1 = 2
+               WORK( I2 ) = WORK( I1 )
+               WORK( I1 ) = PIV
+*
+*              Swap A(I1, I1+1:N) with A(I1+1:N, I2)
+*
+               I1 = I1+J-1
+               I2 = I2+J-1
+               CALL ZSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA,
+     $                              A( J1+I1, I2 ), 1 )
+*
+*              Swap A(I1, I2+1:N) with A(I2, I2+1:N)
+*
+               CALL ZSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
+     $                           A( J1+I2-1, I2+1 ), LDA )
+*
+*              Swap A(I1, I1) with A(I2,I2)
+*
+               PIV = A( I1+J1-1, I1 )
+               A( J1+I1-1, I1 ) = A( J1+I2-1, I2 )
+               A( J1+I2-1, I2 ) = PIV
+*
+*              Swap H(I1, 1:J1) with H(I2, 1:J1)
+*
+               CALL ZSWAP( I1-1, H( I1, 1 ), LDH, H( I2, 1 ), LDH )
+               IPIV( I1 ) = I2
+*
+               IF( I1.GT.(K1-1) ) THEN
+*
+*                 Swap L(1:I1-1, I1) with L(1:I1-1, I2),
+*                  skipping the first column
+*
+                  CALL ZSWAP( I1-K1+1, A( 1, I1 ), 1,
+     $                                 A( 1, I2 ), 1 )
+               END IF
+            ELSE
+               IPIV( J+1 ) = J+1
+            ENDIF
+*
+*           Set A(J, J+1) = T(J, J+1)
+*
+            A( K, J+1 ) = WORK( 2 )
+            IF( (A( K, J ).EQ.ZERO ) .AND.
+     $        ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
+                IF(INFO .EQ. 0) THEN
+                    INFO = J
+                ENDIF
+            END IF
+*
+            IF( J.LT.NB ) THEN
+*
+*              Copy A(J+1:N, J+1) into H(J:N, J),
+*
+               CALL ZCOPY( M-J, A( K+1, J+1 ), LDA,
+     $                          H( J+1, J+1 ), 1 )
+            END IF
+*
+*           Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
+*            where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+*
+            IF( A( K, J+1 ).NE.ZERO ) THEN
+               ALPHA = ONE / A( K, J+1 )
+               CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA )
+               CALL ZSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA )
+            ELSE
+               CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO,
+     $                      A( K, J+2 ), LDA)
+            END IF
+         ELSE
+            IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
+               INFO = J
+            END IF
+         END IF
+         J = J + 1
+         GO TO 10
+ 20      CONTINUE
+*
+      ELSE
+*
+*        .....................................................
+*        Factorize A as L*D*L**T using the lower triangle of A
+*        .....................................................
+*
+ 30      CONTINUE
+         IF( J.GT.MIN( M, NB ) )
+     $      GO TO 40
+*
+*        K is the column to be factorized
+*         when being called from ZSYTRF_AA,
+*         > for the first block column, J1 is 1, hence J1+J-1 is J,
+*         > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
+*
+         K = J1+J-1
+*
+*        H(J:N, J) := A(J:N, J) - H(J:N, 1:(J-1)) * L(J, J1:(J-1))^T,
+*         where H(J:N, J) has been initialized to be A(J:N, J)
+*
+         IF( K.GT.2 ) THEN
+*
+*        K is the column to be factorized
+*         > for the first block column, K is J, skipping the first two
+*           columns
+*         > for the rest of the columns, K is J+1, skipping only the
+*           first column
+*
+            CALL ZGEMV( 'No transpose', M-J+1, J-K1,
+     $                 -ONE, H( J, K1 ), LDH,
+     $                       A( J, 1 ), LDA,
+     $                  ONE, H( J, J ), 1 )
+         END IF
+*
+*        Copy H(J:N, J) into WORK
+*
+         CALL ZCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+*
+         IF( J.GT.K1 ) THEN
+*
+*           Compute WORK := WORK - L(J:N, J-1) * T(J-1,J),
+*            where A(J-1, J) = T(J-1, J) and A(J, J-2) = L(J, J-1)
+*
+            ALPHA = -A( J, K-1 )
+            CALL ZAXPY( M-J+1, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
+         END IF
+*
+*        Set A(J, J) = T(J, J)
+*
+         A( J, K ) = WORK( 1 )
+*
+         IF( J.LT.M ) THEN
+*
+*           Compute WORK(2:N) = T(J, J) L((J+1):N, J)
+*            where A(J, J) = T(J, J) and A((J+1):N, J-1) = L((J+1):N, J)
+*
+            IF( K.GT.1 ) THEN
+               ALPHA = -A( J, K )
+               CALL ZAXPY( M-J, ALPHA, A( J+1, K-1 ), 1,
+     $                                 WORK( 2 ), 1 )
+            ENDIF
+*
+*           Find max(|WORK(2:n)|)
+*
+            I2 = IZAMAX( M-J, WORK( 2 ), 1 ) + 1
+            PIV = WORK( I2 )
+*
+*           Apply symmetric pivot
+*
+            IF( (I2.NE.2) .AND. (PIV.NE.0) ) THEN
+*
+*              Swap WORK(I1) and WORK(I2)
+*
+               I1 = 2
+               WORK( I2 ) = WORK( I1 )
+               WORK( I1 ) = PIV
+*
+*              Swap A(I1+1:N, I1) with A(I2, I1+1:N)
+*
+               I1 = I1+J-1
+               I2 = I2+J-1
+               CALL ZSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1,
+     $                              A( I2, J1+I1 ), LDA )
+*
+*              Swap A(I2+1:N, I1) with A(I2+1:N, I2)
+*
+               CALL ZSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
+     $                           A( I2+1, J1+I2-1 ), 1 )
+*
+*              Swap A(I1, I1) with A(I2, I2)
+*
+               PIV = A( I1, J1+I1-1 )
+               A( I1, J1+I1-1 ) = A( I2, J1+I2-1 )
+               A( I2, J1+I2-1 ) = PIV
+*
+*              Swap H(I1, I1:J1) with H(I2, I2:J1)
+*
+               CALL ZSWAP( I1-1, H( I1, 1 ), LDH, H( I2, 1 ), LDH )
+               IPIV( I1 ) = I2
+*
+               IF( I1.GT.(K1-1) ) THEN
+*
+*                 Swap L(1:I1-1, I1) with L(1:I1-1, I2),
+*                  skipping the first column
+*
+                  CALL ZSWAP( I1-K1+1, A( I1, 1 ), LDA,
+     $                                 A( I2, 1 ), LDA )
+               END IF
+            ELSE
+               IPIV( J+1 ) = J+1
+            ENDIF
+*
+*           Set A(J+1, J) = T(J+1, J)
+*
+            A( J+1, K ) = WORK( 2 )
+            IF( (A( J, K ).EQ.ZERO) .AND.
+     $        ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
+                IF (INFO .EQ. 0)
+     $              INFO = J
+            END IF
+*
+            IF( J.LT.NB ) THEN
+*
+*              Copy A(J+1:N, J+1) into H(J+1:N, J),
+*
+               CALL ZCOPY( M-J, A( J+1, K+1 ), 1,
+     $                          H( J+1, J+1 ), 1 )
+            END IF
+*
+*           Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
+*            where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+*
+            IF( A( J+1, K ).NE.ZERO ) THEN
+               ALPHA = ONE / A( J+1, K )
+               CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 )
+               CALL ZSCAL( M-J-1, ALPHA, A( J+2, K ), 1 )
+            ELSE
+               CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO,
+     $                      A( J+2, K ), LDA )
+            END IF
+         ELSE
+            IF( (A( J, K ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
+               INFO = J
+            END IF
+         END IF
+         J = J + 1
+         GO TO 30
+ 40      CONTINUE
+      END IF
+      RETURN
+*
+*     End of ZLASYF_AA
+*
+      END
diff --git a/SRC/zlasyf_rk.f b/SRC/zlasyf_rk.f
new file mode 100644
index 00000000..391eeff6
--- /dev/null
+++ b/SRC/zlasyf_rk.f
@@ -0,0 +1,974 @@
+*> \brief \b ZLASYF_RK computes a partial factorization of a complex symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLASYF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlasyf_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlasyf_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlasyf_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, KB, LDA, LDW, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), E( * ), W( LDW, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZLASYF_RK computes a partial factorization of a complex symmetric
+*> matrix A using the bounded Bunch-Kaufman (rook) diagonal
+*> pivoting method. The partial factorization has the form:
+*>
+*> A  =  ( I  U12 ) ( A11  0  ) (  I       0    )  if UPLO = 'U', or:
+*>       ( 0  U22 ) (  0   D  ) ( U12**T U22**T )
+*>
+*> A  =  ( L11  0 ) (  D   0  ) ( L11**T L21**T )  if UPLO = 'L',
+*>       ( L21  I ) (  0  A22 ) (  0       I    )
+*>
+*> where the order of D is at most NB. The actual order is returned in
+*> the argument KB, and is either NB or NB-1, or N if N <= NB.
+*>
+*> ZLASYF_RK is an auxiliary routine called by ZSYTRF_RK. It uses
+*> blocked code (calling Level 3 BLAS) to update the submatrix
+*> A11 (if UPLO = 'U') or A22 (if UPLO = 'L').
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The maximum number of columns of the matrix A that should be
+*>          factored.  NB should be at least 2 to allow for 2-by-2 pivot
+*>          blocks.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*>          KB is INTEGER
+*>          The number of columns of A that were actually factored.
+*>          KB is either NB-1 or NB, or N if N <= NB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,N-KB+1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,N-KB+1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the submatrix A(1:N,1:KB).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the submatrix A(1:N,1:KB).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b) is always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] W
+*> \verbatim
+*>          W is COMPLEX*16 array, dimension (LDW,NB)
+*> \endverbatim
+*>
+*> \param[in] LDW
+*> \verbatim
+*>          LDW is INTEGER
+*>          The leading dimension of the array W.  LDW >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, KB, LDA, LDW, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * ), W( LDW, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      DOUBLE PRECISION   EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
+      COMPLEX*16         CONE, CZERO
+      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ),
+     $                   CZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            DONE
+      INTEGER            IMAX, ITEMP, J, JB, JJ, JMAX, K, KK, KW, KKW,
+     $                   KP, KSTEP, P, II
+      DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, ROWMAX, SFMIN, DTEMP
+      COMPLEX*16         D11, D12, D21, D22, R1, T, Z
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            IZAMAX
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           LSAME, IZAMAX, DLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZCOPY, ZGEMM, ZGEMV, ZSCAL, ZSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, DIMAG, MAX, MIN, SQRT
+*     ..
+*     .. Statement Functions ..
+      DOUBLE PRECISION   CABS1
+*     ..
+*     .. Statement Function definitions ..
+      CABS1( Z ) = ABS( DBLE( Z ) ) + ABS( DIMAG( Z ) )
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = DLAMCH( 'S' )
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+*
+*        Factorize the trailing columns of A using the upper triangle
+*        of A and working backwards, and compute the matrix W = U12*D
+*        for use in updating A11
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = CZERO
+*
+*        K is the main loop index, decreasing from N in steps of 1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        KW is the column of W which corresponds to column K of A
+*
+         KW = NB + K - N
+*
+*        Exit from loop
+*
+         IF( ( K.LE.N-NB+1 .AND. NB.LT.N ) .OR. K.LT.1 )
+     $      GO TO 30
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column KW of W and update it
+*
+         CALL ZCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 )
+         IF( K.LT.N )
+     $      CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ),
+     $                  LDA, W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 )
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = CABS1( W( K, KW ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = IZAMAX( K-1, W( 1, KW ), 1 )
+            COLMAX = CABS1( W( IMAX, KW ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            CALL ZCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           Test for interchange
+*
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   12          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*
+*                 Copy column IMAX to column KW-1 of W and update it
+*
+                  CALL ZCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 )
+                  CALL ZCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA,
+     $                        W( IMAX+1, KW-1 ), 1 )
+*
+                  IF( K.LT.N )
+     $               CALL ZGEMV( 'No transpose', K, N-K, -CONE,
+     $                           A( 1, K+1 ), LDA, W( IMAX, KW+1 ), LDW,
+     $                           CONE, W( 1, KW-1 ), 1 )
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + IZAMAX( K-IMAX, W( IMAX+1, KW-1 ),
+     $                                     1 )
+                     ROWMAX = CABS1( W( JMAX, KW-1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = IZAMAX( IMAX-1, W( 1, KW-1 ), 1 )
+                     DTEMP = CABS1( W( ITEMP, KW-1 ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for
+*                 CABS1( W( IMAX, KW-1 ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.(CABS1( W( IMAX, KW-1 ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column KW-1 of W to column KW of W
+*
+                     CALL ZCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K-1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL ZCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
+*
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 12
+*
+            END IF
+*
+*           ============================================================
+*
+            KK = K - KSTEP + 1
+*
+*           KKW is the column of W which corresponds to column KK of A
+*
+            KKW = NB + KK - N
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column K to column P
+*
+               CALL ZCOPY( K-P, A( P+1, K ), 1, A( P, P+1 ), LDA )
+               CALL ZCOPY( P, A( 1, K ), 1, A( 1, P ), 1 )
+*
+*              Interchange rows K and P in last N-K+1 columns of A
+*              and last N-K+2 columns of W
+*
+               CALL ZSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA )
+               CALL ZSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW )
+            END IF
+*
+*           Updated column KP is already stored in column KKW of W
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP
+*
+               A( KP, K ) = A( KK, K )
+               CALL ZCOPY( K-1-KP, A( KP+1, KK ), 1, A( KP, KP+1 ),
+     $                     LDA )
+               CALL ZCOPY( KP, A( 1, KK ), 1, A( 1, KP ), 1 )
+*
+*              Interchange rows KK and KP in last N-KK+1 columns
+*              of A and W
+*
+               CALL ZSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA )
+               CALL ZSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ),
+     $                     LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column KW of W now holds
+*
+*              W(k) = U(k)*D(k)
+*
+*              where U(k) is the k-th column of U
+*
+*              Store U(k) in column k of A
+*
+               CALL ZCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
+               IF( K.GT.1 ) THEN
+                  IF( CABS1( A( K, K ) ).GE.SFMIN ) THEN
+                     R1 = CONE / A( K, K )
+                     CALL ZSCAL( K-1, R1, A( 1, K ), 1 )
+                  ELSE IF( A( K, K ).NE.CZERO ) THEN
+                     DO 14 II = 1, K - 1
+                        A( II, K ) = A( II, K ) / A( K, K )
+   14                CONTINUE
+                  END IF
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns KW and KW-1 of W now
+*              hold
+*
+*              ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+               IF( K.GT.2 ) THEN
+*
+*                 Store U(k) and U(k-1) in columns k and k-1 of A
+*
+                  D12 = W( K-1, KW )
+                  D11 = W( K, KW ) / D12
+                  D22 = W( K-1, KW-1 ) / D12
+                  T = CONE / ( D11*D22-CONE )
+                  DO 20 J = 1, K - 2
+                     A( J, K-1 ) = T*( (D11*W( J, KW-1 )-W( J, KW ) ) /
+     $                             D12 )
+                     A( J, K ) = T*( ( D22*W( J, KW )-W( J, KW-1 ) ) /
+     $                           D12 )
+   20             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy superdiagonal element of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               A( K-1, K-1 ) = W( K-1, KW-1 )
+               A( K-1, K ) = CZERO
+               A( K, K ) = W( K, KW )
+               E( K ) = W( K-1, KW )
+               E( K-1 ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   30    CONTINUE
+*
+*        Update the upper triangle of A11 (= A(1:k,1:k)) as
+*
+*        A11 := A11 - U12*D*U12**T = A11 - U12*W**T
+*
+*        computing blocks of NB columns at a time
+*
+         DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB
+            JB = MIN( NB, K-J+1 )
+*
+*           Update the upper triangle of the diagonal block
+*
+            DO 40 JJ = J, J + JB - 1
+               CALL ZGEMV( 'No transpose', JJ-J+1, N-K, -CONE,
+     $                     A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE,
+     $                     A( J, JJ ), 1 )
+   40       CONTINUE
+*
+*           Update the rectangular superdiagonal block
+*
+            IF( J.GE.2 )
+     $         CALL ZGEMM( 'No transpose', 'Transpose', J-1, JB,
+     $                     N-K, -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ),
+     $                     LDW, CONE, A( 1, J ), LDA )
+   50    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = N - K
+*
+      ELSE
+*
+*        Factorize the leading columns of A using the lower triangle
+*        of A and working forwards, and compute the matrix W = L21*D
+*        for use in updating A22
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = CZERO
+*
+*        K is the main loop index, increasing from 1 in steps of 1 or 2
+*
+         K = 1
+   70   CONTINUE
+*
+*        Exit from loop
+*
+         IF( ( K.GE.NB .AND. NB.LT.N ) .OR. K.GT.N )
+     $      GO TO 90
+*
+         KSTEP = 1
+         P = K
+*
+*        Copy column K of A to column K of W and update it
+*
+         CALL ZCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 )
+         IF( K.GT.1 )
+     $      CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ),
+     $                  LDA, W( K, 1 ), LDW, CONE, W( K, K ), 1 )
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = CABS1( W( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + IZAMAX( N-K, W( K+1, K ), 1 )
+            COLMAX = CABS1( W( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+            CALL ZCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           ============================================================
+*
+*           Test for interchange
+*
+*           Equivalent to testing for ABSAKK.GE.ALPHA*COLMAX
+*           (used to handle NaN and Inf)
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   72          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*
+*                 Copy column IMAX to column K+1 of W and update it
+*
+                  CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1)
+                  CALL ZCOPY( N-IMAX+1, A( IMAX, IMAX ), 1,
+     $                        W( IMAX, K+1 ), 1 )
+                  IF( K.GT.1 )
+     $               CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE,
+     $                           A( K, 1 ), LDA, W( IMAX, 1 ), LDW,
+     $                           CONE, W( K, K+1 ), 1 )
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + IZAMAX( IMAX-K, W( K, K+1 ), 1 )
+                     ROWMAX = CABS1( W( JMAX, K+1 ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + IZAMAX( N-IMAX, W( IMAX+1, K+1 ), 1)
+                     DTEMP = CABS1( W( ITEMP, K+1 ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for
+*                 CABS1( W( IMAX, K+1 ) ).GE.ALPHA*ROWMAX
+*                 (used to handle NaN and Inf)
+*
+                  IF( .NOT.( CABS1( W( IMAX, K+1 ) ).LT.ALPHA*ROWMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+*
+*                    copy column K+1 of W to column K of W
+*
+                     CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX.EQ.COLMAX,
+*                 (used to handle NaN and Inf)
+*
+                  ELSE IF( ( P.EQ.JMAX ) .OR. ( ROWMAX.LE.COLMAX ) )
+     $            THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot not found: set params and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+*
+*                    Copy updated JMAXth (next IMAXth) column to Kth of W
+*
+                     CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
+*
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 72
+*
+            END IF
+*
+*           ============================================================
+*
+            KK = K + KSTEP - 1
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Copy non-updated column K to column P
+*
+               CALL ZCOPY( P-K, A( K, K ), 1, A( P, K ), LDA )
+               CALL ZCOPY( N-P+1, A( P, K ), 1, A( P, P ), 1 )
+*
+*              Interchange rows K and P in first K columns of A
+*              and first K+1 columns of W
+*
+               CALL ZSWAP( K, A( K, 1 ), LDA, A( P, 1 ), LDA )
+               CALL ZSWAP( KK, W( K, 1 ), LDW, W( P, 1 ), LDW )
+            END IF
+*
+*           Updated column KP is already stored in column KK of W
+*
+            IF( KP.NE.KK ) THEN
+*
+*              Copy non-updated column KK to column KP
+*
+               A( KP, K ) = A( KK, K )
+               CALL ZCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA )
+               CALL ZCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 )
+*
+*              Interchange rows KK and KP in first KK columns of A and W
+*
+               CALL ZSWAP( KK, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+               CALL ZSWAP( KK, W( KK, 1 ), LDW, W( KP, 1 ), LDW )
+            END IF
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k of W now holds
+*
+*              W(k) = L(k)*D(k)
+*
+*              where L(k) is the k-th column of L
+*
+*              Store L(k) in column k of A
+*
+               CALL ZCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
+               IF( K.LT.N ) THEN
+                  IF( CABS1( A( K, K ) ).GE.SFMIN ) THEN
+                     R1 = CONE / A( K, K )
+                     CALL ZSCAL( N-K, R1, A( K+1, K ), 1 )
+                  ELSE IF( A( K, K ).NE.CZERO ) THEN
+                     DO 74 II = K + 1, N
+                        A( II, K ) = A( II, K ) / A( K, K )
+   74                CONTINUE
+                  END IF
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 of W now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+               IF( K.LT.N-1 ) THEN
+*
+*                 Store L(k) and L(k+1) in columns k and k+1 of A
+*
+                  D21 = W( K+1, K )
+                  D11 = W( K+1, K+1 ) / D21
+                  D22 = W( K, K ) / D21
+                  T = CONE / ( D11*D22-CONE )
+                  DO 80 J = K + 2, N
+                     A( J, K ) = T*( ( D11*W( J, K )-W( J, K+1 ) ) /
+     $                           D21 )
+                     A( J, K+1 ) = T*( ( D22*W( J, K+1 )-W( J, K ) ) /
+     $                             D21 )
+   80             CONTINUE
+               END IF
+*
+*              Copy diagonal elements of D(K) to A,
+*              copy subdiagonal element of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               A( K, K ) = W( K, K )
+               A( K+1, K ) = CZERO
+               A( K+1, K+1 ) = W( K+1, K+1 )
+               E( K ) = W( K+1, K )
+               E( K+1 ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 70
+*
+   90    CONTINUE
+*
+*        Update the lower triangle of A22 (= A(k:n,k:n)) as
+*
+*        A22 := A22 - L21*D*L21**T = A22 - L21*W**T
+*
+*        computing blocks of NB columns at a time
+*
+         DO 110 J = K, N, NB
+            JB = MIN( NB, N-J+1 )
+*
+*           Update the lower triangle of the diagonal block
+*
+            DO 100 JJ = J, J + JB - 1
+               CALL ZGEMV( 'No transpose', J+JB-JJ, K-1, -CONE,
+     $                     A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE,
+     $                     A( JJ, JJ ), 1 )
+  100       CONTINUE
+*
+*           Update the rectangular subdiagonal block
+*
+            IF( J+JB.LE.N )
+     $         CALL ZGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
+     $                     K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ),
+     $                     LDW, CONE, A( J+JB, J ), LDA )
+  110    CONTINUE
+*
+*        Set KB to the number of columns factorized
+*
+         KB = K - 1
+*
+      END IF
+*
+      RETURN
+*
+*     End of ZLASYF_RK
+*
+      END
diff --git a/SRC/zsycon_3.f b/SRC/zsycon_3.f
new file mode 100644
index 00000000..e2157659
--- /dev/null
+++ b/SRC/zsycon_3.f
@@ -0,0 +1,287 @@
+*> \brief \b ZSYCON_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYCON_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsycon_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsycon_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsycon_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+*                            WORK, IWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       DOUBLE PRECISION   ANORM, RCOND
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * ), IWORK( * )
+*       COMPLEX*16         A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZSYCON_3 estimates the reciprocal of the condition number (in the
+*> 1-norm) of a complex symmetric matrix A using the factorization
+*> computed by ZSYTRF_RK or ZSYTRF_BK:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
+*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
+*> This routine uses BLAS3 solver ZSYTRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**T)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**T)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by ZSYTRF_RK and ZSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by ZSYTRF_RK or ZSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[in] ANORM
+*> \verbatim
+*>          ANORM is DOUBLE PRECISION
+*>          The 1-norm of the original matrix A.
+*> \endverbatim
+*>
+*> \param[out] RCOND
+*> \verbatim
+*>          RCOND is DOUBLE PRECISION
+*>          The reciprocal of the condition number of the matrix A,
+*>          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
+*>          estimate of the 1-norm of inv(A) computed in this routine.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (2*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
+     $                     WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+      DOUBLE PRECISION   ANORM, RCOND
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE, ZERO
+      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+      COMPLEX*16         CZERO
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, KASE
+      DOUBLE PRECISION   AINVNM
+*     ..
+*     .. Local Arrays ..
+      INTEGER            ISAVE( 3 )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZLACN2, ZSYTRS_3, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( ANORM.LT.ZERO ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYCON_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      RCOND = ZERO
+      IF( N.EQ.0 ) THEN
+         RCOND = ONE
+         RETURN
+      ELSE IF( ANORM.LE.ZERO ) THEN
+         RETURN
+      END IF
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO I = N, 1, -1
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.CZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO I = 1, N
+            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.CZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+*     Estimate the 1-norm of the inverse.
+*
+      KASE = 0
+   30 CONTINUE
+      CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
+      IF( KASE.NE.0 ) THEN
+*
+*        Multiply by inv(L*D*L**T) or inv(U*D*U**T).
+*
+         CALL ZSYTRS_3( UPLO, N, 1, A, LDA, E, IPIV, WORK, N, INFO )
+         GO TO 30
+      END IF
+*
+*     Compute the estimate of the reciprocal condition number.
+*
+      IF( AINVNM.NE.ZERO )
+     $   RCOND = ( ONE / AINVNM ) / ANORM
+*
+      RETURN
+*
+*     End of ZSYCON_3
+*
+      END
diff --git a/SRC/zsyconvf.f b/SRC/zsyconvf.f
new file mode 100644
index 00000000..4c65c0ac
--- /dev/null
+++ b/SRC/zsyconvf.f
@@ -0,0 +1,562 @@
+*> \brief \b ZSYCONVF
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYCONVF + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyconvf.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyconvf.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyconvf.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYCONVF( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO, WAY
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> If parameter WAY = 'C':
+*> ZSYCONVF converts the factorization output format used in
+*> ZSYTRF provided on entry in parameter A into the factorization
+*> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored
+*> on exit in parameters A and E. It also coverts in place details of
+*> the intechanges stored in IPIV from the format used in ZSYTRF into
+*> the format used in ZSYTRF_RK (or ZSYTRF_BK).
+*>
+*> If parameter WAY = 'R':
+*> ZSYCONVF performs the conversion in reverse direction, i.e.
+*> converts the factorization output format used in ZSYTRF_RK
+*> (or ZSYTRF_BK) provided on entry in parametes A and E into
+*> the factorization output format used in ZSYTRF that is stored
+*> on exit in parameter A. It also coverts in place details of
+*> the intechanges stored in IPIV from the format used in ZSYTRF_RK
+*> (or ZSYTRF_BK) into the format used in ZSYTRF.
+*>
+*> ZSYCONVF can also convert in Hermitian matrix case, i.e. between
+*> formats used in ZHETRF and ZHETRF_RK (or ZHETRF_BK).
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix A.
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] WAY
+*> \verbatim
+*>          WAY is CHARACTER*1
+*>          = 'C': Convert
+*>          = 'R': Revert
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, contains factorization details in format used in
+*>          ZSYTRF:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          ZSYTRF_RK or ZSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains factorization details in format used in
+*>          ZSYTRF_RK or ZSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          ZSYTRF:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, just a workspace.
+*>
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          On exit, is not changed
+*> \endverbatim
+*.
+*> \param[in,out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>          On entry, details of the interchanges and the block
+*>          structure of D in the format used in ZSYTRF.
+*>          On exit, details of the interchanges and the block
+*>          structure of D in the format used in ZSYTRF_RK
+*>          ( or ZSYTRF_BK).
+*>
+*>          1) If WAY ='R':
+*>          On entry, details of the interchanges and the block
+*>          structure of D in the format used in ZSYTRF_RK
+*>          ( or ZSYTRF_BK).
+*>          On exit, details of the interchanges and the block
+*>          structure of D in the format used in ZSYTRF.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*  =====================================================================
+      SUBROUTINE ZSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO, WAY
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*
+*     .. External Subroutines ..
+      EXTERNAL           ZSWAP, XERBLA
+*     .. Local Scalars ..
+      LOGICAL            UPPER, CONVERT
+      INTEGER            I, IP
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      CONVERT = LSAME( WAY, 'C' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYCONVF', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin A is UPPER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is upper)
+*
+*
+*           Convert VALUE
+*
+*           Assign superdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = N
+            E( 1 ) = ZERO
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  E( I ) = A( I-1, I )
+                  E( I-1 ) = ZERO
+                  A( I-1, I ) = ZERO
+                  I = I - 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I - 1
+            END DO
+*
+*           Convert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = -IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.(I-1) ) THEN
+                        CALL ZSWAP( N-I, A( I-1, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is no interchnge of rows i and and IPIV(i),
+*                 so this should be reflected in IPIV format for
+*                 *SYTRF_RK ( or *SYTRF_BK)
+*
+                  IPIV( I ) = I
+*
+                  I = I - 1
+*
+               END IF
+               I = I - 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is upper)
+*
+*
+*           Revert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in reverse factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
+*
+                  I = I + 1
+                  IP = -IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.(I-1) ) THEN
+                        CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I-1, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is one interchange of rows i-1 and IPIV(i-1),
+*                 so this should be recorded in two consecutive entries
+*                 in IPIV format for *SYTRF
+*
+                  IPIV( I ) = IPIV( I-1 )
+*
+               END IF
+               I = I + 1
+            END DO
+*
+*           Revert VALUE
+*           Assign superdiagonal entries of D from array E to
+*           superdiagonal entries of A.
+*
+            I = N
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I-1, I ) = E( I )
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*        End A is UPPER
+*
+         END IF
+*
+      ELSE
+*
+*        Begin A is LOWER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is lower)
+*
+*
+*           Convert VALUE
+*           Assign subdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = 1
+            E( N ) = ZERO
+            DO WHILE ( I.LE.N )
+               IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
+                  E( I ) = A( I+1, I )
+                  E( I+1 ) = ZERO
+                  A( I+1, I ) = ZERO
+                  I = I + 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I + 1
+            END DO
+*
+*           Convert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in factorization order where k increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = -IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.(I+1) ) THEN
+                        CALL ZSWAP( I-1, A( I+1, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is no interchnge of rows i and and IPIV(i),
+*                 so this should be reflected in IPIV format for
+*                 *SYTRF_RK ( or *SYTRF_BK)
+*
+                  IPIV( I ) = I
+*
+                  I = I + 1
+*
+               END IF
+               I = I + 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is lower)
+*
+*
+*           Revert PERMUTATIONS and IPIV
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in reverse factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
+*
+                  I = I - 1
+                  IP = -IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.(I+1) ) THEN
+                        CALL ZSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I+1, 1 ), LDA )
+                     END IF
+                  END IF
+*
+*                 Convert IPIV
+*                 There is one interchange of rows i+1 and IPIV(i+1),
+*                 so this should be recorded in consecutive entries
+*                 in IPIV format for *SYTRF
+*
+                  IPIV( I ) = IPIV( I+1 )
+*
+               END IF
+               I = I - 1
+            END DO
+*
+*           Revert VALUE
+*           Assign subdiagonal entries of D from array E to
+*           subgiagonal entries of A.
+*
+            I = 1
+            DO WHILE ( I.LE.N-1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I + 1, I ) = E( I )
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+         END IF
+*
+*        End A is LOWER
+*
+      END IF
+
+      RETURN
+*
+*     End of ZSYCONVF
+*
+      END
diff --git a/SRC/zsyconvf_rook.f b/SRC/zsyconvf_rook.f
new file mode 100644
index 00000000..36e765ef
--- /dev/null
+++ b/SRC/zsyconvf_rook.f
@@ -0,0 +1,547 @@
+*> \brief \b ZSYCONVF_ROOK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYCONVF_ROOK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyconvf_rook.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyconvf_rook.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyconvf_rook.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO, WAY
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> If parameter WAY = 'C':
+*> ZSYCONVF_ROOK converts the factorization output format used in
+*> ZSYTRF_ROOK provided on entry in parameter A into the factorization
+*> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored
+*> on exit in parameters A and E. IPIV format for ZSYTRF_ROOK and
+*> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted.
+*>
+*> If parameter WAY = 'R':
+*> ZSYCONVF_ROOK performs the conversion in reverse direction, i.e.
+*> converts the factorization output format used in ZSYTRF_RK
+*> (or ZSYTRF_BK) provided on entry in parametes A and E into
+*> the factorization output format used in ZSYTRF_ROOK that is stored
+*> on exit in parameter A. IPIV format for ZSYTRF_ROOK and
+*> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted.
+*>
+*> ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between
+*> formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK).
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix A.
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] WAY
+*> \verbatim
+*>          WAY is CHARACTER*1
+*>          = 'C': Convert
+*>          = 'R': Revert
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, contains factorization details in format used in
+*>          ZSYTRF_ROOK:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          ZSYTRF_RK or ZSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains factorization details in format used in
+*>          ZSYTRF_RK or ZSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, contains factorization details in format used in
+*>          ZSYTRF_ROOK:
+*>            a) all elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A and on superdiagonal
+*>               (or subdiagonal) of A, and
+*>            b) If UPLO = 'U': multipliers used to obtain factor U
+*>               in the superdiagonal part of A.
+*>               If UPLO = 'L': multipliers used to obtain factor L
+*>               in the superdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>
+*>          1) If WAY ='C':
+*>
+*>          On entry, just a workspace.
+*>
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          2) If WAY = 'R':
+*>
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          On exit, is not changed
+*> \endverbatim
+*.
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          On entry, details of the interchanges and the block
+*>          structure of D as determined:
+*>          1) by ZSYTRF_ROOK, if WAY ='C';
+*>          2) by ZSYTRF_RK (or ZSYTRF_BK), if WAY ='R'.
+*>          The IPIV format is the same for all these routines.
+*>
+*>          On exit, is not changed.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*  =====================================================================
+      SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO, WAY
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         ZERO
+      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*
+*     .. External Subroutines ..
+      EXTERNAL           ZSWAP, XERBLA
+*     .. Local Scalars ..
+      LOGICAL            UPPER, CONVERT
+      INTEGER            I, IP, IP2
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      CONVERT = LSAME( WAY, 'C' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYCONVF_ROOK', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin A is UPPER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is upper)
+*
+*
+*           Convert VALUE
+*
+*           Assign superdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = N
+            E( 1 ) = ZERO
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  E( I ) = A( I-1, I )
+                  E( I-1 ) = ZERO
+                  A( I-1, I ) = ZERO
+                  I = I - 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I - 1
+            END DO
+*
+*           Convert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
+*                 in A(1:i,N-i:N)
+*
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I-1 )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( N-I, A( I, I+1 ), LDA,
+     $                              A( IP, I+1 ), LDA )
+                     END IF
+                     IF( IP2.NE.(I-1) ) THEN
+                        CALL ZSWAP( N-I, A( I-1, I+1 ), LDA,
+     $                              A( IP2, I+1 ), LDA )
+                     END IF
+                  END IF
+                  I = I - 1
+*
+               END IF
+               I = I - 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is upper)
+*
+*
+*           Revert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of upper part of A
+*           in reverse factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
+*
+                  IP = IPIV( I )
+                  IF( I.LT.N ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
+*                 in A(1:i,N-i:N)
+*
+                  I = I + 1
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I-1 )
+                  IF( I.LT.N ) THEN
+                     IF( IP2.NE.(I-1) ) THEN
+                        CALL ZSWAP( N-I, A( IP2, I+1 ), LDA,
+     $                              A( I-1, I+1 ), LDA )
+                     END IF
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
+     $                              A( I, I+1 ), LDA )
+                     END IF
+                  END IF
+*
+               END IF
+               I = I + 1
+            END DO
+*
+*           Revert VALUE
+*           Assign superdiagonal entries of D from array E to
+*           superdiagonal entries of A.
+*
+            I = N
+            DO WHILE ( I.GT.1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I-1, I ) = E( I )
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*        End A is UPPER
+*
+         END IF
+*
+      ELSE
+*
+*        Begin A is LOWER
+*
+         IF ( CONVERT ) THEN
+*
+*           Convert A (A is lower)
+*
+*
+*           Convert VALUE
+*           Assign subdiagonal entries of D to array E and zero out
+*           corresponding entries in input storage A
+*
+            I = 1
+            E( N ) = ZERO
+            DO WHILE ( I.LE.N )
+               IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
+                  E( I ) = A( I+1, I )
+                  E( I+1 ) = ZERO
+                  A( I+1, I ) = ZERO
+                  I = I + 1
+               ELSE
+                  E( I ) = ZERO
+               END IF
+               I = I + 1
+            END DO
+*
+*           Convert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in factorization order where i increases from 1 to N
+*
+            I = 1
+            DO WHILE ( I.LE.N )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
+*                 in A(i:N,1:i-1)
+*
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I+1 )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( I-1, A( I, 1 ), LDA,
+     $                              A( IP, 1 ), LDA )
+                     END IF
+                     IF( IP2.NE.(I+1) ) THEN
+                        CALL ZSWAP( I-1, A( I+1, 1 ), LDA,
+     $                              A( IP2, 1 ), LDA )
+                     END IF
+                  END IF
+                  I = I + 1
+*
+               END IF
+               I = I + 1
+            END DO
+*
+         ELSE
+*
+*           Revert A (A is lower)
+*
+*
+*           Revert PERMUTATIONS
+*
+*           Apply permutaions to submatrices of lower part of A
+*           in reverse factorization order where i decreases from N to 1
+*
+            I = N
+            DO WHILE ( I.GE.1 )
+               IF( IPIV( I ).GT.0 ) THEN
+*
+*                 1-by-1 pivot interchange
+*
+*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
+*
+                  IP = IPIV( I )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               ELSE
+*
+*                 2-by-2 pivot interchange
+*
+*                 Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
+*                 in A(i:N,1:i-1)
+*
+                  I = I - 1
+                  IP = -IPIV( I )
+                  IP2 = -IPIV( I+1 )
+                  IF ( I.GT.1 ) THEN
+                     IF( IP2.NE.(I+1) ) THEN
+                        CALL ZSWAP( I-1, A( IP2, 1 ), LDA,
+     $                              A( I+1, 1 ), LDA )
+                     END IF
+                     IF( IP.NE.I ) THEN
+                        CALL ZSWAP( I-1, A( IP, 1 ), LDA,
+     $                              A( I, 1 ), LDA )
+                     END IF
+                  END IF
+*
+               END IF
+               I = I - 1
+            END DO
+*
+*           Revert VALUE
+*           Assign subdiagonal entries of D from array E to
+*           subgiagonal entries of A.
+*
+            I = 1
+            DO WHILE ( I.LE.N-1 )
+               IF( IPIV( I ).LT.0 ) THEN
+                  A( I + 1, I ) = E( I )
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+         END IF
+*
+*        End A is LOWER
+*
+      END IF
+
+      RETURN
+*
+*     End of ZSYCONVF_ROOK
+*
+      END
diff --git a/SRC/zsysv_aa.f b/SRC/zsysv_aa.f
new file mode 100644
index 00000000..6c767148
--- /dev/null
+++ b/SRC/zsysv_aa.f
@@ -0,0 +1,254 @@
+*> \brief <b> ZSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYSV_AA + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsysv_aa.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsysv_aa.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsysv_aa.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
+*                            LWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            N, NRHS, LDA, LDB, LWORK, INFO
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZSYSV computes the solution to a complex system of linear equations
+*>    A * X = B,
+*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+*> matrices.
+*>
+*> Aasen's algorithm is used to factor A as
+*>    A = U * T * U**T,  if UPLO = 'U', or
+*>    A = L * T * L**T,  if UPLO = 'L',
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is symmetric tridiagonal. The factored
+*> form of A is then used to solve the system of equations A * X = B.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of linear equations, i.e., the order of the
+*>          matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>
+*>          On exit, if INFO = 0, the tridiagonal matrix T and the
+*>          multipliers used to obtain the factor U or L from the
+*>          factorization A = U*T*U**T or A = L*T*L**T as computed by
+*>          ZSYTRF.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          On exit, it contains the details of the interchanges, i.e.,
+*>          the row and column k of A were interchanged with the
+*>          row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (LDB,NRHS)
+*>          On entry, the N-by-NRHS right hand side matrix B.
+*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >= MAX(1,2*N,3*N-2), and for
+*>          the best performance, LWORK >= MAX(1,N*NB), where NB is
+*>          the optimal blocksize for ZSYTRF_AA.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) is exactly zero.  The factorization
+*>               has been completed, but the block diagonal matrix D is
+*>               exactly singular, so the solution could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYsolve
+*
+*  =====================================================================
+      SUBROUTINE ZSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
+     $                     LWORK, INFO )
+*
+*  -- LAPACK driver routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV, LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, ZSYTRF, ZSYTRS, ZSYTRS2
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -8
+      ELSE IF( LWORK.LT.MAX(2*N, 3*N-2) .AND. .NOT.LQUERY ) THEN
+         INFO = -10
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         CALL ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
+         LWKOPT_SYTRF = INT( WORK(1) )
+         CALL ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
+     $                   -1, INFO )
+         LWKOPT_SYTRS = INT( WORK(1) )
+         LWKOPT = MAX( LWKOPT_SYTRF, LWKOPT_SYTRS )
+         WORK( 1 ) = LWKOPT
+         IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN
+            INFO = -10
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYSV_AA ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Compute the factorization A = U*T*U**T or A = L*T*L**T.
+*
+      CALL ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
+      IF( INFO.EQ.0 ) THEN
+*
+*        Solve the system A*X = B, overwriting B with X.
+*
+         CALL ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
+     $                      LWORK, INFO )
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of ZSYSV_AA
+*
+      END
diff --git a/SRC/zsysv_rk.f b/SRC/zsysv_rk.f
new file mode 100644
index 00000000..3445512f
--- /dev/null
+++ b/SRC/zsysv_rk.f
@@ -0,0 +1,317 @@
+*> \brief <b> ZSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYSV_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsysv_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsysv_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsysv_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            WORK, LWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZSYSV_RK computes the solution to a complex system of linear
+*> equations A * X = B, where A is an N-by-N symmetric matrix
+*> and X and B are N-by-NRHS matrices.
+*>
+*> The bounded Bunch-Kaufman (rook) diagonal pivoting method is used
+*> to factor A as
+*>    A = P*U*D*(U**T)*(P**T),  if UPLO = 'U', or
+*>    A = P*L*D*(L**T)*(P**T),  if UPLO = 'L',
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> ZSYTRF_RK is called to compute the factorization of a complex
+*> symmetric matrix.  The factored form of A is then used to solve
+*> the system of equations A * X = B by calling BLAS3 routine ZSYTRS_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of linear equations, i.e., the order of the
+*>          matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, if INFO = 0, diagonal of the block diagonal
+*>          matrix D and factors U or L  as computed by ZSYTRF_RK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          For more info see the description of ZSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On exit, contains the output computed by the factorization
+*>          routine ZSYTRF_RK, i.e. the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*>
+*>          For more info see the description of ZSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D,
+*>          as determined by ZSYTRF_RK.
+*>
+*>          For more info see the description of ZSYTRF_RK routine.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (LDB,NRHS)
+*>          On entry, the N-by-NRHS right hand side matrix B.
+*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension ( MAX(1,LWORK) ).
+*>          Work array used in the factorization stage.
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >= 1. For best performance
+*>          of factorization stage LWORK >= max(1,N*NB), where NB is
+*>          the optimal blocksize for ZSYTRF_RK.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array for factorization stage, returns this value as
+*>          the first entry of the WORK array, and no error message
+*>          related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYsolve
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK,
+     $                     LWORK, INFO )
+*
+*  -- LAPACK driver routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            LWKOPT
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, ZSYTRF_RK, ZSYTRS_3
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -11
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( N.EQ.0 ) THEN
+            LWKOPT = 1
+         ELSE
+            CALL ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
+            LWKOPT = WORK(1)
+         END IF
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYSV_RK ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Compute the factorization A = P*U*D*(U**T)*(P**T) or
+*     A = P*U*D*(U**T)*(P**T).
+*
+      CALL ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO )
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Solve the system A*X = B with BLAS3 solver, overwriting B with X.
+*
+         CALL ZSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO )
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of ZSYSV_RK
+*
+      END
diff --git a/SRC/zsytf2_rk.f b/SRC/zsytf2_rk.f
new file mode 100644
index 00000000..6f2649df
--- /dev/null
+++ b/SRC/zsytf2_rk.f
@@ -0,0 +1,952 @@
+*> \brief \b ZSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYTF2_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsytf2_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsytf2_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsytf2_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), E ( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZSYTF2_RK computes the factorization of a complex symmetric matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the unblocked version of the algorithm, calling Level 2 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put further details
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*>  01-01-96 - Based on modifications by
+*>    J. Lewis, Boeing Computer Services Company
+*>    A. Petitet, Computer Science Dept.,
+*>                Univ. of Tenn., Knoxville abd , USA
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      DOUBLE PRECISION   EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
+      COMPLEX*16         CONE, CZERO
+      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ),
+     $                   CZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER, DONE
+      INTEGER            I, IMAX, J, JMAX, ITEMP, K, KK, KP, KSTEP,
+     $                   P, II
+      DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, ROWMAX, DTEMP, SFMIN
+      COMPLEX*16         D11, D12, D21, D22, T, WK, WKM1, WKP1, Z
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            IZAMAX
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           LSAME, IZAMAX, DLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZSCAL, ZSWAP, ZSYR, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, SQRT, DIMAG, DBLE
+*     ..
+*     .. Statement Functions ..
+      DOUBLE PRECISION   CABS1
+*     ..
+*     .. Statement Function definitions ..
+      CABS1( Z ) = ABS( DBLE( Z ) ) + ABS( DIMAG( Z ) )
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYTF2_RK', -INFO )
+         RETURN
+      END IF
+*
+*     Initialize ALPHA for use in choosing pivot block size.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Compute machine safe minimum
+*
+      SFMIN = DLAMCH( 'S' )
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**T using the upper triangle of A
+*
+*        Initilize the first entry of array E, where superdiagonal
+*        elements of D are stored
+*
+         E( 1 ) = CZERO
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        1 or 2
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 34
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = CABS1( A( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.GT.1 ) THEN
+            IMAX = IZAMAX( K-1, A( 1, K ), 1 )
+            COLMAX = CABS1( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+*
+*           Set E( K ) to zero
+*
+            IF( K.GT.1 )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           Test for interchange
+*
+*           Equivalent to testing for (used to handle NaN and Inf)
+*           ABSAKK.GE.ALPHA*COLMAX
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange,
+*              use 1-by-1 pivot block
+*
+               KP = K
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   12          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = IMAX + IZAMAX( K-IMAX, A( IMAX, IMAX+1 ),
+     $                                    LDA )
+                     ROWMAX = CABS1( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.GT.1 ) THEN
+                     ITEMP = IZAMAX( IMAX-1, A( 1, IMAX ), 1 )
+                     DTEMP = CABS1( A( ITEMP, IMAX ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for (used to handle NaN and Inf)
+*                 ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX
+*
+                  IF( .NOT.( CABS1( A( IMAX, IMAX ) ).LT.ALPHA*ROWMAX ))
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX .EQ. COLMAX,
+*                 used to handle NaN and Inf
+*
+                  ELSE IF( ( P.EQ.JMAX ).OR.( ROWMAX.LE.COLMAX ) ) THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot NOT found, set variables and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 12
+*
+            END IF
+*
+*           Swap TWO rows and TWO columns
+*
+*           First swap
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Interchange rows and column K and P in the leading
+*              submatrix A(1:k,1:k) if we have a 2-by-2 pivot
+*
+               IF( P.GT.1 )
+     $            CALL ZSWAP( P-1, A( 1, K ), 1, A( 1, P ), 1 )
+               IF( P.LT.(K-1) )
+     $            CALL ZSWAP( K-P-1, A( P+1, K ), 1, A( P, P+1 ),
+     $                     LDA )
+               T = A( K, K )
+               A( K, K ) = A( P, P )
+               A( P, P ) = T
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL ZSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA )
+*
+            END IF
+*
+*           Second swap
+*
+            KK = K - KSTEP + 1
+            IF( KP.NE.KK ) THEN
+*
+*              Interchange rows and columns KK and KP in the leading
+*              submatrix A(1:k,1:k)
+*
+               IF( KP.GT.1 )
+     $            CALL ZSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 )
+               IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) )
+     $            CALL ZSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ),
+     $                     LDA )
+               T = A( KK, KK )
+               A( KK, KK ) = A( KP, KP )
+               A( KP, KP ) = T
+               IF( KSTEP.EQ.2 ) THEN
+                  T = A( K-1, K )
+                  A( K-1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert upper triangle of A into U form by applying
+*              the interchanges in columns k+1:N.
+*
+               IF( K.LT.N )
+     $            CALL ZSWAP( N-K, A( KK, K+1 ), LDA, A( KP, K+1 ),
+     $                        LDA )
+*
+            END IF
+*
+*           Update the leading submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k now holds
+*
+*              W(k) = U(k)*D(k)
+*
+*              where U(k) is the k-th column of U
+*
+               IF( K.GT.1 ) THEN
+*
+*                 Perform a rank-1 update of A(1:k-1,1:k-1) and
+*                 store U(k) in column k
+*
+                  IF( CABS1( A( K, K ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(1:k-1,1:k-1) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*1/D(k)*W(k)**T
+*
+                     D11 = CONE / A( K, K )
+                     CALL ZSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+*
+*                    Store U(k) in column k
+*
+                     CALL ZSCAL( K-1, D11, A( 1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column K
+*
+                     D11 = A( K, K )
+                     DO 16 II = 1, K - 1
+                        A( II, K ) = A( II, K ) / D11
+   16                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - U(k)*D(k)*U(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL ZSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA )
+                  END IF
+*
+*                 Store the superdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k-1 now hold
+*
+*              ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k)
+*
+*              where U(k) and U(k-1) are the k-th and (k-1)-th columns
+*              of U
+*
+*              Perform a rank-2 update of A(1:k-2,1:k-2) as
+*
+*              A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )**T
+*                 = A - ( ( A(k-1)A(k) )*inv(D(k)) ) * ( A(k-1)A(k) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.GT.2 ) THEN
+*
+                  D12 = A( K-1, K )
+                  D22 = A( K-1, K-1 ) / D12
+                  D11 = A( K, K ) / D12
+                  T = CONE / ( D11*D22-CONE )
+*
+                  DO 30 J = K - 2, 1, -1
+*
+                     WKM1 = T*( D11*A( J, K-1 )-A( J, K ) )
+                     WK = T*( D22*A( J, K )-A( J, K-1 ) )
+*
+                     DO 20 I = J, 1, -1
+                        A( I, J ) = A( I, J ) - (A( I, K ) / D12 )*WK -
+     $                              ( A( I, K-1 ) / D12 )*WKM1
+   20                CONTINUE
+*
+*                    Store U(k) and U(k-1) in cols k and k-1 for row J
+*
+                     A( J, K ) = WK / D12
+                     A( J, K-1 ) = WKM1 / D12
+*
+   30             CONTINUE
+*
+               END IF
+*
+*              Copy superdiagonal elements of D(K) to E(K) and
+*              ZERO out superdiagonal entry of A
+*
+               E( K ) = A( K-1, K )
+               E( K-1 ) = CZERO
+               A( K-1, K ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K-1 ) = -KP
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KSTEP
+         GO TO 10
+*
+   34    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**T using the lower triangle of A
+*
+*        Initilize the unused last entry of the subdiagonal array E.
+*
+         E( N ) = CZERO
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        1 or 2
+*
+         K = 1
+   40    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 64
+         KSTEP = 1
+         P = K
+*
+*        Determine rows and columns to be interchanged and whether
+*        a 1-by-1 or 2-by-2 pivot block will be used
+*
+         ABSAKK = CABS1( A( K, K ) )
+*
+*        IMAX is the row-index of the largest off-diagonal element in
+*        column K, and COLMAX is its absolute value.
+*        Determine both COLMAX and IMAX.
+*
+         IF( K.LT.N ) THEN
+            IMAX = K + IZAMAX( N-K, A( K+1, K ), 1 )
+            COLMAX = CABS1( A( IMAX, K ) )
+         ELSE
+            COLMAX = ZERO
+         END IF
+*
+         IF( ( MAX( ABSAKK, COLMAX ).EQ.ZERO ) ) THEN
+*
+*           Column K is zero or underflow: set INFO and continue
+*
+            IF( INFO.EQ.0 )
+     $         INFO = K
+            KP = K
+*
+*           Set E( K ) to zero
+*
+            IF( K.LT.N )
+     $         E( K ) = CZERO
+*
+         ELSE
+*
+*           Test for interchange
+*
+*           Equivalent to testing for (used to handle NaN and Inf)
+*           ABSAKK.GE.ALPHA*COLMAX
+*
+            IF( .NOT.( ABSAKK.LT.ALPHA*COLMAX ) ) THEN
+*
+*              no interchange, use 1-by-1 pivot block
+*
+               KP = K
+*
+            ELSE
+*
+               DONE = .FALSE.
+*
+*              Loop until pivot found
+*
+   42          CONTINUE
+*
+*                 Begin pivot search loop body
+*
+*                 JMAX is the column-index of the largest off-diagonal
+*                 element in row IMAX, and ROWMAX is its absolute value.
+*                 Determine both ROWMAX and JMAX.
+*
+                  IF( IMAX.NE.K ) THEN
+                     JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA )
+                     ROWMAX = CABS1( A( IMAX, JMAX ) )
+                  ELSE
+                     ROWMAX = ZERO
+                  END IF
+*
+                  IF( IMAX.LT.N ) THEN
+                     ITEMP = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ),
+     $                                     1 )
+                     DTEMP = CABS1( A( ITEMP, IMAX ) )
+                     IF( DTEMP.GT.ROWMAX ) THEN
+                        ROWMAX = DTEMP
+                        JMAX = ITEMP
+                     END IF
+                  END IF
+*
+*                 Equivalent to testing for (used to handle NaN and Inf)
+*                 ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX
+*
+                  IF( .NOT.( CABS1( A( IMAX, IMAX ) ).LT.ALPHA*ROWMAX ))
+     $            THEN
+*
+*                    interchange rows and columns K and IMAX,
+*                    use 1-by-1 pivot block
+*
+                     KP = IMAX
+                     DONE = .TRUE.
+*
+*                 Equivalent to testing for ROWMAX .EQ. COLMAX,
+*                 used to handle NaN and Inf
+*
+                  ELSE IF( ( P.EQ.JMAX ).OR.( ROWMAX.LE.COLMAX ) ) THEN
+*
+*                    interchange rows and columns K+1 and IMAX,
+*                    use 2-by-2 pivot block
+*
+                     KP = IMAX
+                     KSTEP = 2
+                     DONE = .TRUE.
+                  ELSE
+*
+*                    Pivot NOT found, set variables and repeat
+*
+                     P = IMAX
+                     COLMAX = ROWMAX
+                     IMAX = JMAX
+                  END IF
+*
+*                 End pivot search loop body
+*
+               IF( .NOT. DONE ) GOTO 42
+*
+            END IF
+*
+*           Swap TWO rows and TWO columns
+*
+*           First swap
+*
+            IF( ( KSTEP.EQ.2 ) .AND. ( P.NE.K ) ) THEN
+*
+*              Interchange rows and column K and P in the trailing
+*              submatrix A(k:n,k:n) if we have a 2-by-2 pivot
+*
+               IF( P.LT.N )
+     $            CALL ZSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 )
+               IF( P.GT.(K+1) )
+     $            CALL ZSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA )
+               T = A( K, K )
+               A( K, K ) = A( P, P )
+               A( P, P ) = T
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL ZSWAP( K-1, A( K, 1 ), LDA, A( P, 1 ), LDA )
+*
+            END IF
+*
+*           Second swap
+*
+            KK = K + KSTEP - 1
+            IF( KP.NE.KK ) THEN
+*
+*              Interchange rows and columns KK and KP in the trailing
+*              submatrix A(k:n,k:n)
+*
+               IF( KP.LT.N )
+     $            CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+               IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) )
+     $            CALL ZSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
+     $                     LDA )
+               T = A( KK, KK )
+               A( KK, KK ) = A( KP, KP )
+               A( KP, KP ) = T
+               IF( KSTEP.EQ.2 ) THEN
+                  T = A( K+1, K )
+                  A( K+1, K ) = A( KP, K )
+                  A( KP, K ) = T
+               END IF
+*
+*              Convert lower triangle of A into L form by applying
+*              the interchanges in columns 1:k-1.
+*
+               IF ( K.GT.1 )
+     $            CALL ZSWAP( K-1, A( KK, 1 ), LDA, A( KP, 1 ), LDA )
+*
+            END IF
+*
+*           Update the trailing submatrix
+*
+            IF( KSTEP.EQ.1 ) THEN
+*
+*              1-by-1 pivot block D(k): column k now holds
+*
+*              W(k) = L(k)*D(k)
+*
+*              where L(k) is the k-th column of L
+*
+               IF( K.LT.N ) THEN
+*
+*              Perform a rank-1 update of A(k+1:n,k+1:n) and
+*              store L(k) in column k
+*
+                  IF( CABS1( A( K, K ) ).GE.SFMIN ) THEN
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*
+                     D11 = CONE / A( K, K )
+                     CALL ZSYR( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+*
+*                    Store L(k) in column k
+*
+                     CALL ZSCAL( N-K, D11, A( K+1, K ), 1 )
+                  ELSE
+*
+*                    Store L(k) in column k
+*
+                     D11 = A( K, K )
+                     DO 46 II = K + 1, N
+                        A( II, K ) = A( II, K ) / D11
+   46                CONTINUE
+*
+*                    Perform a rank-1 update of A(k+1:n,k+1:n) as
+*                    A := A - L(k)*D(k)*L(k)**T
+*                       = A - W(k)*(1/D(k))*W(k)**T
+*                       = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T
+*
+                     CALL ZSYR( UPLO, N-K, -D11, A( K+1, K ), 1,
+     $                          A( K+1, K+1 ), LDA )
+                  END IF
+*
+*                 Store the subdiagonal element of D in array E
+*
+                  E( K ) = CZERO
+*
+               END IF
+*
+            ELSE
+*
+*              2-by-2 pivot block D(k): columns k and k+1 now hold
+*
+*              ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k)
+*
+*              where L(k) and L(k+1) are the k-th and (k+1)-th columns
+*              of L
+*
+*
+*              Perform a rank-2 update of A(k+2:n,k+2:n) as
+*
+*              A := A - ( L(k) L(k+1) ) * D(k) * ( L(k) L(k+1) )**T
+*                 = A - ( ( A(k)A(k+1) )*inv(D(k) ) * ( A(k)A(k+1) )**T
+*
+*              and store L(k) and L(k+1) in columns k and k+1
+*
+               IF( K.LT.N-1 ) THEN
+*
+                  D21 = A( K+1, K )
+                  D11 = A( K+1, K+1 ) / D21
+                  D22 = A( K, K ) / D21
+                  T = CONE / ( D11*D22-CONE )
+*
+                  DO 60 J = K + 2, N
+*
+*                    Compute  D21 * ( W(k)W(k+1) ) * inv(D(k)) for row J
+*
+                     WK = T*( D11*A( J, K )-A( J, K+1 ) )
+                     WKP1 = T*( D22*A( J, K+1 )-A( J, K ) )
+*
+*                    Perform a rank-2 update of A(k+2:n,k+2:n)
+*
+                     DO 50 I = J, N
+                        A( I, J ) = A( I, J ) - ( A( I, K ) / D21 )*WK -
+     $                              ( A( I, K+1 ) / D21 )*WKP1
+   50                CONTINUE
+*
+*                    Store L(k) and L(k+1) in cols k and k+1 for row J
+*
+                     A( J, K ) = WK / D21
+                     A( J, K+1 ) = WKP1 / D21
+*
+   60             CONTINUE
+*
+               END IF
+*
+*              Copy subdiagonal elements of D(K) to E(K) and
+*              ZERO out subdiagonal entry of A
+*
+               E( K ) = A( K+1, K )
+               E( K+1 ) = CZERO
+               A( K+1, K ) = CZERO
+*
+            END IF
+*
+*           End column K is nonsingular
+*
+         END IF
+*
+*        Store details of the interchanges in IPIV
+*
+         IF( KSTEP.EQ.1 ) THEN
+            IPIV( K ) = KP
+         ELSE
+            IPIV( K ) = -P
+            IPIV( K+1 ) = -KP
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KSTEP
+         GO TO 40
+*
+   64    CONTINUE
+*
+      END IF
+*
+      RETURN
+*
+*     End of ZSYTF2_RK
+*
+      END
diff --git a/SRC/zsytrf_aa.f b/SRC/zsytrf_aa.f
new file mode 100644
index 00000000..f82e5139
--- /dev/null
+++ b/SRC/zsytrf_aa.f
@@ -0,0 +1,480 @@
+*> \brief \b ZSYTRF_AA
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYTRF_AA + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsytrf_aa.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsytrf_aa.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsytrf_aa.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            N, LDA, LWORK, INFO
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), WORK( * )
+*       ..
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZSYTRF_AA computes the factorization of a complex symmetric matrix A
+*> using the Aasen's algorithm.  The form of the factorization is
+*>
+*>    A = U*T*U**T  or  A = L*T*L**T
+*>
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is a complex symmetric tridiagonal matrix.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
+*>          N-by-N upper triangular part of A contains the upper
+*>          triangular part of the matrix A, and the strictly lower
+*>          triangular part of A is not referenced.  If UPLO = 'L', the
+*>          leading N-by-N lower triangular part of A contains the lower
+*>          triangular part of the matrix A, and the strictly upper
+*>          triangular part of A is not referenced.
+*>
+*>          On exit, the tridiagonal matrix is stored in the diagonals
+*>          and the subdiagonals of A just below (or above) the diagonals,
+*>          and L is stored below (or above) the subdiaonals, when UPLO
+*>          is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          On exit, it contains the details of the interchanges, i.e.,
+*>          the row and column k of A were interchanged with the
+*>          row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK. LWORK >=MAX(1,2*N). For optimum performance
+*>          LWORK >= N*(1+NB), where NB is the optimal blocksize.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, D(i,i) is exactly zero.  The factorization
+*>                has been completed, but the block diagonal matrix D is
+*>                exactly singular, and division by zero will occur if it
+*>                is used to solve a system of equations.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*  =====================================================================
+      SUBROUTINE ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+      IMPLICIT NONE
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            N, LDA, LWORK, INFO
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*     .. Parameters ..
+      COMPLEX*16         ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            J, LWKOPT, IINFO
+      INTEGER            NB, MJ, NJ, K1, K2, J1, J2, J3, JB
+      COMPLEX*16         ALPHA
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Determine the block size
+*
+      NB = ILAENV( 1, 'ZSYTRF', UPLO, N, -1, -1, -1 )
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
+         INFO = -7
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         LWKOPT = (NB+1)*N
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYTRF_AA', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return
+*
+      IF ( N.EQ.0 ) THEN
+          RETURN
+      ENDIF
+      IPIV( 1 ) = 1
+      IF ( N.EQ.1 ) THEN
+         IF ( A( 1, 1 ).EQ.ZERO ) THEN
+            INFO = 1
+         END IF
+         RETURN
+      END IF
+*
+*     Adjubst block size based on the workspace size
+*
+      IF( LWORK.LT.((1+NB)*N) ) THEN
+         NB = ( LWORK-N ) / N
+      END IF
+*
+      IF( UPPER ) THEN
+*
+*        .....................................................
+*        Factorize A as L*D*L**T using the upper triangle of A
+*        .....................................................
+*
+*        Copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N))
+*
+         CALL ZCOPY( N, A( 1, 1 ), LDA, WORK( 1 ), 1 )
+*
+*        J is the main loop index, increasing from 1 to N in steps of
+*        JB, where JB is the number of columns factorized by ZLASYF;
+*        JB is either NB, or N-J+1 for the last block
+*
+         J = 0
+ 10      CONTINUE
+         IF( J.GE.N )
+     $      GO TO 20
+*
+*        each step of the main loop
+*         J is the last column of the previous panel
+*         J1 is the first column of the current panel
+*         K1 identifies if the previous column of the panel has been
+*          explicitly stored, e.g., K1=1 for the first panel, and
+*          K1=0 for the rest
+*
+         J1 = J + 1
+         JB = MIN( N-J1+1, NB )
+         K1 = MAX(1, J)-J
+*
+*        Panel factorization
+*
+         CALL ZLASYF_AA( UPLO, 2-K1, N-J, JB,
+     $                   A( MAX(1, J), J+1 ), LDA,
+     $                   IPIV( J+1 ), WORK, N, WORK( N*NB+1 ),
+     $                      IINFO )
+         IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
+             INFO = IINFO+J
+         ENDIF
+*
+*        Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
+*
+         DO J2 = J+2, MIN(N, J+JB+1)
+            IPIV( J2 ) = IPIV( J2 ) + J
+            IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN
+               CALL ZSWAP( J1-K1-2, A( 1, J2 ), 1,
+     $                              A( 1, IPIV(J2) ), 1 )
+            END IF
+         END DO
+         J = J + JB
+*
+*        Trailing submatrix update, where
+*         the row A(J1-1, J2-1:N) stores U(J1, J2+1:N) and
+*         WORK stores the current block of the auxiriarly matrix H
+*
+         IF( J.LT.N ) THEN
+*
+*           If first panel and JB=1 (NB=1), then nothing to do
+*
+            IF( J1.GT.1 .OR. JB.GT.1 ) THEN
+*
+*              Merge rank-1 update with BLAS-3 update
+*
+               ALPHA = A( J, J+1 )
+               A( J, J+1 ) = ONE
+               CALL ZCOPY( N-J, A( J-1, J+1 ), LDA,
+     $                          WORK( (J+1-J1+1)+JB*N ), 1 )
+               CALL ZSCAL( N-J, ALPHA, WORK( (J+1-J1+1)+JB*N ), 1 )
+*
+*              K1 identifies if the previous column of the panel has been
+*               explicitly stored, e.g., K1=1 and K2= 0 for the first panel,
+*               while K1=0 and K2=1 for the rest
+*
+               IF( J1.GT.1 ) THEN
+*
+*                 Not first panel
+*
+                  K2 = 1
+               ELSE
+*
+*                 First panel
+*
+                  K2 = 0
+*
+*                 First update skips the first column
+*
+                  JB = JB - 1
+               END IF
+*
+               DO J2 = J+1, N, NB
+                  NJ = MIN( NB, N-J2+1 )
+*
+*                 Update (J2, J2) diagonal block with ZGEMV
+*
+                  J3 = J2
+                  DO MJ = NJ-1, 1, -1
+                     CALL ZGEMV( 'No transpose', MJ, JB+1,
+     $                          -ONE, WORK( J3-J1+1+K1*N ), N,
+     $                                A( J1-K2, J3 ), 1,
+     $                           ONE, A( J3, J3 ), LDA )
+                     J3 = J3 + 1
+                  END DO
+*
+*                 Update off-diagonal block of J2-th block row with ZGEMM
+*
+                  CALL ZGEMM( 'Transpose', 'Transpose',
+     $                        NJ, N-J3+1, JB+1,
+     $                       -ONE, A( J1-K2, J2 ), LDA,
+     $                             WORK( J3-J1+1+K1*N ), N,
+     $                        ONE, A( J2, J3 ), LDA )
+               END DO
+*
+*              Recover T( J, J+1 )
+*
+               A( J, J+1 ) = ALPHA
+            END IF
+*
+*           WORK(J+1, 1) stores H(J+1, 1)
+*
+            CALL ZCOPY( N-J, A( J+1, J+1 ), LDA, WORK( 1 ), 1 )
+         END IF
+         GO TO 10
+      ELSE
+*
+*        .....................................................
+*        Factorize A as L*D*L**T using the lower triangle of A
+*        .....................................................
+*
+*        copy first column A(1:N, 1) into H(1:N, 1)
+*         (stored in WORK(1:N))
+*
+         CALL ZCOPY( N, A( 1, 1 ), 1, WORK( 1 ), 1 )
+*
+*        J is the main loop index, increasing from 1 to N in steps of
+*        JB, where JB is the number of columns factorized by ZLASYF;
+*        JB is either NB, or N-J+1 for the last block
+*
+         J = 0
+ 11      CONTINUE
+         IF( J.GE.N )
+     $      GO TO 20
+*
+*        each step of the main loop
+*         J is the last column of the previous panel
+*         J1 is the first column of the current panel
+*         K1 identifies if the previous column of the panel has been
+*          explicitly stored, e.g., K1=1 for the first panel, and
+*          K1=0 for the rest
+*
+         J1 = J+1
+         JB = MIN( N-J1+1, NB )
+         K1 = MAX(1, J)-J
+*
+*        Panel factorization
+*
+         CALL ZLASYF_AA( UPLO, 2-K1, N-J, JB,
+     $                   A( J+1, MAX(1, J) ), LDA,
+     $                   IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO)
+         IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
+            INFO = IINFO+J
+         ENDIF
+*
+*        Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
+*
+         DO J2 = J+2, MIN(N, J+JB+1)
+            IPIV( J2 ) = IPIV( J2 ) + J
+            IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN
+               CALL ZSWAP( J1-K1-2, A( J2, 1 ), LDA,
+     $                              A( IPIV(J2), 1 ), LDA )
+            END IF
+         END DO
+         J = J + JB
+*
+*        Trailing submatrix update, where
+*          A(J2+1, J1-1) stores L(J2+1, J1) and
+*          WORK(J2+1, 1) stores H(J2+1, 1)
+*
+         IF( J.LT.N ) THEN
+*
+*           if first panel and JB=1 (NB=1), then nothing to do
+*
+            IF( J1.GT.1 .OR. JB.GT.1 ) THEN
+*
+*              Merge rank-1 update with BLAS-3 update
+*
+               ALPHA = A( J+1, J )
+               A( J+1, J ) = ONE
+               CALL ZCOPY( N-J, A( J+1, J-1 ), 1,
+     $                          WORK( (J+1-J1+1)+JB*N ), 1 )
+               CALL ZSCAL( N-J, ALPHA, WORK( (J+1-J1+1)+JB*N ), 1 )
+*
+*              K1 identifies if the previous column of the panel has been
+*               explicitly stored, e.g., K1=1 and K2= 0 for the first panel,
+*               while K1=0 and K2=1 for the rest
+*
+               IF( J1.GT.1 ) THEN
+*
+*                 Not first panel
+*
+                  K2 = 1
+               ELSE
+*
+*                 First panel
+*
+                  K2 = 0
+*
+*                 First update skips the first column
+*
+                  JB = JB - 1
+               END IF
+*
+               DO J2 = J+1, N, NB
+                  NJ = MIN( NB, N-J2+1 )
+*
+*                 Update (J2, J2) diagonal block with ZGEMV
+*
+                  J3 = J2
+                  DO MJ = NJ-1, 1, -1
+                     CALL ZGEMV( 'No transpose', MJ, JB+1,
+     $                          -ONE, WORK( J3-J1+1+K1*N ), N,
+     $                                A( J3, J1-K2 ), LDA,
+     $                           ONE, A( J3, J3 ), 1 )
+                     J3 = J3 + 1
+                  END DO
+*
+*                 Update off-diagonal block in J2-th block column with ZGEMM
+*
+                  CALL ZGEMM( 'No transpose', 'Transpose',
+     $                        N-J3+1, NJ, JB+1,
+     $                       -ONE, WORK( J3-J1+1+K1*N ), N,
+     $                             A( J2, J1-K2 ), LDA,
+     $                        ONE, A( J3, J2 ), LDA )
+               END DO
+*
+*              Recover T( J+1, J )
+*
+               A( J+1, J ) = ALPHA
+            END IF
+*
+*           WORK(J+1, 1) stores H(J+1, 1)
+*
+            CALL ZCOPY( N-J, A( J+1, J+1 ), 1, WORK( 1 ), 1 )
+         END IF
+         GO TO 11
+      END IF
+*
+   20 CONTINUE
+      RETURN
+*
+*     End of ZSYTRF_AA
+*
+      END
diff --git a/SRC/zsytrf_rk.f b/SRC/zsytrf_rk.f
new file mode 100644
index 00000000..b584be58
--- /dev/null
+++ b/SRC/zsytrf_rk.f
@@ -0,0 +1,498 @@
+*> \brief \b ZSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm).
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYTRF_RK + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsytrf_rk.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsytrf_rk.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsytrf_rk.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                             INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), E ( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZSYTRF_RK computes the factorization of a complex symmetric matrix A
+*> using the bounded Bunch-Kaufman (rook) diagonal pivoting method:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> For more information see Further Details section.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the symmetric matrix A.
+*>            If UPLO = 'U': the leading N-by-N upper triangular part
+*>            of A contains the upper triangular part of the matrix A,
+*>            and the strictly lower triangular part of A is not
+*>            referenced.
+*>
+*>            If UPLO = 'L': the leading N-by-N lower triangular part
+*>            of A contains the lower triangular part of the matrix A,
+*>            and the strictly upper triangular part of A is not
+*>            referenced.
+*>
+*>          On exit, contains:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                are stored on exit in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On exit, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is set to 0 in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          IPIV describes the permutation matrix P in the factorization
+*>          of matrix A as follows. The absolute value of IPIV(k)
+*>          represents the index of row and column that were
+*>          interchanged with the k-th row and column. The value of UPLO
+*>          describes the order in which the interchanges were applied.
+*>          Also, the sign of IPIV represents the block structure of
+*>          the symmetric block diagonal matrix D with 1-by-1 or 2-by-2
+*>          diagonal blocks which correspond to 1 or 2 interchanges
+*>          at each factorization step. For more info see Further
+*>          Details section.
+*>
+*>          If UPLO = 'U',
+*>          ( in factorization order, k decreases from N to 1 ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N);
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k-1) < 0 means:
+*>               D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k-1) != k-1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k-1) = k-1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) <= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*>
+*>          If UPLO = 'L',
+*>          ( in factorization order, k increases from 1 to N ):
+*>            a) A single positive entry IPIV(k) > 0 means:
+*>               D(k,k) is a 1-by-1 diagonal block.
+*>               If IPIV(k) != k, rows and columns k and IPIV(k) were
+*>               interchanged in the matrix A(1:N,1:N).
+*>               If IPIV(k) = k, no interchange occurred.
+*>
+*>            b) A pair of consecutive negative entries
+*>               IPIV(k) < 0 and IPIV(k+1) < 0 means:
+*>               D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
+*>               (NOTE: negative entries in IPIV appear ONLY in pairs).
+*>               1) If -IPIV(k) != k, rows and columns
+*>                  k and -IPIV(k) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k) = k, no interchange occurred.
+*>               2) If -IPIV(k+1) != k+1, rows and columns
+*>                  k-1 and -IPIV(k-1) were interchanged
+*>                  in the matrix A(1:N,1:N).
+*>                  If -IPIV(k+1) = k+1, no interchange occurred.
+*>
+*>            c) In both cases a) and b), always ABS( IPIV(k) ) >= k.
+*>
+*>            d) NOTE: Any entry IPIV(k) is always NONZERO on output.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension ( MAX(1,LWORK) ).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK.  LWORK >=1.  For best performance
+*>          LWORK >= N*NB, where NB is the block size returned
+*>          by ILAENV.
+*>
+*>          If LWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the WORK
+*>          array, returns this value as the first entry of the WORK
+*>          array, and no error message related to LWORK is issued
+*>          by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>
+*>          < 0: If INFO = -k, the k-th argument had an illegal value
+*>
+*>          > 0: If INFO = k, the matrix A is singular, because:
+*>                 If UPLO = 'U': column k in the upper
+*>                 triangular part of A contains all zeros.
+*>                 If UPLO = 'L': column k in the lower
+*>                 triangular part of A contains all zeros.
+*>
+*>               Therefore D(k,k) is exactly zero, and superdiagonal
+*>               elements of column k of U (or subdiagonal elements of
+*>               column k of L ) are all zeros. The factorization has
+*>               been completed, but the block diagonal matrix D is
+*>               exactly singular, and division by zero will occur if
+*>               it is used to solve a system of equations.
+*>
+*>               NOTE: INFO only stores the first occurrence of
+*>               a singularity, any subsequent occurrence of singularity
+*>               is not stored in INFO even though the factorization
+*>               always completes.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> TODO: put correct description
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                      INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, UPPER
+      INTEGER            I, IINFO, IP, IWS, K, KB, LDWORK, LWKOPT,
+     $                   NB, NBMIN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZLASYF_RK, ZSYTF2_RK, ZSWAP, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size
+*
+         NB = ILAENV( 1, 'ZSYTRF_RK', UPLO, N, -1, -1, -1 )
+         LWKOPT = N*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYTRF_RK', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+      NBMIN = 2
+      LDWORK = N
+      IF( NB.GT.1 .AND. NB.LT.N ) THEN
+         IWS = LDWORK*NB
+         IF( LWORK.LT.IWS ) THEN
+            NB = MAX( LWORK / LDWORK, 1 )
+            NBMIN = MAX( 2, ILAENV( 2, 'ZSYTRF_RK',
+     $                              UPLO, N, -1, -1, -1 ) )
+         END IF
+      ELSE
+         IWS = 1
+      END IF
+      IF( NB.LT.NBMIN )
+     $   NB = N
+*
+      IF( UPPER ) THEN
+*
+*        Factorize A as U*D*U**T using the upper triangle of A
+*
+*        K is the main loop index, decreasing from N to 1 in steps of
+*        KB, where KB is the number of columns factorized by ZLASYF_RK;
+*        KB is either NB or NB-1, or K for the last block
+*
+         K = N
+   10    CONTINUE
+*
+*        If K < 1, exit from loop
+*
+         IF( K.LT.1 )
+     $      GO TO 15
+*
+         IF( K.GT.NB ) THEN
+*
+*           Factorize columns k-kb+1:k of A and use blocked code to
+*           update columns 1:k-kb
+*
+            CALL ZLASYF_RK( UPLO, K, NB, KB, A, LDA, E,
+     $                      IPIV, WORK, LDWORK, IINFO )
+         ELSE
+*
+*           Use unblocked code to factorize columns 1:k of A
+*
+            CALL ZSYTF2_RK( UPLO, K, A, LDA, E, IPIV, IINFO )
+            KB = K
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO
+*
+*        No need to adjust IPIV
+*
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k-kb+1:k and apply row permutations to the
+*        last k+1 colunms k+1:N after that block
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.LT.N ) THEN
+            DO I = K, ( K - KB + 1 ), -1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL ZSWAP( N-K, A( I, K+1 ), LDA,
+     $                        A( IP, K+1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Decrease K and return to the start of the main loop
+*
+         K = K - KB
+         GO TO 10
+*
+*        This label is the exit from main loop over K decreasing
+*        from N to 1 in steps of KB
+*
+   15    CONTINUE
+*
+      ELSE
+*
+*        Factorize A as L*D*L**T using the lower triangle of A
+*
+*        K is the main loop index, increasing from 1 to N in steps of
+*        KB, where KB is the number of columns factorized by ZLASYF_RK;
+*        KB is either NB or NB-1, or N-K+1 for the last block
+*
+         K = 1
+   20    CONTINUE
+*
+*        If K > N, exit from loop
+*
+         IF( K.GT.N )
+     $      GO TO 35
+*
+         IF( K.LE.N-NB ) THEN
+*
+*           Factorize columns k:k+kb-1 of A and use blocked code to
+*           update columns k+kb:n
+*
+            CALL ZLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ),
+     $                        IPIV( K ), WORK, LDWORK, IINFO )
+
+
+         ELSE
+*
+*           Use unblocked code to factorize columns k:n of A
+*
+            CALL ZSYTF2_RK( UPLO, N-K+1, A( K, K ), LDA, E( K ),
+     $                      IPIV( K ), IINFO )
+            KB = N - K + 1
+*
+         END IF
+*
+*        Set INFO on the first occurrence of a zero pivot
+*
+         IF( INFO.EQ.0 .AND. IINFO.GT.0 )
+     $      INFO = IINFO + K - 1
+*
+*        Adjust IPIV
+*
+         DO I = K, K + KB - 1
+            IF( IPIV( I ).GT.0 ) THEN
+               IPIV( I ) = IPIV( I ) + K - 1
+            ELSE
+               IPIV( I ) = IPIV( I ) - K + 1
+            END IF
+         END DO
+*
+*        Apply permutations to the leading panel 1:k-1
+*
+*        Read IPIV from the last block factored, i.e.
+*        indices  k:k+kb-1 and apply row permutations to the
+*        first k-1 colunms 1:k-1 before that block
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV( I ) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         IF( K.GT.1 ) THEN
+            DO I = K, ( K + KB - 1 ), 1
+               IP = ABS( IPIV( I ) )
+               IF( IP.NE.I ) THEN
+                  CALL ZSWAP( K-1, A( I, 1 ), LDA,
+     $                        A( IP, 1 ), LDA )
+               END IF
+            END DO
+         END IF
+*
+*        Increase K and return to the start of the main loop
+*
+         K = K + KB
+         GO TO 20
+*
+*        This label is the exit from main loop over K increasing
+*        from 1 to N in steps of KB
+*
+   35    CONTINUE
+*
+*     End Lower
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+      RETURN
+*
+*     End of ZSYTRF_RK
+*
+      END
diff --git a/SRC/zsytri_3.f b/SRC/zsytri_3.f
new file mode 100644
index 00000000..81a66ed7
--- /dev/null
+++ b/SRC/zsytri_3.f
@@ -0,0 +1,248 @@
+*> \brief \b ZSYTRI_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYTRI_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsytri_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsytri_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsytri_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LWORK, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), E( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZSYTRI_3 computes the inverse of a complex symmetric indefinite
+*> matrix A using the factorization computed by ZSYTRF_RK or ZSYTRF_BK:
+*>
+*>     A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> ZSYTRI_3 sets the leading dimension of the workspace  before calling
+*> ZSYTRI_3X that actually computes the inverse.  This is the blocked
+*> version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by ZSYTRF_RK and ZSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the symmetric inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by ZSYTRF_RK or ZSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (N+NB+1)*(NB+3).
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The length of WORK. LWORK >= (N+NB+1)*(NB+3).
+*>
+*>          If LDWORK = -1, then a workspace query is assumed;
+*>          the routine only calculates the optimal size of the optimal
+*>          size of the WORK array, returns this value as the first
+*>          entry of the WORK array, and no error message related to
+*>          LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LWORK, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            UPPER, LQUERY
+      INTEGER            LWKOPT, NB
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZSYTRI_3X
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+*     Determine the block size
+*
+      NB = MAX( 1, ILAENV( 1, 'ZSYTRI_3', UPLO, N, -1, -1, -1 ) )
+      LWKOPT = ( N+NB+1 ) * ( NB+3 )
+*
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYTRI_3', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         WORK( 1 ) = LWKOPT
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      CALL ZSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of ZSYTRI_3
+*
+      END
diff --git a/SRC/zsytri_3x.f b/SRC/zsytri_3x.f
new file mode 100644
index 00000000..f1cb1f31
--- /dev/null
+++ b/SRC/zsytri_3x.f
@@ -0,0 +1,647 @@
+*> \brief \b ZSYTRI_3X
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYTRI_3X + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsytri_3x.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsytri_3x.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsytri_3x.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, N, NB
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ),  E( * ), WORK( N+NB+1, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZSYTRI_3X computes the inverse of a complex symmetric indefinite
+*> matrix A using the factorization computed by ZSYTRF_RK or ZSYTRF_BK:
+*>
+*>     A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix.
+*>          = 'U':  Upper triangle of A is stored;
+*>          = 'L':  Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, diagonal of the block diagonal matrix D and
+*>          factors U or L as computed by ZSYTRF_RK and ZSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*>
+*>          On exit, if INFO = 0, the symmetric inverse of the original
+*>          matrix.
+*>             If UPLO = 'U': the upper triangular part of the inverse
+*>             is formed and the part of A below the diagonal is not
+*>             referenced;
+*>             If UPLO = 'L': the lower triangular part of the inverse
+*>             is formed and the part of A above the diagonal is not
+*>             referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by ZSYTRF_RK or ZSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (N+NB+1,NB+3).
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          Block size.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*>          > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
+*>               inverse could not be computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*> \par Contributors:
+*  ==================
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, N, NB
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), E( * ), WORK( N+NB+1, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         CONE, CZERO
+      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ),
+     $                     CZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            CUT, I, ICOUNT, INVD, IP, K, NNB, J, U11
+      COMPLEX*16         AK, AKKP1, AKP1, D, T, U01_I_J, U01_IP1_J,
+     $                   U11_I_J, U11_IP1_J
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZGEMM, ZSYSWAPR, ZTRTRI, ZTRMM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -4
+      END IF
+*
+*     Quick return if possible
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYTRI_3X', -INFO )
+         RETURN
+      END IF
+      IF( N.EQ.0 )
+     $   RETURN
+*
+*     Workspace got Non-diag elements of D
+*
+      DO K = 1, N
+         WORK( K, 1 ) = E( K )
+      END DO
+*
+*     Check that the diagonal matrix D is nonsingular.
+*
+      IF( UPPER ) THEN
+*
+*        Upper triangular storage: examine D from bottom to top
+*
+         DO INFO = N, 1, -1
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.CZERO )
+     $         RETURN
+         END DO
+      ELSE
+*
+*        Lower triangular storage: examine D from top to bottom.
+*
+         DO INFO = 1, N
+            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.CZERO )
+     $         RETURN
+         END DO
+      END IF
+*
+      INFO = 0
+*
+*     Splitting Workspace
+*     U01 is a block ( N, NB+1 )
+*     The first element of U01 is in WORK( 1, 1 )
+*     U11 is a block ( NB+1, NB+1 )
+*     The first element of U11 is in WORK( N+1, 1 )
+*
+      U11 = N
+*
+*     INVD is a block ( N, 2 )
+*     The first element of INVD is in WORK( 1, INVD )
+*
+      INVD = NB + 2
+
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        invA = P * inv(U**T) * inv(D) * inv(U) * P**T.
+*
+         CALL ZTRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(U)
+*
+         K = 1
+         DO WHILE( K.LE.N )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = CONE /  A( K, K )
+               WORK( K, INVD+1 ) = CZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = WORK( K+1, 1 )
+               AK = A( K, K ) / T
+               AKP1 = A( K+1, K+1 ) / T
+               AKKP1 = WORK( K+1, 1 )  / T
+               D = T*( AK*AKP1-CONE )
+               WORK( K, INVD ) = AKP1 / D
+               WORK( K+1, INVD+1 ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K+1, INVD ) = WORK( K, INVD+1 )
+               K = K + 1
+            END IF
+            K = K + 1
+         END DO
+*
+*        inv(U**T) = (inv(U))**T
+*
+*        inv(U**T) * inv(D) * inv(U)
+*
+         CUT = N
+         DO WHILE( CUT.GT.0 )
+            NNB = NB
+            IF( CUT.LE.NNB ) THEN
+               NNB = CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT+1-NNB, CUT
+                  IF( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+
+            CUT = CUT - NNB
+*
+*           U01 Block
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  WORK( I, J ) = A( I, CUT+J )
+               END DO
+            END DO
+*
+*           U11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I ) = CONE
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = CZERO
+                END DO
+                DO J = I+1, NNB
+                   WORK( U11+I, J ) = A( CUT+I, CUT+J )
+                END DO
+            END DO
+*
+*           invD * U01
+*
+            I = 1
+            DO WHILE( I.LE.CUT )
+               IF( IPIV( I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( I, INVD ) * WORK( I, J )
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK( I, J )
+                     U01_IP1_J = WORK( I+1, J )
+                     WORK( I, J ) = WORK( I, INVD ) * U01_I_J
+     $                            + WORK( I, INVD+1 ) * U01_IP1_J
+                     WORK( I+1, J ) = WORK( I+1, INVD ) * U01_I_J
+     $                              + WORK( I+1, INVD+1 ) * U01_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           invD1 * U11
+*
+            I = 1
+            DO WHILE ( I.LE.NNB )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = I, NNB
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+                  END DO
+               ELSE
+                  DO J = I, NNB
+                     U11_I_J = WORK(U11+I,J)
+                     U11_IP1_J = WORK(U11+I+1,J)
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                            + WORK(CUT+I,INVD+1) * WORK(U11+I+1,J)
+                     WORK( U11+I+1, J ) = WORK(CUT+I+1,INVD) * U11_I_J
+     $                               + WORK(CUT+I+1,INVD+1) * U11_IP1_J
+                  END DO
+                  I = I + 1
+               END IF
+               I = I + 1
+            END DO
+*
+*           U11**T * invD1 * U11 -> U11
+*
+            CALL ZTRMM( 'L', 'U', 'T', 'U', NNB, NNB,
+     $                 CONE, A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                 N+NB+1 )
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+*           U01**T * invD * U01 -> A( CUT+I, CUT+J )
+*
+            CALL ZGEMM( 'T', 'N', NNB, NNB, CUT, CONE, A( 1, CUT+1 ),
+     $                  LDA, WORK, N+NB+1, CZERO, WORK(U11+1,1),
+     $                  N+NB+1 )
+
+*
+*           U11 =  U11**T * invD1 * U11 + U01**T * invD * U01
+*
+            DO I = 1, NNB
+               DO J = I, NNB
+                  A( CUT+I, CUT+J ) = A( CUT+I, CUT+J ) + WORK(U11+I,J)
+               END DO
+            END DO
+*
+*           U01 =  U00**T * invD0 * U01
+*
+            CALL ZTRMM( 'L', UPLO, 'T', 'U', CUT, NNB,
+     $                  CONE, A, LDA, WORK, N+NB+1 )
+
+*
+*           Update U01
+*
+            DO I = 1, CUT
+               DO J = 1, NNB
+                  A( I, CUT+J ) = WORK( I, J )
+               END DO
+            END DO
+*
+*           Next Block
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(U**T) * inv(D) * inv(U) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Upper case.
+*
+*        ( We can use a loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = 1, N
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        inv A = P * inv(L**T) * inv(D) * inv(L) * P**T.
+*
+         CALL ZTRTRI( UPLO, 'U', N, A, LDA, INFO )
+*
+*        inv(D) and inv(D) * inv(L)
+*
+         K = N
+         DO WHILE ( K .GE. 1 )
+            IF( IPIV( K ).GT.0 ) THEN
+*              1 x 1 diagonal NNB
+               WORK( K, INVD ) = CONE /  A( K, K )
+               WORK( K, INVD+1 ) = CZERO
+            ELSE
+*              2 x 2 diagonal NNB
+               T = WORK( K-1, 1 )
+               AK = A( K-1, K-1 ) / T
+               AKP1 = A( K, K ) / T
+               AKKP1 = WORK( K-1, 1 ) / T
+               D = T*( AK*AKP1-CONE )
+               WORK( K-1, INVD ) = AKP1 / D
+               WORK( K, INVD ) = AK / D
+               WORK( K, INVD+1 ) = -AKKP1 / D
+               WORK( K-1, INVD+1 ) = WORK( K, INVD+1 )
+               K = K - 1
+            END IF
+            K = K - 1
+         END DO
+*
+*        inv(L**T) = (inv(L))**T
+*
+*        inv(L**T) * inv(D) * inv(L)
+*
+         CUT = 0
+         DO WHILE( CUT.LT.N )
+            NNB = NB
+            IF( (CUT + NNB).GT.N ) THEN
+               NNB = N - CUT
+            ELSE
+               ICOUNT = 0
+*              count negative elements,
+               DO I = CUT + 1, CUT+NNB
+                  IF ( IPIV( I ).LT.0 ) ICOUNT = ICOUNT + 1
+               END DO
+*              need a even number for a clear cut
+               IF( MOD( ICOUNT, 2 ).EQ.1 ) NNB = NNB + 1
+            END IF
+*
+*           L21 Block
+*
+            DO I = 1, N-CUT-NNB
+               DO J = 1, NNB
+                 WORK( I, J ) = A( CUT+NNB+I, CUT+J )
+               END DO
+            END DO
+*
+*           L11 Block
+*
+            DO I = 1, NNB
+               WORK( U11+I, I) = CONE
+               DO J = I+1, NNB
+                  WORK( U11+I, J ) = CZERO
+               END DO
+               DO J = 1, I-1
+                  WORK( U11+I, J ) = A( CUT+I, CUT+J )
+               END DO
+            END DO
+*
+*           invD*L21
+*
+            I = N-CUT-NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+NNB+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( I, J ) = WORK( CUT+NNB+I, INVD) * WORK( I, J)
+                  END DO
+               ELSE
+                  DO J = 1, NNB
+                     U01_I_J = WORK(I,J)
+                     U01_IP1_J = WORK(I-1,J)
+                     WORK(I,J)=WORK(CUT+NNB+I,INVD)*U01_I_J+
+     $                        WORK(CUT+NNB+I,INVD+1)*U01_IP1_J
+                     WORK(I-1,J)=WORK(CUT+NNB+I-1,INVD+1)*U01_I_J+
+     $                        WORK(CUT+NNB+I-1,INVD)*U01_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           invD1*L11
+*
+            I = NNB
+            DO WHILE( I.GE.1 )
+               IF( IPIV( CUT+I ).GT.0 ) THEN
+                  DO J = 1, NNB
+                     WORK( U11+I, J ) = WORK( CUT+I, INVD)*WORK(U11+I,J)
+                  END DO
+
+               ELSE
+                  DO J = 1, NNB
+                     U11_I_J = WORK( U11+I, J )
+                     U11_IP1_J = WORK( U11+I-1, J )
+                     WORK( U11+I, J ) = WORK(CUT+I,INVD) * WORK(U11+I,J)
+     $                                + WORK(CUT+I,INVD+1) * U11_IP1_J
+                     WORK( U11+I-1, J ) = WORK(CUT+I-1,INVD+1) * U11_I_J
+     $                                  + WORK(CUT+I-1,INVD) * U11_IP1_J
+                  END DO
+                  I = I - 1
+               END IF
+               I = I - 1
+            END DO
+*
+*           L11**T * invD1 * L11 -> L11
+*
+            CALL ZTRMM( 'L', UPLO, 'T', 'U', NNB, NNB, CONE,
+     $                   A( CUT+1, CUT+1 ), LDA, WORK( U11+1, 1 ),
+     $                   N+NB+1 )
+
+*
+            DO I = 1, NNB
+               DO J = 1, I
+                  A( CUT+I, CUT+J ) = WORK( U11+I, J )
+               END DO
+            END DO
+*
+            IF( (CUT+NNB).LT.N ) THEN
+*
+*              L21**T * invD2*L21 -> A( CUT+I, CUT+J )
+*
+               CALL ZGEMM( 'T', 'N', NNB, NNB, N-NNB-CUT, CONE,
+     $                     A( CUT+NNB+1, CUT+1 ), LDA, WORK, N+NB+1,
+     $                     CZERO, WORK( U11+1, 1 ), N+NB+1 )
+
+*
+*              L11 =  L11**T * invD1 * L11 + U01**T * invD * U01
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = A( CUT+I, CUT+J )+WORK(U11+I,J)
+                  END DO
+               END DO
+*
+*              L01 =  L22**T * invD2 * L21
+*
+               CALL ZTRMM( 'L', UPLO, 'T', 'U', N-NNB-CUT, NNB, CONE,
+     $                     A( CUT+NNB+1, CUT+NNB+1 ), LDA, WORK,
+     $                     N+NB+1 )
+*
+*              Update L21
+*
+               DO I = 1, N-CUT-NNB
+                  DO J = 1, NNB
+                     A( CUT+NNB+I, CUT+J ) = WORK( I, J )
+                  END DO
+               END DO
+*
+            ELSE
+*
+*              L11 =  L11**T * invD1 * L11
+*
+               DO I = 1, NNB
+                  DO J = 1, I
+                     A( CUT+I, CUT+J ) = WORK( U11+I, J )
+                  END DO
+               END DO
+            END IF
+*
+*           Next Block
+*
+            CUT = CUT + NNB
+*
+         END DO
+*
+*        Apply PERMUTATIONS P and P**T:
+*        P * inv(L**T) * inv(D) * inv(L) * P**T.
+*        Interchange rows and columns I and IPIV(I) in reverse order
+*        from the formation order of IPIV vector for Lower case.
+*
+*        ( We can use a loop over IPIV with increment -1,
+*        since the ABS value of IPIV(I) represents the row (column)
+*        index of the interchange with row (column) i in both 1x1
+*        and 2x2 pivot cases, i.e. we don't need separate code branches
+*        for 1x1 and 2x2 pivot cases )
+*
+         DO I = N, 1, -1
+             IP = ABS( IPIV( I ) )
+             IF( IP.NE.I ) THEN
+                IF (I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I ,IP )
+                IF (I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP ,I )
+             END IF
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of ZSYTRI_3X
+*
+      END
+
diff --git a/SRC/zsytrs_3.f b/SRC/zsytrs_3.f
new file mode 100644
index 00000000..45e6fbc1
--- /dev/null
+++ b/SRC/zsytrs_3.f
@@ -0,0 +1,371 @@
+*> \brief \b ZSYTRS_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYTRS_3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsytrs_3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsytrs_3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsytrs_3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+*                            INFO )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INFO, LDA, LDB, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       COMPLEX*16         A( LDA, * ), B( LDB, * ), E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> ZSYTRS_3 solves a system of linear equations A * X = B with a complex
+*> symmetric matrix A using the factorization computed
+*> by ZSYTRF_RK or ZSYTRF_BK:
+*>
+*>    A = P*U*D*(U**T)*(P**T) or A = P*L*D*(L**T)*(P**T),
+*>
+*> where U (or L) is unit upper (or lower) triangular matrix,
+*> U**T (or L**T) is the transpose of U (or L), P is a permutation
+*> matrix, P**T is the transpose of P, and D is symmetric and block
+*> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
+*>
+*> This algorithm is using Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the details of the factorization are
+*>          stored as an upper or lower triangular matrix:
+*>          = 'U':  Upper triangular, form is A = P*U*D*(U**T)*(P**T);
+*>          = 'L':  Lower triangular, form is A = P*L*D*(L**T)*(P**T).
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by ZSYTRF_RK and ZSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*>
+*>          NOTE: For 1-by-1 diagonal block D(k), where
+*>          1 <= k <= N, the element E(k) is not referenced in both
+*>          UPLO = 'U' or UPLO = 'L' cases.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          Details of the interchanges and the block structure of D
+*>          as determined by ZSYTRF_RK or ZSYTRF_BK.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (LDB,NRHS)
+*>          On entry, the right hand side matrix B.
+*>          On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16SYcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*> \verbatim
+*>
+*>  November 2016,  Igor Kozachenko,
+*>                  Computer Science Division,
+*>                  University of California, Berkeley
+*>
+*>  September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
+*>                  School of Mathematics,
+*>                  University of Manchester
+*>
+*> \endverbatim
+*
+*  =====================================================================
+      SUBROUTINE ZSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
+     $                     INFO )
+*
+*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INFO, LDA, LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER          ( ONE = ( 1.0D+0,0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            UPPER
+      INTEGER            I, J, K, KP
+      COMPLEX*16         AK, AKM1, AKM1K, BK, BKM1, DENOM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZSCAL, ZSWAP, ZTRSM, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      UPPER = LSAME( UPLO, 'U' )
+      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSYTRS_3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. NRHS.EQ.0 )
+     $   RETURN
+*
+      IF( UPPER ) THEN
+*
+*        Begin Upper
+*
+*        Solve A*X = B, where A = U*D*U**T.
+*
+*        P**T * B
+*
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]
+*
+         CALL ZTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (U \P**T * B) ]
+*
+         I = N
+         DO WHILE ( I.GE.1 )
+            IF( IPIV( I ).GT.0 ) THEN
+               CALL ZSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
+            ELSE IF ( I.GT.1 ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I-1, I-1 ) / AKM1K
+               AK = A( I, I ) / AKM1K
+               DENOM = AKM1*AK - ONE
+               DO J = 1, NRHS
+                  BKM1 = B( I-1, J ) / AKM1K
+                  BK = B( I, J ) / AKM1K
+                  B( I-1, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I - 1
+            END IF
+            I = I - 1
+         END DO
+*
+*        Compute (U**T \ B) -> B   [ U**T \ (D \ (U \P**T * B) ) ]
+*
+         CALL ZTRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (U**T \ (D \ (U \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Upper case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N, 1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+      ELSE
+*
+*        Begin Lower
+*
+*        Solve A*X = B, where A = L*D*L**T.
+*
+*        P**T * B
+*        Interchange rows K and IPIV(K) of matrix B in the same order
+*        that the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with increment 1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = 1, N, 1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]
+*
+         CALL ZTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        Compute D \ B -> B   [ D \ (L \P**T * B) ]
+*
+         I = 1
+         DO WHILE ( I.LE.N )
+            IF( IPIV( I ).GT.0 ) THEN
+               CALL ZSCAL( NRHS, ONE / A( I, I ), B( I, 1 ), LDB )
+            ELSE IF( I.LT.N ) THEN
+               AKM1K = E( I )
+               AKM1 = A( I, I ) / AKM1K
+               AK = A( I+1, I+1 ) / AKM1K
+               DENOM = AKM1*AK - ONE
+               DO  J = 1, NRHS
+                  BKM1 = B( I, J ) / AKM1K
+                  BK = B( I+1, J ) / AKM1K
+                  B( I, J ) = ( AK*BKM1-BK ) / DENOM
+                  B( I+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
+               END DO
+               I = I + 1
+            END IF
+            I = I + 1
+         END DO
+*
+*        Compute (L**T \ B) -> B   [ L**T \ (D \ (L \P**T * B) ) ]
+*
+         CALL ZTRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB )
+*
+*        P * B  [ P * (L**T \ (D \ (L \P**T * B) )) ]
+*
+*        Interchange rows K and IPIV(K) of matrix B in reverse order
+*        from the formation order of IPIV(I) vector for Lower case.
+*
+*        (We can do the simple loop over IPIV with decrement -1,
+*        since the ABS value of IPIV(I) represents the row index
+*        of the interchange with row i in both 1x1 and 2x2 pivot cases)
+*
+         DO K = N, 1, -1
+            KP = ABS( IPIV( K ) )
+            IF( KP.NE.K ) THEN
+               CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+            END IF
+         END DO
+*
+*        END Lower
+*
+      END IF
+*
+      RETURN
+*
+*     End of ZSYTRS_3
+*
+      END
diff --git a/SRC/zhetrs_aa_REMOTE_88959.f b/SRC/zsytrs_aa.f
index 6d2c73cc..cae83a76 100644
--- a/SRC/zhetrs_aa_REMOTE_88959.f
+++ b/SRC/zsytrs_aa.f
@@ -1,4 +1,4 @@
-*> \brief \b ZHETRS_AASEN
+*> \brief \b ZSYTRS_AA
 *
 *  =========== DOCUMENTATION ===========
 *
@@ -6,20 +6,20 @@
 *            http://www.netlib.org/lapack/explore-html/
 *
 *> \htmlonly
-*> Download ZHETRS_AASEN + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrs_aasen.f">
+*> Download ZSYTRS_AA + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsytrs_aa.f">
 *> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrs_aasen.f">
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsytrs_aa.f">
 *> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrs_aasen.f">
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsytrs_aa.f">
 *> [TXT]</a>
 *> \endhtmlonly
 *
 *  Definition:
 *  ===========
 *
-*       SUBROUTINE ZHETRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
-*                                WORK, LWORK, INFO )
+*       SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
+*                             WORK, LWORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
@@ -27,7 +27,7 @@
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * )
-*       COMPLEX*16   A( LDA, * ), B( LDB, * ), WORK( * )
+*       COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
 *       ..
 *
 *
@@ -36,9 +36,9 @@
 *>
 *> \verbatim
 *>
-*> ZHETRS_AASEN solves a system of linear equations A*X = B with a real
-*> hermitian matrix A using the factorization A = U*T*U**T or
-*> A = L*T*L**T computed by ZHETRF_AASEN.
+*> ZSYTRS_AA solves a system of linear equations A*X = B with a complex
+*> symmetric matrix A using the factorization A = U*T*U**T or
+*> A = L*T*L**T computed by ZSYTRF_AA.
 *> \endverbatim
 *
 *  Arguments:
@@ -69,7 +69,7 @@
 *> \param[in,out] A
 *> \verbatim
 *>          A is COMPLEX*16 array, dimension (LDA,N)
-*>          Details of factors computed by ZHETRF_AASEN.
+*>          Details of factors computed by ZSYTRF_AA.
 *> \endverbatim
 *>
 *> \param[in] LDA
@@ -81,7 +81,7 @@
 *> \param[in] IPIV
 *> \verbatim
 *>          IPIV is INTEGER array, dimension (N)
-*>          Details of the interchanges as computed by ZHETRF_AASEN.
+*>          Details of the interchanges as computed by ZSYTRF_AA.
 *> \endverbatim
 *>
 *> \param[in,out] B
@@ -104,7 +104,7 @@
 *>
 *> \param[in] LWORK
 *> \verbatim
-*>          LWORK is INTEGER, LWORK >= 3*N-2.
+*>          LWORK is INTEGER, LWORK >= MAX(1,3*N-2).
 *>
 *> \param[out] INFO
 *> \verbatim
@@ -125,13 +125,11 @@
 *
 *> \ingroup complex16SYcomputational
 *
-*  @precisions fortran z -> c
-*
 *  =====================================================================
-      SUBROUTINE ZHETRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
-     $                         WORK, LWORK, INFO )
+      SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
+     $                      WORK, LWORK, INFO )
 *
-*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK computational routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     November 2016
@@ -144,17 +142,17 @@
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * )
-      COMPLEX*16   A( LDA, * ), B( LDB, * ), WORK( * )
+      COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
 *     ..
 *
 *  =====================================================================
 *
-      COMPLEX*16   ONE
+      COMPLEX*16         ONE
       PARAMETER          ( ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            K, KP
+      LOGICAL            LQUERY, UPPER
+      INTEGER            K, KP, LWKOPT
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
@@ -170,6 +168,7 @@
 *
       INFO = 0
       UPPER = LSAME( UPLO, 'U' )
+      LQUERY = ( LWORK.EQ.-1 )
       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
@@ -180,11 +179,15 @@
          INFO = -5
       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
          INFO = -8
-      ELSE IF( LWORK.LT.(3*N-2) ) THEN
+      ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
          INFO = -10
       END IF
       IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZHETRS_AASEN', -INFO )
+         CALL XERBLA( 'ZSYTRS_AA', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         LWKOPT = (3*N-2)
+         WORK( 1 ) = LWKOPT
          RETURN
       END IF
 *
@@ -207,24 +210,23 @@
 *
 *        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]
 *
-         CALL ZTRSM('L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
+         CALL ZTRSM('L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
      $               B( 2, 1 ), LDB)
 *
 *        Compute T \ B -> B   [ T \ (U \P**T * B) ]
 *
-         CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
+         CALL ZLACPY( 'F', 1, N, A( 1, 1 ), LDA+1, WORK( N ), 1)
          IF( N.GT.1 ) THEN
-             CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1)
-             CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1)
-             CALL ZLACGV( N-1, WORK( 1 ), 1 )
+            CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1 )
+            CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1 )
          END IF
-         CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
-     $              INFO)
+         CALL ZGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, LDB,
+     $               INFO )
 *
 *        Compute (U**T \ B) -> B   [ U**T \ (T \ (U \P**T * B) ) ]
 *
          CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
-     $               B(2, 1), LDB)
+     $               B( 2, 1 ), LDB)
 *
 *        Pivot, P * B  [ P * (U**T \ (T \ (U \P**T * B) )) ]
 *
@@ -249,22 +251,21 @@
 *        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]
 *
          CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
-     $               B(2, 1), LDB)
+     $               B( 2, 1 ), LDB)
 *
 *        Compute T \ B -> B   [ T \ (L \P**T * B) ]
 *
          CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
          IF( N.GT.1 ) THEN
-             CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1)
-             CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1)
-             CALL ZLACGV( N-1, WORK( 2*N ), 1 )
+            CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1 )
+            CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1 )
          END IF
-         CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
-     $              INFO)
+         CALL ZGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, LDB,
+     $               INFO)
 *
 *        Compute (L**T \ B) -> B   [ L**T \ (T \ (L \P**T * B) ) ]
 *
-         CALL ZTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
+         CALL ZTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
      $              B( 2, 1 ), LDB)
 *
 *        Pivot, P * B  [ P * (L**T \ (T \ (L \P**T * B) )) ]
@@ -279,6 +280,6 @@
 *
       RETURN
 *
-*     End of ZHETRS_AASEN
+*     End of ZSYTRS_AA
 *
       END
diff --git a/TESTING/.DS_Store b/TESTING/.DS_Store
deleted file mode 100644
index 96586931..00000000
--- a/TESTING/.DS_Store
+++ /dev/null
diff --git a/TESTING/CMakeLists.txt b/TESTING/CMakeLists.txt
index 3cd6c4a5..ec3d8522 100644
--- a/TESTING/CMakeLists.txt
+++ b/TESTING/CMakeLists.txt
@@ -21,7 +21,7 @@ macro(add_lapack_test output input target)
   endif()
 endmacro()
 
-if (BUILD_SINGLE)
+if(BUILD_SINGLE)
 add_lapack_test(stest.out stest.in xlintsts)
 #
 # ======== SINGLE RFP LIN TESTS ========================
@@ -30,65 +30,29 @@ add_lapack_test(stest_rfp.out stest_rfp.in xlintstrfs)
 #
 # ======== SINGLE EIG TESTS ===========================
 #
-
 add_lapack_test(snep.out nep.in xeigtsts)
-
-
 add_lapack_test(ssep.out sep.in xeigtsts)
-
-
+add_lapack_test(sse2.out se2.in xeigtsts)
 add_lapack_test(ssvd.out svd.in xeigtsts)
-
-
 add_lapack_test(sec.out sec.in xeigtsts)
-
-
 add_lapack_test(sed.out sed.in xeigtsts)
-
-
 add_lapack_test(sgg.out sgg.in xeigtsts)
-
-
 add_lapack_test(sgd.out sgd.in xeigtsts)
-
-
 add_lapack_test(ssb.out ssb.in xeigtsts)
-
-
 add_lapack_test(ssg.out ssg.in xeigtsts)
-
-
 add_lapack_test(sbal.out sbal.in xeigtsts)
-
-
 add_lapack_test(sbak.out sbak.in xeigtsts)
-
-
 add_lapack_test(sgbal.out sgbal.in xeigtsts)
-
-
 add_lapack_test(sgbak.out sgbak.in xeigtsts)
-
-
 add_lapack_test(sbb.out sbb.in xeigtsts)
-
-
 add_lapack_test(sglm.out glm.in xeigtsts)
-
-
 add_lapack_test(sgqr.out gqr.in xeigtsts)
-
-
 add_lapack_test(sgsv.out gsv.in xeigtsts)
-
-
 add_lapack_test(scsd.out csd.in xeigtsts)
-
-
 add_lapack_test(slse.out lse.in xeigtsts)
 endif()
 
-if (BUILD_DOUBLE)
+if(BUILD_DOUBLE)
 #
 # ======== DOUBLE LIN TESTS ===========================
 add_lapack_test(dtest.out dtest.in xlintstd)
@@ -97,130 +61,58 @@ add_lapack_test(dtest.out dtest.in xlintstd)
 add_lapack_test(dtest_rfp.out dtest_rfp.in xlintstrfd)
 #
 # ======== DOUBLE EIG TESTS ===========================
-
 add_lapack_test(dnep.out nep.in xeigtstd)
-
-
 add_lapack_test(dsep.out sep.in xeigtstd)
-
-
+add_lapack_test(dse2.out se2.in xeigtstd)
 add_lapack_test(dsvd.out svd.in xeigtstd)
-
-
 add_lapack_test(dec.out dec.in xeigtstd)
-
-
 add_lapack_test(ded.out ded.in xeigtstd)
-
-
 add_lapack_test(dgg.out dgg.in xeigtstd)
-
-
 add_lapack_test(dgd.out dgd.in xeigtstd)
-
-
 add_lapack_test(dsb.out dsb.in xeigtstd)
-
-
 add_lapack_test(dsg.out dsg.in xeigtstd)
-
-
 add_lapack_test(dbal.out dbal.in xeigtstd)
-
-
 add_lapack_test(dbak.out dbak.in xeigtstd)
-
-
 add_lapack_test(dgbal.out dgbal.in xeigtstd)
-
-
 add_lapack_test(dgbak.out dgbak.in xeigtstd)
-
-
 add_lapack_test(dbb.out dbb.in xeigtstd)
-
-
 add_lapack_test(dglm.out glm.in xeigtstd)
-
-
 add_lapack_test(dgqr.out gqr.in xeigtstd)
-
-
 add_lapack_test(dgsv.out gsv.in xeigtstd)
-
-
 add_lapack_test(dcsd.out csd.in xeigtstd)
-
-
 add_lapack_test(dlse.out lse.in xeigtstd)
 endif()
 
-if (BUILD_COMPLEX)
+if(BUILD_COMPLEX)
 add_lapack_test(ctest.out ctest.in xlintstc)
 #
 # ======== COMPLEX RFP LIN TESTS ========================
 add_lapack_test(ctest_rfp.out ctest_rfp.in xlintstrfc)
 #
 # ======== COMPLEX EIG TESTS ===========================
-
 add_lapack_test(cnep.out nep.in xeigtstc)
-
-
 add_lapack_test(csep.out sep.in xeigtstc)
-
-
+add_lapack_test(cse2.out se2.in xeigtstc)
 add_lapack_test(csvd.out svd.in xeigtstc)
-
-
 add_lapack_test(cec.out cec.in xeigtstc)
-
-
 add_lapack_test(ced.out ced.in xeigtstc)
-
-
 add_lapack_test(cgg.out cgg.in xeigtstc)
-
-
 add_lapack_test(cgd.out cgd.in xeigtstc)
-
-
 add_lapack_test(csb.out csb.in xeigtstc)
-
-
 add_lapack_test(csg.out csg.in xeigtstc)
-
-
 add_lapack_test(cbal.out cbal.in xeigtstc)
-
-
 add_lapack_test(cbak.out cbak.in xeigtstc)
-
-
 add_lapack_test(cgbal.out cgbal.in xeigtstc)
-
-
 add_lapack_test(cgbak.out cgbak.in xeigtstc)
-
-
 add_lapack_test(cbb.out cbb.in xeigtstc)
-
-
 add_lapack_test(cglm.out glm.in xeigtstc)
-
-
 add_lapack_test(cgqr.out gqr.in xeigtstc)
-
-
 add_lapack_test(cgsv.out gsv.in xeigtstc)
-
-
 add_lapack_test(ccsd.out csd.in xeigtstc)
-
-
 add_lapack_test(clse.out lse.in xeigtstc)
 endif()
 
-if (BUILD_COMPLEX16)
+if(BUILD_COMPLEX16)
 #
 # ======== COMPLEX16 LIN TESTS ========================
 add_lapack_test(ztest.out ztest.in xlintstz)
@@ -229,80 +121,40 @@ add_lapack_test(ztest.out ztest.in xlintstz)
 add_lapack_test(ztest_rfp.out ztest_rfp.in xlintstrfz)
 #
 # ======== COMPLEX16 EIG TESTS ===========================
-
 add_lapack_test(znep.out nep.in xeigtstz)
-
-
 add_lapack_test(zsep.out sep.in xeigtstz)
-
-
+add_lapack_test(zse2.out se2.in xeigtstz)
 add_lapack_test(zsvd.out svd.in xeigtstz)
-
-
 add_lapack_test(zec.out zec.in xeigtstz)
-
-
 add_lapack_test(zed.out zed.in xeigtstz)
-
-
 add_lapack_test(zgg.out zgg.in xeigtstz)
-
-
 add_lapack_test(zgd.out zgd.in xeigtstz)
-
-
 add_lapack_test(zsb.out zsb.in xeigtstz)
-
-
 add_lapack_test(zsg.out zsg.in xeigtstz)
-
-
 add_lapack_test(zbal.out zbal.in xeigtstz)
-
-
 add_lapack_test(zbak.out zbak.in xeigtstz)
-
-
 add_lapack_test(zgbal.out zgbal.in xeigtstz)
-
-
 add_lapack_test(zgbak.out zgbak.in xeigtstz)
-
-
 add_lapack_test(zbb.out zbb.in xeigtstz)
-
-
 add_lapack_test(zglm.out glm.in xeigtstz)
-
-
 add_lapack_test(zgqr.out gqr.in xeigtstz)
-
-
 add_lapack_test(zgsv.out gsv.in xeigtstz)
-
-
 add_lapack_test(zcsd.out csd.in xeigtstz)
-
-
 add_lapack_test(zlse.out lse.in xeigtstz)
 endif()
 
 
-if (BUILD_SIMPLE)
-    if (BUILD_DOUBLE)
+if(BUILD_SINGLE AND BUILD_DOUBLE)
 #
 # ======== SINGLE-DOUBLE PROTO LIN TESTS ==============
-        add_lapack_test(dstest.out dstest.in xlintstds)
-    endif()
+  add_lapack_test(dstest.out dstest.in xlintstds)
 endif()
 
 
-if (BUILD_COMPLEX)
-    if (BUILD_COMPLEX16)
+if(BUILD_COMPLEX AND BUILD_COMPLEX16)
 #
 # ======== COMPLEX-COMPLEX16 LIN TESTS ========================
-        add_lapack_test(zctest.out zctest.in xlintstzc)
-    endif()
+  add_lapack_test(zctest.out zctest.in xlintstzc)
 endif()
 
 # ==============================================================================
@@ -310,9 +162,9 @@ endif()
 if(PYTHONINTERP_FOUND)
   message(STATUS "Running Summary")
   execute_process(COMMAND ${CMAKE_COMMAND} -E copy ${LAPACK_SOURCE_DIR}/lapack_testing.py ${LAPACK_BINARY_DIR})
-   add_test(
+  add_test(
     NAME LAPACK_Test_Summary
     WORKING_DIRECTORY ${LAPACK_BINARY_DIR}
     COMMAND ${PYTHON_EXECUTABLE} "lapack_testing.py"
-   )
+    )
 endif()
diff --git a/TESTING/EIG/CMakeLists.txt b/TESTING/EIG/CMakeLists.txt
index b6bc77d6..19fffcd4 100644
--- a/TESTING/EIG/CMakeLists.txt
+++ b/TESTING/EIG/CMakeLists.txt
@@ -43,17 +43,17 @@ set(AEIGTST
    xlaenv.f
    chkxer.f)
 
-set(SCIGTST  slafts.f slahd2.f slasum.f slatb9.f sstech.f sstect.f
+set(SCIGTST slafts.f slahd2.f slasum.f slatb9.f sstech.f sstect.f
    ssvdch.f ssvdct.f ssxt1.f)
 
-set(SEIGTST  schkee.f
+set(SEIGTST schkee.f
    sbdt01.f sbdt02.f sbdt03.f sbdt04.f sbdt05.f
    schkbb.f schkbd.f schkbk.f schkbl.f schkec.f
-   schkgg.f schkgk.f schkgl.f schkhs.f schksb.f schkst.f
+   schkgg.f schkgk.f schkgl.f schkhs.f schksb.f schkst.f schkst2stg.f schksb2stg.f
    sckcsd.f sckglm.f sckgqr.f sckgsv.f scklse.f scsdts.f
    sdrges.f sdrgev.f sdrges3.f sdrgev3.f sdrgsx.f sdrgvx.f
-   sdrvbd.f sdrves.f sdrvev.f sdrvsg.f
-   sdrvst.f sdrvsx.f sdrvvx.f
+   sdrvbd.f sdrves.f sdrvev.f sdrvsg.f sdrvsg2stg.f
+   sdrvst.f sdrvst2stg.f sdrvsx.f sdrvvx.f
    serrbd.f serrec.f serred.f serrgg.f serrhs.f serrst.f
    sget02.f sget10.f sget22.f sget23.f sget24.f sget31.f
    sget32.f sget33.f sget34.f sget35.f sget36.f
@@ -63,14 +63,14 @@ set(SEIGTST  schkee.f
    sort03.f ssbt21.f ssgt01.f sslect.f sspt21.f sstt21.f
    sstt22.f ssyt21.f ssyt22.f)
 
-set(CEIGTST  cchkee.f
+set(CEIGTST cchkee.f
    cbdt01.f cbdt02.f cbdt03.f cbdt05.f
    cchkbb.f cchkbd.f cchkbk.f cchkbl.f cchkec.f
-   cchkgg.f cchkgk.f cchkgl.f cchkhb.f cchkhs.f cchkst.f
+   cchkgg.f cchkgk.f cchkgl.f cchkhb.f cchkhs.f cchkst.f cchkst2stg.f cchkhb2stg.f
    cckcsd.f cckglm.f cckgqr.f cckgsv.f ccklse.f ccsdts.f
    cdrges.f cdrgev.f cdrges3.f cdrgev3.f cdrgsx.f cdrgvx.f
-   cdrvbd.f cdrves.f cdrvev.f cdrvsg.f
-   cdrvst.f cdrvsx.f cdrvvx.f
+   cdrvbd.f cdrves.f cdrvev.f cdrvsg.f cdrvsg2stg.f
+   cdrvst.f cdrvst2stg.f cdrvsx.f cdrvvx.f
    cerrbd.f cerrec.f cerred.f cerrgg.f cerrhs.f cerrst.f
    cget02.f cget10.f cget22.f cget23.f cget24.f
    cget35.f cget36.f cget37.f cget38.f cget51.f cget52.f
@@ -80,17 +80,17 @@ set(CEIGTST  cchkee.f
    csgt01.f cslect.f
    cstt21.f cstt22.f cunt01.f cunt03.f)
 
-set(DZIGTST  dlafts.f dlahd2.f dlasum.f dlatb9.f dstech.f dstect.f
+set(DZIGTST dlafts.f dlahd2.f dlasum.f dlatb9.f dstech.f dstect.f
    dsvdch.f dsvdct.f dsxt1.f)
 
-set(DEIGTST  dchkee.f
+set(DEIGTST dchkee.f
    dbdt01.f dbdt02.f dbdt03.f dbdt04.f dbdt05.f
    dchkbb.f dchkbd.f dchkbk.f dchkbl.f dchkec.f
-   dchkgg.f dchkgk.f dchkgl.f dchkhs.f dchksb.f dchkst.f
+   dchkgg.f dchkgk.f dchkgl.f dchkhs.f dchksb.f dchkst.f dchkst2stg.f dchksb2stg.f
    dckcsd.f dckglm.f dckgqr.f dckgsv.f dcklse.f dcsdts.f
    ddrges.f ddrgev.f ddrges3.f ddrgev3.f ddrgsx.f ddrgvx.f
-   ddrvbd.f ddrves.f ddrvev.f ddrvsg.f
-   ddrvst.f ddrvsx.f ddrvvx.f
+   ddrvbd.f ddrves.f ddrvev.f ddrvsg.f ddrvsg2stg.f
+   ddrvst.f ddrvst2stg.f ddrvsx.f ddrvvx.f
    derrbd.f derrec.f derred.f derrgg.f derrhs.f derrst.f
    dget02.f dget10.f dget22.f dget23.f dget24.f dget31.f
    dget32.f dget33.f dget34.f dget35.f dget36.f
@@ -100,14 +100,14 @@ set(DEIGTST  dchkee.f
    dort03.f dsbt21.f dsgt01.f dslect.f dspt21.f dstt21.f
    dstt22.f dsyt21.f dsyt22.f)
 
-set(ZEIGTST  zchkee.f
+set(ZEIGTST zchkee.f
    zbdt01.f zbdt02.f zbdt03.f zbdt05.f
    zchkbb.f zchkbd.f zchkbk.f zchkbl.f zchkec.f
-   zchkgg.f zchkgk.f zchkgl.f zchkhb.f zchkhs.f zchkst.f
+   zchkgg.f zchkgk.f zchkgl.f zchkhb.f zchkhs.f zchkst.f zchkst2stg.f zchkhb2stg.f
    zckcsd.f zckglm.f zckgqr.f zckgsv.f zcklse.f zcsdts.f
    zdrges.f zdrgev.f zdrges3.f zdrgev3.f zdrgsx.f zdrgvx.f
-   zdrvbd.f zdrves.f zdrvev.f zdrvsg.f
-   zdrvst.f zdrvsx.f zdrvvx.f
+   zdrvbd.f zdrves.f zdrvev.f zdrvsg.f zdrvsg2stg.f
+   zdrvst.f zdrvst2stg.f zdrvsx.f zdrvvx.f
    zerrbd.f zerrec.f zerred.f zerrgg.f zerrhs.f zerrst.f
    zget02.f zget10.f zget22.f zget23.f zget24.f
    zget35.f zget36.f zget37.f zget38.f zget51.f zget52.f
@@ -117,27 +117,27 @@ set(ZEIGTST  zchkee.f
    zsgt01.f zslect.f
    zstt21.f zstt22.f zunt01.f zunt03.f)
 
-macro(add_eig_executable name )
+macro(add_eig_executable name)
   add_executable(${name} ${ARGN})
   target_link_libraries(${name} tmglib ${LAPACK_LIBRARIES})
 endmacro()
 
-if (BUILD_SINGLE)
+if(BUILD_SINGLE)
 add_eig_executable(xeigtsts ${SEIGTST} ${SCIGTST} ${AEIGTST}
-  ${SECOND_SRC} )
+  ${SECOND_SRC})
 endif()
 
-if (BUILD_COMPLEX)
+if(BUILD_COMPLEX)
 add_eig_executable(xeigtstc ${CEIGTST} ${SCIGTST} ${AEIGTST}
-  ${SECOND_SRC} )
+  ${SECOND_SRC})
 endif()
 
-if (BUILD_DOUBLE)
+if(BUILD_DOUBLE)
 add_eig_executable(xeigtstd ${DEIGTST} ${DZIGTST} ${AEIGTST}
-  ${DSECOND_SRC} )
+  ${DSECOND_SRC})
 endif()
 
-if (BUILD_COMPLEX16)
+if(BUILD_COMPLEX16)
 add_eig_executable(xeigtstz ${ZEIGTST} ${DZIGTST} ${AEIGTST}
-  ${DSECOND_SRC} )
+  ${DSECOND_SRC})
 endif()
diff --git a/TESTING/EIG/Makefile b/TESTING/EIG/Makefile
index 6811cc2c..eef087d9 100644
--- a/TESTING/EIG/Makefile
+++ b/TESTING/EIG/Makefile
@@ -49,13 +49,13 @@ SCIGTST = slafts.o slahd2.o slasum.o slatb9.o sstech.o sstect.o \
    ssvdch.o ssvdct.o ssxt1.o
 
 SEIGTST = schkee.o \
-   sbdt01.o sbdt02.o sbdt03.o sbdt04.o sbdt05.o\
+   sbdt01.o sbdt02.o sbdt03.o sbdt04.o sbdt05.o \
    schkbb.o schkbd.o schkbk.o schkbl.o schkec.o \
-   schkgg.o schkgk.o schkgl.o schkhs.o schksb.o schkst.o \
+   schkgg.o schkgk.o schkgl.o schkhs.o schksb.o schkst.o schkst2stg.o schksb2stg.o \
    sckcsd.o sckglm.o sckgqr.o sckgsv.o scklse.o scsdts.o \
    sdrges.o sdrgev.o sdrges3.o sdrgev3.o sdrgsx.o sdrgvx.o \
-   sdrvbd.o sdrves.o sdrvev.o sdrvsg.o \
-   sdrvst.o sdrvsx.o sdrvvx.o \
+   sdrvbd.o sdrves.o sdrvev.o sdrvsg.o sdrvsg2stg.o \
+   sdrvst.o sdrvst2stg.o sdrvsx.o sdrvvx.o \
    serrbd.o serrec.o serred.o serrgg.o serrhs.o serrst.o \
    sget02.o sget10.o sget22.o sget23.o sget24.o sget31.o \
    sget32.o sget33.o sget34.o sget35.o sget36.o \
@@ -66,13 +66,13 @@ SEIGTST = schkee.o \
    sstt22.o ssyt21.o ssyt22.o
 
 CEIGTST = cchkee.o \
-   cbdt01.o cbdt02.o cbdt03.o cbdt05.o\
+   cbdt01.o cbdt02.o cbdt03.o cbdt05.o \
    cchkbb.o cchkbd.o cchkbk.o cchkbl.o cchkec.o \
-   cchkgg.o cchkgk.o cchkgl.o cchkhb.o cchkhs.o cchkst.o \
+   cchkgg.o cchkgk.o cchkgl.o cchkhb.o cchkhs.o cchkst.o cchkst2stg.o cchkhb2stg.o \
    cckcsd.o cckglm.o cckgqr.o cckgsv.o ccklse.o ccsdts.o \
    cdrges.o cdrgev.o cdrges3.o cdrgev3.o cdrgsx.o cdrgvx.o \
-   cdrvbd.o cdrves.o cdrvev.o cdrvsg.o \
-   cdrvst.o cdrvsx.o cdrvvx.o \
+   cdrvbd.o cdrves.o cdrvev.o cdrvsg.o cdrvsg2stg.o \
+   cdrvst.o cdrvst2stg.o cdrvsx.o cdrvvx.o \
    cerrbd.o cerrec.o cerred.o cerrgg.o cerrhs.o cerrst.o \
    cget02.o cget10.o cget22.o cget23.o cget24.o \
    cget35.o cget36.o cget37.o cget38.o cget51.o cget52.o \
@@ -86,13 +86,13 @@ DZIGTST = dlafts.o dlahd2.o dlasum.o dlatb9.o dstech.o dstect.o \
    dsvdch.o dsvdct.o dsxt1.o
 
 DEIGTST = dchkee.o \
-   dbdt01.o dbdt02.o dbdt03.o dbdt04.o dbdt05.o\
+   dbdt01.o dbdt02.o dbdt03.o dbdt04.o dbdt05.o \
    dchkbb.o dchkbd.o dchkbk.o dchkbl.o dchkec.o \
-   dchkgg.o dchkgk.o dchkgl.o dchkhs.o dchksb.o dchkst.o \
+   dchkgg.o dchkgk.o dchkgl.o dchkhs.o dchksb.o dchkst.o dchkst2stg.o dchksb2stg.o \
    dckcsd.o dckglm.o dckgqr.o dckgsv.o dcklse.o dcsdts.o \
    ddrges.o ddrgev.o ddrges3.o ddrgev3.o ddrgsx.o ddrgvx.o \
-   ddrvbd.o ddrves.o ddrvev.o ddrvsg.o \
-   ddrvst.o ddrvsx.o ddrvvx.o \
+   ddrvbd.o ddrves.o ddrvev.o ddrvsg.o ddrvsg2stg.o \
+   ddrvst.o ddrvst2stg.o ddrvsx.o ddrvvx.o \
    derrbd.o derrec.o derred.o derrgg.o derrhs.o derrst.o \
    dget02.o dget10.o dget22.o dget23.o dget24.o dget31.o \
    dget32.o dget33.o dget34.o dget35.o dget36.o \
@@ -103,13 +103,13 @@ DEIGTST = dchkee.o \
    dstt22.o dsyt21.o dsyt22.o
 
 ZEIGTST = zchkee.o \
-   zbdt01.o zbdt02.o zbdt03.o zbdt05.o\
+   zbdt01.o zbdt02.o zbdt03.o zbdt05.o \
    zchkbb.o zchkbd.o zchkbk.o zchkbl.o zchkec.o \
-   zchkgg.o zchkgk.o zchkgl.o zchkhb.o zchkhs.o zchkst.o \
+   zchkgg.o zchkgk.o zchkgl.o zchkhb.o zchkhs.o zchkst.o zchkst2stg.o zchkhb2stg.o \
    zckcsd.o zckglm.o zckgqr.o zckgsv.o zcklse.o zcsdts.o \
    zdrges.o zdrgev.o zdrges3.o zdrgev3.o zdrgsx.o zdrgvx.o \
-   zdrvbd.o zdrves.o zdrvev.o zdrvsg.o \
-   zdrvst.o zdrvsx.o zdrvvx.o \
+   zdrvbd.o zdrves.o zdrvev.o zdrvsg.o zdrvsg2stg.o \
+   zdrvst.o zdrvst2stg.o zdrvsx.o zdrvvx.o \
    zerrbd.o zerrec.o zerred.o zerrgg.o zerrhs.o zerrst.o \
    zget02.o zget10.o zget22.o zget23.o zget24.o \
    zget35.o zget36.o zget37.o zget38.o zget51.o zget52.o \
@@ -126,25 +126,25 @@ complex: ../xeigtstc
 double: ../xeigtstd
 complex16: ../xeigtstz
 
-../xeigtsts: $(SEIGTST) $(SCIGTST) $(AEIGTST) ../../$(LAPACKLIB); \
-          $(LOADER) $(LOADOPTS) -o xeigtsts \
-          $(SEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) \
-	  ../../$(LAPACKLIB) $(BLASLIB) && mv xeigtsts $@
+../xeigtsts: $(SEIGTST) $(SCIGTST) $(AEIGTST) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ \
+	$(SEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) \
+	../../$(LAPACKLIB) $(BLASLIB)
 
-../xeigtstc: $(CEIGTST) $(SCIGTST) $(AEIGTST) ../../$(LAPACKLIB); \
-          $(LOADER) $(LOADOPTS) -o xeigtstc \
-          $(CEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) \
-	  ../../$(LAPACKLIB) $(BLASLIB) && mv xeigtstc $@
+../xeigtstc: $(CEIGTST) $(SCIGTST) $(AEIGTST) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ \
+	$(CEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) \
+	../../$(LAPACKLIB) $(BLASLIB)
 
-../xeigtstd: $(DEIGTST) $(DZIGTST) $(AEIGTST) ../../$(LAPACKLIB); \
-          $(LOADER) $(LOADOPTS) -o xeigtstd \
-          $(DEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) \
-	  ../../$(LAPACKLIB) $(BLASLIB) && mv xeigtstd $@
+../xeigtstd: $(DEIGTST) $(DZIGTST) $(AEIGTST) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ \
+	$(DEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) \
+	../../$(LAPACKLIB) $(BLASLIB)
 
-../xeigtstz: $(ZEIGTST) $(DZIGTST) $(AEIGTST) ../../$(LAPACKLIB); \
-          $(LOADER) $(LOADOPTS) -o xeigtstz \
-          $(ZEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) \
-	  ../../$(LAPACKLIB) $(BLASLIB) && mv xeigtstz $@
+../xeigtstz: $(ZEIGTST) $(DZIGTST) $(AEIGTST) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ \
+	$(ZEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) \
+	../../$(LAPACKLIB) $(BLASLIB)
 
 $(AEIGTST): $(FRC)
 $(SCIGTST): $(FRC)
@@ -161,12 +161,13 @@ clean:
 	rm -f *.o
 
 schkee.o: schkee.f
-	$(FORTRAN) $(DRVOPTS) -c $< -o $@
+	$(FORTRAN) $(DRVOPTS) -c -o $@ $<
 dchkee.o: dchkee.f
-	$(FORTRAN) $(DRVOPTS) -c $< -o $@
+	$(FORTRAN) $(DRVOPTS) -c -o $@ $<
 cchkee.o: cchkee.f
-	$(FORTRAN) $(DRVOPTS) -c $< -o $@
+	$(FORTRAN) $(DRVOPTS) -c -o $@ $<
 zchkee.o: zchkee.f
-	$(FORTRAN) $(DRVOPTS) -c $< -o $@
+	$(FORTRAN) $(DRVOPTS) -c -o $@ $<
 
-.f.o : ; $(FORTRAN) $(OPTS) -c $< -o $@
+.f.o:
+	$(FORTRAN) $(OPTS) -c -o $@ $<
diff --git a/TESTING/EIG/cchkee.f b/TESTING/EIG/cchkee.f
index d5f3f729..2fd530f6 100644
--- a/TESTING/EIG/cchkee.f
+++ b/TESTING/EIG/cchkee.f
@@ -1102,7 +1102,8 @@
      $                   CDRGEV, CDRGSX, CDRGVX, CDRVBD, CDRVES, CDRVEV,
      $                   CDRVSG, CDRVST, CDRVSX, CDRVVX, CERRBD,
      $                   CERRED, CERRGG, CERRHS, CERRST, ILAVER, XLAENV,
-     $                   CDRGES3, CDRGEV3
+     $                   CDRGES3, CDRGEV3, 
+     $                   CCHKST2STG, CDRVST2STG, CCHKHB2STG
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          LEN, MIN
@@ -1149,7 +1150,7 @@
       PATH = LINE( 1: 3 )
       NEP = LSAMEN( 3, PATH, 'NEP' ) .OR. LSAMEN( 3, PATH, 'CHS' )
       SEP = LSAMEN( 3, PATH, 'SEP' ) .OR. LSAMEN( 3, PATH, 'CST' ) .OR.
-     $      LSAMEN( 3, PATH, 'CSG' )
+     $      LSAMEN( 3, PATH, 'CSG' ) .OR. LSAMEN( 3, PATH, 'SE2' )
       SVD = LSAMEN( 3, PATH, 'SVD' ) .OR. LSAMEN( 3, PATH, 'CBD' )
       CEV = LSAMEN( 3, PATH, 'CEV' )
       CES = LSAMEN( 3, PATH, 'CES' )
@@ -1829,7 +1830,8 @@
      $         WRITE( NOUT, FMT = 9980 )'CCHKHS', INFO
   270    CONTINUE
 *
-      ELSE IF( LSAMEN( 3, C3, 'CST' ) .OR. LSAMEN( 3, C3, 'SEP' ) ) THEN
+      ELSE IF( LSAMEN( 3, C3, 'CST' ) .OR. LSAMEN( 3, C3, 'SEP' )
+     $                                .OR. LSAMEN( 3, C3, 'SE2' ) ) THEN
 *
 *        ----------------------------------
 *        SEP:  Symmetric Eigenvalue Problem
@@ -1859,6 +1861,17 @@
             WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
      $         NXVAL( I )
             IF( TSTCHK ) THEN
+               IF( LSAMEN( 3, C3, 'SE2' ) ) THEN
+               CALL CCHKST2STG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ),
+     $                      DR( 1, 1 ), DR( 1, 2 ), DR( 1, 3 ),
+     $                      DR( 1, 4 ), DR( 1, 5 ), DR( 1, 6 ),
+     $                      DR( 1, 7 ), DR( 1, 8 ), DR( 1, 9 ),
+     $                      DR( 1, 10 ), DR( 1, 11 ), A( 1, 3 ), NMAX,
+     $                      A( 1, 4 ), A( 1, 5 ), DC( 1, 1 ), A( 1, 6 ),
+     $                      WORK, LWORK, RWORK, LWORK, IWORK, LIWORK,
+     $                      RESULT, INFO )
+               ELSE
                CALL CCHKST( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
      $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ),
      $                      DR( 1, 1 ), DR( 1, 2 ), DR( 1, 3 ),
@@ -1868,16 +1881,26 @@
      $                      A( 1, 4 ), A( 1, 5 ), DC( 1, 1 ), A( 1, 6 ),
      $                      WORK, LWORK, RWORK, LWORK, IWORK, LIWORK,
      $                      RESULT, INFO )
+               ENDIF
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'CCHKST', INFO
             END IF
             IF( TSTDRV ) THEN
+               IF( LSAMEN( 3, C3, 'SE2' ) ) THEN
+               CALL CDRVST2STG( NN, NVAL, 18, DOTYPE, ISEED, THRESH,
+     $                    NOUT, A( 1, 1 ), NMAX, DR( 1, 3 ), DR( 1, 4 ),
+     $                    DR( 1, 5 ), DR( 1, 8 ), DR( 1, 9 ),
+     $                    DR( 1, 10 ), A( 1, 2 ), NMAX, A( 1, 3 ),
+     $                    DC( 1, 1 ), A( 1, 4 ), WORK, LWORK, RWORK,
+     $                    LWORK, IWORK, LIWORK, RESULT, INFO )
+               ELSE
                CALL CDRVST( NN, NVAL, 18, DOTYPE, ISEED, THRESH, NOUT,
-     $                      A( 1, 1 ), NMAX, DR( 1, 3 ), DR( 1, 4 ),
-     $                      DR( 1, 5 ), DR( 1, 8 ), DR( 1, 9 ),
-     $                      DR( 1, 10 ), A( 1, 2 ), NMAX, A( 1, 3 ),
-     $                      DC( 1, 1 ), A( 1, 4 ), WORK, LWORK, RWORK,
-     $                      LWORK, IWORK, LIWORK, RESULT, INFO )
+     $                    A( 1, 1 ), NMAX, DR( 1, 3 ), DR( 1, 4 ),
+     $                    DR( 1, 5 ), DR( 1, 8 ), DR( 1, 9 ),
+     $                    DR( 1, 10 ), A( 1, 2 ), NMAX, A( 1, 3 ),
+     $                    DC( 1, 1 ), A( 1, 4 ), WORK, LWORK, RWORK,
+     $                    LWORK, IWORK, LIWORK, RESULT, INFO )
+           ENDIF
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'CDRVST', INFO
             END IF
@@ -1910,12 +1933,18 @@
             WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
      $         NXVAL( I )
             IF( TSTCHK ) THEN
-               CALL CDRVSG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
-     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
-     $                      DR( 1, 3 ), A( 1, 3 ), NMAX, A( 1, 4 ),
-     $                      A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), WORK,
-     $                      LWORK, RWORK, LWORK, IWORK, LIWORK, RESULT,
-     $                      INFO )
+*               CALL CDRVSG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+*     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
+*     $                      DR( 1, 3 ), A( 1, 3 ), NMAX, A( 1, 4 ),
+*     $                      A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), WORK,
+*     $                      LWORK, RWORK, LWORK, IWORK, LIWORK, RESULT,
+*     $                      INFO )
+               CALL CDRVSG2STG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+     $                          NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
+     $                          DR( 1, 3 ), DR( 1, 4 ), A( 1, 3 ), NMAX,
+     $                          A( 1, 4 ), A( 1, 5 ), A( 1, 6 ),
+     $                          A( 1, 7 ), WORK, LWORK, RWORK, LWORK,
+     $                          IWORK, LIWORK, RESULT, INFO )
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'CDRVSG', INFO
             END IF
@@ -2278,10 +2307,15 @@
          CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
          IF( TSTERR )
      $      CALL CERRST( 'CHB', NOUT )
-         CALL CCHKHB( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED, THRESH,
-     $                NOUT, A( 1, 1 ), NMAX, DR( 1, 1 ), DR( 1, 2 ),
-     $                A( 1, 2 ), NMAX, WORK, LWORK, RWORK, RESULT,
-     $                INFO )
+*         CALL CCHKHB( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+*     $                NOUT, A( 1, 1 ), NMAX, DR( 1, 1 ), DR( 1, 2 ),
+*     $                A( 1, 2 ), NMAX, WORK, LWORK, RWORK, RESULT,
+*     $                INFO )
+         CALL CCHKHB2STG( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED,
+     $                 THRESH, NOUT, A( 1, 1 ), NMAX, DR( 1, 1 ), 
+     $                 DR( 1, 2 ), DR( 1, 3 ), DR( 1, 4 ), DR( 1, 5 ),
+     $                 A( 1, 2 ), NMAX, WORK, LWORK, RWORK, RESULT, 
+     $                 INFO )
          IF( INFO.NE.0 )
      $      WRITE( NOUT, FMT = 9980 )'CCHKHB', INFO
 *
diff --git a/TESTING/EIG/cchkhb2stg.f b/TESTING/EIG/cchkhb2stg.f
new file mode 100644
index 00000000..5a7f1eda
--- /dev/null
+++ b/TESTING/EIG/cchkhb2stg.f
@@ -0,0 +1,878 @@
+*> \brief \b CCHKHBSTG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CCHKHBSTG( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE,
+*                          ISEED, THRESH, NOUNIT, A, LDA, SD, SE, D1,
+*                          D2, D3, U, LDU, WORK, LWORK, RWORK RESULT, 
+*                          INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
+*      $                   NWDTHS
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), KK( * ), NN( * )
+*       REAL               RESULT( * ), RWORK( * ), SD( * ), SE( * )
+*       COMPLEX            A( LDA, * ), U( LDU, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CCHKHBSTG tests the reduction of a Hermitian band matrix to tridiagonal
+*> from, used with the Hermitian eigenvalue problem.
+*>
+*> CHBTRD factors a Hermitian band matrix A as  U S U* , where * means
+*> conjugate transpose, S is symmetric tridiagonal, and U is unitary.
+*> CHBTRD can use either just the lower or just the upper triangle
+*> of A; CCHKHBSTG checks both cases.
+*>
+*> CHETRD_HB2ST factors a Hermitian band matrix A as  U S U* , 
+*> where * means conjugate transpose, S is symmetric tridiagonal, and U is
+*> unitary. CHETRD_HB2ST can use either just the lower or just
+*> the upper triangle of A; CCHKHBSTG checks both cases.
+*>
+*> DSTEQR factors S as  Z D1 Z'.  
+*> D1 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of DSBTRD "U" (used as reference for DSYTRD_SB2ST)
+*> D2 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of DSYTRD_SB2ST "U".
+*> D3 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of DSYTRD_SB2ST "L".
+*>
+*> When CCHKHBSTG is called, a number of matrix "sizes" ("n's"), a number
+*> of bandwidths ("k's"), and a number of matrix "types" are
+*> specified.  For each size ("n"), each bandwidth ("k") less than or
+*> equal to "n", and each type of matrix, one matrix will be generated
+*> and used to test the hermitian banded reduction routine.  For each
+*> matrix, a number of tests will be performed:
+*>
+*> (1)     | A - V S V* | / ( |A| n ulp )  computed by CHBTRD with
+*>                                         UPLO='U'
+*>
+*> (2)     | I - UU* | / ( n ulp )
+*>
+*> (3)     | A - V S V* | / ( |A| n ulp )  computed by CHBTRD with
+*>                                         UPLO='L'
+*>
+*> (4)     | I - UU* | / ( n ulp )
+*>
+*> (5)     | D1 - D2 | / ( |D1| ulp )      where D1 is computed by
+*>                                         DSBTRD with UPLO='U' and
+*>                                         D2 is computed by
+*>                                         CHETRD_HB2ST with UPLO='U'
+*>
+*> (6)     | D1 - D3 | / ( |D1| ulp )      where D1 is computed by
+*>                                         DSBTRD with UPLO='U' and
+*>                                         D3 is computed by
+*>                                         CHETRD_HB2ST with UPLO='L'
+*>
+*> The "sizes" are specified by an array NN(1:NSIZES); the value of
+*> each element NN(j) specifies one size.
+*> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*> Currently, the list of possible types is:
+*>
+*> (1)  The zero matrix.
+*> (2)  The identity matrix.
+*>
+*> (3)  A diagonal matrix with evenly spaced entries
+*>      1, ..., ULP  and random signs.
+*>      (ULP = (first number larger than 1) - 1 )
+*> (4)  A diagonal matrix with geometrically spaced entries
+*>      1, ..., ULP  and random signs.
+*> (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>      and random signs.
+*>
+*> (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*> (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*> (8)  A matrix of the form  U* D U, where U is unitary and
+*>      D has evenly spaced entries 1, ..., ULP with random signs
+*>      on the diagonal.
+*>
+*> (9)  A matrix of the form  U* D U, where U is unitary and
+*>      D has geometrically spaced entries 1, ..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (10) A matrix of the form  U* D U, where U is unitary and
+*>      D has "clustered" entries 1, ULP,..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*> (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*> (13) Hermitian matrix with random entries chosen from (-1,1).
+*> (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*> (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] NSIZES
+*> \verbatim
+*>          NSIZES is INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          CCHKHBSTG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*> \endverbatim
+*>
+*> \param[in] NWDTHS
+*> \verbatim
+*>          NWDTHS is INTEGER
+*>          The number of bandwidths to use.  If it is zero,
+*>          CCHKHBSTG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] KK
+*> \verbatim
+*>          KK is INTEGER array, dimension (NWDTHS)
+*>          An array containing the bandwidths to be used for the band
+*>          matrices.  The values must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NTYPES
+*> \verbatim
+*>          NTYPES is INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, CCHKHBSTG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*> \endverbatim
+*>
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*> \endverbatim
+*>
+*> \param[in,out] ISEED
+*> \verbatim
+*>          ISEED is INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to CCHKHBSTG to continue the same random number
+*>          sequence.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NOUNIT
+*> \verbatim
+*>          NOUNIT is INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension
+*>                            (LDA, max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of A.  It must be at least 2 (not 1!)
+*>          and at least max( KK )+1.
+*> \endverbatim
+*>
+*> \param[out] SD
+*> \verbatim
+*>          SD is REAL array, dimension (max(NN))
+*>          Used to hold the diagonal of the tridiagonal matrix computed
+*>          by CHBTRD.
+*> \endverbatim
+*>
+*> \param[out] SE
+*> \verbatim
+*>          SE is REAL array, dimension (max(NN))
+*>          Used to hold the off-diagonal of the tridiagonal matrix
+*>          computed by CHBTRD.
+*> \endverbatim
+*>
+*> \param[out] U
+*> \verbatim
+*>          U is COMPLEX array, dimension (LDU, max(NN))
+*>          Used to hold the unitary matrix computed by CHBTRD.
+*> \endverbatim
+*>
+*> \param[in] LDU
+*> \verbatim
+*>          LDU is INTEGER
+*>          The leading dimension of U.  It must be at least 1
+*>          and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (LWORK)
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          max( LDA+1, max(NN)+1 )*max(NN).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array
+*> \endverbatim
+*>
+*> \param[out] RESULT
+*> \verbatim
+*>          RESULT is REAL array, dimension (4)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          If 0, then everything ran OK.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far.
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex_eig
+*
+*  =====================================================================
+      SUBROUTINE CCHKHB2STG( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE,
+     $                   ISEED, THRESH, NOUNIT, A, LDA, SD, SE, D1,
+     $                   D2, D3, U, LDU, WORK, LWORK, RWORK, RESULT, 
+     $                   INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
+     $                   NWDTHS
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), KK( * ), NN( * )
+      REAL               RESULT( * ), RWORK( * ), SD( * ), SE( * ),
+     $                   D1( * ), D2( * ), D3( * )
+      COMPLEX            A( LDA, * ), U( LDU, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX            CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   CONE = ( 1.0E+0, 0.0E+0 ) )
+      REAL               ZERO, ONE, TWO, TEN
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
+     $                   TEN = 10.0E+0 )
+      REAL               HALF
+      PARAMETER          ( HALF = ONE / TWO )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 15 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN, BADNNB
+      INTEGER            I, IINFO, IMODE, ITYPE, J, JC, JCOL, JR, JSIZE,
+     $                   JTYPE, JWIDTH, K, KMAX, LH, LW, MTYPES, N,
+     $                   NERRS, NMATS, NMAX, NTEST, NTESTT
+      REAL               ANINV, ANORM, COND, OVFL, RTOVFL, RTUNFL,
+     $                   TEMP1, TEMP2, TEMP3, TEMP4, ULP, ULPINV, UNFL
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ),
+     $                   KMODE( MAXTYP ), KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      REAL               SLAMCH
+      EXTERNAL           SLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLASUM, XERBLA, CHBT21, CHBTRD, CLACPY, CLASET,
+     $                   CLATMR, CLATMS, CHBTRD_HB2ST, CSTEQR
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, REAL, CONJG, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0 /
+*     ..
+*     .. Executable Statements ..
+*
+*     Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+*     Important constants
+*
+      BADNN = .FALSE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+      BADNNB = .FALSE.
+      KMAX = 0
+      DO 20 J = 1, NSIZES
+         KMAX = MAX( KMAX, KK( J ) )
+         IF( KK( J ).LT.0 )
+     $      BADNNB = .TRUE.
+   20 CONTINUE
+      KMAX = MIN( NMAX-1, KMAX )
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NWDTHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( BADNNB ) THEN
+         INFO = -4
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDA.LT.KMAX+1 ) THEN
+         INFO = -11
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -15
+      ELSE IF( ( MAX( LDA, NMAX )+1 )*NMAX.GT.LWORK ) THEN
+         INFO = -17
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CCHKHBSTG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 .OR. NWDTHS.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = SLAMCH( 'Safe minimum' )
+      OVFL = ONE / UNFL
+      ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      NERRS = 0
+      NMATS = 0
+*
+      DO 190 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         ANINV = ONE / REAL( MAX( 1, N ) )
+*
+         DO 180 JWIDTH = 1, NWDTHS
+            K = KK( JWIDTH )
+            IF( K.GT.N )
+     $         GO TO 180
+            K = MAX( 0, MIN( N-1, K ) )
+*
+            IF( NSIZES.NE.1 ) THEN
+               MTYPES = MIN( MAXTYP, NTYPES )
+            ELSE
+               MTYPES = MIN( MAXTYP+1, NTYPES )
+            END IF
+*
+            DO 170 JTYPE = 1, MTYPES
+               IF( .NOT.DOTYPE( JTYPE ) )
+     $            GO TO 170
+               NMATS = NMATS + 1
+               NTEST = 0
+*
+               DO 30 J = 1, 4
+                  IOLDSD( J ) = ISEED( J )
+   30          CONTINUE
+*
+*              Compute "A".
+*              Store as "Upper"; later, we will copy to other format.
+*
+*              Control parameters:
+*
+*                  KMAGN  KMODE        KTYPE
+*              =1  O(1)   clustered 1  zero
+*              =2  large  clustered 2  identity
+*              =3  small  exponential  (none)
+*              =4         arithmetic   diagonal, (w/ eigenvalues)
+*              =5         random log   hermitian, w/ eigenvalues
+*              =6         random       (none)
+*              =7                      random diagonal
+*              =8                      random hermitian
+*              =9                      positive definite
+*              =10                     diagonally dominant tridiagonal
+*
+               IF( MTYPES.GT.MAXTYP )
+     $            GO TO 100
+*
+               ITYPE = KTYPE( JTYPE )
+               IMODE = KMODE( JTYPE )
+*
+*              Compute norm
+*
+               GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40          CONTINUE
+               ANORM = ONE
+               GO TO 70
+*
+   50          CONTINUE
+               ANORM = ( RTOVFL*ULP )*ANINV
+               GO TO 70
+*
+   60          CONTINUE
+               ANORM = RTUNFL*N*ULPINV
+               GO TO 70
+*
+   70          CONTINUE
+*
+               CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+               IINFO = 0
+               IF( JTYPE.LE.15 ) THEN
+                  COND = ULPINV
+               ELSE
+                  COND = ULPINV*ANINV / TEN
+               END IF
+*
+*              Special Matrices -- Identity & Jordan block
+*
+*                 Zero
+*
+               IF( ITYPE.EQ.1 ) THEN
+                  IINFO = 0
+*
+               ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*                 Identity
+*
+                  DO 80 JCOL = 1, N
+                     A( K+1, JCOL ) = ANORM
+   80             CONTINUE
+*
+               ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*                 Diagonal Matrix, [Eigen]values Specified
+*
+                  CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE,
+     $                         COND, ANORM, 0, 0, 'Q', A( K+1, 1 ), LDA,
+     $                         WORK, IINFO )
+*
+               ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*                 Hermitian, eigenvalues specified
+*
+                  CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE,
+     $                         COND, ANORM, K, K, 'Q', A, LDA, WORK,
+     $                         IINFO )
+*
+               ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*                 Diagonal, random eigenvalues
+*
+                  CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE,
+     $                         CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
+     $                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                         ZERO, ANORM, 'Q', A( K+1, 1 ), LDA,
+     $                         IDUMMA, IINFO )
+*
+               ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*                 Hermitian, random eigenvalues
+*
+                  CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE,
+     $                         CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
+     $                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, K, K,
+     $                         ZERO, ANORM, 'Q', A, LDA, IDUMMA, IINFO )
+*
+               ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*                 Positive definite, eigenvalues specified.
+*
+                  CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE,
+     $                         COND, ANORM, K, K, 'Q', A, LDA,
+     $                         WORK( N+1 ), IINFO )
+*
+               ELSE IF( ITYPE.EQ.10 ) THEN
+*
+*                 Positive definite tridiagonal, eigenvalues specified.
+*
+                  IF( N.GT.1 )
+     $               K = MAX( 1, K )
+                  CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE,
+     $                         COND, ANORM, 1, 1, 'Q', A( K, 1 ), LDA,
+     $                         WORK, IINFO )
+                  DO 90 I = 2, N
+                     TEMP1 = ABS( A( K, I ) ) /
+     $                       SQRT( ABS( A( K+1, I-1 )*A( K+1, I ) ) )
+                     IF( TEMP1.GT.HALF ) THEN
+                        A( K, I ) = HALF*SQRT( ABS( A( K+1,
+     $                              I-1 )*A( K+1, I ) ) )
+                     END IF
+   90             CONTINUE
+*
+               ELSE
+*
+                  IINFO = 1
+               END IF
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  RETURN
+               END IF
+*
+  100          CONTINUE
+*
+*              Call CHBTRD to compute S and U from upper triangle.
+*
+               CALL CLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
+*
+               NTEST = 1
+               CALL CHBTRD( 'V', 'U', N, K, WORK, LDA, SD, SE, U, LDU,
+     $                      WORK( LDA*N+1 ), IINFO )
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHBTRD(U)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 1 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Do tests 1 and 2
+*
+               CALL CHBT21( 'Upper', N, K, 1, A, LDA, SD, SE, U, LDU,
+     $                      WORK, RWORK, RESULT( 1 ) )
+*
+*              Before converting A into lower for DSBTRD, run DSYTRD_SB2ST 
+*              otherwise matrix A will be converted to lower and then need
+*              to be converted back to upper in order to run the upper case 
+*              ofDSYTRD_SB2ST
+*            
+*              Compute D1 the eigenvalues resulting from the tridiagonal
+*              form using the DSBTRD and used as reference to compare
+*              with the DSYTRD_SB2ST routine
+*            
+*              Compute D1 from the DSBTRD and used as reference for the
+*              DSYTRD_SB2ST
+*            
+               CALL SCOPY( N, SD, 1, D1, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+               CALL CSTEQR( 'N', N, D1, RWORK, WORK, LDU,
+     $                      RWORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 5 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*            
+*              DSYTRD_SB2ST Upper case is used to compute D2.
+*              Note to set SD and SE to zero to be sure not reusing 
+*              the one from above. Compare it with D1 computed 
+*              using the DSBTRD.
+*            
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+               CALL CLACPY( ' ', K+1, N, A, LDA, U, LDU )
+               LH = MAX(1, 4*N)
+               LW = LWORK - LH
+               CALL CHETRD_HB2ST( 'N', 'N', "U", N, K, U, LDU, SD, SE, 
+     $                      WORK, LH, WORK( LH+1 ), LW, IINFO )
+*            
+*              Compute D2 from the DSYTRD_SB2ST Upper case
+*            
+               CALL SCOPY( N, SD, 1, D2, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*            
+               CALL CSTEQR( 'N', N, D2, RWORK, WORK, LDU,
+     $                      RWORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 5 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Convert A from Upper-Triangle-Only storage to
+*              Lower-Triangle-Only storage.
+*
+               DO 120 JC = 1, N
+                  DO 110 JR = 0, MIN( K, N-JC )
+                     A( JR+1, JC ) = CONJG( A( K+1-JR, JC+JR ) )
+  110             CONTINUE
+  120          CONTINUE
+               DO 140 JC = N + 1 - K, N
+                  DO 130 JR = MIN( K, N-JC ) + 1, K
+                     A( JR+1, JC ) = ZERO
+  130             CONTINUE
+  140          CONTINUE
+*
+*              Call CHBTRD to compute S and U from lower triangle
+*
+               CALL CLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
+*
+               NTEST = 3
+               CALL CHBTRD( 'V', 'L', N, K, WORK, LDA, SD, SE, U, LDU,
+     $                      WORK( LDA*N+1 ), IINFO )
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHBTRD(L)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 3 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+               NTEST = 4
+*
+*              Do tests 3 and 4
+*
+               CALL CHBT21( 'Lower', N, K, 1, A, LDA, SD, SE, U, LDU,
+     $                      WORK, RWORK, RESULT( 3 ) )
+*
+*              DSYTRD_SB2ST Lower case is used to compute D3.
+*              Note to set SD and SE to zero to be sure not reusing 
+*              the one from above. Compare it with D1 computed 
+*              using the DSBTRD. 
+*           
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+               CALL CLACPY( ' ', K+1, N, A, LDA, U, LDU )
+               LH = MAX(1, 4*N)
+               LW = LWORK - LH
+               CALL CHETRD_HB2ST( 'N', 'N', "L", N, K, U, LDU, SD, SE, 
+     $                      WORK, LH, WORK( LH+1 ), LW, IINFO )
+*           
+*              Compute D3 from the 2-stage Upper case
+*           
+               CALL SCOPY( N, SD, 1, D3, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*           
+               CALL CSTEQR( 'N', N, D3, RWORK, WORK, LDU,
+     $                      RWORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 6 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*           
+*           
+*              Do Tests 3 and 4 which are similar to 11 and 12 but with the
+*              D1 computed using the standard 1-stage reduction as reference
+*           
+               NTEST = 6
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               TEMP3 = ZERO
+               TEMP4 = ZERO
+*           
+               DO 151 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+                  TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  151          CONTINUE
+*           
+               RESULT(5) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+               RESULT(6) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*              End of Loop -- Check for RESULT(j) > THRESH
+*
+  150          CONTINUE
+               NTESTT = NTESTT + NTEST
+*
+*              Print out tests which fail.
+*
+               DO 160 JR = 1, NTEST
+                  IF( RESULT( JR ).GE.THRESH ) THEN
+*
+*                    If this is the first test to fail,
+*                    print a header to the data file.
+*
+                     IF( NERRS.EQ.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9998 )'CHB'
+                        WRITE( NOUNIT, FMT = 9997 )
+                        WRITE( NOUNIT, FMT = 9996 )
+                        WRITE( NOUNIT, FMT = 9995 )'Hermitian'
+                        WRITE( NOUNIT, FMT = 9994 )'unitary', '*',
+     $                     'conjugate transpose', ( '*', J = 1, 6 )
+                     END IF
+                     NERRS = NERRS + 1
+                     WRITE( NOUNIT, FMT = 9993 )N, K, IOLDSD, JTYPE,
+     $                  JR, RESULT( JR )
+                  END IF
+  160          CONTINUE
+*
+  170       CONTINUE
+  180    CONTINUE
+  190 CONTINUE
+*
+*     Summary
+*
+      CALL SLASUM( 'CHB', NOUNIT, NERRS, NTESTT )
+      RETURN
+*
+ 9999 FORMAT( ' CCHKHBSTG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
+     $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+ 9998 FORMAT( / 1X, A3,
+     $     ' -- Complex Hermitian Banded Tridiagonal Reduction Routines'
+     $       )
+ 9997 FORMAT( ' Matrix types (see SCHK23 for details): ' )
+*
+ 9996 FORMAT( / ' Special Matrices:',
+     $      / '  1=Zero matrix.                        ',
+     $      '  5=Diagonal: clustered entries.',
+     $      / '  2=Identity matrix.                    ',
+     $      '  6=Diagonal: large, evenly spaced.',
+     $      / '  3=Diagonal: evenly spaced entries.    ',
+     $      '  7=Diagonal: small, evenly spaced.',
+     $      / '  4=Diagonal: geometr. spaced entries.' )
+ 9995 FORMAT( ' Dense ', A, ' Banded Matrices:',
+     $      / '  8=Evenly spaced eigenvals.            ',
+     $      ' 12=Small, evenly spaced eigenvals.',
+     $      / '  9=Geometrically spaced eigenvals.     ',
+     $      ' 13=Matrix with random O(1) entries.',
+     $      / ' 10=Clustered eigenvalues.              ',
+     $      ' 14=Matrix with large random entries.',
+     $      / ' 11=Large, evenly spaced eigenvals.     ',
+     $      ' 15=Matrix with small random entries.' )
+*
+ 9994 FORMAT( / ' Tests performed:   (S is Tridiag,  U is ', A, ',',
+     $      / 20X, A, ' means ', A, '.', / ' UPLO=''U'':',
+     $      / '  1= | A - U S U', A1, ' | / ( |A| n ulp )     ',
+     $      '  2= | I - U U', A1, ' | / ( n ulp )', / ' UPLO=''L'':',
+     $      / '  3= | A - U S U', A1, ' | / ( |A| n ulp )     ',
+     $      '  4= | I - U U', A1, ' | / ( n ulp )' / ' Eig check:',
+     $      /'  5= | D1 - D2', '', ' | / ( |D1| ulp )         ',
+     $      '  6= | D1 - D3', '', ' | / ( |D1| ulp )          ' )
+ 9993 FORMAT( ' N=', I5, ', K=', I4, ', seed=', 4( I4, ',' ), ' type ',
+     $      I2, ', test(', I2, ')=', G10.3 )
+*
+*     End of CCHKHBSTG
+*
+      END
diff --git a/TESTING/EIG/cchkst2stg.f b/TESTING/EIG/cchkst2stg.f
new file mode 100644
index 00000000..c0fa4288
--- /dev/null
+++ b/TESTING/EIG/cchkst2stg.f
@@ -0,0 +1,2093 @@
+*> \brief \b CCHKST2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                          NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5,
+*                          WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK,
+*                          LWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT,
+*                          INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
+*      $                   NSIZES, NTYPES
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       REAL               D1( * ), D2( * ), D3( * ), D4( * ), D5( * ),
+*      $                   RESULT( * ), RWORK( * ), SD( * ), SE( * ),
+*      $                   WA1( * ), WA2( * ), WA3( * ), WR( * )
+*       COMPLEX            A( LDA, * ), AP( * ), TAU( * ), U( LDU, * ),
+*      $                   V( LDU, * ), VP( * ), WORK( * ), Z( LDU, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CCHKST2STG  checks the Hermitian eigenvalue problem routines
+*> using the 2-stage reduction techniques. Since the generation
+*> of Q or the vectors is not available in this release, we only 
+*> compare the eigenvalue resulting when using the 2-stage to the 
+*> one considered as reference using the standard 1-stage reduction
+*> CHETRD. For that, we call the standard CHETRD and compute D1 using 
+*> DSTEQR, then we call the 2-stage CHETRD_2STAGE with Upper and Lower
+*> and we compute D2 and D3 using DSTEQR and then we replaced tests
+*> 3 and 4 by tests 11 and 12. test 1 and 2 remain to verify that 
+*> the 1-stage results are OK and can be trusted.
+*> This testing routine will converge to the CCHKST in the next 
+*> release when vectors and generation of Q will be implemented.
+*>
+*>    CHETRD factors A as  U S U* , where * means conjugate transpose,
+*>    S is real symmetric tridiagonal, and U is unitary.
+*>    CHETRD can use either just the lower or just the upper triangle
+*>    of A; CCHKST2STG checks both cases.
+*>    U is represented as a product of Householder
+*>    transformations, whose vectors are stored in the first
+*>    n-1 columns of V, and whose scale factors are in TAU.
+*>
+*>    CHPTRD does the same as CHETRD, except that A and V are stored
+*>    in "packed" format.
+*>
+*>    CUNGTR constructs the matrix U from the contents of V and TAU.
+*>
+*>    CUPGTR constructs the matrix U from the contents of VP and TAU.
+*>
+*>    CSTEQR factors S as  Z D1 Z* , where Z is the unitary
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal.  D2 is the matrix of
+*>    eigenvalues computed when Z is not computed.
+*>
+*>    SSTERF computes D3, the matrix of eigenvalues, by the
+*>    PWK method, which does not yield eigenvectors.
+*>
+*>    CPTEQR factors S as  Z4 D4 Z4* , for a
+*>    Hermitian positive definite tridiagonal matrix.
+*>    D5 is the matrix of eigenvalues computed when Z is not
+*>    computed.
+*>
+*>    SSTEBZ computes selected eigenvalues.  WA1, WA2, and
+*>    WA3 will denote eigenvalues computed to high
+*>    absolute accuracy, with different range options.
+*>    WR will denote eigenvalues computed to high relative
+*>    accuracy.
+*>
+*>    CSTEIN computes Y, the eigenvectors of S, given the
+*>    eigenvalues.
+*>
+*>    CSTEDC factors S as Z D1 Z* , where Z is the unitary
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal ('I' option). It may also
+*>    update an input unitary matrix, usually the output
+*>    from CHETRD/CUNGTR or CHPTRD/CUPGTR ('V' option). It may
+*>    also just compute eigenvalues ('N' option).
+*>
+*>    CSTEMR factors S as Z D1 Z* , where Z is the unitary
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal ('I' option).  CSTEMR
+*>    uses the Relatively Robust Representation whenever possible.
+*>
+*> When CCHKST2STG is called, a number of matrix "sizes" ("n's") and a
+*> number of matrix "types" are specified.  For each size ("n")
+*> and each type of matrix, one matrix will be generated and used
+*> to test the Hermitian eigenroutines.  For each matrix, a number
+*> of tests will be performed:
+*>
+*> (1)     | A - V S V* | / ( |A| n ulp ) CHETRD( UPLO='U', ... )
+*>
+*> (2)     | I - UV* | / ( n ulp )        CUNGTR( UPLO='U', ... )
+*>
+*> (3)     | A - V S V* | / ( |A| n ulp ) CHETRD( UPLO='L', ... )
+*>         replaced by | D1 - D2 | / ( |D1| ulp ) where D1 is the 
+*>         eigenvalue matrix computed using S and D2 is the 
+*>         eigenvalue matrix computed using S_2stage the output of
+*>         CHETRD_2STAGE("N", "U",....). D1 and D2 are computed 
+*>         via DSTEQR('N',...) 
+*>
+*> (4)     | I - UV* | / ( n ulp )        CUNGTR( UPLO='L', ... )
+*>         replaced by | D1 - D3 | / ( |D1| ulp ) where D1 is the 
+*>         eigenvalue matrix computed using S and D3 is the 
+*>         eigenvalue matrix computed using S_2stage the output of
+*>         CHETRD_2STAGE("N", "L",....). D1 and D3 are computed 
+*>         via DSTEQR('N',...)  
+*>
+*> (5-8)   Same as 1-4, but for CHPTRD and CUPGTR.
+*>
+*> (9)     | S - Z D Z* | / ( |S| n ulp ) CSTEQR('V',...)
+*>
+*> (10)    | I - ZZ* | / ( n ulp )        CSTEQR('V',...)
+*>
+*> (11)    | D1 - D2 | / ( |D1| ulp )        CSTEQR('N',...)
+*>
+*> (12)    | D1 - D3 | / ( |D1| ulp )        SSTERF
+*>
+*> (13)    0 if the true eigenvalues (computed by sturm count)
+*>         of S are within THRESH of
+*>         those in D1.  2*THRESH if they are not.  (Tested using
+*>         SSTECH)
+*>
+*> For S positive definite,
+*>
+*> (14)    | S - Z4 D4 Z4* | / ( |S| n ulp ) CPTEQR('V',...)
+*>
+*> (15)    | I - Z4 Z4* | / ( n ulp )        CPTEQR('V',...)
+*>
+*> (16)    | D4 - D5 | / ( 100 |D4| ulp )       CPTEQR('N',...)
+*>
+*> When S is also diagonally dominant by the factor gamma < 1,
+*>
+*> (17)    max | D4(i) - WR(i) | / ( |D4(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              SSTEBZ( 'A', 'E', ...)
+*>
+*> (18)    | WA1 - D3 | / ( |D3| ulp )          SSTEBZ( 'A', 'E', ...)
+*>
+*> (19)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>                                              SSTEBZ( 'I', 'E', ...)
+*>
+*> (20)    | S - Y WA1 Y* | / ( |S| n ulp )  SSTEBZ, CSTEIN
+*>
+*> (21)    | I - Y Y* | / ( n ulp )          SSTEBZ, CSTEIN
+*>
+*> (22)    | S - Z D Z* | / ( |S| n ulp )    CSTEDC('I')
+*>
+*> (23)    | I - ZZ* | / ( n ulp )           CSTEDC('I')
+*>
+*> (24)    | S - Z D Z* | / ( |S| n ulp )    CSTEDC('V')
+*>
+*> (25)    | I - ZZ* | / ( n ulp )           CSTEDC('V')
+*>
+*> (26)    | D1 - D2 | / ( |D1| ulp )           CSTEDC('V') and
+*>                                              CSTEDC('N')
+*>
+*> Test 27 is disabled at the moment because CSTEMR does not
+*> guarantee high relatvie accuracy.
+*>
+*> (27)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              CSTEMR('V', 'A')
+*>
+*> (28)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              CSTEMR('V', 'I')
+*>
+*> Tests 29 through 34 are disable at present because CSTEMR
+*> does not handle partial specturm requests.
+*>
+*> (29)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'I')
+*>
+*> (30)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'I')
+*>
+*> (31)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         CSTEMR('N', 'I') vs. CSTEMR('V', 'I')
+*>
+*> (32)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'V')
+*>
+*> (33)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'V')
+*>
+*> (34)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         CSTEMR('N', 'V') vs. CSTEMR('V', 'V')
+*>
+*> (35)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'A')
+*>
+*> (36)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'A')
+*>
+*> (37)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         CSTEMR('N', 'A') vs. CSTEMR('V', 'A')
+*>
+*> The "sizes" are specified by an array NN(1:NSIZES); the value of
+*> each element NN(j) specifies one size.
+*> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*> Currently, the list of possible types is:
+*>
+*> (1)  The zero matrix.
+*> (2)  The identity matrix.
+*>
+*> (3)  A diagonal matrix with evenly spaced entries
+*>      1, ..., ULP  and random signs.
+*>      (ULP = (first number larger than 1) - 1 )
+*> (4)  A diagonal matrix with geometrically spaced entries
+*>      1, ..., ULP  and random signs.
+*> (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>      and random signs.
+*>
+*> (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*> (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*> (8)  A matrix of the form  U* D U, where U is unitary and
+*>      D has evenly spaced entries 1, ..., ULP with random signs
+*>      on the diagonal.
+*>
+*> (9)  A matrix of the form  U* D U, where U is unitary and
+*>      D has geometrically spaced entries 1, ..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (10) A matrix of the form  U* D U, where U is unitary and
+*>      D has "clustered" entries 1, ULP,..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*> (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*> (13) Hermitian matrix with random entries chosen from (-1,1).
+*> (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*> (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*> (16) Same as (8), but diagonal elements are all positive.
+*> (17) Same as (9), but diagonal elements are all positive.
+*> (18) Same as (10), but diagonal elements are all positive.
+*> (19) Same as (16), but multiplied by SQRT( overflow threshold )
+*> (20) Same as (16), but multiplied by SQRT( underflow threshold )
+*> (21) A diagonally dominant tridiagonal matrix with geometrically
+*>      spaced diagonal entries 1, ..., ULP.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] NSIZES
+*> \verbatim
+*>          NSIZES is INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          CCHKST2STG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*> \endverbatim
+*>
+*> \param[in] NTYPES
+*> \verbatim
+*>          NTYPES is INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, CCHKST2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*> \endverbatim
+*>
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*> \endverbatim
+*>
+*> \param[in,out] ISEED
+*> \verbatim
+*>          ISEED is INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to CCHKST2STG to continue the same random number
+*>          sequence.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NOUNIT
+*> \verbatim
+*>          NOUNIT is INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array of
+*>                                  dimension ( LDA , max(NN) )
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of A.  It must be at
+*>          least 1 and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] AP
+*> \verbatim
+*>          AP is COMPLEX array of
+*>                      dimension( max(NN)*max(NN+1)/2 )
+*>          The matrix A stored in packed format.
+*> \endverbatim
+*>
+*> \param[out] SD
+*> \verbatim
+*>          SD is REAL array of
+*>                             dimension( max(NN) )
+*>          The diagonal of the tridiagonal matrix computed by CHETRD.
+*>          On exit, SD and SE contain the tridiagonal form of the
+*>          matrix in A.
+*> \endverbatim
+*>
+*> \param[out] SE
+*> \verbatim
+*>          SE is REAL array of
+*>                             dimension( max(NN) )
+*>          The off-diagonal of the tridiagonal matrix computed by
+*>          CHETRD.  On exit, SD and SE contain the tridiagonal form of
+*>          the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D1
+*> \verbatim
+*>          D1 is REAL array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by CSTEQR simlutaneously
+*>          with Z.  On exit, the eigenvalues in D1 correspond with the
+*>          matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D2
+*> \verbatim
+*>          D2 is REAL array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by CSTEQR if Z is not
+*>          computed.  On exit, the eigenvalues in D2 correspond with
+*>          the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D3
+*> \verbatim
+*>          D3 is REAL array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by SSTERF.  On exit, the
+*>          eigenvalues in D3 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D4
+*> \verbatim
+*>          D4 is REAL array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by CPTEQR(V).
+*>          CPTEQR factors S as  Z4 D4 Z4*
+*>          On exit, the eigenvalues in D4 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D5
+*> \verbatim
+*>          D5 is REAL array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by CPTEQR(N)
+*>          when Z is not computed. On exit, the
+*>          eigenvalues in D4 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] WA1
+*> \verbatim
+*>          WA1 is REAL array of
+*>                             dimension( max(NN) )
+*>          All eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by SSTEBZ.
+*> \endverbatim
+*>
+*> \param[out] WA2
+*> \verbatim
+*>          WA2 is REAL array of
+*>                             dimension( max(NN) )
+*>          Selected eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by SSTEBZ.
+*>          Choose random values for IL and IU, and ask for the
+*>          IL-th through IU-th eigenvalues.
+*> \endverbatim
+*>
+*> \param[out] WA3
+*> \verbatim
+*>          WA3 is REAL array of
+*>                             dimension( max(NN) )
+*>          Selected eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by SSTEBZ.
+*>          Determine the values VL and VU of the IL-th and IU-th
+*>          eigenvalues and ask for all eigenvalues in this range.
+*> \endverbatim
+*>
+*> \param[out] WR
+*> \verbatim
+*>          WR is REAL array of
+*>                             dimension( max(NN) )
+*>          All eigenvalues of A, computed to high
+*>          absolute accuracy, with different options.
+*>          as computed by SSTEBZ.
+*> \endverbatim
+*>
+*> \param[out] U
+*> \verbatim
+*>          U is COMPLEX array of
+*>                             dimension( LDU, max(NN) ).
+*>          The unitary matrix computed by CHETRD + CUNGTR.
+*> \endverbatim
+*>
+*> \param[in] LDU
+*> \verbatim
+*>          LDU is INTEGER
+*>          The leading dimension of U, Z, and V.  It must be at least 1
+*>          and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] V
+*> \verbatim
+*>          V is COMPLEX array of
+*>                             dimension( LDU, max(NN) ).
+*>          The Housholder vectors computed by CHETRD in reducing A to
+*>          tridiagonal form.  The vectors computed with UPLO='U' are
+*>          in the upper triangle, and the vectors computed with UPLO='L'
+*>          are in the lower triangle.  (As described in CHETRD, the
+*>          sub- and superdiagonal are not set to 1, although the
+*>          true Householder vector has a 1 in that position.  The
+*>          routines that use V, such as CUNGTR, set those entries to
+*>          1 before using them, and then restore them later.)
+*> \endverbatim
+*>
+*> \param[out] VP
+*> \verbatim
+*>          VP is COMPLEX array of
+*>                      dimension( max(NN)*max(NN+1)/2 )
+*>          The matrix V stored in packed format.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is COMPLEX array of
+*>                             dimension( max(NN) )
+*>          The Householder factors computed by CHETRD in reducing A
+*>          to tridiagonal form.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX array of
+*>                             dimension( LDU, max(NN) ).
+*>          The unitary matrix of eigenvectors computed by CSTEQR,
+*>          CPTEQR, and CSTEIN.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array of
+*>                      dimension( LWORK )
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 3 * Nmax**2
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array,
+*>          Workspace.
+*> \endverbatim
+*>
+*> \param[out] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The number of entries in IWORK.  This must be at least
+*>                  6 + 6*Nmax + 5 * Nmax * lg Nmax
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array
+*> \endverbatim
+*>
+*> \param[in] LRWORK
+*> \verbatim
+*>          LRWORK is INTEGER
+*>          The number of entries in LRWORK (dimension( ??? )
+*> \endverbatim
+*>
+*> \param[out] RESULT
+*> \verbatim
+*>          RESULT is REAL array, dimension (26)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -23: LDU < 1 or LDU < NMAX.
+*>          -29: LWORK too small.
+*>          If  CLATMR, CLATMS, CHETRD, CUNGTR, CSTEQR, SSTERF,
+*>              or CUNMC2 returns an error code, the
+*>              absolute value of it is returned.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NBLOCK          Blocksize as returned by ENVIR.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far.
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex_eig
+*
+*  =====================================================================
+      SUBROUTINE CCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                   NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5,
+     $                   WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK,
+     $                   LWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT,
+     $                   INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
+     $                   NSIZES, NTYPES
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      REAL               D1( * ), D2( * ), D3( * ), D4( * ), D5( * ),
+     $                   RESULT( * ), RWORK( * ), SD( * ), SE( * ),
+     $                   WA1( * ), WA2( * ), WA3( * ), WR( * )
+      COMPLEX            A( LDA, * ), AP( * ), TAU( * ), U( LDU, * ),
+     $                   V( LDU, * ), VP( * ), WORK( * ), Z( LDU, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE, TWO, EIGHT, TEN, HUN
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
+     $                   EIGHT = 8.0E0, TEN = 10.0E0, HUN = 100.0E0 )
+      COMPLEX            CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   CONE = ( 1.0E+0, 0.0E+0 ) )
+      REAL               HALF
+      PARAMETER          ( HALF = ONE / TWO )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 21 )
+      LOGICAL            CRANGE
+      PARAMETER          ( CRANGE = .FALSE. )
+      LOGICAL            CREL
+      PARAMETER          ( CREL = .FALSE. )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN, TRYRAC
+      INTEGER            I, IINFO, IL, IMODE, INDE, INDRWK, ITEMP,
+     $                   ITYPE, IU, J, JC, JR, JSIZE, JTYPE, LGN,
+     $                   LIWEDC, LOG2UI, LRWEDC, LWEDC, M, M2, M3,
+     $                   MTYPES, N, NAP, NBLOCK, NERRS, NMATS, NMAX,
+     $                   NSPLIT, NTEST, NTESTT, LH, LW
+      REAL               ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, TEMP1, TEMP2, TEMP3, TEMP4, ULP,
+     $                   ULPINV, UNFL, VL, VU
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+      REAL               DUMMA( 1 )
+*     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLARND, SSXT1
+      EXTERNAL           ILAENV, SLAMCH, SLARND, SSXT1
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SLABAD, SLASUM, SSTEBZ, SSTECH, SSTERF,
+     $                   XERBLA, CCOPY, CHET21, CHETRD, CHPT21, CHPTRD,
+     $                   CLACPY, CLASET, CLATMR, CLATMS, CPTEQR, CSTEDC,
+     $                   CSTEMR, CSTEIN, CSTEQR, CSTT21, CSTT22, CUNGTR,
+     $                   CUPGTR, CHETRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, REAL, CONJG, INT, LOG, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
+     $                   8, 8, 9, 9, 9, 9, 9, 10 /
+      DATA               KMAGN / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 1, 1, 1, 2, 3, 1 /
+      DATA               KMODE / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 4, 3, 1, 4, 4, 3 /
+*     ..
+*     .. Executable Statements ..
+*
+*     Keep ftnchek happy
+      IDUMMA( 1 ) = 1
+*
+*     Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+*     Important constants
+*
+      BADNN = .FALSE.
+      TRYRAC = .TRUE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+      NBLOCK = ILAENV( 1, 'CHETRD', 'L', NMAX, -1, -1, -1 )
+      NBLOCK = MIN( NMAX, MAX( 1, NBLOCK ) )
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -23
+      ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
+         INFO = -29
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CCHKST2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = SLAMCH( 'Safe minimum' )
+      OVFL = ONE / UNFL
+      CALL SLABAD( UNFL, OVFL )
+      ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) )
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+   20 CONTINUE
+      NERRS = 0
+      NMATS = 0
+*
+      DO 310 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         IF( N.GT.0 ) THEN
+            LGN = INT( LOG( REAL( N ) ) / LOG( TWO ) )
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2
+            LRWEDC = 1 + 3*N + 2*N*LGN + 4*N**2
+            LIWEDC = 6 + 6*N + 5*N*LGN
+         ELSE
+            LWEDC = 8
+            LRWEDC = 7
+            LIWEDC = 12
+         END IF
+         NAP = ( N*( N+1 ) ) / 2
+         ANINV = ONE / REAL( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         DO 300 JTYPE = 1, MTYPES
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 300
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           Compute "A"
+*
+*           Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, (w/ eigenvalues)
+*           =5         random log   Hermitian, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random Hermitian
+*           =9                      positive definite
+*           =10                     diagonally dominant tridiagonal
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 100
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+            IINFO = 0
+            IF( JTYPE.LE.15 ) THEN
+               COND = ULPINV
+            ELSE
+               COND = ULPINV*ANINV / TEN
+            END IF
+*
+*           Special Matrices -- Identity & Jordan block
+*
+*              Zero
+*
+            IF( ITYPE.EQ.1 ) THEN
+               IINFO = 0
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               DO 80 JC = 1, N
+                  A( JC, JC ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
+*
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              Hermitian, eigenvalues specified
+*
+               CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              Hermitian, random eigenvalues
+*
+               CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              Positive definite, eigenvalues specified.
+*
+               CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.10 ) THEN
+*
+*              Positive definite tridiagonal, eigenvalues specified.
+*
+               CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE, COND,
+     $                      ANORM, 1, 1, 'N', A, LDA, WORK, IINFO )
+               DO 90 I = 2, N
+                  TEMP1 = ABS( A( I-1, I ) )
+                  TEMP2 = SQRT( ABS( A( I-1, I-1 )*A( I, I ) ) )
+                  IF( TEMP1.GT.HALF*TEMP2 ) THEN
+                     A( I-1, I ) = A( I-1, I )*
+     $                             ( HALF*TEMP2 / ( UNFL+TEMP1 ) )
+                     A( I, I-1 ) = CONJG( A( I-1, I ) )
+                  END IF
+   90          CONTINUE
+*
+            ELSE
+*
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+  100       CONTINUE
+*
+*           Call CHETRD and CUNGTR to compute S and U from
+*           upper triangle.
+*
+            CALL CLACPY( 'U', N, N, A, LDA, V, LDU )
+*
+            NTEST = 1
+            CALL CHETRD( 'U', N, V, LDU, SD, SE, TAU, WORK, LWORK,
+     $                   IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CHETRD(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 1 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL CLACPY( 'U', N, N, V, LDU, U, LDU )
+*
+            NTEST = 2
+            CALL CUNGTR( 'U', N, U, LDU, TAU, WORK, LWORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CUNGTR(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 2 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 1 and 2
+*
+            CALL CHET21( 2, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
+     $                   LDU, TAU, WORK, RWORK, RESULT( 1 ) )
+            CALL CHET21( 3, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
+     $                   LDU, TAU, WORK, RWORK, RESULT( 2 ) )
+*
+*           Compute D1 the eigenvalues resulting from the tridiagonal
+*           form using the standard 1-stage algorithm and use it as a
+*           reference to compare with the 2-stage technique
+*
+*           Compute D1 from the 1-stage and used as reference for the
+*           2-stage
+*
+            CALL SCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+            CALL CSTEQR( 'N', N, D1, RWORK, WORK, LDU, RWORK( N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 3 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           2-STAGE TRD Upper case is used to compute D2.
+*           Note to set SD and SE to zero to be sure not reusing 
+*           the one from above. Compare it with D1 computed 
+*           using the 1-stage.
+*
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+            CALL CLACPY( 'U', N, N, A, LDA, V, LDU )
+            LH = MAX(1, 4*N)
+            LW = LWORK - LH
+            CALL CHETRD_2STAGE( 'N', "U", N, V, LDU, SD, SE, TAU, 
+     $                   WORK, LH, WORK( LH+1 ), LW, IINFO )
+*
+*           Compute D2 from the 2-stage Upper case
+*
+            CALL SCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+            NTEST = 3
+            CALL CSTEQR( 'N', N, D2, RWORK, WORK, LDU, RWORK( N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 3 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           2-STAGE TRD Lower case is used to compute D3.
+*           Note to set SD and SE to zero to be sure not reusing 
+*           the one from above. Compare it with D1 computed 
+*           using the 1-stage. 
+*
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+            CALL CLACPY( 'L', N, N, A, LDA, V, LDU )
+            CALL CHETRD_2STAGE( 'N', "L", N, V, LDU, SD, SE, TAU, 
+     $                   WORK, LH, WORK( LH+1 ), LW, IINFO )
+*
+*           Compute D3 from the 2-stage Upper case
+*
+            CALL SCOPY( N, SD, 1, D3, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+            NTEST = 4
+            CALL CSTEQR( 'N', N, D3, RWORK, WORK, LDU, RWORK( N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 4 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*
+*           Do Tests 3 and 4 which are similar to 11 and 12 but with the
+*           D1 computed using the standard 1-stage reduction as reference
+*
+            NTEST = 4
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            TEMP3 = ZERO
+            TEMP4 = ZERO
+*
+            DO 151 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+               TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+               TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  151       CONTINUE
+*
+            RESULT( 3 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+            RESULT( 4 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*           Store the upper triangle of A in AP
+*
+            I = 0
+            DO 120 JC = 1, N
+               DO 110 JR = 1, JC
+                  I = I + 1
+                  AP( I ) = A( JR, JC )
+  110          CONTINUE
+  120       CONTINUE
+*
+*           Call CHPTRD and CUPGTR to compute S and U from AP
+*
+            CALL CCOPY( NAP, AP, 1, VP, 1 )
+*
+            NTEST = 5
+            CALL CHPTRD( 'U', N, VP, SD, SE, TAU, IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CHPTRD(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 5 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            NTEST = 6
+            CALL CUPGTR( 'U', N, VP, TAU, U, LDU, WORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CUPGTR(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 6 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 5 and 6
+*
+            CALL CHPT21( 2, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RWORK, RESULT( 5 ) )
+            CALL CHPT21( 3, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RWORK, RESULT( 6 ) )
+*
+*           Store the lower triangle of A in AP
+*
+            I = 0
+            DO 140 JC = 1, N
+               DO 130 JR = JC, N
+                  I = I + 1
+                  AP( I ) = A( JR, JC )
+  130          CONTINUE
+  140       CONTINUE
+*
+*           Call CHPTRD and CUPGTR to compute S and U from AP
+*
+            CALL CCOPY( NAP, AP, 1, VP, 1 )
+*
+            NTEST = 7
+            CALL CHPTRD( 'L', N, VP, SD, SE, TAU, IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CHPTRD(L)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 7 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            NTEST = 8
+            CALL CUPGTR( 'L', N, VP, TAU, U, LDU, WORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CUPGTR(L)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 8 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL CHPT21( 2, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RWORK, RESULT( 7 ) )
+            CALL CHPT21( 3, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RWORK, RESULT( 8 ) )
+*
+*           Call CSTEQR to compute D1, D2, and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            CALL SCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+            CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+            NTEST = 9
+            CALL CSTEQR( 'V', N, D1, RWORK, Z, LDU, RWORK( N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CSTEQR(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 9 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Compute D2
+*
+            CALL SCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+            NTEST = 11
+            CALL CSTEQR( 'N', N, D2, RWORK, WORK, LDU, RWORK( N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 11 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Compute D3 (using PWK method)
+*
+            CALL SCOPY( N, SD, 1, D3, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+            NTEST = 12
+            CALL SSTERF( N, D3, RWORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTERF', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 12 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 9 and 10
+*
+            CALL CSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
+     $                   RESULT( 9 ) )
+*
+*           Do Tests 11 and 12
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            TEMP3 = ZERO
+            TEMP4 = ZERO
+*
+            DO 150 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+               TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+               TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  150       CONTINUE
+*
+            RESULT( 11 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+            RESULT( 12 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*           Do Test 13 -- Sturm Sequence Test of Eigenvalues
+*                         Go up by factors of two until it succeeds
+*
+            NTEST = 13
+            TEMP1 = THRESH*( HALF-ULP )
+*
+            DO 160 J = 0, LOG2UI
+               CALL SSTECH( N, SD, SE, D1, TEMP1, RWORK, IINFO )
+               IF( IINFO.EQ.0 )
+     $            GO TO 170
+               TEMP1 = TEMP1*TWO
+  160       CONTINUE
+*
+  170       CONTINUE
+            RESULT( 13 ) = TEMP1
+*
+*           For positive definite matrices ( JTYPE.GT.15 ) call CPTEQR
+*           and do tests 14, 15, and 16 .
+*
+            IF( JTYPE.GT.15 ) THEN
+*
+*              Compute D4 and Z4
+*
+               CALL SCOPY( N, SD, 1, D4, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+               CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+               NTEST = 14
+               CALL CPTEQR( 'V', N, D4, RWORK, Z, LDU, RWORK( N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CPTEQR(V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 14 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do Tests 14 and 15
+*
+               CALL CSTT21( N, 0, SD, SE, D4, DUMMA, Z, LDU, WORK,
+     $                      RWORK, RESULT( 14 ) )
+*
+*              Compute D5
+*
+               CALL SCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+               NTEST = 16
+               CALL CPTEQR( 'N', N, D5, RWORK, Z, LDU, RWORK( N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CPTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 16 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do Test 16
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 180 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D4( J ) ), ABS( D5( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D4( J )-D5( J ) ) )
+  180          CONTINUE
+*
+               RESULT( 16 ) = TEMP2 / MAX( UNFL,
+     $                        HUN*ULP*MAX( TEMP1, TEMP2 ) )
+            ELSE
+               RESULT( 14 ) = ZERO
+               RESULT( 15 ) = ZERO
+               RESULT( 16 ) = ZERO
+            END IF
+*
+*           Call SSTEBZ with different options and do tests 17-18.
+*
+*              If S is positive definite and diagonally dominant,
+*              ask for all eigenvalues with high relative accuracy.
+*
+            VL = ZERO
+            VU = ZERO
+            IL = 0
+            IU = 0
+            IF( JTYPE.EQ.21 ) THEN
+               NTEST = 17
+               ABSTOL = UNFL + UNFL
+               CALL SSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                      M, NSPLIT, WR, IWORK( 1 ), IWORK( N+1 ),
+     $                      RWORK, IWORK( 2*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A,rel)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 17 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do test 17
+*
+               TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
+     $                 ( ONE-HALF )**4
+*
+               TEMP1 = ZERO
+               DO 190 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
+     $                    ( ABSTOL+ABS( D4( J ) ) ) )
+  190          CONTINUE
+*
+               RESULT( 17 ) = TEMP1 / TEMP2
+            ELSE
+               RESULT( 17 ) = ZERO
+            END IF
+*
+*           Now ask for all eigenvalues with high absolute accuracy.
+*
+            NTEST = 18
+            ABSTOL = UNFL + UNFL
+            CALL SSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
+     $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), RWORK,
+     $                   IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 18 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do test 18
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            DO 200 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D3( J ) ), ABS( WA1( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D3( J )-WA1( J ) ) )
+  200       CONTINUE
+*
+            RESULT( 18 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*           Choose random values for IL and IU, and ask for the
+*           IL-th through IU-th eigenvalues.
+*
+            NTEST = 19
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+               IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+               IF( IU.LT.IL ) THEN
+                  ITEMP = IU
+                  IU = IL
+                  IL = ITEMP
+               END IF
+            END IF
+*
+            CALL SSTEBZ( 'I', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                   M2, NSPLIT, WA2, IWORK( 1 ), IWORK( N+1 ),
+     $                   RWORK, IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(I)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 19 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Determine the values VL and VU of the IL-th and IU-th
+*           eigenvalues and ask for all eigenvalues in this range.
+*
+            IF( N.GT.0 ) THEN
+               IF( IL.NE.1 ) THEN
+                  VL = WA1( IL ) - MAX( HALF*( WA1( IL )-WA1( IL-1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               ELSE
+                  VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               END IF
+               IF( IU.NE.N ) THEN
+                  VU = WA1( IU ) + MAX( HALF*( WA1( IU+1 )-WA1( IU ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               ELSE
+                  VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               END IF
+            ELSE
+               VL = ZERO
+               VU = ONE
+            END IF
+*
+            CALL SSTEBZ( 'V', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                   M3, NSPLIT, WA3, IWORK( 1 ), IWORK( N+1 ),
+     $                   RWORK, IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 19 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            IF( M3.EQ.0 .AND. N.NE.0 ) THEN
+               RESULT( 19 ) = ULPINV
+               GO TO 280
+            END IF
+*
+*           Do test 19
+*
+            TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+            TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+            IF( N.GT.0 ) THEN
+               TEMP3 = MAX( ABS( WA1( N ) ), ABS( WA1( 1 ) ) )
+            ELSE
+               TEMP3 = ZERO
+            END IF
+*
+            RESULT( 19 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
+*
+*           Call CSTEIN to compute eigenvectors corresponding to
+*           eigenvalues in WA1.  (First call SSTEBZ again, to make sure
+*           it returns these eigenvalues in the correct order.)
+*
+            NTEST = 21
+            CALL SSTEBZ( 'A', 'B', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
+     $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), RWORK,
+     $                   IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A,B)', IINFO, N,
+     $            JTYPE, IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 20 ) = ULPINV
+                  RESULT( 21 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL CSTEIN( N, SD, SE, M, WA1, IWORK( 1 ), IWORK( N+1 ), Z,
+     $                   LDU, RWORK, IWORK( 2*N+1 ), IWORK( 3*N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CSTEIN', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 20 ) = ULPINV
+                  RESULT( 21 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 20 and 21
+*
+            CALL CSTT21( N, 0, SD, SE, WA1, DUMMA, Z, LDU, WORK, RWORK,
+     $                   RESULT( 20 ) )
+*
+*           Call CSTEDC(I) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            INDE = 1
+            INDRWK = INDE + N
+            CALL SCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
+            CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+            NTEST = 22
+            CALL CSTEDC( 'I', N, D1, RWORK( INDE ), Z, LDU, WORK, LWEDC,
+     $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CSTEDC(I)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 22 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 22 and 23
+*
+            CALL CSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
+     $                   RESULT( 22 ) )
+*
+*           Call CSTEDC(V) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            CALL SCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
+            CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+            NTEST = 24
+            CALL CSTEDC( 'V', N, D1, RWORK( INDE ), Z, LDU, WORK, LWEDC,
+     $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CSTEDC(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 24 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 24 and 25
+*
+            CALL CSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
+     $                   RESULT( 24 ) )
+*
+*           Call CSTEDC(N) to compute D2, do tests.
+*
+*           Compute D2
+*
+            CALL SCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
+            CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+            NTEST = 26
+            CALL CSTEDC( 'N', N, D2, RWORK( INDE ), Z, LDU, WORK, LWEDC,
+     $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'CSTEDC(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 26 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Test 26
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+*
+            DO 210 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  210       CONTINUE
+*
+            RESULT( 26 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*           Only test CSTEMR if IEEE compliant
+*
+            IF( ILAENV( 10, 'CSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 .AND.
+     $          ILAENV( 11, 'CSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 ) THEN
+*
+*           Call CSTEMR, do test 27 (relative eigenvalue accuracy)
+*
+*              If S is positive definite and diagonally dominant,
+*              ask for all eigenvalues with high relative accuracy.
+*
+               VL = ZERO
+               VU = ZERO
+               IL = 0
+               IU = 0
+               IF( JTYPE.EQ.21 .AND. CREL ) THEN
+                  NTEST = 27
+                  ABSTOL = UNFL + UNFL
+                  CALL CSTEMR( 'V', 'A', N, SD, SE, VL, VU, IL, IU,
+     $                         M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         RWORK, LRWORK, IWORK( 2*N+1 ), LWORK-2*N,
+     $                         IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,A,rel)',
+     $                  IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 27 ) = ULPINV
+                        GO TO 270
+                     END IF
+                  END IF
+*
+*              Do test 27
+*
+                  TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
+     $                    ( ONE-HALF )**4
+*
+                  TEMP1 = ZERO
+                  DO 220 J = 1, N
+                     TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
+     $                       ( ABSTOL+ABS( D4( J ) ) ) )
+  220             CONTINUE
+*
+                  RESULT( 27 ) = TEMP1 / TEMP2
+*
+                  IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+                  IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+                  IF( IU.LT.IL ) THEN
+                     ITEMP = IU
+                     IU = IL
+                     IL = ITEMP
+                  END IF
+*
+                  IF( CRANGE ) THEN
+                     NTEST = 28
+                     ABSTOL = UNFL + UNFL
+                     CALL CSTEMR( 'V', 'I', N, SD, SE, VL, VU, IL, IU,
+     $                            M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                            RWORK, LRWORK, IWORK( 2*N+1 ),
+     $                            LWORK-2*N, IINFO )
+*
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,I,rel)',
+     $                     IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( 28 ) = ULPINV
+                           GO TO 270
+                        END IF
+                     END IF
+*
+*
+*                 Do test 28
+*
+                     TEMP2 = TWO*( TWO*N-ONE )*ULP*
+     $                       ( ONE+EIGHT*HALF**2 ) / ( ONE-HALF )**4
+*
+                     TEMP1 = ZERO
+                     DO 230 J = IL, IU
+                        TEMP1 = MAX( TEMP1, ABS( WR( J-IL+1 )-D4( N-J+
+     $                          1 ) ) / ( ABSTOL+ABS( WR( J-IL+1 ) ) ) )
+  230                CONTINUE
+*
+                     RESULT( 28 ) = TEMP1 / TEMP2
+                  ELSE
+                     RESULT( 28 ) = ZERO
+                  END IF
+               ELSE
+                  RESULT( 27 ) = ZERO
+                  RESULT( 28 ) = ZERO
+               END IF
+*
+*           Call CSTEMR(V,I) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+               CALL SCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+               CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+               IF( CRANGE ) THEN
+                  NTEST = 29
+                  IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+                  IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+                  IF( IU.LT.IL ) THEN
+                     ITEMP = IU
+                     IU = IL
+                     IL = ITEMP
+                  END IF
+                  CALL CSTEMR( 'V', 'I', N, D5, RWORK, VL, VU, IL, IU,
+     $                         M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,I)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 29 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Tests 29 and 30
+*
+*
+*           Call CSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+                  CALL SCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+                  NTEST = 31
+                  CALL CSTEMR( 'N', 'I', N, D5, RWORK, VL, VU, IL, IU,
+     $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CSTEMR(N,I)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 31 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Test 31
+*
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+*
+                  DO 240 J = 1, IU - IL + 1
+                     TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
+     $                       ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  240             CONTINUE
+*
+                  RESULT( 31 ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*
+*           Call CSTEMR(V,V) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+                  CALL SCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+                  CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+                  NTEST = 32
+*
+                  IF( N.GT.0 ) THEN
+                     IF( IL.NE.1 ) THEN
+                        VL = D2( IL ) - MAX( HALF*
+     $                       ( D2( IL )-D2( IL-1 ) ), ULP*ANORM,
+     $                       TWO*RTUNFL )
+                     ELSE
+                        VL = D2( 1 ) - MAX( HALF*( D2( N )-D2( 1 ) ),
+     $                       ULP*ANORM, TWO*RTUNFL )
+                     END IF
+                     IF( IU.NE.N ) THEN
+                        VU = D2( IU ) + MAX( HALF*
+     $                       ( D2( IU+1 )-D2( IU ) ), ULP*ANORM,
+     $                       TWO*RTUNFL )
+                     ELSE
+                        VU = D2( N ) + MAX( HALF*( D2( N )-D2( 1 ) ),
+     $                       ULP*ANORM, TWO*RTUNFL )
+                     END IF
+                  ELSE
+                     VL = ZERO
+                     VU = ONE
+                  END IF
+*
+                  CALL CSTEMR( 'V', 'V', N, D5, RWORK, VL, VU, IL, IU,
+     $                         M, D1, Z, LDU, M, IWORK( 1 ), TRYRAC,
+     $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,V)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 32 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Tests 32 and 33
+*
+                  CALL CSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                         M, RWORK, RESULT( 32 ) )
+*
+*           Call CSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+                  CALL SCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+                  NTEST = 34
+                  CALL CSTEMR( 'N', 'V', N, D5, RWORK, VL, VU, IL, IU,
+     $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CSTEMR(N,V)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 34 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Test 34
+*
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+*
+                  DO 250 J = 1, IU - IL + 1
+                     TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
+     $                       ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  250             CONTINUE
+*
+                  RESULT( 34 ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+               ELSE
+                  RESULT( 29 ) = ZERO
+                  RESULT( 30 ) = ZERO
+                  RESULT( 31 ) = ZERO
+                  RESULT( 32 ) = ZERO
+                  RESULT( 33 ) = ZERO
+                  RESULT( 34 ) = ZERO
+               END IF
+*
+*
+*           Call CSTEMR(V,A) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+               CALL SCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+               NTEST = 35
+*
+               CALL CSTEMR( 'V', 'A', N, D5, RWORK, VL, VU, IL, IU,
+     $                      M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                      RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                      LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 35 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*           Do Tests 35 and 36
+*
+               CALL CSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, M,
+     $                      RWORK, RESULT( 35 ) )
+*
+*           Call CSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+               CALL SCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
+*
+               NTEST = 37
+               CALL CSTEMR( 'N', 'A', N, D5, RWORK, VL, VU, IL, IU,
+     $                      M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                      RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                      LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CSTEMR(N,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 37 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*           Do Test 34
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+*
+               DO 260 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  260          CONTINUE
+*
+               RESULT( 37 ) = TEMP2 / MAX( UNFL,
+     $                        ULP*MAX( TEMP1, TEMP2 ) )
+            END IF
+  270       CONTINUE
+  280       CONTINUE
+            NTESTT = NTESTT + NTEST
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+*
+*           Print out tests which fail.
+*
+            DO 290 JR = 1, NTEST
+               IF( RESULT( JR ).GE.THRESH ) THEN
+*
+*                 If this is the first test to fail,
+*                 print a header to the data file.
+*
+                  IF( NERRS.EQ.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9998 )'CST'
+                     WRITE( NOUNIT, FMT = 9997 )
+                     WRITE( NOUNIT, FMT = 9996 )
+                     WRITE( NOUNIT, FMT = 9995 )'Hermitian'
+                     WRITE( NOUNIT, FMT = 9994 )
+*
+*                    Tests performed
+*
+                     WRITE( NOUNIT, FMT = 9987 )
+                  END IF
+                  NERRS = NERRS + 1
+                  IF( RESULT( JR ).LT.10000.0E0 ) THEN
+                     WRITE( NOUNIT, FMT = 9989 )N, JTYPE, IOLDSD, JR,
+     $                  RESULT( JR )
+                  ELSE
+                     WRITE( NOUNIT, FMT = 9988 )N, JTYPE, IOLDSD, JR,
+     $                  RESULT( JR )
+                  END IF
+               END IF
+  290       CONTINUE
+  300    CONTINUE
+  310 CONTINUE
+*
+*     Summary
+*
+      CALL SLASUM( 'CST', NOUNIT, NERRS, NTESTT )
+      RETURN
+*
+ 9999 FORMAT( ' CCHKST2STG: ', A, ' returned INFO=', I6, '.', / 9X,
+     $   'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+*
+ 9998 FORMAT( / 1X, A3, ' -- Complex Hermitian eigenvalue problem' )
+ 9997 FORMAT( ' Matrix types (see CCHKST2STG for details): ' )
+*
+ 9996 FORMAT( / ' Special Matrices:',
+     $      / '  1=Zero matrix.                        ',
+     $      '  5=Diagonal: clustered entries.',
+     $      / '  2=Identity matrix.                    ',
+     $      '  6=Diagonal: large, evenly spaced.',
+     $      / '  3=Diagonal: evenly spaced entries.    ',
+     $      '  7=Diagonal: small, evenly spaced.',
+     $      / '  4=Diagonal: geometr. spaced entries.' )
+ 9995 FORMAT( ' Dense ', A, ' Matrices:',
+     $      / '  8=Evenly spaced eigenvals.            ',
+     $      ' 12=Small, evenly spaced eigenvals.',
+     $      / '  9=Geometrically spaced eigenvals.     ',
+     $      ' 13=Matrix with random O(1) entries.',
+     $      / ' 10=Clustered eigenvalues.              ',
+     $      ' 14=Matrix with large random entries.',
+     $      / ' 11=Large, evenly spaced eigenvals.     ',
+     $      ' 15=Matrix with small random entries.' )
+ 9994 FORMAT( ' 16=Positive definite, evenly spaced eigenvalues',
+     $      / ' 17=Positive definite, geometrically spaced eigenvlaues',
+     $      / ' 18=Positive definite, clustered eigenvalues',
+     $      / ' 19=Positive definite, small evenly spaced eigenvalues',
+     $      / ' 20=Positive definite, large evenly spaced eigenvalues',
+     $      / ' 21=Diagonally dominant tridiagonal, geometrically',
+     $      ' spaced eigenvalues' )
+*
+ 9989 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=',
+     $      4( I4, ',' ), ' result ', I3, ' is', 0P, F8.2 )
+ 9988 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=',
+     $      4( I4, ',' ), ' result ', I3, ' is', 1P, E10.3 )
+*
+ 9987 FORMAT( / 'Test performed:  see CCHKST2STG for details.', / )
+*     End of CCHKST2STG
+*
+      END
diff --git a/TESTING/EIG/cdrvsg2stg.f b/TESTING/EIG/cdrvsg2stg.f
new file mode 100644
index 00000000..a6ccefbf
--- /dev/null
+++ b/TESTING/EIG/cdrvsg2stg.f
@@ -0,0 +1,1382 @@
+*> \brief \b CDRVSG2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                              NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
+*                              BB, AP, BP, WORK, NWORK, RWORK, LRWORK,
+*                              IWORK, LIWORK, RESULT, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
+*      $                   NSIZES, NTYPES, NWORK
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       REAL               D( * ), RESULT( * ), RWORK( * )
+*       COMPLEX            A( LDA, * ), AB( LDA, * ), AP( * ),
+*      $                   B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ),
+*      $                   Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>      CDRVSG2STG checks the complex Hermitian generalized eigenproblem
+*>      drivers.
+*>
+*>              CHEGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem.
+*>
+*>              CHEGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem using a divide and conquer algorithm.
+*>
+*>              CHEGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem.
+*>
+*>              CHPGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem in packed storage.
+*>
+*>              CHPGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem in packed storage using a divide and
+*>              conquer algorithm.
+*>
+*>              CHPGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem in packed storage.
+*>
+*>              CHBGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite banded
+*>              generalized eigenproblem.
+*>
+*>              CHBGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite banded
+*>              generalized eigenproblem using a divide and conquer
+*>              algorithm.
+*>
+*>              CHBGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite banded
+*>              generalized eigenproblem.
+*>
+*>      When CDRVSG2STG is called, a number of matrix "sizes" ("n's") and a
+*>      number of matrix "types" are specified.  For each size ("n")
+*>      and each type of matrix, one matrix A of the given type will be
+*>      generated; a random well-conditioned matrix B is also generated
+*>      and the pair (A,B) is used to test the drivers.
+*>
+*>      For each pair (A,B), the following tests are performed:
+*>
+*>      (1) CHEGV with ITYPE = 1 and UPLO ='U':
+*>
+*>              | A Z - B Z D | / ( |A| |Z| n ulp )
+*>              | D - D2 | / ( |D| ulp )   where D is computed by
+*>                                         CHEGV and  D2 is computed by
+*>                                         CHEGV_2STAGE. This test is
+*>                                         only performed for DSYGV
+*>
+*>      (2) as (1) but calling CHPGV
+*>      (3) as (1) but calling CHBGV
+*>      (4) as (1) but with UPLO = 'L'
+*>      (5) as (4) but calling CHPGV
+*>      (6) as (4) but calling CHBGV
+*>
+*>      (7) CHEGV with ITYPE = 2 and UPLO ='U':
+*>
+*>              | A B Z - Z D | / ( |A| |Z| n ulp )
+*>
+*>      (8) as (7) but calling CHPGV
+*>      (9) as (7) but with UPLO = 'L'
+*>      (10) as (9) but calling CHPGV
+*>
+*>      (11) CHEGV with ITYPE = 3 and UPLO ='U':
+*>
+*>              | B A Z - Z D | / ( |A| |Z| n ulp )
+*>
+*>      (12) as (11) but calling CHPGV
+*>      (13) as (11) but with UPLO = 'L'
+*>      (14) as (13) but calling CHPGV
+*>
+*>      CHEGVD, CHPGVD and CHBGVD performed the same 14 tests.
+*>
+*>      CHEGVX, CHPGVX and CHBGVX performed the above 14 tests with
+*>      the parameter RANGE = 'A', 'N' and 'I', respectively.
+*>
+*>      The "sizes" are specified by an array NN(1:NSIZES); the value of
+*>      each element NN(j) specifies one size.
+*>      The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*>      if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*>      This type is used for the matrix A which has half-bandwidth KA.
+*>      B is generated as a well-conditioned positive definite matrix
+*>      with half-bandwidth KB (<= KA).
+*>      Currently, the list of possible types for A is:
+*>
+*>      (1)  The zero matrix.
+*>      (2)  The identity matrix.
+*>
+*>      (3)  A diagonal matrix with evenly spaced entries
+*>           1, ..., ULP  and random signs.
+*>           (ULP = (first number larger than 1) - 1 )
+*>      (4)  A diagonal matrix with geometrically spaced entries
+*>           1, ..., ULP  and random signs.
+*>      (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>           and random signs.
+*>
+*>      (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*>      (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*>      (8)  A matrix of the form  U* D U, where U is unitary and
+*>           D has evenly spaced entries 1, ..., ULP with random signs
+*>           on the diagonal.
+*>
+*>      (9)  A matrix of the form  U* D U, where U is unitary and
+*>           D has geometrically spaced entries 1, ..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (10) A matrix of the form  U* D U, where U is unitary and
+*>           D has "clustered" entries 1, ULP,..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*>      (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*>      (13) Hermitian matrix with random entries chosen from (-1,1).
+*>      (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*>      (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*>
+*>      (16) Same as (8), but with KA = 1 and KB = 1
+*>      (17) Same as (8), but with KA = 2 and KB = 1
+*>      (18) Same as (8), but with KA = 2 and KB = 2
+*>      (19) Same as (8), but with KA = 3 and KB = 1
+*>      (20) Same as (8), but with KA = 3 and KB = 2
+*>      (21) Same as (8), but with KA = 3 and KB = 3
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \verbatim
+*>  NSIZES  INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          CDRVSG2STG does nothing.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NN      INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*>          Not modified.
+*>
+*>  NTYPES  INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, CDRVSG2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*>          Not modified.
+*>
+*>  DOTYPE  LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*>          Not modified.
+*>
+*>  ISEED   INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to CDRVSG2STG to continue the same random number
+*>          sequence.
+*>          Modified.
+*>
+*>  THRESH  REAL
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NOUNIT  INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*>          Not modified.
+*>
+*>  A       COMPLEX array, dimension (LDA , max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDA     INTEGER
+*>          The leading dimension of A.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  B       COMPLEX array, dimension (LDB , max(NN))
+*>          Used to hold the Hermitian positive definite matrix for
+*>          the generailzed problem.
+*>          On exit, B contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDB     INTEGER
+*>          The leading dimension of B.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  D       REAL             array, dimension (max(NN))
+*>          The eigenvalues of A. On exit, the eigenvalues in D
+*>          correspond with the matrix in A.
+*>          Modified.
+*>
+*>  Z       COMPLEX array, dimension (LDZ, max(NN))
+*>          The matrix of eigenvectors.
+*>          Modified.
+*>
+*>  LDZ     INTEGER
+*>          The leading dimension of ZZ.  It must be at least 1 and
+*>          at least max( NN ).
+*>          Not modified.
+*>
+*>  AB      COMPLEX array, dimension (LDA, max(NN))
+*>          Workspace.
+*>          Modified.
+*>
+*>  BB      COMPLEX array, dimension (LDB, max(NN))
+*>          Workspace.
+*>          Modified.
+*>
+*>  AP      COMPLEX array, dimension (max(NN)**2)
+*>          Workspace.
+*>          Modified.
+*>
+*>  BP      COMPLEX array, dimension (max(NN)**2)
+*>          Workspace.
+*>          Modified.
+*>
+*>  WORK    COMPLEX array, dimension (NWORK)
+*>          Workspace.
+*>          Modified.
+*>
+*>  NWORK   INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          2*N + N**2  where  N = max( NN(j), 2 ).
+*>          Not modified.
+*>
+*>  RWORK   REAL array, dimension (LRWORK)
+*>          Workspace.
+*>          Modified.
+*>
+*>  LRWORK  INTEGER
+*>          The number of entries in RWORK.  This must be at least
+*>          max( 7*N, 1 + 4*N + 2*N*lg(N) + 3*N**2 ) where
+*>          N = max( NN(j) ) and lg( N ) = smallest integer k such
+*>          that 2**k >= N .
+*>          Not modified.
+*>
+*>  IWORK   INTEGER array, dimension (LIWORK))
+*>          Workspace.
+*>          Modified.
+*>
+*>  LIWORK  INTEGER
+*>          The number of entries in IWORK.  This must be at least
+*>          2 + 5*max( NN(j) ).
+*>          Not modified.
+*>
+*>  RESULT  REAL array, dimension (70)
+*>          The values computed by the 70 tests described above.
+*>          Modified.
+*>
+*>  INFO    INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -16: LDZ < 1 or LDZ < NMAX.
+*>          -21: NWORK too small.
+*>          -23: LRWORK too small.
+*>          -25: LIWORK too small.
+*>          If  CLATMR, CLATMS, CHEGV, CHPGV, CHBGV, CHEGVD, CHPGVD,
+*>              CHPGVD, CHEGVX, CHPGVX, CHBGVX returns an error code,
+*>              the absolute value of it is returned.
+*>          Modified.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests that have been run
+*>                       on this matrix.
+*>       NTESTT          The total number of tests for this call.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far (computed by SLAFTS).
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex_eig
+*
+*  =====================================================================
+      SUBROUTINE CDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                       NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
+     $                       BB, AP, BP, WORK, NWORK, RWORK, LRWORK,
+     $                       IWORK, LIWORK, RESULT, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
+     $                   NSIZES, NTYPES, NWORK
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      REAL               D( * ), D2( * ), RESULT( * ), RWORK( * )
+      COMPLEX            A( LDA, * ), AB( LDA, * ), AP( * ),
+     $                   B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ),
+     $                   Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE, TEN
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0, TEN = 10.0E+0 )
+      COMPLEX            CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   CONE = ( 1.0E+0, 0.0E+0 ) )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 21 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN
+      CHARACTER          UPLO
+      INTEGER            I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
+     $                   ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
+     $                   KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
+     $                   NTESTT
+      REAL               ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, ULP, ULPINV, UNFL, VL, VU, TEMP1, TEMP2
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      REAL               SLAMCH, SLARND
+      EXTERNAL           LSAME, SLAMCH, SLARND
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLABAD, SLAFTS, SLASUM, XERBLA, CHBGV, CHBGVD,
+     $                   CHBGVX, CHEGV, CHEGVD, CHEGVX, CHPGV, CHPGVD,
+     $                   CHPGVX, CLACPY, CLASET, CLATMR, CLATMS, CSGT01,
+     $                   CHEGV_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, REAL, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 6*1 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 6*4 /
+*     ..
+*     .. Executable Statements ..
+*
+*     1)      Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+      BADNN = .FALSE.
+      NMAX = 0
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN
+         INFO = -16
+      ELSE IF( 2*MAX( NMAX, 2 )**2.GT.NWORK ) THEN
+         INFO = -21
+      ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LRWORK ) THEN
+         INFO = -23
+      ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LIWORK ) THEN
+         INFO = -25
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CDRVSG2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = SLAMCH( 'Safe minimum' )
+      OVFL = SLAMCH( 'Overflow' )
+      CALL SLABAD( UNFL, OVFL )
+      ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+   20 CONTINUE
+*
+*     Loop over sizes, types
+*
+      NERRS = 0
+      NMATS = 0
+*
+      DO 650 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         ANINV = ONE / REAL( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         KA9 = 0
+         KB9 = 0
+         DO 640 JTYPE = 1, MTYPES
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 640
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           2)      Compute "A"
+*
+*                   Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, w/ eigenvalues
+*           =5         random log   hermitian, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random hermitian
+*           =9                      banded, w/ eigenvalues
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 90
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            IINFO = 0
+            COND = ULPINV
+*
+*           Special Matrices -- Identity & Jordan block
+*
+            IF( ITYPE.EQ.1 ) THEN
+*
+*              Zero
+*
+               KA = 0
+               KB = 0
+               CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               KA = 0
+               KB = 0
+               CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+               DO 80 JCOL = 1, N
+                  A( JCOL, JCOL ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               KA = 0
+               KB = 0
+               CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              Hermitian, eigenvalues specified
+*
+               KA = MAX( 0, N-1 )
+               KB = KA
+               CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               KA = 0
+               KB = 0
+               CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              Hermitian, random eigenvalues
+*
+               KA = MAX( 0, N-1 )
+               KB = KA
+               CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              Hermitian banded, eigenvalues specified
+*
+*              The following values are used for the half-bandwidths:
+*
+*                ka = 1   kb = 1
+*                ka = 2   kb = 1
+*                ka = 2   kb = 2
+*                ka = 3   kb = 1
+*                ka = 3   kb = 2
+*                ka = 3   kb = 3
+*
+               KB9 = KB9 + 1
+               IF( KB9.GT.KA9 ) THEN
+                  KA9 = KA9 + 1
+                  KB9 = 1
+               END IF
+               KA = MAX( 0, MIN( N-1, KA9 ) )
+               KB = MAX( 0, MIN( N-1, KB9 ) )
+               CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, KA, KA, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE
+*
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+   90       CONTINUE
+*
+            ABSTOL = UNFL + UNFL
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) )
+               IU = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) )
+               IF( IL.GT.IU ) THEN
+                  ITEMP = IL
+                  IL = IU
+                  IU = ITEMP
+               END IF
+            END IF
+*
+*           3) Call CHEGV, CHPGV, CHBGV, CHEGVD, CHPGVD, CHBGVD,
+*              CHEGVX, CHPGVX and CHBGVX, do tests.
+*
+*           loop over the three generalized problems
+*                 IBTYPE = 1: A*x = (lambda)*B*x
+*                 IBTYPE = 2: A*B*x = (lambda)*x
+*                 IBTYPE = 3: B*A*x = (lambda)*x
+*
+            DO 630 IBTYPE = 1, 3
+*
+*              loop over the setting UPLO
+*
+               DO 620 IBUPLO = 1, 2
+                  IF( IBUPLO.EQ.1 )
+     $               UPLO = 'U'
+                  IF( IBUPLO.EQ.2 )
+     $               UPLO = 'L'
+*
+*                 Generate random well-conditioned positive definite
+*                 matrix B, of bandwidth not greater than that of A.
+*
+                  CALL CLATMS( N, N, 'U', ISEED, 'P', RWORK, 5, TEN,
+     $                         ONE, KB, KB, UPLO, B, LDB, WORK( N+1 ),
+     $                         IINFO )
+*
+*                 Test CHEGV
+*
+                  NTEST = NTEST + 1
+*
+                  CALL CLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL CHEGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
+     $                        WORK, NWORK, RWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CHEGV(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                 Test CHEGV_2STAGE
+*
+                  NTEST = NTEST + 1
+*
+                  CALL CLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL CHEGV_2STAGE( IBTYPE, 'N', UPLO, N, Z, LDZ,
+     $                               BB, LDB, D2, WORK, NWORK, RWORK, 
+     $                               IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )
+     $                  'CHEGV_2STAGE(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+C                  CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+C     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*           
+*                 Do Tests | D1 - D2 | / ( |D1| ulp )
+*                 D1 computed using the standard 1-stage reduction as reference
+*                 D2 computed using the 2-stage reduction
+*           
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+                  DO 151 J = 1, N
+                     TEMP1 = MAX( TEMP1, ABS( D( J ) ), 
+     $                                   ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D( J )-D2( J ) ) )
+  151             CONTINUE
+*           
+                  RESULT( NTEST ) = TEMP2 / 
+     $                              MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*                 Test CHEGVD
+*
+                  NTEST = NTEST + 1
+*
+                  CALL CLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL CHEGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
+     $                         WORK, NWORK, RWORK, LRWORK, IWORK,
+     $                         LIWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CHEGVD(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                 Test CHEGVX
+*
+                  NTEST = NTEST + 1
+*
+                  CALL CLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL CHEGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
+     $                         IWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CHEGVX(V,A' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+                  CALL CLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+*                 since we do not know the exact eigenvalues of this
+*                 eigenpair, we just set VL and VU as constants.
+*                 It is quite possible that there are no eigenvalues
+*                 in this interval.
+*
+                  VL = ZERO
+                  VU = ANORM
+                  CALL CHEGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
+     $                         IWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CHEGVX(V,V,' //
+     $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+                  CALL CLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL CHEGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
+     $                         IWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CHEGVX(V,I,' //
+     $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+  100             CONTINUE
+*
+*                 Test CHPGV
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 120 J = 1, N
+                        DO 110 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  110                   CONTINUE
+  120                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 140 J = 1, N
+                        DO 130 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  130                   CONTINUE
+  140                CONTINUE
+                  END IF
+*
+                  CALL CHPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
+     $                        WORK, RWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CHPGV(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                 Test CHPGVD
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 160 J = 1, N
+                        DO 150 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  150                   CONTINUE
+  160                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 180 J = 1, N
+                        DO 170 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  170                   CONTINUE
+  180                CONTINUE
+                  END IF
+*
+                  CALL CHPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
+     $                         WORK, NWORK, RWORK, LRWORK, IWORK,
+     $                         LIWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CHPGVD(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                 Test CHPGVX
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 200 J = 1, N
+                        DO 190 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  190                   CONTINUE
+  200                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 220 J = 1, N
+                        DO 210 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  210                   CONTINUE
+  220                CONTINUE
+                  END IF
+*
+                  CALL CHPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         RWORK, IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CHPGVX(V,A' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 240 J = 1, N
+                        DO 230 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  230                   CONTINUE
+  240                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 260 J = 1, N
+                        DO 250 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  250                   CONTINUE
+  260                CONTINUE
+                  END IF
+*
+                  VL = ZERO
+                  VU = ANORM
+                  CALL CHPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         RWORK, IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CHPGVX(V,V' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 280 J = 1, N
+                        DO 270 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  270                   CONTINUE
+  280                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 300 J = 1, N
+                        DO 290 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  290                   CONTINUE
+  300                CONTINUE
+                  END IF
+*
+                  CALL CHPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         RWORK, IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'CHPGVX(V,I' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+  310             CONTINUE
+*
+                  IF( IBTYPE.EQ.1 ) THEN
+*
+*                    TEST CHBGV
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 340 J = 1, N
+                           DO 320 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  320                      CONTINUE
+                           DO 330 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  330                      CONTINUE
+  340                   CONTINUE
+                     ELSE
+                        DO 370 J = 1, N
+                           DO 350 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  350                      CONTINUE
+                           DO 360 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  360                      CONTINUE
+  370                   CONTINUE
+                     END IF
+*
+                     CALL CHBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB,
+     $                           D, Z, LDZ, WORK, RWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'CHBGV(V,' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                    TEST CHBGVD
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 400 J = 1, N
+                           DO 380 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  380                      CONTINUE
+                           DO 390 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  390                      CONTINUE
+  400                   CONTINUE
+                     ELSE
+                        DO 430 J = 1, N
+                           DO 410 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  410                      CONTINUE
+                           DO 420 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  420                      CONTINUE
+  430                   CONTINUE
+                     END IF
+*
+                     CALL CHBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB,
+     $                            LDB, D, Z, LDZ, WORK, NWORK, RWORK,
+     $                            LRWORK, IWORK, LIWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'CHBGVD(V,' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                    Test CHBGVX
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 460 J = 1, N
+                           DO 440 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  440                      CONTINUE
+                           DO 450 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  450                      CONTINUE
+  460                   CONTINUE
+                     ELSE
+                        DO 490 J = 1, N
+                           DO 470 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  470                      CONTINUE
+                           DO 480 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  480                      CONTINUE
+  490                   CONTINUE
+                     END IF
+*
+                     CALL CHBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'CHBGVX(V,A' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 520 J = 1, N
+                           DO 500 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  500                      CONTINUE
+                           DO 510 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  510                      CONTINUE
+  520                   CONTINUE
+                     ELSE
+                        DO 550 J = 1, N
+                           DO 530 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  530                      CONTINUE
+                           DO 540 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  540                      CONTINUE
+  550                   CONTINUE
+                     END IF
+*
+                     VL = ZERO
+                     VU = ANORM
+                     CALL CHBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'CHBGVX(V,V' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 580 J = 1, N
+                           DO 560 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  560                      CONTINUE
+                           DO 570 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  570                      CONTINUE
+  580                   CONTINUE
+                     ELSE
+                        DO 610 J = 1, N
+                           DO 590 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  590                      CONTINUE
+                           DO 600 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  600                      CONTINUE
+  610                   CONTINUE
+                     END IF
+*
+                     CALL CHBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'CHBGVX(V,I' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                  END IF
+*
+  620          CONTINUE
+  630       CONTINUE
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+            NTESTT = NTESTT + NTEST
+            CALL SLAFTS( 'CSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
+     $                   THRESH, NOUNIT, NERRS )
+  640    CONTINUE
+  650 CONTINUE
+*
+*     Summary
+*
+      CALL SLASUM( 'CSG', NOUNIT, NERRS, NTESTT )
+*
+      RETURN
+*
+ 9999 FORMAT( ' CDRVSG2STG: ', A, ' returned INFO=', I6, '.', / 9X,
+     $  'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+*
+*     End of CDRVSG2STG
+*
+      END
diff --git a/TESTING/EIG/cdrvst2stg.f b/TESTING/EIG/cdrvst2stg.f
new file mode 100644
index 00000000..3d452e3a
--- /dev/null
+++ b/TESTING/EIG/cdrvst2stg.f
@@ -0,0 +1,2116 @@
+*> \brief \b CDRVST2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                          NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U,
+*                          LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK,
+*                          IWORK, LIWORK, RESULT, INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
+*      $                   NSIZES, NTYPES
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       REAL               D1( * ), D2( * ), D3( * ), RESULT( * ),
+*      $                   RWORK( * ), WA1( * ), WA2( * ), WA3( * )
+*       COMPLEX            A( LDA, * ), TAU( * ), U( LDU, * ),
+*      $                   V( LDU, * ), WORK( * ), Z( LDU, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>      CDRVST2STG  checks the Hermitian eigenvalue problem drivers.
+*>
+*>              CHEEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix,
+*>              using a divide-and-conquer algorithm.
+*>
+*>              CHEEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix.
+*>
+*>              CHEEVR computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix
+*>              using the Relatively Robust Representation where it can.
+*>
+*>              CHPEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix in packed
+*>              storage, using a divide-and-conquer algorithm.
+*>
+*>              CHPEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix in packed
+*>              storage.
+*>
+*>              CHBEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian band matrix,
+*>              using a divide-and-conquer algorithm.
+*>
+*>              CHBEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian band matrix.
+*>
+*>              CHEEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix.
+*>
+*>              CHPEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix in packed
+*>              storage.
+*>
+*>              CHBEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian band matrix.
+*>
+*>      When CDRVST2STG is called, a number of matrix "sizes" ("n's") and a
+*>      number of matrix "types" are specified.  For each size ("n")
+*>      and each type of matrix, one matrix will be generated and used
+*>      to test the appropriate drivers.  For each matrix and each
+*>      driver routine called, the following tests will be performed:
+*>
+*>      (1)     | A - Z D Z' | / ( |A| n ulp )
+*>
+*>      (2)     | I - Z Z' | / ( n ulp )
+*>
+*>      (3)     | D1 - D2 | / ( |D1| ulp )
+*>
+*>      where Z is the matrix of eigenvectors returned when the
+*>      eigenvector option is given and D1 and D2 are the eigenvalues
+*>      returned with and without the eigenvector option.
+*>
+*>      The "sizes" are specified by an array NN(1:NSIZES); the value of
+*>      each element NN(j) specifies one size.
+*>      The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*>      if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*>      Currently, the list of possible types is:
+*>
+*>      (1)  The zero matrix.
+*>      (2)  The identity matrix.
+*>
+*>      (3)  A diagonal matrix with evenly spaced entries
+*>           1, ..., ULP  and random signs.
+*>           (ULP = (first number larger than 1) - 1 )
+*>      (4)  A diagonal matrix with geometrically spaced entries
+*>           1, ..., ULP  and random signs.
+*>      (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>           and random signs.
+*>
+*>      (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*>      (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*>      (8)  A matrix of the form  U* D U, where U is unitary and
+*>           D has evenly spaced entries 1, ..., ULP with random signs
+*>           on the diagonal.
+*>
+*>      (9)  A matrix of the form  U* D U, where U is unitary and
+*>           D has geometrically spaced entries 1, ..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (10) A matrix of the form  U* D U, where U is unitary and
+*>           D has "clustered" entries 1, ULP,..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*>      (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*>      (13) Symmetric matrix with random entries chosen from (-1,1).
+*>      (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*>      (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*>      (16) A band matrix with half bandwidth randomly chosen between
+*>           0 and N-1, with evenly spaced eigenvalues 1, ..., ULP
+*>           with random signs.
+*>      (17) Same as (16), but multiplied by SQRT( overflow threshold )
+*>      (18) Same as (16), but multiplied by SQRT( underflow threshold )
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \verbatim
+*>  NSIZES  INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          CDRVST2STG does nothing.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NN      INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*>          Not modified.
+*>
+*>  NTYPES  INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, CDRVST2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*>          Not modified.
+*>
+*>  DOTYPE  LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*>          Not modified.
+*>
+*>  ISEED   INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to CDRVST2STG to continue the same random number
+*>          sequence.
+*>          Modified.
+*>
+*>  THRESH  REAL
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NOUNIT  INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*>          Not modified.
+*>
+*>  A       COMPLEX array, dimension (LDA , max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDA     INTEGER
+*>          The leading dimension of A.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  D1      REAL             array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by CSTEQR simlutaneously
+*>          with Z.  On exit, the eigenvalues in D1 correspond with the
+*>          matrix in A.
+*>          Modified.
+*>
+*>  D2      REAL             array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by CSTEQR if Z is not
+*>          computed.  On exit, the eigenvalues in D2 correspond with
+*>          the matrix in A.
+*>          Modified.
+*>
+*>  D3      REAL             array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by SSTERF.  On exit, the
+*>          eigenvalues in D3 correspond with the matrix in A.
+*>          Modified.
+*>
+*>  WA1     REAL array, dimension
+*>
+*>  WA2     REAL array, dimension
+*>
+*>  WA3     REAL array, dimension
+*>
+*>  U       COMPLEX array, dimension (LDU, max(NN))
+*>          The unitary matrix computed by CHETRD + CUNGC3.
+*>          Modified.
+*>
+*>  LDU     INTEGER
+*>          The leading dimension of U, Z, and V.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  V       COMPLEX array, dimension (LDU, max(NN))
+*>          The Housholder vectors computed by CHETRD in reducing A to
+*>          tridiagonal form.
+*>          Modified.
+*>
+*>  TAU     COMPLEX array, dimension (max(NN))
+*>          The Householder factors computed by CHETRD in reducing A
+*>          to tridiagonal form.
+*>          Modified.
+*>
+*>  Z       COMPLEX array, dimension (LDU, max(NN))
+*>          The unitary matrix of eigenvectors computed by CHEEVD,
+*>          CHEEVX, CHPEVD, CHPEVX, CHBEVD, and CHBEVX.
+*>          Modified.
+*>
+*>  WORK  - COMPLEX array of dimension ( LWORK )
+*>           Workspace.
+*>           Modified.
+*>
+*>  LWORK - INTEGER
+*>           The number of entries in WORK.  This must be at least
+*>           2*max( NN(j), 2 )**2.
+*>           Not modified.
+*>
+*>  RWORK   REAL array, dimension (3*max(NN))
+*>           Workspace.
+*>           Modified.
+*>
+*>  LRWORK - INTEGER
+*>           The number of entries in RWORK.
+*>
+*>  IWORK   INTEGER array, dimension (6*max(NN))
+*>          Workspace.
+*>          Modified.
+*>
+*>  LIWORK - INTEGER
+*>           The number of entries in IWORK.
+*>
+*>  RESULT  REAL array, dimension (??)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*>          Modified.
+*>
+*>  INFO    INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -16: LDU < 1 or LDU < NMAX.
+*>          -21: LWORK too small.
+*>          If  SLATMR, SLATMS, CHETRD, SORGC3, CSTEQR, SSTERF,
+*>              or SORMC2 returns an error code, the
+*>              absolute value of it is returned.
+*>          Modified.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far (computed by SLAFTS).
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex_eig
+*
+*  =====================================================================
+      SUBROUTINE CDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                   NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U,
+     $                   LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK,
+     $                   IWORK, LIWORK, RESULT, INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
+     $                   NSIZES, NTYPES
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      REAL               D1( * ), D2( * ), D3( * ), RESULT( * ),
+     $                   RWORK( * ), WA1( * ), WA2( * ), WA3( * )
+      COMPLEX            A( LDA, * ), TAU( * ), U( LDU, * ),
+     $                   V( LDU, * ), WORK( * ), Z( LDU, * )
+*     ..
+*
+*  =====================================================================
+*
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE, TWO, TEN
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
+     $                   TEN = 10.0E+0 )
+      REAL               HALF
+      PARAMETER          ( HALF = ONE / TWO )
+      COMPLEX            CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   CONE = ( 1.0E+0, 0.0E+0 ) )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 18 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN
+      CHARACTER          UPLO
+      INTEGER            I, IDIAG, IHBW, IINFO, IL, IMODE, INDWRK, INDX,
+     $                   IROW, ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL,
+     $                   JSIZE, JTYPE, KD, LGN, LIWEDC, LRWEDC, LWEDC,
+     $                   M, M2, M3, MTYPES, N, NERRS, NMATS, NMAX,
+     $                   NTEST, NTESTT
+      REAL               ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL,
+     $                   VL, VU
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      REAL               SLAMCH, SLARND, SSXT1
+      EXTERNAL           SLAMCH, SLARND, SSXT1
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALASVM, SLABAD, SLAFTS, XERBLA, CHBEV, CHBEVD,
+     $                   CHBEVX, CHEEV, CHEEVD, CHEEVR, CHEEVX, CHET21,
+     $                   CHET22, CHPEV, CHPEVD, CHPEVX, CLACPY, CLASET,
+     $                   CHEEVD_2STAGE, CHEEVR_2STAGE, CHEEVX_2STAGE,
+     $                   CHEEV_2STAGE, CHBEV_2STAGE, CHBEVD_2STAGE,
+     $                   CHBEVX_2STAGE, CHETRD_2STAGE, CHETRD_SY2SB, 
+     $                   CHETRD_SB2ST, CLATMR, CLATMS
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, REAL, INT, LOG, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 1, 2, 3 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 4, 4, 4 /
+*     ..
+*     .. Executable Statements ..
+*
+*     1)      Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+      BADNN = .FALSE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -16
+      ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
+         INFO = -22
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CDRVST2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if nothing to do
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = SLAMCH( 'Safe minimum' )
+      OVFL = SLAMCH( 'Overflow' )
+      CALL SLABAD( UNFL, OVFL )
+      ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+         ISEED3( I ) = ISEED( I )
+   20 CONTINUE
+*
+      NERRS = 0
+      NMATS = 0
+*
+      DO 1220 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         IF( N.GT.0 ) THEN
+            LGN = INT( LOG( REAL( N ) ) / LOG( TWO ) )
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            LWEDC = MAX( 2*N+N*N, 2*N*N )
+            LRWEDC = 1 + 4*N + 2*N*LGN + 3*N**2
+            LIWEDC = 3 + 5*N
+         ELSE
+            LWEDC = 2
+            LRWEDC = 8
+            LIWEDC = 8
+         END IF
+         ANINV = ONE / REAL( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         DO 1210 JTYPE = 1, MTYPES
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 1210
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           2)      Compute "A"
+*
+*                   Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, (w/ eigenvalues)
+*           =5         random log   Hermitian, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random Hermitian
+*           =9                      band Hermitian, w/ eigenvalues
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 110
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+            IINFO = 0
+            COND = ULPINV
+*
+*           Special Matrices -- Identity & Jordan block
+*
+*                   Zero
+*
+            IF( ITYPE.EQ.1 ) THEN
+               IINFO = 0
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               DO 80 JCOL = 1, N
+                  A( JCOL, JCOL ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              Hermitian, eigenvalues specified
+*
+               CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              Hermitian, random eigenvalues
+*
+               CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              Hermitian banded, eigenvalues specified
+*
+               IHBW = INT( ( N-1 )*SLARND( 1, ISEED3 ) )
+               CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, IHBW, IHBW, 'Z', U, LDU, WORK,
+     $                      IINFO )
+*
+*              Store as dense matrix for most routines.
+*
+               CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+               DO 100 IDIAG = -IHBW, IHBW
+                  IROW = IHBW - IDIAG + 1
+                  J1 = MAX( 1, IDIAG+1 )
+                  J2 = MIN( N, N+IDIAG )
+                  DO 90 J = J1, J2
+                     I = J - IDIAG
+                     A( I, J ) = U( IROW, J )
+   90             CONTINUE
+  100          CONTINUE
+            ELSE
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+  110       CONTINUE
+*
+            ABSTOL = UNFL + UNFL
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) )
+               IU = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) )
+               IF( IL.GT.IU ) THEN
+                  ITEMP = IL
+                  IL = IU
+                  IU = ITEMP
+               END IF
+            END IF
+*
+*           Perform tests storing upper or lower triangular
+*           part of matrix.
+*
+            DO 1200 IUPLO = 0, 1
+               IF( IUPLO.EQ.0 ) THEN
+                  UPLO = 'L'
+               ELSE
+                  UPLO = 'U'
+               END IF
+*
+*              Call CHEEVD and CHEEVX.
+*
+               CALL CLACPY( ' ', N, N, A, LDA, V, LDU )
+*
+               NTEST = NTEST + 1
+               CALL CHEEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC,
+     $                      RWORK, LRWEDC, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHEEVD(V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 130
+                  END IF
+               END IF
+*
+*              Do tests 1 and 2.
+*
+               CALL CHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 2
+               CALL CHEEVD_2STAGE( 'N', UPLO, N, A, LDU, D3, WORK,
+     $                      LWORK, RWORK, LRWEDC, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'CHEEVD_2STAGE(N,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 130
+                  END IF
+               END IF
+*
+*              Do test 3.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 120 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  120          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  130          CONTINUE
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 1
+*
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
+                  IF( IL.NE.1 ) THEN
+                     VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  TEMP3 = ZERO
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               CALL CHEEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, WORK, LWORK, RWORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHEEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Do tests 4 and 5.
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL CHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL CHEEVX_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M2, WA2, Z, LDU,
+     $                             WORK, LWORK, RWORK, IWORK, 
+     $                             IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'CHEEVX_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Do test 6.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 140 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+  140          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  150          CONTINUE
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 1
+*
+               CALL CHEEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHEEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 160
+                  END IF
+               END IF
+*
+*              Do tests 7 and 8.
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               CALL CHEEVX_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M3, WA3, Z, LDU,
+     $                             WORK, LWORK, RWORK, IWORK, 
+     $                             IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'CHEEVX_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 160
+                  END IF
+               END IF
+*
+*              Do test 9.
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  160          CONTINUE
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 1
+*
+               CALL CHEEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHEEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 170
+                  END IF
+               END IF
+*
+*              Do tests 10 and 11.
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               CALL CHEEVX_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M3, WA3, Z, LDU,
+     $                             WORK, LWORK, RWORK, IWORK, 
+     $                             IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'CHEEVX_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 170
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 170
+               END IF
+*
+*              Do test 12.
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  170          CONTINUE
+*
+*              Call CHPEVD and CHPEVX.
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+*              Load array WORK with the upper or lower triangular
+*              part of the matrix in packed form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 190 J = 1, N
+                     DO 180 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  180                CONTINUE
+  190             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 210 J = 1, N
+                     DO 200 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  200                CONTINUE
+  210             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               INDWRK = N*( N+1 ) / 2 + 1
+               CALL CHPEVD( 'V', UPLO, N, WORK, D1, Z, LDU,
+     $                      WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK,
+     $                      LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHPEVD(V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 270
+                  END IF
+               END IF
+*
+*              Do tests 13 and 14.
+*
+               CALL CHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 230 J = 1, N
+                     DO 220 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  220                CONTINUE
+  230             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 250 J = 1, N
+                     DO 240 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  240                CONTINUE
+  250             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               INDWRK = N*( N+1 ) / 2 + 1
+               CALL CHPEVD( 'N', UPLO, N, WORK, D3, Z, LDU,
+     $                      WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK,
+     $                      LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHPEVD(N,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 270
+                  END IF
+               END IF
+*
+*              Do test 15.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 260 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  260          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*              Load array WORK with the upper or lower triangular part
+*              of the matrix in packed form.
+*
+  270          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 290 J = 1, N
+                     DO 280 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  280                CONTINUE
+  290             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 310 J = 1, N
+                     DO 300 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  300                CONTINUE
+  310             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+*
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
+                  IF( IL.NE.1 ) THEN
+                     VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  TEMP3 = ZERO
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               CALL CHPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHPEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 370
+                  END IF
+               END IF
+*
+*              Do tests 16 and 17.
+*
+               CALL CHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 330 J = 1, N
+                     DO 320 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  320                CONTINUE
+  330             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 350 J = 1, N
+                     DO 340 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  340                CONTINUE
+  350             CONTINUE
+               END IF
+*
+               CALL CHPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHPEVX(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 370
+                  END IF
+               END IF
+*
+*              Do test 18.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 360 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+  360          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  370          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 390 J = 1, N
+                     DO 380 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  380                CONTINUE
+  390             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 410 J = 1, N
+                     DO 400 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  400                CONTINUE
+  410             CONTINUE
+               END IF
+*
+               CALL CHPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHPEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 460
+                  END IF
+               END IF
+*
+*              Do tests 19 and 20.
+*
+               CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 430 J = 1, N
+                     DO 420 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  420                CONTINUE
+  430             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 450 J = 1, N
+                     DO 440 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  440                CONTINUE
+  450             CONTINUE
+               END IF
+*
+               CALL CHPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHPEVX(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 460
+                  END IF
+               END IF
+*
+*              Do test 21.
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  460          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 480 J = 1, N
+                     DO 470 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  470                CONTINUE
+  480             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 500 J = 1, N
+                     DO 490 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  490                CONTINUE
+  500             CONTINUE
+               END IF
+*
+               CALL CHPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHPEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 550
+                  END IF
+               END IF
+*
+*              Do tests 22 and 23.
+*
+               CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 520 J = 1, N
+                     DO 510 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  510                CONTINUE
+  520             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 540 J = 1, N
+                     DO 530 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  530                CONTINUE
+  540             CONTINUE
+               END IF
+*
+               CALL CHPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHPEVX(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 550
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 550
+               END IF
+*
+*              Do test 24.
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  550          CONTINUE
+*
+*              Call CHBEVD and CHBEVX.
+*
+               IF( JTYPE.LE.7 ) THEN
+                  KD = 0
+               ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
+                  KD = MAX( N-1, 0 )
+               ELSE
+                  KD = IHBW
+               END IF
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 570 J = 1, N
+                     DO 560 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  560                CONTINUE
+  570             CONTINUE
+               ELSE
+                  DO 590 J = 1, N
+                     DO 580 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  580                CONTINUE
+  590             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               CALL CHBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
+     $                      LWEDC, RWORK, LRWEDC, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )'CHBEVD(V,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 650
+                  END IF
+               END IF
+*
+*              Do tests 25 and 26.
+*
+               CALL CHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 610 J = 1, N
+                     DO 600 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  600                CONTINUE
+  610             CONTINUE
+               ELSE
+                  DO 630 J = 1, N
+                     DO 620 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  620                CONTINUE
+  630             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               CALL CHBEVD_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, 
+     $                             Z, LDU, WORK, LWORK, RWORK,
+     $                             LRWEDC, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )
+     $               'CHBEVD_2STAGE(N,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 650
+                  END IF
+               END IF
+*
+*              Do test 27.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 640 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  640          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+  650          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 670 J = 1, N
+                     DO 660 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  660                CONTINUE
+  670             CONTINUE
+               ELSE
+                  DO 690 J = 1, N
+                     DO 680 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  680                CONTINUE
+  690             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               CALL CHBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M, WA1, Z, LDU, WORK,
+     $                      RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHBEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 750
+                  END IF
+               END IF
+*
+*              Do tests 28 and 29.
+*
+               CALL CHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 710 J = 1, N
+                     DO 700 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  700                CONTINUE
+  710             CONTINUE
+               ELSE
+                  DO 730 J = 1, N
+                     DO 720 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  720                CONTINUE
+  730             CONTINUE
+               END IF
+*
+               CALL CHBEVX_2STAGE( 'N', 'A', UPLO, N, KD, V, LDU,
+     $                             U, LDU, VL, VU, IL, IU, ABSTOL,
+     $                             M2, WA2, Z, LDU, WORK, LWORK,
+     $                             RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )
+     $               'CHBEVX_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 750
+                  END IF
+               END IF
+*
+*              Do test 30.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 740 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+  740          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+  750          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 770 J = 1, N
+                     DO 760 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  760                CONTINUE
+  770             CONTINUE
+               ELSE
+                  DO 790 J = 1, N
+                     DO 780 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  780                CONTINUE
+  790             CONTINUE
+               END IF
+*
+               CALL CHBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
+     $                      RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )'CHBEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 840
+                  END IF
+               END IF
+*
+*              Do tests 31 and 32.
+*
+               CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 810 J = 1, N
+                     DO 800 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  800                CONTINUE
+  810             CONTINUE
+               ELSE
+                  DO 830 J = 1, N
+                     DO 820 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  820                CONTINUE
+  830             CONTINUE
+               END IF
+               CALL CHBEVX_2STAGE( 'N', 'I', UPLO, N, KD, V, LDU,
+     $                             U, LDU, VL, VU, IL, IU, ABSTOL,
+     $                             M3, WA3, Z, LDU, WORK, LWORK,
+     $                             RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )
+     $               'CHBEVX_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 840
+                  END IF
+               END IF
+*
+*              Do test 33.
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+  840          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 860 J = 1, N
+                     DO 850 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  850                CONTINUE
+  860             CONTINUE
+               ELSE
+                  DO 880 J = 1, N
+                     DO 870 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  870                CONTINUE
+  880             CONTINUE
+               END IF
+               CALL CHBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
+     $                      RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )'CHBEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 930
+                  END IF
+               END IF
+*
+*              Do tests 34 and 35.
+*
+               CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 900 J = 1, N
+                     DO 890 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  890                CONTINUE
+  900             CONTINUE
+               ELSE
+                  DO 920 J = 1, N
+                     DO 910 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  910                CONTINUE
+  920             CONTINUE
+               END IF
+               CALL CHBEVX_2STAGE( 'N', 'V', UPLO, N, KD, V, LDU,
+     $                             U, LDU, VL, VU, IL, IU, ABSTOL,
+     $                             M3, WA3, Z, LDU, WORK, LWORK,
+     $                             RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )
+     $               'CHBEVX_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 930
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 930
+               END IF
+*
+*              Do test 36.
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  930          CONTINUE
+*
+*              Call CHEEV
+*
+               CALL CLACPY( ' ', N, N, A, LDA, V, LDU )
+*
+               NTEST = NTEST + 1
+               CALL CHEEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK, RWORK,
+     $                     IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHEEV(V,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 950
+                  END IF
+               END IF
+*
+*              Do tests 37 and 38
+*
+               CALL CHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 2
+               CALL CHEEV_2STAGE( 'N', UPLO, N, A, LDU, D3,
+     $                            WORK, LWORK, RWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'CHEEV_2STAGE(N,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 950
+                  END IF
+               END IF
+*
+*              Do test 39
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 940 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  940          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  950          CONTINUE
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+*              Call CHPEV
+*
+*              Load array WORK with the upper or lower triangular
+*              part of the matrix in packed form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 970 J = 1, N
+                     DO 960 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  960                CONTINUE
+  970             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 990 J = 1, N
+                     DO 980 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  980                CONTINUE
+  990             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               INDWRK = N*( N+1 ) / 2 + 1
+               CALL CHPEV( 'V', UPLO, N, WORK, D1, Z, LDU,
+     $                     WORK( INDWRK ), RWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHPEV(V,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1050
+                  END IF
+               END IF
+*
+*              Do tests 40 and 41.
+*
+               CALL CHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 1010 J = 1, N
+                     DO 1000 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1000                CONTINUE
+ 1010             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 1030 J = 1, N
+                     DO 1020 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1020                CONTINUE
+ 1030             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               INDWRK = N*( N+1 ) / 2 + 1
+               CALL CHPEV( 'N', UPLO, N, WORK, D3, Z, LDU,
+     $                     WORK( INDWRK ), RWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHPEV(N,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1050
+                  END IF
+               END IF
+*
+*              Do test 42
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1040 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1040          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1050          CONTINUE
+*
+*              Call CHBEV
+*
+               IF( JTYPE.LE.7 ) THEN
+                  KD = 0
+               ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
+                  KD = MAX( N-1, 0 )
+               ELSE
+                  KD = IHBW
+               END IF
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1070 J = 1, N
+                     DO 1060 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1060                CONTINUE
+ 1070             CONTINUE
+               ELSE
+                  DO 1090 J = 1, N
+                     DO 1080 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1080                CONTINUE
+ 1090             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               CALL CHBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
+     $                     RWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )'CHBEV(V,' // UPLO // ')',
+     $               IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1140
+                  END IF
+               END IF
+*
+*              Do tests 43 and 44.
+*
+               CALL CHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1110 J = 1, N
+                     DO 1100 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1100                CONTINUE
+ 1110             CONTINUE
+               ELSE
+                  DO 1130 J = 1, N
+                     DO 1120 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1120                CONTINUE
+ 1130             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               CALL CHBEV_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU,
+     $                            WORK, LWORK, RWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )
+     $               'CHBEV_2STAGE(N,' // UPLO // ')',
+     $               IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1140
+                  END IF
+               END IF
+*
+ 1140          CONTINUE
+*
+*              Do test 45.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1150 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1150          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+               CALL CLACPY( ' ', N, N, A, LDA, V, LDU )
+               NTEST = NTEST + 1
+               CALL CHEEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK,
+     $                      RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHEEVR(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1170
+                  END IF
+               END IF
+*
+*              Do tests 45 and 46 (or ... )
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL CHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL CHEEVR_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M2, WA2, Z, LDU,
+     $                             IWORK, WORK, LWORK, RWORK, LRWORK,
+     $                             IWORK( 2*N+1 ), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'CHEEVR_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1170
+                  END IF
+               END IF
+*
+*              Do test 47 (or ... )
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1160 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+ 1160          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1170          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+               CALL CHEEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHEEVR(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1180
+                  END IF
+               END IF
+*
+*              Do tests 48 and 49 (or +??)
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+               CALL CHEEVR_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M3, WA3, Z, LDU,
+     $                             IWORK, WORK, LWORK, RWORK, LRWORK,
+     $                             IWORK( 2*N+1 ), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'CHEEVR_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1180
+                  END IF
+               END IF
+*
+*              Do test 50 (or +??)
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, ULP*TEMP3 )
+ 1180          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+               CALL CHEEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'CHEEVR(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1190
+                  END IF
+               END IF
+*
+*              Do tests 51 and 52 (or +??)
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL CHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+               CALL CHEEVR_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M3, WA3, Z, LDU,
+     $                             IWORK, WORK, LWORK, RWORK, LRWORK,
+     $                             IWORK( 2*N+1 ), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'CHEEVR_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1190
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 1190
+               END IF
+*
+*              Do test 52 (or +??)
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+               CALL CLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+*
+*
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+ 1190          CONTINUE
+*
+ 1200       CONTINUE
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+            NTESTT = NTESTT + NTEST
+            CALL SLAFTS( 'CST', N, N, JTYPE, NTEST, RESULT, IOLDSD,
+     $                   THRESH, NOUNIT, NERRS )
+*
+ 1210    CONTINUE
+ 1220 CONTINUE
+*
+*     Summary
+*
+      CALL ALASVM( 'CST', NOUNIT, NERRS, NTESTT, 0 )
+*
+ 9999 FORMAT( ' CDRVST2STG: ', A, ' returned INFO=', I6, / 9X, 'N=', I6,
+     $      ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+ 9998 FORMAT( ' CDRVST2STG: ', A, ' returned INFO=', I6, / 9X, 'N=', I6,
+     $      ', KD=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5,
+     $      ')' )
+*
+      RETURN
+*
+*     End of CDRVST2STG
+*
+      END
diff --git a/TESTING/EIG/cerrst.f b/TESTING/EIG/cerrst.f
index 14e4bfbe..c15bf5f4 100644
--- a/TESTING/EIG/cerrst.f
+++ b/TESTING/EIG/cerrst.f
@@ -25,6 +25,10 @@
 *> CUNGTR, CUPMTR, CSTEQR, CSTEIN, CPTEQR, CHBTRD,
 *> CHEEV, CHEEVX, CHEEVD, CHBEV, CHBEVX, CHBEVD,
 *> CHPEV, CHPEVX, CHPEVD, and CSTEDC.
+*> CHEEVD_2STAGE, CHEEVR_2STAGE, CHEEVX_2STAGE,
+*> CHEEV_2STAGE, CHBEV_2STAGE, CHBEVD_2STAGE,
+*> CHBEVX_2STAGE, CHETRD_2STAGE, CHETRD_SY2SB,
+*> CHETRD_SB2ST
 *> \endverbatim
 *
 *  Arguments:
@@ -93,7 +97,11 @@
       EXTERNAL           CHBEV, CHBEVD, CHBEVX, CHBTRD, CHEEV, CHEEVD,
      $                   CHEEVR, CHEEVX, CHETRD, CHKXER, CHPEV, CHPEVD,
      $                   CHPEVX, CHPTRD, CPTEQR, CSTEDC, CSTEIN, CSTEQR,
-     $                   CUNGTR, CUNMTR, CUPGTR, CUPMTR
+     $                   CUNGTR, CUNMTR, CUPGTR, CUPMTR,
+     $                   CHEEVD_2STAGE, CHEEVR_2STAGE, CHEEVX_2STAGE,
+     $                   CHEEV_2STAGE, CHBEV_2STAGE, CHBEVD_2STAGE,
+     $                   CHBEVX_2STAGE, CHETRD_2STAGE, CHETRD_SY2SB,
+     $                   CHETRD_SB2ST
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -151,6 +159,103 @@
          CALL CHKXER( 'CHETRD', INFOT, NOUT, LERR, OK )
          NT = NT + 4
 *
+*        CHETRD_2STAGE
+*
+         SRNAMT = 'CHETRD_2STAGE'
+         INFOT = 1
+         CALL CHETRD_2STAGE( '/', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL CHETRD_2STAGE( 'H', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRD_2STAGE( 'N', '/', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHETRD_2STAGE( 'N', 'U', -1, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHETRD_2STAGE( 'N', 'U', 2, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHETRD_2STAGE( 'N', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 0, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL CHETRD_2STAGE( 'N', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 0, INFO )
+         CALL CHKXER( 'CHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 7
+*
+*        CHETRD_HE2HB
+*
+         SRNAMT = 'CHETRD_HE2HB'
+         INFOT = 1
+         CALL CHETRD_HE2HB( '/', 0, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRD_HE2HB( 'U', -1, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHETRD_HE2HB( 'U', 0, -1, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHETRD_HE2HB( 'U', 2, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRD_HE2HB( 'U', 0, 2, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHETRD_HE2HB( 'U', 0, 0, A, 1, C, 1, TAU, W, 0, INFO )
+         CALL CHKXER( 'CHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         NT = NT + 6
+*
+*        CHETRD_HB2ST
+*
+         SRNAMT = 'CHETRD_HB2ST'
+         INFOT = 1
+         CALL CHETRD_HB2ST( '/', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRD_HB2ST( 'Y', '/', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRD_HB2ST( 'Y', 'H', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHETRD_HB2ST( 'Y', 'N', '/', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETRD_HB2ST( 'Y', 'N', 'U', -1, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHETRD_HB2ST( 'Y', 'N', 'U', 0, -1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRD_HB2ST( 'Y', 'N', 'U', 0, 1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CHETRD_HB2ST( 'Y', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 0, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL CHETRD_HB2ST( 'Y', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 0, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         NT = NT + 9
+*
 *        CUNGTR
 *
          SRNAMT = 'CUNGTR'
@@ -377,6 +482,63 @@
          CALL CHKXER( 'CHEEVD', INFOT, NOUT, LERR, OK )
          NT = NT + 12
 *
+*        CHEEVD_2STAGE
+*
+         SRNAMT = 'CHEEVD_2STAGE'
+         INFOT = 1
+         CALL CHEEVD_2STAGE( '/', 'U', 0, A, 1, X, W, 1,
+     $                              RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL CHEEVD_2STAGE( 'V', 'U', 0, A, 1, X, W, 1,
+     $                              RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHEEVD_2STAGE( 'N', '/', 0, A, 1, X, W, 1,
+     $                              RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHEEVD_2STAGE( 'N', 'U', -1, A, 1, X, W, 1,
+     $                               RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHEEVD_2STAGE( 'N', 'U', 2, A, 1, X, W, 3,
+     $                              RW, 2, IW, 1, INFO )
+         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHEEVD_2STAGE( 'N', 'U', 1, A, 1, X, W, 0,
+     $                              RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHEEVD_2STAGE( 'N', 'U', 2, A, 2, X, W, 2,
+     $                              RW, 2, IW, 1, INFO )
+         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 8
+*         CALL CHEEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 3,
+*     $                            RW, 25, IW, 12, INFO )
+*         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHEEVD_2STAGE( 'N', 'U', 1, A, 1, X, W, 1,
+     $                              RW, 0, IW, 1, INFO )
+         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHEEVD_2STAGE( 'N', 'U', 2, A, 2, X, W, 25,
+     $                              RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 10
+*         CALL CHEEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 8,
+*     $                            RW, 18, IW, 12, INFO )
+*         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL CHEEVD_2STAGE( 'N', 'U', 1, A, 1, X, W, 1,
+     $                              RW, 1, IW, 0, INFO )
+         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+*         CALL CHEEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 8,
+*     $                            RW, 25, IW, 11, INFO )
+*         CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 10
+*
 *        CHEEV
 *
          SRNAMT = 'CHEEV '
@@ -397,6 +559,29 @@
          CALL CHKXER( 'CHEEV ', INFOT, NOUT, LERR, OK )
          NT = NT + 5
 *
+*        CHEEV_2STAGE
+*
+         SRNAMT = 'CHEEV_2STAGE '
+         INFOT = 1
+         CALL CHEEV_2STAGE( '/', 'U', 0, A, 1, X, W, 1, RW, INFO )
+         CALL CHKXER( 'CHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL CHEEV_2STAGE( 'V', 'U', 0, A, 1, X, W, 1, RW, INFO )
+         CALL CHKXER( 'CHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHEEV_2STAGE( 'N', '/', 0, A, 1, X, W, 1, RW, INFO )
+         CALL CHKXER( 'CHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHEEV_2STAGE( 'N', 'U', -1, A, 1, X, W, 1, RW, INFO )
+         CALL CHKXER( 'CHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHEEV_2STAGE( 'N', 'U', 2, A, 1, X, W, 3, RW, INFO )
+         CALL CHKXER( 'CHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHEEV_2STAGE( 'N', 'U', 2, A, 2, X, W, 2, RW, INFO )
+         CALL CHKXER( 'CHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         NT = NT + 6
+*
 *        CHEEVX
 *
          SRNAMT = 'CHEEVX'
@@ -441,6 +626,65 @@
          CALL CHKXER( 'CHEEVX', INFOT, NOUT, LERR, OK )
          NT = NT + 10
 *
+*        CHEEVX_2STAGE
+*
+         SRNAMT = 'CHEEVX_2STAGE'
+         INFOT = 1
+         CALL CHEEVX_2STAGE( '/', 'A', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL CHEEVX_2STAGE( 'V', 'A', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHEEVX_2STAGE( 'N', '/', 'U', 0, A, 1,
+     $                0.0D0, 1.0D0, 1, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHEEVX_2STAGE( 'N', 'A', '/', 0, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         INFOT = 4
+         CALL CHEEVX_2STAGE( 'N', 'A', 'U', -1, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL CHEEVX_2STAGE( 'N', 'A', 'U', 2, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 2, W, 3, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHEEVX_2STAGE( 'N', 'V', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CHEEVX_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHEEVX_2STAGE( 'N', 'I', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 2, 1, 0.0D0,
+     $                M, X, Z, 2, W, 3, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL CHEEVX_2STAGE( 'N', 'A', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 0, W, 3, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 17
+         CALL CHEEVX_2STAGE( 'N', 'A', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 2, W, 0, RW, IW, I1, INFO )
+         CALL CHKXER( 'CHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 11
+*
 *        CHEEVR
 *
          SRNAMT = 'CHEEVR'
@@ -508,6 +752,90 @@
          CALL CHKXER( 'CHEEVR', INFOT, NOUT, LERR, OK )
          NT = NT + 12
 *
+*        CHEEVR_2STAGE
+*
+         SRNAMT = 'CHEEVR_2STAGE'
+         N = 1
+         INFOT = 1
+         CALL CHEEVR_2STAGE( '/', 'A', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL CHEEVR_2STAGE( 'V', 'A', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHEEVR_2STAGE( 'N', '/', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHEEVR_2STAGE( 'N', 'A', '/', -1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N,
+     $                IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHEEVR_2STAGE( 'N', 'A', 'U', -1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N,
+     $                IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL CHEEVR_2STAGE( 'N', 'A', 'U', 2, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHEEVR_2STAGE( 'N', 'V', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 0, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHEEVR_2STAGE( 'N', 'I', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 2, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL CHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 0, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 18
+         CALL CHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N-1, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 20
+         CALL CHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, RW, 24*N-1, IW( 2*N-1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 22
+         CALL CHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, RW, 24*N, IW, 10*N-1,
+     $                INFO )
+         CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 13
+*
 *        CHPEVD
 *
          SRNAMT = 'CHPEVD'
@@ -646,6 +974,47 @@
          CALL CHKXER( 'CHBTRD', INFOT, NOUT, LERR, OK )
          NT = NT + 6
 *
+*        CHETRD_HB2ST
+*
+         SRNAMT = 'CHETRD_HB2ST'
+         INFOT = 1
+         CALL CHETRD_HB2ST( '/', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRD_HB2ST( 'N', '/', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRD_HB2ST( 'N', 'H', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHETRD_HB2ST( 'N', 'N', '/', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETRD_HB2ST( 'N', 'N', 'U', -1, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHETRD_HB2ST( 'N', 'N', 'U', 0, -1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRD_HB2ST( 'N', 'N', 'U', 0, 1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CHETRD_HB2ST( 'N', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 0, W, 1, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL CHETRD_HB2ST( 'N', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 0, INFO )
+         CALL CHKXER( 'CHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         NT = NT + 9
+*
 *        CHBEVD
 *
          SRNAMT = 'CHBEVD'
@@ -711,6 +1080,75 @@
          CALL CHKXER( 'CHBEVD', INFOT, NOUT, LERR, OK )
          NT = NT + 15
 *
+*        CHBEVD_2STAGE
+*
+         SRNAMT = 'CHBEVD_2STAGE'
+         INFOT = 1
+         CALL CHBEVD_2STAGE( '/', 'U', 0, 0, A, 1, X, Z, 1, 
+     $                           W, 1, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL CHBEVD_2STAGE( 'V', 'U', 0, 0, A, 1, X, Z, 1, 
+     $                           W, 1, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHBEVD_2STAGE( 'N', '/', 0, 0, A, 1, X, Z, 1,
+     $                           W, 1, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHBEVD_2STAGE( 'N', 'U', -1, 0, A, 1, X, Z, 1,
+     $                            W, 1, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHBEVD_2STAGE( 'N', 'U', 0, -1, A, 1, X, Z, 1,
+     $                            W, 1, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL CHBEVD_2STAGE( 'N', 'U', 2, 1, A, 1, X, Z, 1,
+     $                           W, 2, RW, 2, IW, 1, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CHBEVD_2STAGE( 'N', 'U', 2, 1, A, 2, X, Z, 0,
+     $                         W, 8, RW, 25, IW, 12, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CHBEVD_2STAGE( 'N', 'U', 1, 0, A, 1, X, Z, 1,
+     $                           W, 0, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CHBEVD_2STAGE( 'N', 'U', 2, 1, A, 2, X, Z, 2,
+     $                           W, 1, RW, 2, IW, 1, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 11
+*         CALL CHBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 2,
+*     $                         W, 2, RW, 25, IW, 12, INFO )
+*         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL CHBEVD_2STAGE( 'N', 'U', 1, 0, A, 1, X, Z, 1,
+     $                           W, 1, RW, 0, IW, 1, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL CHBEVD_2STAGE( 'N', 'U', 2, 1, A, 2, X, Z, 2,
+     $                           W, 25, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 13
+*         CALL CHBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 2,
+*     $                          W, 25, RW, 2, IW, 12, INFO )
+*         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL CHBEVD_2STAGE( 'N', 'U', 1, 0, A, 1, X, Z, 1,
+     $                           W, 1, RW, 1, IW, 0, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL CHBEVD_2STAGE( 'N', 'U', 2, 1, A, 2, X, Z, 2,
+     $                           W, 25, RW, 2, IW, 0, INFO )
+         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 15
+*         CALL CHBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 2,
+*     $                          W, 25, RW, 25, IW, 2, INFO )
+*         CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 13
+*
 *        CHBEV
 *
          SRNAMT = 'CHBEV '
@@ -734,6 +1172,43 @@
          CALL CHKXER( 'CHBEV ', INFOT, NOUT, LERR, OK )
          NT = NT + 6
 *
+*        CHBEV_2STAGE
+*
+         SRNAMT = 'CHBEV_2STAGE '
+         INFOT = 1
+         CALL CHBEV_2STAGE( '/', 'U', 0, 0, A, 1, X,
+     $                        Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'CHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL CHBEV_2STAGE( 'V', 'U', 0, 0, A, 1, X,
+     $                        Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'CHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHBEV_2STAGE( 'N', '/', 0, 0, A, 1, X,
+     $                        Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'CHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHBEV_2STAGE( 'N', 'U', -1, 0, A, 1, X,
+     $                         Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'CHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHBEV_2STAGE( 'N', 'U', 0, -1, A, 1, X,
+     $                         Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'CHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL CHBEV_2STAGE( 'N', 'U', 2, 1, A, 1, X,
+     $                        Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'CHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CHBEV_2STAGE( 'N', 'U', 2, 0, A, 1, X,
+     $                        Z, 0, W, 0, RW, INFO )
+         CALL CHKXER( 'CHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CHBEV_2STAGE( 'N', 'U', 2, 0, A, 1, X,
+     $                        Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'CHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         NT = NT + 8
+*
 *        CHBEVX
 *
          SRNAMT = 'CHBEVX'
@@ -781,6 +1256,74 @@
      $                0.0, M, X, Z, 1, W, RW, IW, I3, INFO )
          CALL CHKXER( 'CHBEVX', INFOT, NOUT, LERR, OK )
          NT = NT + 11
+*
+*        CHBEVX_2STAGE
+*
+         SRNAMT = 'CHBEVX_2STAGE'
+         INFOT = 1
+         CALL CHBEVX_2STAGE( '/', 'A', 'U', 0, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         INFOT = 1
+         CALL CHBEVX_2STAGE( 'V', 'A', 'U', 0, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHBEVX_2STAGE( 'N', '/', 'U', 0, 0, A, 1, Q, 1,
+     $                       0.0D0, 1.0D0, 1, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHBEVX_2STAGE( 'N', 'A', '/', 0, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         INFOT = 4
+         CALL CHBEVX_2STAGE( 'N', 'A', 'U', -1, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHBEVX_2STAGE( 'N', 'A', 'U', 0, -1, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHBEVX_2STAGE( 'N', 'A', 'U', 2, 1, A, 1, Q, 2,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 2, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 9
+*         CALL CHBEVX_2STAGE( 'V', 'A', 'U', 2, 0, A, 1, Q, 1,
+*     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+*     $                       M, X, Z, 2, W, 0, RW, IW, I3, INFO )
+*         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CHBEVX_2STAGE( 'N', 'V', 'U', 1, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL CHBEVX_2STAGE( 'N', 'I', 'U', 1, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL CHBEVX_2STAGE( 'N', 'I', 'U', 1, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 1, 2, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 18
+         CALL CHBEVX_2STAGE( 'N', 'A', 'U', 2, 0, A, 1, Q, 2,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 0, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 20
+         CALL CHBEVX_2STAGE( 'N', 'A', 'U', 2, 0, A, 1, Q, 2,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 12
       END IF
 *
 *     Print a summary line.
diff --git a/TESTING/EIG/dchkee.f b/TESTING/EIG/dchkee.f
index b723687a..4d342085 100644
--- a/TESTING/EIG/dchkee.f
+++ b/TESTING/EIG/dchkee.f
@@ -1106,7 +1106,8 @@
      $                   DDRGEV, DDRGSX, DDRGVX, DDRVBD, DDRVES, DDRVEV,
      $                   DDRVSG, DDRVST, DDRVSX, DDRVVX, DERRBD,
      $                   DERRED, DERRGG, DERRHS, DERRST, ILAVER, XLAENV,
-     $                   DDRGES3, DDRGEV3
+     $                   DDRGES3, DDRGEV3, 
+     $                   DCHKST2STG, DDRVST2STG, DCHKSB2STG, DDRVSG2STG
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          LEN, MIN
@@ -1153,7 +1154,7 @@
       PATH = LINE( 1: 3 )
       NEP = LSAMEN( 3, PATH, 'NEP' ) .OR. LSAMEN( 3, PATH, 'DHS' )
       SEP = LSAMEN( 3, PATH, 'SEP' ) .OR. LSAMEN( 3, PATH, 'DST' ) .OR.
-     $      LSAMEN( 3, PATH, 'DSG' )
+     $      LSAMEN( 3, PATH, 'DSG' ) .OR. LSAMEN( 3, PATH, 'SE2' )
       SVD = LSAMEN( 3, PATH, 'SVD' ) .OR. LSAMEN( 3, PATH, 'DBD' )
       DEV = LSAMEN( 3, PATH, 'DEV' )
       DES = LSAMEN( 3, PATH, 'DES' )
@@ -1839,7 +1840,8 @@
      $         WRITE( NOUT, FMT = 9980 )'DCHKHS', INFO
   270    CONTINUE
 *
-      ELSE IF( LSAMEN( 3, C3, 'DST' ) .OR. LSAMEN( 3, C3, 'SEP' ) ) THEN
+      ELSE IF( LSAMEN( 3, C3, 'DST' ) .OR. LSAMEN( 3, C3, 'SEP' ) 
+     $                                .OR. LSAMEN( 3, C3, 'SE2' ) ) THEN
 *
 *        ----------------------------------
 *        SEP:  Symmetric Eigenvalue Problem
@@ -1869,6 +1871,15 @@
             WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
      $         NXVAL( I )
             IF( TSTCHK ) THEN
+               IF( LSAMEN( 3, C3, 'SE2' ) ) THEN
+               CALL DCHKST2STG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), D( 1, 1 ),
+     $                      D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), D( 1, 5 ),
+     $                      D( 1, 6 ), D( 1, 7 ), D( 1, 8 ), D( 1, 9 ),
+     $                      D( 1, 10 ), D( 1, 11 ), A( 1, 3 ), NMAX,
+     $                      A( 1, 4 ), A( 1, 5 ), D( 1, 12 ), A( 1, 6 ),
+     $                      WORK, LWORK, IWORK, LIWORK, RESULT, INFO )
+               ELSE
                CALL DCHKST( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
      $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), D( 1, 1 ),
      $                      D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), D( 1, 5 ),
@@ -1876,16 +1887,26 @@
      $                      D( 1, 10 ), D( 1, 11 ), A( 1, 3 ), NMAX,
      $                      A( 1, 4 ), A( 1, 5 ), D( 1, 12 ), A( 1, 6 ),
      $                      WORK, LWORK, IWORK, LIWORK, RESULT, INFO )
+               ENDIF
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'DCHKST', INFO
             END IF
             IF( TSTDRV ) THEN
+               IF( LSAMEN( 3, C3, 'SE2' ) ) THEN
+               CALL DDRVST2STG( NN, NVAL, 18, DOTYPE, ISEED, THRESH,
+     $                      NOUT, A( 1, 1 ), NMAX, D( 1, 3 ), D( 1, 4 ),
+     $                      D( 1, 5 ), D( 1, 6 ), D( 1, 8 ), D( 1, 9 ),
+     $                      D( 1, 10 ), D( 1, 11 ), A( 1, 2 ), NMAX,
+     $                      A( 1, 3 ), D( 1, 12 ), A( 1, 4 ), WORK,
+     $                      LWORK, IWORK, LIWORK, RESULT, INFO )
+               ELSE
                CALL DDRVST( NN, NVAL, 18, DOTYPE, ISEED, THRESH, NOUT,
      $                      A( 1, 1 ), NMAX, D( 1, 3 ), D( 1, 4 ),
      $                      D( 1, 5 ), D( 1, 6 ), D( 1, 8 ), D( 1, 9 ),
      $                      D( 1, 10 ), D( 1, 11 ), A( 1, 2 ), NMAX,
      $                      A( 1, 3 ), D( 1, 12 ), A( 1, 4 ), WORK,
      $                      LWORK, IWORK, LIWORK, RESULT, INFO )
+               ENDIF
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'DDRVST', INFO
             END IF
@@ -1918,11 +1939,17 @@
             WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
      $         NXVAL( I )
             IF( TSTCHK ) THEN
-               CALL DDRVSG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
-     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
-     $                      D( 1, 3 ), A( 1, 3 ), NMAX, A( 1, 4 ),
-     $                      A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), WORK,
-     $                      LWORK, IWORK, LIWORK, RESULT, INFO )
+*               CALL DDRVSG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+*     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
+*     $                      D( 1, 3 ), A( 1, 3 ), NMAX, A( 1, 4 ),
+*     $                      A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), WORK,
+*     $                      LWORK, IWORK, LIWORK, RESULT, INFO )
+               CALL DDRVSG2STG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+     $                          NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
+     $                          D( 1, 3 ), D( 1, 3 ), A( 1, 3 ), NMAX,
+     $                          A( 1, 4 ), A( 1, 5 ), A( 1, 6 ),
+     $                          A( 1, 7 ), WORK, LWORK, IWORK, LIWORK,
+     $                          RESULT, INFO )
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'DDRVSG', INFO
             END IF
@@ -2282,9 +2309,13 @@
          CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
          IF( TSTERR )
      $      CALL DERRST( 'DSB', NOUT )
-         CALL DCHKSB( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED, THRESH,
-     $                NOUT, A( 1, 1 ), NMAX, D( 1, 1 ), D( 1, 2 ),
-     $                A( 1, 2 ), NMAX, WORK, LWORK, RESULT, INFO )
+*         CALL DCHKSB( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+*     $                NOUT, A( 1, 1 ), NMAX, D( 1, 1 ), D( 1, 2 ),
+*     $                A( 1, 2 ), NMAX, WORK, LWORK, RESULT, INFO )
+         CALL DCHKSB2STG( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED,
+     $                 THRESH, NOUT, A( 1, 1 ), NMAX, D( 1, 1 ), 
+     $                 D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), D( 1, 5 ),
+     $                 A( 1, 2 ), NMAX, WORK, LWORK, RESULT, INFO )
          IF( INFO.NE.0 )
      $      WRITE( NOUT, FMT = 9980 )'DCHKSB', INFO
 *
diff --git a/TESTING/EIG/dchksb2stg.f b/TESTING/EIG/dchksb2stg.f
new file mode 100644
index 00000000..078ba65c
--- /dev/null
+++ b/TESTING/EIG/dchksb2stg.f
@@ -0,0 +1,868 @@
+*> \brief \b DCHKSBSTG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DCHKSB2STG( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE,
+*                          ISEED, THRESH, NOUNIT, A, LDA, SD, SE, D1,
+*                          D2, D3, U, LDU, WORK, LWORK, RESULT, INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
+*      $                   NWDTHS
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), KK( * ), NN( * )
+*       DOUBLE PRECISION   A( LDA, * ), RESULT( * ), SD( * ), SE( * ),
+*      $                   U( LDU, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DCHKSBSTG tests the reduction of a symmetric band matrix to tridiagonal
+*> form, used with the symmetric eigenvalue problem.
+*>
+*> DSBTRD factors a symmetric band matrix A as  U S U' , where ' means
+*> transpose, S is symmetric tridiagonal, and U is orthogonal.
+*> DSBTRD can use either just the lower or just the upper triangle
+*> of A; DCHKSBSTG checks both cases.
+*>
+*> DSYTRD_SB2ST factors a symmetric band matrix A as  U S U' , 
+*> where ' means transpose, S is symmetric tridiagonal, and U is
+*> orthogonal. DSYTRD_SB2ST can use either just the lower or just
+*> the upper triangle of A; DCHKSBSTG checks both cases.
+*>
+*> DSTEQR factors S as  Z D1 Z'.  
+*> D1 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of DSBTRD "U" (used as reference for DSYTRD_SB2ST)
+*> D2 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of DSYTRD_SB2ST "U".
+*> D3 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of DSYTRD_SB2ST "L".
+*>
+*> When DCHKSBSTG is called, a number of matrix "sizes" ("n's"), a number
+*> of bandwidths ("k's"), and a number of matrix "types" are
+*> specified.  For each size ("n"), each bandwidth ("k") less than or
+*> equal to "n", and each type of matrix, one matrix will be generated
+*> and used to test the symmetric banded reduction routine.  For each
+*> matrix, a number of tests will be performed:
+*>
+*> (1)     | A - V S V' | / ( |A| n ulp )  computed by DSBTRD with
+*>                                         UPLO='U'
+*>
+*> (2)     | I - UU' | / ( n ulp )
+*>
+*> (3)     | A - V S V' | / ( |A| n ulp )  computed by DSBTRD with
+*>                                         UPLO='L'
+*>
+*> (4)     | I - UU' | / ( n ulp )
+*>
+*> (5)     | D1 - D2 | / ( |D1| ulp )      where D1 is computed by
+*>                                         DSBTRD with UPLO='U' and
+*>                                         D2 is computed by
+*>                                         DSYTRD_SB2ST with UPLO='U'
+*>
+*> (6)     | D1 - D3 | / ( |D1| ulp )      where D1 is computed by
+*>                                         DSBTRD with UPLO='U' and
+*>                                         D3 is computed by
+*>                                         DSYTRD_SB2ST with UPLO='L'
+*>
+*> The "sizes" are specified by an array NN(1:NSIZES); the value of
+*> each element NN(j) specifies one size.
+*> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*> Currently, the list of possible types is:
+*>
+*> (1)  The zero matrix.
+*> (2)  The identity matrix.
+*>
+*> (3)  A diagonal matrix with evenly spaced entries
+*>      1, ..., ULP  and random signs.
+*>      (ULP = (first number larger than 1) - 1 )
+*> (4)  A diagonal matrix with geometrically spaced entries
+*>      1, ..., ULP  and random signs.
+*> (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>      and random signs.
+*>
+*> (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*> (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*> (8)  A matrix of the form  U' D U, where U is orthogonal and
+*>      D has evenly spaced entries 1, ..., ULP with random signs
+*>      on the diagonal.
+*>
+*> (9)  A matrix of the form  U' D U, where U is orthogonal and
+*>      D has geometrically spaced entries 1, ..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (10) A matrix of the form  U' D U, where U is orthogonal and
+*>      D has "clustered" entries 1, ULP,..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*> (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*> (13) Symmetric matrix with random entries chosen from (-1,1).
+*> (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*> (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] NSIZES
+*> \verbatim
+*>          NSIZES is INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          DCHKSBSTG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*> \endverbatim
+*>
+*> \param[in] NWDTHS
+*> \verbatim
+*>          NWDTHS is INTEGER
+*>          The number of bandwidths to use.  If it is zero,
+*>          DCHKSBSTG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] KK
+*> \verbatim
+*>          KK is INTEGER array, dimension (NWDTHS)
+*>          An array containing the bandwidths to be used for the band
+*>          matrices.  The values must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NTYPES
+*> \verbatim
+*>          NTYPES is INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, DCHKSBSTG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*> \endverbatim
+*>
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*> \endverbatim
+*>
+*> \param[in,out] ISEED
+*> \verbatim
+*>          ISEED is INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to DCHKSBSTG to continue the same random number
+*>          sequence.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is DOUBLE PRECISION
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NOUNIT
+*> \verbatim
+*>          NOUNIT is INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension
+*>                            (LDA, max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of A.  It must be at least 2 (not 1!)
+*>          and at least max( KK )+1.
+*> \endverbatim
+*>
+*> \param[out] SD
+*> \verbatim
+*>          SD is DOUBLE PRECISION array, dimension (max(NN))
+*>          Used to hold the diagonal of the tridiagonal matrix computed
+*>          by DSBTRD.
+*> \endverbatim
+*>
+*> \param[out] SE
+*> \verbatim
+*>          SE is DOUBLE PRECISION array, dimension (max(NN))
+*>          Used to hold the off-diagonal of the tridiagonal matrix
+*>          computed by DSBTRD.
+*> \endverbatim
+*>
+*> \param[out] U
+*> \verbatim
+*>          U is DOUBLE PRECISION array, dimension (LDU, max(NN))
+*>          Used to hold the orthogonal matrix computed by DSBTRD.
+*> \endverbatim
+*>
+*> \param[in] LDU
+*> \verbatim
+*>          LDU is INTEGER
+*>          The leading dimension of U.  It must be at least 1
+*>          and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (LWORK)
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          max( LDA+1, max(NN)+1 )*max(NN).
+*> \endverbatim
+*>
+*> \param[out] RESULT
+*> \verbatim
+*>          RESULT is DOUBLE PRECISION array, dimension (4)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          If 0, then everything ran OK.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far.
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup double_eig
+*
+*  =====================================================================
+      SUBROUTINE DCHKSB2STG( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE,
+     $                   ISEED, THRESH, NOUNIT, A, LDA, SD, SE, D1,
+     $                   D2, D3, U, LDU, WORK, LWORK, RESULT, INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
+     $                   NWDTHS
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), KK( * ), NN( * )
+      DOUBLE PRECISION   A( LDA, * ), RESULT( * ), SD( * ), SE( * ),
+     $                   D1( * ), D2( * ), D3( * ),
+     $                   U( LDU, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE, TWO, TEN
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
+     $                   TEN = 10.0D0 )
+      DOUBLE PRECISION   HALF
+      PARAMETER          ( HALF = ONE / TWO )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 15 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN, BADNNB
+      INTEGER            I, IINFO, IMODE, ITYPE, J, JC, JCOL, JR, JSIZE,
+     $                   JTYPE, JWIDTH, K, KMAX, LH, LW, MTYPES, N,
+     $                   NERRS, NMATS, NMAX, NTEST, NTESTT
+      DOUBLE PRECISION   ANINV, ANORM, COND, OVFL, RTOVFL, RTUNFL,
+     $                   TEMP1, TEMP2, TEMP3, TEMP4, ULP, ULPINV, UNFL
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ),
+     $                   KMODE( MAXTYP ), KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           DLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLACPY, DLASET, DLASUM, DLATMR, DLATMS, DSBT21,
+     $                   DSBTRD, XERBLA, DSBTRD_SB2ST, DSTEQR
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0 /
+*     ..
+*     .. Executable Statements ..
+*
+*     Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+*     Important constants
+*
+      BADNN = .FALSE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+      BADNNB = .FALSE.
+      KMAX = 0
+      DO 20 J = 1, NSIZES
+         KMAX = MAX( KMAX, KK( J ) )
+         IF( KK( J ).LT.0 )
+     $      BADNNB = .TRUE.
+   20 CONTINUE
+      KMAX = MIN( NMAX-1, KMAX )
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NWDTHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( BADNNB ) THEN
+         INFO = -4
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDA.LT.KMAX+1 ) THEN
+         INFO = -11
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -15
+      ELSE IF( ( MAX( LDA, NMAX )+1 )*NMAX.GT.LWORK ) THEN
+         INFO = -17
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DCHKSBSTG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 .OR. NWDTHS.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = DLAMCH( 'Safe minimum' )
+      OVFL = ONE / UNFL
+      ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      NERRS = 0
+      NMATS = 0
+*
+      DO 190 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         ANINV = ONE / DBLE( MAX( 1, N ) )
+*
+         DO 180 JWIDTH = 1, NWDTHS
+            K = KK( JWIDTH )
+            IF( K.GT.N )
+     $         GO TO 180
+            K = MAX( 0, MIN( N-1, K ) )
+*
+            IF( NSIZES.NE.1 ) THEN
+               MTYPES = MIN( MAXTYP, NTYPES )
+            ELSE
+               MTYPES = MIN( MAXTYP+1, NTYPES )
+            END IF
+*
+            DO 170 JTYPE = 1, MTYPES
+               IF( .NOT.DOTYPE( JTYPE ) )
+     $            GO TO 170
+               NMATS = NMATS + 1
+               NTEST = 0
+*
+               DO 30 J = 1, 4
+                  IOLDSD( J ) = ISEED( J )
+   30          CONTINUE
+*
+*              Compute "A".
+*              Store as "Upper"; later, we will copy to other format.
+*
+*              Control parameters:
+*
+*                  KMAGN  KMODE        KTYPE
+*              =1  O(1)   clustered 1  zero
+*              =2  large  clustered 2  identity
+*              =3  small  exponential  (none)
+*              =4         arithmetic   diagonal, (w/ eigenvalues)
+*              =5         random log   symmetric, w/ eigenvalues
+*              =6         random       (none)
+*              =7                      random diagonal
+*              =8                      random symmetric
+*              =9                      positive definite
+*              =10                     diagonally dominant tridiagonal
+*
+               IF( MTYPES.GT.MAXTYP )
+     $            GO TO 100
+*
+               ITYPE = KTYPE( JTYPE )
+               IMODE = KMODE( JTYPE )
+*
+*              Compute norm
+*
+               GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40          CONTINUE
+               ANORM = ONE
+               GO TO 70
+*
+   50          CONTINUE
+               ANORM = ( RTOVFL*ULP )*ANINV
+               GO TO 70
+*
+   60          CONTINUE
+               ANORM = RTUNFL*N*ULPINV
+               GO TO 70
+*
+   70          CONTINUE
+*
+               CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+               IINFO = 0
+               IF( JTYPE.LE.15 ) THEN
+                  COND = ULPINV
+               ELSE
+                  COND = ULPINV*ANINV / TEN
+               END IF
+*
+*              Special Matrices -- Identity & Jordan block
+*
+*                 Zero
+*
+               IF( ITYPE.EQ.1 ) THEN
+                  IINFO = 0
+*
+               ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*                 Identity
+*
+                  DO 80 JCOL = 1, N
+                     A( K+1, JCOL ) = ANORM
+   80             CONTINUE
+*
+               ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*                 Diagonal Matrix, [Eigen]values Specified
+*
+                  CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                         ANORM, 0, 0, 'Q', A( K+1, 1 ), LDA,
+     $                         WORK( N+1 ), IINFO )
+*
+               ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*                 Symmetric, eigenvalues specified
+*
+                  CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                         ANORM, K, K, 'Q', A, LDA, WORK( N+1 ),
+     $                         IINFO )
+*
+               ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*                 Diagonal, random eigenvalues
+*
+                  CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                         'T', 'N', WORK( N+1 ), 1, ONE,
+     $                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                         ZERO, ANORM, 'Q', A( K+1, 1 ), LDA,
+     $                         IDUMMA, IINFO )
+*
+               ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*                 Symmetric, random eigenvalues
+*
+                  CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                         'T', 'N', WORK( N+1 ), 1, ONE,
+     $                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, K, K,
+     $                         ZERO, ANORM, 'Q', A, LDA, IDUMMA, IINFO )
+*
+               ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*                 Positive definite, eigenvalues specified.
+*
+                  CALL DLATMS( N, N, 'S', ISEED, 'P', WORK, IMODE, COND,
+     $                         ANORM, K, K, 'Q', A, LDA, WORK( N+1 ),
+     $                         IINFO )
+*
+               ELSE IF( ITYPE.EQ.10 ) THEN
+*
+*                 Positive definite tridiagonal, eigenvalues specified.
+*
+                  IF( N.GT.1 )
+     $               K = MAX( 1, K )
+                  CALL DLATMS( N, N, 'S', ISEED, 'P', WORK, IMODE, COND,
+     $                         ANORM, 1, 1, 'Q', A( K, 1 ), LDA,
+     $                         WORK( N+1 ), IINFO )
+                  DO 90 I = 2, N
+                     TEMP1 = ABS( A( K, I ) ) /
+     $                       SQRT( ABS( A( K+1, I-1 )*A( K+1, I ) ) )
+                     IF( TEMP1.GT.HALF ) THEN
+                        A( K, I ) = HALF*SQRT( ABS( A( K+1,
+     $                              I-1 )*A( K+1, I ) ) )
+                     END IF
+   90             CONTINUE
+*
+               ELSE
+*
+                  IINFO = 1
+               END IF
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  RETURN
+               END IF
+*
+  100          CONTINUE
+*
+*              Call DSBTRD to compute S and U from upper triangle.
+*
+               CALL DLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
+*
+               NTEST = 1
+               CALL DSBTRD( 'V', 'U', N, K, WORK, LDA, SD, SE, U, LDU,
+     $                      WORK( LDA*N+1 ), IINFO )
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSBTRD(U)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 1 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Do tests 1 and 2
+*
+               CALL DSBT21( 'Upper', N, K, 1, A, LDA, SD, SE, U, LDU,
+     $                      WORK, RESULT( 1 ) )
+*
+*              Before converting A into lower for DSBTRD, run DSYTRD_SB2ST 
+*              otherwise matrix A will be converted to lower and then need
+*              to be converted back to upper in order to run the upper case 
+*              ofDSYTRD_SB2ST
+*            
+*              Compute D1 the eigenvalues resulting from the tridiagonal
+*              form using the DSBTRD and used as reference to compare
+*              with the DSYTRD_SB2ST routine
+*            
+*              Compute D1 from the DSBTRD and used as reference for the
+*              DSYTRD_SB2ST
+*            
+               CALL DCOPY( N, SD, 1, D1, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*            
+               CALL DSTEQR( 'N', N, D1, WORK, WORK( N+1 ), LDU,
+     $                      WORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 5 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*            
+*              DSYTRD_SB2ST Upper case is used to compute D2.
+*              Note to set SD and SE to zero to be sure not reusing 
+*              the one from above. Compare it with D1 computed 
+*              using the DSBTRD.
+*            
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+               CALL DLACPY( ' ', K+1, N, A, LDA, U, LDU )
+               LH = MAX(1, 4*N)
+               LW = LWORK - LH
+               CALL DSYTRD_SB2ST( 'N', 'N', "U", N, K, U, LDU, SD, SE, 
+     $                      WORK, LH, WORK( LH+1 ), LW, IINFO )
+*            
+*              Compute D2 from the DSYTRD_SB2ST Upper case
+*            
+               CALL DCOPY( N, SD, 1, D2, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*            
+               CALL DSTEQR( 'N', N, D2, WORK, WORK( N+1 ), LDU,
+     $                      WORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 5 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Convert A from Upper-Triangle-Only storage to
+*              Lower-Triangle-Only storage.
+*
+               DO 120 JC = 1, N
+                  DO 110 JR = 0, MIN( K, N-JC )
+                     A( JR+1, JC ) = A( K+1-JR, JC+JR )
+  110             CONTINUE
+  120          CONTINUE
+               DO 140 JC = N + 1 - K, N
+                  DO 130 JR = MIN( K, N-JC ) + 1, K
+                     A( JR+1, JC ) = ZERO
+  130             CONTINUE
+  140          CONTINUE
+*
+*              Call DSBTRD to compute S and U from lower triangle
+*
+               CALL DLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
+*
+               NTEST = 3
+               CALL DSBTRD( 'V', 'L', N, K, WORK, LDA, SD, SE, U, LDU,
+     $                      WORK( LDA*N+1 ), IINFO )
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSBTRD(L)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 3 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+               NTEST = 4
+*
+*              Do tests 3 and 4
+*
+               CALL DSBT21( 'Lower', N, K, 1, A, LDA, SD, SE, U, LDU,
+     $                      WORK, RESULT( 3 ) )
+*
+*              DSYTRD_SB2ST Lower case is used to compute D3.
+*              Note to set SD and SE to zero to be sure not reusing 
+*              the one from above. Compare it with D1 computed 
+*              using the DSBTRD. 
+*           
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+               CALL DLACPY( ' ', K+1, N, A, LDA, U, LDU )
+               LH = MAX(1, 4*N)
+               LW = LWORK - LH
+               CALL DSYTRD_SB2ST( 'N', 'N', "L", N, K, U, LDU, SD, SE, 
+     $                      WORK, LH, WORK( LH+1 ), LW, IINFO )
+*           
+*              Compute D3 from the 2-stage Upper case
+*           
+               CALL DCOPY( N, SD, 1, D3, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*           
+               CALL DSTEQR( 'N', N, D3, WORK, WORK( N+1 ), LDU,
+     $                      WORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 6 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*           
+*           
+*              Do Tests 3 and 4 which are similar to 11 and 12 but with the
+*              D1 computed using the standard 1-stage reduction as reference
+*           
+               NTEST = 6
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               TEMP3 = ZERO
+               TEMP4 = ZERO
+*           
+               DO 151 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+                  TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  151          CONTINUE
+*           
+               RESULT(5) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+               RESULT(6) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*              End of Loop -- Check for RESULT(j) > THRESH
+*
+  150          CONTINUE
+               NTESTT = NTESTT + NTEST
+*
+*              Print out tests which fail.
+*
+               DO 160 JR = 1, NTEST
+                  IF( RESULT( JR ).GE.THRESH ) THEN
+*
+*                    If this is the first test to fail,
+*                    print a header to the data file.
+*
+                     IF( NERRS.EQ.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9998 )'DSB'
+                        WRITE( NOUNIT, FMT = 9997 )
+                        WRITE( NOUNIT, FMT = 9996 )
+                        WRITE( NOUNIT, FMT = 9995 )'Symmetric'
+                        WRITE( NOUNIT, FMT = 9994 )'orthogonal', '''',
+     $                     'transpose', ( '''', J = 1, 6 )
+                     END IF
+                     NERRS = NERRS + 1
+                     WRITE( NOUNIT, FMT = 9993 )N, K, IOLDSD, JTYPE,
+     $                  JR, RESULT( JR )
+                  END IF
+  160          CONTINUE
+*
+  170       CONTINUE
+  180    CONTINUE
+  190 CONTINUE
+*
+*     Summary
+*
+      CALL DLASUM( 'DSB', NOUNIT, NERRS, NTESTT )
+      RETURN
+*
+ 9999 FORMAT( ' DCHKSBSTG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
+     $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+*
+ 9998 FORMAT( / 1X, A3,
+     $      ' -- Real Symmetric Banded Tridiagonal Reduction Routines' )
+ 9997 FORMAT( ' Matrix types (see DCHKSBSTG for details): ' )
+*
+ 9996 FORMAT( / ' Special Matrices:',
+     $      / '  1=Zero matrix.                        ',
+     $      '  5=Diagonal: clustered entries.',
+     $      / '  2=Identity matrix.                    ',
+     $      '  6=Diagonal: large, evenly spaced.',
+     $      / '  3=Diagonal: evenly spaced entries.    ',
+     $      '  7=Diagonal: small, evenly spaced.',
+     $      / '  4=Diagonal: geometr. spaced entries.' )
+ 9995 FORMAT( ' Dense ', A, ' Banded Matrices:',
+     $      / '  8=Evenly spaced eigenvals.            ',
+     $      ' 12=Small, evenly spaced eigenvals.',
+     $      / '  9=Geometrically spaced eigenvals.     ',
+     $      ' 13=Matrix with random O(1) entries.',
+     $      / ' 10=Clustered eigenvalues.              ',
+     $      ' 14=Matrix with large random entries.',
+     $      / ' 11=Large, evenly spaced eigenvals.     ',
+     $      ' 15=Matrix with small random entries.' )
+*
+ 9994 FORMAT( / ' Tests performed:   (S is Tridiag,  U is ', A, ',',
+     $      / 20X, A, ' means ', A, '.', / ' UPLO=''U'':',
+     $      / '  1= | A - U S U', A1, ' | / ( |A| n ulp )     ',
+     $      '  2= | I - U U', A1, ' | / ( n ulp )', / ' UPLO=''L'':',
+     $      / '  3= | A - U S U', A1, ' | / ( |A| n ulp )     ',
+     $      '  4= | I - U U', A1, ' | / ( n ulp )' / ' Eig check:',
+     $      /'  5= | D1 - D2', '', ' | / ( |D1| ulp )         ',
+     $      '  6= | D1 - D3', '', ' | / ( |D1| ulp )          ' )
+ 9993 FORMAT( ' N=', I5, ', K=', I4, ', seed=', 4( I4, ',' ), ' type ',
+     $      I2, ', test(', I2, ')=', G10.3 )
+*
+*     End of DCHKSBSTG
+*
+      END
diff --git a/TESTING/EIG/dchkst2stg.f b/TESTING/EIG/dchkst2stg.f
new file mode 100644
index 00000000..0aec629a
--- /dev/null
+++ b/TESTING/EIG/dchkst2stg.f
@@ -0,0 +1,2068 @@
+*> \brief \b DCHKST2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                          NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5,
+*                          WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK,
+*                          LWORK, IWORK, LIWORK, RESULT, INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
+*      $                   NTYPES
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       DOUBLE PRECISION   A( LDA, * ), AP( * ), D1( * ), D2( * ),
+*      $                   D3( * ), D4( * ), D5( * ), RESULT( * ),
+*      $                   SD( * ), SE( * ), TAU( * ), U( LDU, * ),
+*      $                   V( LDU, * ), VP( * ), WA1( * ), WA2( * ),
+*      $                   WA3( * ), WORK( * ), WR( * ), Z( LDU, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DCHKST2STG  checks the symmetric eigenvalue problem routines
+*> using the 2-stage reduction techniques. Since the generation
+*> of Q or the vectors is not available in this release, we only 
+*> compare the eigenvalue resulting when using the 2-stage to the 
+*> one considered as reference using the standard 1-stage reduction
+*> DSYTRD. For that, we call the standard DSYTRD and compute D1 using 
+*> DSTEQR, then we call the 2-stage DSYTRD_2STAGE with Upper and Lower
+*> and we compute D2 and D3 using DSTEQR and then we replaced tests
+*> 3 and 4 by tests 11 and 12. test 1 and 2 remain to verify that 
+*> the 1-stage results are OK and can be trusted.
+*> This testing routine will converge to the DCHKST in the next 
+*> release when vectors and generation of Q will be implemented.
+*>
+*>    DSYTRD factors A as  U S U' , where ' means transpose,
+*>    S is symmetric tridiagonal, and U is orthogonal.
+*>    DSYTRD can use either just the lower or just the upper triangle
+*>    of A; DCHKST2STG checks both cases.
+*>    U is represented as a product of Householder
+*>    transformations, whose vectors are stored in the first
+*>    n-1 columns of V, and whose scale factors are in TAU.
+*>
+*>    DSPTRD does the same as DSYTRD, except that A and V are stored
+*>    in "packed" format.
+*>
+*>    DORGTR constructs the matrix U from the contents of V and TAU.
+*>
+*>    DOPGTR constructs the matrix U from the contents of VP and TAU.
+*>
+*>    DSTEQR factors S as  Z D1 Z' , where Z is the orthogonal
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal.  D2 is the matrix of
+*>    eigenvalues computed when Z is not computed.
+*>
+*>    DSTERF computes D3, the matrix of eigenvalues, by the
+*>    PWK method, which does not yield eigenvectors.
+*>
+*>    DPTEQR factors S as  Z4 D4 Z4' , for a
+*>    symmetric positive definite tridiagonal matrix.
+*>    D5 is the matrix of eigenvalues computed when Z is not
+*>    computed.
+*>
+*>    DSTEBZ computes selected eigenvalues.  WA1, WA2, and
+*>    WA3 will denote eigenvalues computed to high
+*>    absolute accuracy, with different range options.
+*>    WR will denote eigenvalues computed to high relative
+*>    accuracy.
+*>
+*>    DSTEIN computes Y, the eigenvectors of S, given the
+*>    eigenvalues.
+*>
+*>    DSTEDC factors S as Z D1 Z' , where Z is the orthogonal
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal ('I' option). It may also
+*>    update an input orthogonal matrix, usually the output
+*>    from DSYTRD/DORGTR or DSPTRD/DOPGTR ('V' option). It may
+*>    also just compute eigenvalues ('N' option).
+*>
+*>    DSTEMR factors S as Z D1 Z' , where Z is the orthogonal
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal ('I' option).  DSTEMR
+*>    uses the Relatively Robust Representation whenever possible.
+*>
+*> When DCHKST2STG is called, a number of matrix "sizes" ("n's") and a
+*> number of matrix "types" are specified.  For each size ("n")
+*> and each type of matrix, one matrix will be generated and used
+*> to test the symmetric eigenroutines.  For each matrix, a number
+*> of tests will be performed:
+*>
+*> (1)     | A - V S V' | / ( |A| n ulp ) DSYTRD( UPLO='U', ... )
+*>
+*> (2)     | I - UV' | / ( n ulp )        DORGTR( UPLO='U', ... )
+*>
+*> (3)     | A - V S V' | / ( |A| n ulp ) DSYTRD( UPLO='L', ... )
+*>         replaced by | D1 - D2 | / ( |D1| ulp ) where D1 is the 
+*>         eigenvalue matrix computed using S and D2 is the 
+*>         eigenvalue matrix computed using S_2stage the output of
+*>         DSYTRD_2STAGE("N", "U",....). D1 and D2 are computed 
+*>         via DSTEQR('N',...)  
+*>
+*> (4)     | I - UV' | / ( n ulp )        DORGTR( UPLO='L', ... )
+*>         replaced by | D1 - D3 | / ( |D1| ulp ) where D1 is the 
+*>         eigenvalue matrix computed using S and D3 is the 
+*>         eigenvalue matrix computed using S_2stage the output of
+*>         DSYTRD_2STAGE("N", "L",....). D1 and D3 are computed 
+*>         via DSTEQR('N',...)  
+*>
+*> (5-8)   Same as 1-4, but for DSPTRD and DOPGTR.
+*>
+*> (9)     | S - Z D Z' | / ( |S| n ulp ) DSTEQR('V',...)
+*>
+*> (10)    | I - ZZ' | / ( n ulp )        DSTEQR('V',...)
+*>
+*> (11)    | D1 - D2 | / ( |D1| ulp )        DSTEQR('N',...)
+*>
+*> (12)    | D1 - D3 | / ( |D1| ulp )        DSTERF
+*>
+*> (13)    0 if the true eigenvalues (computed by sturm count)
+*>         of S are within THRESH of
+*>         those in D1.  2*THRESH if they are not.  (Tested using
+*>         DSTECH)
+*>
+*> For S positive definite,
+*>
+*> (14)    | S - Z4 D4 Z4' | / ( |S| n ulp ) DPTEQR('V',...)
+*>
+*> (15)    | I - Z4 Z4' | / ( n ulp )        DPTEQR('V',...)
+*>
+*> (16)    | D4 - D5 | / ( 100 |D4| ulp )       DPTEQR('N',...)
+*>
+*> When S is also diagonally dominant by the factor gamma < 1,
+*>
+*> (17)    max | D4(i) - WR(i) | / ( |D4(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              DSTEBZ( 'A', 'E', ...)
+*>
+*> (18)    | WA1 - D3 | / ( |D3| ulp )          DSTEBZ( 'A', 'E', ...)
+*>
+*> (19)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>                                              DSTEBZ( 'I', 'E', ...)
+*>
+*> (20)    | S - Y WA1 Y' | / ( |S| n ulp )  DSTEBZ, SSTEIN
+*>
+*> (21)    | I - Y Y' | / ( n ulp )          DSTEBZ, SSTEIN
+*>
+*> (22)    | S - Z D Z' | / ( |S| n ulp )    DSTEDC('I')
+*>
+*> (23)    | I - ZZ' | / ( n ulp )           DSTEDC('I')
+*>
+*> (24)    | S - Z D Z' | / ( |S| n ulp )    DSTEDC('V')
+*>
+*> (25)    | I - ZZ' | / ( n ulp )           DSTEDC('V')
+*>
+*> (26)    | D1 - D2 | / ( |D1| ulp )           DSTEDC('V') and
+*>                                              DSTEDC('N')
+*>
+*> Test 27 is disabled at the moment because DSTEMR does not
+*> guarantee high relatvie accuracy.
+*>
+*> (27)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              DSTEMR('V', 'A')
+*>
+*> (28)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              DSTEMR('V', 'I')
+*>
+*> Tests 29 through 34 are disable at present because DSTEMR
+*> does not handle partial specturm requests.
+*>
+*> (29)    | S - Z D Z' | / ( |S| n ulp )    DSTEMR('V', 'I')
+*>
+*> (30)    | I - ZZ' | / ( n ulp )           DSTEMR('V', 'I')
+*>
+*> (31)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         DSTEMR('N', 'I') vs. SSTEMR('V', 'I')
+*>
+*> (32)    | S - Z D Z' | / ( |S| n ulp )    DSTEMR('V', 'V')
+*>
+*> (33)    | I - ZZ' | / ( n ulp )           DSTEMR('V', 'V')
+*>
+*> (34)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         DSTEMR('N', 'V') vs. SSTEMR('V', 'V')
+*>
+*> (35)    | S - Z D Z' | / ( |S| n ulp )    DSTEMR('V', 'A')
+*>
+*> (36)    | I - ZZ' | / ( n ulp )           DSTEMR('V', 'A')
+*>
+*> (37)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         DSTEMR('N', 'A') vs. SSTEMR('V', 'A')
+*>
+*> The "sizes" are specified by an array NN(1:NSIZES); the value of
+*> each element NN(j) specifies one size.
+*> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*> Currently, the list of possible types is:
+*>
+*> (1)  The zero matrix.
+*> (2)  The identity matrix.
+*>
+*> (3)  A diagonal matrix with evenly spaced entries
+*>      1, ..., ULP  and random signs.
+*>      (ULP = (first number larger than 1) - 1 )
+*> (4)  A diagonal matrix with geometrically spaced entries
+*>      1, ..., ULP  and random signs.
+*> (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>      and random signs.
+*>
+*> (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*> (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*> (8)  A matrix of the form  U' D U, where U is orthogonal and
+*>      D has evenly spaced entries 1, ..., ULP with random signs
+*>      on the diagonal.
+*>
+*> (9)  A matrix of the form  U' D U, where U is orthogonal and
+*>      D has geometrically spaced entries 1, ..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (10) A matrix of the form  U' D U, where U is orthogonal and
+*>      D has "clustered" entries 1, ULP,..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*> (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*> (13) Symmetric matrix with random entries chosen from (-1,1).
+*> (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*> (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*> (16) Same as (8), but diagonal elements are all positive.
+*> (17) Same as (9), but diagonal elements are all positive.
+*> (18) Same as (10), but diagonal elements are all positive.
+*> (19) Same as (16), but multiplied by SQRT( overflow threshold )
+*> (20) Same as (16), but multiplied by SQRT( underflow threshold )
+*> (21) A diagonally dominant tridiagonal matrix with geometrically
+*>      spaced diagonal entries 1, ..., ULP.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] NSIZES
+*> \verbatim
+*>          NSIZES is INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          DCHKST2STG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*> \endverbatim
+*>
+*> \param[in] NTYPES
+*> \verbatim
+*>          NTYPES is INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, DCHKST2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*> \endverbatim
+*>
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*> \endverbatim
+*>
+*> \param[in,out] ISEED
+*> \verbatim
+*>          ISEED is INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to DCHKST2STG to continue the same random number
+*>          sequence.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is DOUBLE PRECISION
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NOUNIT
+*> \verbatim
+*>          NOUNIT is INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of
+*>                                  dimension ( LDA , max(NN) )
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of A.  It must be at
+*>          least 1 and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] AP
+*> \verbatim
+*>          AP is DOUBLE PRECISION array of
+*>                      dimension( max(NN)*max(NN+1)/2 )
+*>          The matrix A stored in packed format.
+*> \endverbatim
+*>
+*> \param[out] SD
+*> \verbatim
+*>          SD is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The diagonal of the tridiagonal matrix computed by DSYTRD.
+*>          On exit, SD and SE contain the tridiagonal form of the
+*>          matrix in A.
+*> \endverbatim
+*>
+*> \param[out] SE
+*> \verbatim
+*>          SE is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The off-diagonal of the tridiagonal matrix computed by
+*>          DSYTRD.  On exit, SD and SE contain the tridiagonal form of
+*>          the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D1
+*> \verbatim
+*>          D1 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by DSTEQR simlutaneously
+*>          with Z.  On exit, the eigenvalues in D1 correspond with the
+*>          matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D2
+*> \verbatim
+*>          D2 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by DSTEQR if Z is not
+*>          computed.  On exit, the eigenvalues in D2 correspond with
+*>          the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D3
+*> \verbatim
+*>          D3 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by DSTERF.  On exit, the
+*>          eigenvalues in D3 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D4
+*> \verbatim
+*>          D4 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by DPTEQR(V).
+*>          DPTEQR factors S as  Z4 D4 Z4*
+*>          On exit, the eigenvalues in D4 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D5
+*> \verbatim
+*>          D5 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by DPTEQR(N)
+*>          when Z is not computed. On exit, the
+*>          eigenvalues in D4 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] WA1
+*> \verbatim
+*>          WA1 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          All eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by DSTEBZ.
+*> \endverbatim
+*>
+*> \param[out] WA2
+*> \verbatim
+*>          WA2 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          Selected eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by DSTEBZ.
+*>          Choose random values for IL and IU, and ask for the
+*>          IL-th through IU-th eigenvalues.
+*> \endverbatim
+*>
+*> \param[out] WA3
+*> \verbatim
+*>          WA3 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          Selected eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by DSTEBZ.
+*>          Determine the values VL and VU of the IL-th and IU-th
+*>          eigenvalues and ask for all eigenvalues in this range.
+*> \endverbatim
+*>
+*> \param[out] WR
+*> \verbatim
+*>          WR is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          All eigenvalues of A, computed to high
+*>          absolute accuracy, with different options.
+*>          as computed by DSTEBZ.
+*> \endverbatim
+*>
+*> \param[out] U
+*> \verbatim
+*>          U is DOUBLE PRECISION array of
+*>                             dimension( LDU, max(NN) ).
+*>          The orthogonal matrix computed by DSYTRD + DORGTR.
+*> \endverbatim
+*>
+*> \param[in] LDU
+*> \verbatim
+*>          LDU is INTEGER
+*>          The leading dimension of U, Z, and V.  It must be at least 1
+*>          and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] V
+*> \verbatim
+*>          V is DOUBLE PRECISION array of
+*>                             dimension( LDU, max(NN) ).
+*>          The Housholder vectors computed by DSYTRD in reducing A to
+*>          tridiagonal form.  The vectors computed with UPLO='U' are
+*>          in the upper triangle, and the vectors computed with UPLO='L'
+*>          are in the lower triangle.  (As described in DSYTRD, the
+*>          sub- and superdiagonal are not set to 1, although the
+*>          true Householder vector has a 1 in that position.  The
+*>          routines that use V, such as DORGTR, set those entries to
+*>          1 before using them, and then restore them later.)
+*> \endverbatim
+*>
+*> \param[out] VP
+*> \verbatim
+*>          VP is DOUBLE PRECISION array of
+*>                      dimension( max(NN)*max(NN+1)/2 )
+*>          The matrix V stored in packed format.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The Householder factors computed by DSYTRD in reducing A
+*>          to tridiagonal form.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is DOUBLE PRECISION array of
+*>                             dimension( LDU, max(NN) ).
+*>          The orthogonal matrix of eigenvectors computed by DSTEQR,
+*>          DPTEQR, and DSTEIN.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array of
+*>                      dimension( LWORK )
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 3 * Nmax**2
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array,
+*>          Workspace.
+*> \endverbatim
+*>
+*> \param[out] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The number of entries in IWORK.  This must be at least
+*>                  6 + 6*Nmax + 5 * Nmax * lg Nmax
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*> \endverbatim
+*>
+*> \param[out] RESULT
+*> \verbatim
+*>          RESULT is DOUBLE PRECISION array, dimension (26)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -23: LDU < 1 or LDU < NMAX.
+*>          -29: LWORK too small.
+*>          If  DLATMR, SLATMS, DSYTRD, DORGTR, DSTEQR, SSTERF,
+*>              or DORMC2 returns an error code, the
+*>              absolute value of it is returned.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NBLOCK          Blocksize as returned by ENVIR.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far.
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup double_eig
+*
+*  =====================================================================
+      SUBROUTINE DCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                   NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5,
+     $                   WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK,
+     $                   LWORK, IWORK, LIWORK, RESULT, INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
+     $                   NTYPES
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      DOUBLE PRECISION   A( LDA, * ), AP( * ), D1( * ), D2( * ),
+     $                   D3( * ), D4( * ), D5( * ), RESULT( * ),
+     $                   SD( * ), SE( * ), TAU( * ), U( LDU, * ),
+     $                   V( LDU, * ), VP( * ), WA1( * ), WA2( * ),
+     $                   WA3( * ), WORK( * ), WR( * ), Z( LDU, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE, TWO, EIGHT, TEN, HUN
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
+     $                   EIGHT = 8.0D0, TEN = 10.0D0, HUN = 100.0D0 )
+      DOUBLE PRECISION   HALF
+      PARAMETER          ( HALF = ONE / TWO )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 21 )
+      LOGICAL            SRANGE
+      PARAMETER          ( SRANGE = .FALSE. )
+      LOGICAL            SREL
+      PARAMETER          ( SREL = .FALSE. )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN, TRYRAC
+      INTEGER            I, IINFO, IL, IMODE, ITEMP, ITYPE, IU, J, JC,
+     $                   JR, JSIZE, JTYPE, LGN, LIWEDC, LOG2UI, LWEDC,
+     $                   M, M2, M3, MTYPES, N, NAP, NBLOCK, NERRS,
+     $                   NMATS, NMAX, NSPLIT, NTEST, NTESTT, LH, LW
+      DOUBLE PRECISION   ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, TEMP1, TEMP2, TEMP3, TEMP4, ULP,
+     $                   ULPINV, UNFL, VL, VU
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+      DOUBLE PRECISION   DUMMA( 1 )
+*     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, DLARND, DSXT1
+      EXTERNAL           ILAENV, DLAMCH, DLARND, DSXT1
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DCOPY, DLABAD, DLACPY, DLASET, DLASUM, DLATMR,
+     $                   DLATMS, DOPGTR, DORGTR, DPTEQR, DSPT21, DSPTRD,
+     $                   DSTEBZ, DSTECH, DSTEDC, DSTEMR, DSTEIN, DSTEQR,
+     $                   DSTERF, DSTT21, DSTT22, DSYT21, DSYTRD, XERBLA,
+     $                   DSYTRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, INT, LOG, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
+     $                   8, 8, 9, 9, 9, 9, 9, 10 /
+      DATA               KMAGN / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 1, 1, 1, 2, 3, 1 /
+      DATA               KMODE / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 4, 3, 1, 4, 4, 3 /
+*     ..
+*     .. Executable Statements ..
+*
+*     Keep ftnchek happy
+      IDUMMA( 1 ) = 1
+*
+*     Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+*     Important constants
+*
+      BADNN = .FALSE.
+      TRYRAC = .TRUE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+      NBLOCK = ILAENV( 1, 'DSYTRD', 'L', NMAX, -1, -1, -1 )
+      NBLOCK = MIN( NMAX, MAX( 1, NBLOCK ) )
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -23
+      ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
+         INFO = -29
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DCHKST2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = DLAMCH( 'Safe minimum' )
+      OVFL = ONE / UNFL
+      CALL DLABAD( UNFL, OVFL )
+      ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) )
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+   20 CONTINUE
+      NERRS = 0
+      NMATS = 0
+*
+      DO 310 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         IF( N.GT.0 ) THEN
+            LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) )
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2
+            LIWEDC = 6 + 6*N + 5*N*LGN
+         ELSE
+            LWEDC = 8
+            LIWEDC = 12
+         END IF
+         NAP = ( N*( N+1 ) ) / 2
+         ANINV = ONE / DBLE( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         DO 300 JTYPE = 1, MTYPES
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 300
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           Compute "A"
+*
+*           Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, (w/ eigenvalues)
+*           =5         random log   symmetric, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random symmetric
+*           =9                      positive definite
+*           =10                     diagonally dominant tridiagonal
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 100
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+            IINFO = 0
+            IF( JTYPE.LE.15 ) THEN
+               COND = ULPINV
+            ELSE
+               COND = ULPINV*ANINV / TEN
+            END IF
+*
+*           Special Matrices -- Identity & Jordan block
+*
+*              Zero
+*
+            IF( ITYPE.EQ.1 ) THEN
+               IINFO = 0
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               DO 80 JC = 1, N
+                  A( JC, JC ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              Symmetric, eigenvalues specified
+*
+               CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              Symmetric, random eigenvalues
+*
+               CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              Positive definite, eigenvalues specified.
+*
+               CALL DLATMS( N, N, 'S', ISEED, 'P', WORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.10 ) THEN
+*
+*              Positive definite tridiagonal, eigenvalues specified.
+*
+               CALL DLATMS( N, N, 'S', ISEED, 'P', WORK, IMODE, COND,
+     $                      ANORM, 1, 1, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+               DO 90 I = 2, N
+                  TEMP1 = ABS( A( I-1, I ) ) /
+     $                    SQRT( ABS( A( I-1, I-1 )*A( I, I ) ) )
+                  IF( TEMP1.GT.HALF ) THEN
+                     A( I-1, I ) = HALF*SQRT( ABS( A( I-1, I-1 )*A( I,
+     $                             I ) ) )
+                     A( I, I-1 ) = A( I-1, I )
+                  END IF
+   90          CONTINUE
+*
+            ELSE
+*
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+  100       CONTINUE
+*
+*           Call DSYTRD and DORGTR to compute S and U from
+*           upper triangle.
+*
+            CALL DLACPY( 'U', N, N, A, LDA, V, LDU )
+*
+            NTEST = 1
+            CALL DSYTRD( 'U', N, V, LDU, SD, SE, TAU, WORK, LWORK,
+     $                   IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSYTRD(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 1 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL DLACPY( 'U', N, N, V, LDU, U, LDU )
+*
+            NTEST = 2
+            CALL DORGTR( 'U', N, U, LDU, TAU, WORK, LWORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DORGTR(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 2 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 1 and 2
+*
+            CALL DSYT21( 2, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
+     $                   LDU, TAU, WORK, RESULT( 1 ) )
+            CALL DSYT21( 3, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
+     $                   LDU, TAU, WORK, RESULT( 2 ) )
+*
+*           Compute D1 the eigenvalues resulting from the tridiagonal
+*           form using the standard 1-stage algorithm and use it as a
+*           reference to compare with the 2-stage technique
+*
+*           Compute D1 from the 1-stage and used as reference for the
+*           2-stage
+*
+            CALL DCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*
+            CALL DSTEQR( 'N', N, D1, WORK, WORK( N+1 ), LDU,
+     $                   WORK( N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 3 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           2-STAGE TRD Upper case is used to compute D2.
+*           Note to set SD and SE to zero to be sure not reusing 
+*           the one from above. Compare it with D1 computed 
+*           using the 1-stage.
+*
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+            CALL DLACPY( "U", N, N, A, LDA, V, LDU )
+            LH = MAX(1, 4*N)
+            LW = LWORK - LH
+            CALL DSYTRD_2STAGE( 'N', "U", N, V, LDU, SD, SE, TAU, 
+     $                   WORK, LH, WORK( LH+1 ), LW, IINFO )
+*
+*           Compute D2 from the 2-stage Upper case
+*
+            CALL DCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*
+            CALL DSTEQR( 'N', N, D2, WORK, WORK( N+1 ), LDU,
+     $                   WORK( N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 3 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           2-STAGE TRD Lower case is used to compute D3.
+*           Note to set SD and SE to zero to be sure not reusing 
+*           the one from above. Compare it with D1 computed 
+*           using the 1-stage. 
+*
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+            CALL DLACPY( "L", N, N, A, LDA, V, LDU )
+            CALL DSYTRD_2STAGE( 'N', "L", N, V, LDU, SD, SE, TAU, 
+     $                   WORK, LH, WORK( LH+1 ), LW, IINFO )
+*
+*           Compute D3 from the 2-stage Upper case
+*
+            CALL DCOPY( N, SD, 1, D3, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*
+            CALL DSTEQR( 'N', N, D3, WORK, WORK( N+1 ), LDU,
+     $                   WORK( N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 4 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*
+*           Do Tests 3 and 4 which are similar to 11 and 12 but with the
+*           D1 computed using the standard 1-stage reduction as reference
+*
+            NTEST = 4
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            TEMP3 = ZERO
+            TEMP4 = ZERO
+*
+            DO 151 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+               TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+               TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  151       CONTINUE
+*
+            RESULT( 3 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+            RESULT( 4 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*           Store the upper triangle of A in AP
+*
+            I = 0
+            DO 120 JC = 1, N
+               DO 110 JR = 1, JC
+                  I = I + 1
+                  AP( I ) = A( JR, JC )
+  110          CONTINUE
+  120       CONTINUE
+*
+*           Call DSPTRD and DOPGTR to compute S and U from AP
+*
+            CALL DCOPY( NAP, AP, 1, VP, 1 )
+*
+            NTEST = 5
+            CALL DSPTRD( 'U', N, VP, SD, SE, TAU, IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSPTRD(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 5 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            NTEST = 6
+            CALL DOPGTR( 'U', N, VP, TAU, U, LDU, WORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DOPGTR(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 6 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 5 and 6
+*
+            CALL DSPT21( 2, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RESULT( 5 ) )
+            CALL DSPT21( 3, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RESULT( 6 ) )
+*
+*           Store the lower triangle of A in AP
+*
+            I = 0
+            DO 140 JC = 1, N
+               DO 130 JR = JC, N
+                  I = I + 1
+                  AP( I ) = A( JR, JC )
+  130          CONTINUE
+  140       CONTINUE
+*
+*           Call DSPTRD and DOPGTR to compute S and U from AP
+*
+            CALL DCOPY( NAP, AP, 1, VP, 1 )
+*
+            NTEST = 7
+            CALL DSPTRD( 'L', N, VP, SD, SE, TAU, IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSPTRD(L)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 7 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            NTEST = 8
+            CALL DOPGTR( 'L', N, VP, TAU, U, LDU, WORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DOPGTR(L)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 8 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL DSPT21( 2, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RESULT( 7 ) )
+            CALL DSPT21( 3, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RESULT( 8 ) )
+*
+*           Call DSTEQR to compute D1, D2, and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            CALL DCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, WORK, 1 )
+            CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+            NTEST = 9
+            CALL DSTEQR( 'V', N, D1, WORK, Z, LDU, WORK( N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEQR(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 9 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Compute D2
+*
+            CALL DCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*
+            NTEST = 11
+            CALL DSTEQR( 'N', N, D2, WORK, WORK( N+1 ), LDU,
+     $                   WORK( N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 11 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Compute D3 (using PWK method)
+*
+            CALL DCOPY( N, SD, 1, D3, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*
+            NTEST = 12
+            CALL DSTERF( N, D3, WORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTERF', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 12 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 9 and 10
+*
+            CALL DSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                   RESULT( 9 ) )
+*
+*           Do Tests 11 and 12
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            TEMP3 = ZERO
+            TEMP4 = ZERO
+*
+            DO 150 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+               TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+               TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  150       CONTINUE
+*
+            RESULT( 11 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+            RESULT( 12 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*           Do Test 13 -- Sturm Sequence Test of Eigenvalues
+*                         Go up by factors of two until it succeeds
+*
+            NTEST = 13
+            TEMP1 = THRESH*( HALF-ULP )
+*
+            DO 160 J = 0, LOG2UI
+               CALL DSTECH( N, SD, SE, D1, TEMP1, WORK, IINFO )
+               IF( IINFO.EQ.0 )
+     $            GO TO 170
+               TEMP1 = TEMP1*TWO
+  160       CONTINUE
+*
+  170       CONTINUE
+            RESULT( 13 ) = TEMP1
+*
+*           For positive definite matrices ( JTYPE.GT.15 ) call DPTEQR
+*           and do tests 14, 15, and 16 .
+*
+            IF( JTYPE.GT.15 ) THEN
+*
+*              Compute D4 and Z4
+*
+               CALL DCOPY( N, SD, 1, D4, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, WORK, 1 )
+               CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+               NTEST = 14
+               CALL DPTEQR( 'V', N, D4, WORK, Z, LDU, WORK( N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DPTEQR(V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 14 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do Tests 14 and 15
+*
+               CALL DSTT21( N, 0, SD, SE, D4, DUMMA, Z, LDU, WORK,
+     $                      RESULT( 14 ) )
+*
+*              Compute D5
+*
+               CALL DCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*
+               NTEST = 16
+               CALL DPTEQR( 'N', N, D5, WORK, Z, LDU, WORK( N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DPTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 16 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do Test 16
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 180 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D4( J ) ), ABS( D5( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D4( J )-D5( J ) ) )
+  180          CONTINUE
+*
+               RESULT( 16 ) = TEMP2 / MAX( UNFL,
+     $                        HUN*ULP*MAX( TEMP1, TEMP2 ) )
+            ELSE
+               RESULT( 14 ) = ZERO
+               RESULT( 15 ) = ZERO
+               RESULT( 16 ) = ZERO
+            END IF
+*
+*           Call DSTEBZ with different options and do tests 17-18.
+*
+*              If S is positive definite and diagonally dominant,
+*              ask for all eigenvalues with high relative accuracy.
+*
+            VL = ZERO
+            VU = ZERO
+            IL = 0
+            IU = 0
+            IF( JTYPE.EQ.21 ) THEN
+               NTEST = 17
+               ABSTOL = UNFL + UNFL
+               CALL DSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                      M, NSPLIT, WR, IWORK( 1 ), IWORK( N+1 ),
+     $                      WORK, IWORK( 2*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(A,rel)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 17 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do test 17
+*
+               TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
+     $                 ( ONE-HALF )**4
+*
+               TEMP1 = ZERO
+               DO 190 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
+     $                    ( ABSTOL+ABS( D4( J ) ) ) )
+  190          CONTINUE
+*
+               RESULT( 17 ) = TEMP1 / TEMP2
+            ELSE
+               RESULT( 17 ) = ZERO
+            END IF
+*
+*           Now ask for all eigenvalues with high absolute accuracy.
+*
+            NTEST = 18
+            ABSTOL = UNFL + UNFL
+            CALL DSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
+     $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), WORK,
+     $                   IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(A)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 18 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do test 18
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            DO 200 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D3( J ) ), ABS( WA1( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D3( J )-WA1( J ) ) )
+  200       CONTINUE
+*
+            RESULT( 18 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*           Choose random values for IL and IU, and ask for the
+*           IL-th through IU-th eigenvalues.
+*
+            NTEST = 19
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+               IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+               IF( IU.LT.IL ) THEN
+                  ITEMP = IU
+                  IU = IL
+                  IL = ITEMP
+               END IF
+            END IF
+*
+            CALL DSTEBZ( 'I', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                   M2, NSPLIT, WA2, IWORK( 1 ), IWORK( N+1 ),
+     $                   WORK, IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(I)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 19 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Determine the values VL and VU of the IL-th and IU-th
+*           eigenvalues and ask for all eigenvalues in this range.
+*
+            IF( N.GT.0 ) THEN
+               IF( IL.NE.1 ) THEN
+                  VL = WA1( IL ) - MAX( HALF*( WA1( IL )-WA1( IL-1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               ELSE
+                  VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               END IF
+               IF( IU.NE.N ) THEN
+                  VU = WA1( IU ) + MAX( HALF*( WA1( IU+1 )-WA1( IU ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               ELSE
+                  VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               END IF
+            ELSE
+               VL = ZERO
+               VU = ONE
+            END IF
+*
+            CALL DSTEBZ( 'V', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                   M3, NSPLIT, WA3, IWORK( 1 ), IWORK( N+1 ),
+     $                   WORK, IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 19 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            IF( M3.EQ.0 .AND. N.NE.0 ) THEN
+               RESULT( 19 ) = ULPINV
+               GO TO 280
+            END IF
+*
+*           Do test 19
+*
+            TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+            TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+            IF( N.GT.0 ) THEN
+               TEMP3 = MAX( ABS( WA1( N ) ), ABS( WA1( 1 ) ) )
+            ELSE
+               TEMP3 = ZERO
+            END IF
+*
+            RESULT( 19 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
+*
+*           Call DSTEIN to compute eigenvectors corresponding to
+*           eigenvalues in WA1.  (First call DSTEBZ again, to make sure
+*           it returns these eigenvalues in the correct order.)
+*
+            NTEST = 21
+            CALL DSTEBZ( 'A', 'B', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
+     $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), WORK,
+     $                   IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(A,B)', IINFO, N,
+     $            JTYPE, IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 20 ) = ULPINV
+                  RESULT( 21 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL DSTEIN( N, SD, SE, M, WA1, IWORK( 1 ), IWORK( N+1 ), Z,
+     $                   LDU, WORK, IWORK( 2*N+1 ), IWORK( 3*N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEIN', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 20 ) = ULPINV
+                  RESULT( 21 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 20 and 21
+*
+            CALL DSTT21( N, 0, SD, SE, WA1, DUMMA, Z, LDU, WORK,
+     $                   RESULT( 20 ) )
+*
+*           Call DSTEDC(I) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            CALL DCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, WORK, 1 )
+            CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+            NTEST = 22
+            CALL DSTEDC( 'I', N, D1, WORK, Z, LDU, WORK( N+1 ), LWEDC-N,
+     $                   IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEDC(I)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 22 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 22 and 23
+*
+            CALL DSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                   RESULT( 22 ) )
+*
+*           Call DSTEDC(V) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            CALL DCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, WORK, 1 )
+            CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+            NTEST = 24
+            CALL DSTEDC( 'V', N, D1, WORK, Z, LDU, WORK( N+1 ), LWEDC-N,
+     $                   IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEDC(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 24 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 24 and 25
+*
+            CALL DSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                   RESULT( 24 ) )
+*
+*           Call DSTEDC(N) to compute D2, do tests.
+*
+*           Compute D2
+*
+            CALL DCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, WORK, 1 )
+            CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+            NTEST = 26
+            CALL DSTEDC( 'N', N, D2, WORK, Z, LDU, WORK( N+1 ), LWEDC-N,
+     $                   IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEDC(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 26 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Test 26
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+*
+            DO 210 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  210       CONTINUE
+*
+            RESULT( 26 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*           Only test DSTEMR if IEEE compliant
+*
+            IF( ILAENV( 10, 'DSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 .AND.
+     $          ILAENV( 11, 'DSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 ) THEN
+*
+*           Call DSTEMR, do test 27 (relative eigenvalue accuracy)
+*
+*              If S is positive definite and diagonally dominant,
+*              ask for all eigenvalues with high relative accuracy.
+*
+               VL = ZERO
+               VU = ZERO
+               IL = 0
+               IU = 0
+               IF( JTYPE.EQ.21 .AND. SREL ) THEN
+                  NTEST = 27
+                  ABSTOL = UNFL + UNFL
+                  CALL DSTEMR( 'V', 'A', N, SD, SE, VL, VU, IL, IU,
+     $                         M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         WORK, LWORK, IWORK( 2*N+1 ), LWORK-2*N,
+     $                         IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSTEMR(V,A,rel)',
+     $                  IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 27 ) = ULPINV
+                        GO TO 270
+                     END IF
+                  END IF
+*
+*              Do test 27
+*
+                  TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
+     $                    ( ONE-HALF )**4
+*
+                  TEMP1 = ZERO
+                  DO 220 J = 1, N
+                     TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
+     $                       ( ABSTOL+ABS( D4( J ) ) ) )
+  220             CONTINUE
+*
+                  RESULT( 27 ) = TEMP1 / TEMP2
+*
+                  IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+                  IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+                  IF( IU.LT.IL ) THEN
+                     ITEMP = IU
+                     IU = IL
+                     IL = ITEMP
+                  END IF
+*
+                  IF( SRANGE ) THEN
+                     NTEST = 28
+                     ABSTOL = UNFL + UNFL
+                     CALL DSTEMR( 'V', 'I', N, SD, SE, VL, VU, IL, IU,
+     $                            M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                            WORK, LWORK, IWORK( 2*N+1 ),
+     $                            LWORK-2*N, IINFO )
+*
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'DSTEMR(V,I,rel)',
+     $                     IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( 28 ) = ULPINV
+                           GO TO 270
+                        END IF
+                     END IF
+*
+*
+*                 Do test 28
+*
+                     TEMP2 = TWO*( TWO*N-ONE )*ULP*
+     $                       ( ONE+EIGHT*HALF**2 ) / ( ONE-HALF )**4
+*
+                     TEMP1 = ZERO
+                     DO 230 J = IL, IU
+                        TEMP1 = MAX( TEMP1, ABS( WR( J-IL+1 )-D4( N-J+
+     $                          1 ) ) / ( ABSTOL+ABS( WR( J-IL+1 ) ) ) )
+  230                CONTINUE
+*
+                     RESULT( 28 ) = TEMP1 / TEMP2
+                  ELSE
+                     RESULT( 28 ) = ZERO
+                  END IF
+               ELSE
+                  RESULT( 27 ) = ZERO
+                  RESULT( 28 ) = ZERO
+               END IF
+*
+*           Call DSTEMR(V,I) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+               CALL DCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, WORK, 1 )
+               CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+               IF( SRANGE ) THEN
+                  NTEST = 29
+                  IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+                  IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+                  IF( IU.LT.IL ) THEN
+                     ITEMP = IU
+                     IU = IL
+                     IL = ITEMP
+                  END IF
+                  CALL DSTEMR( 'V', 'I', N, D5, WORK, VL, VU, IL, IU,
+     $                         M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSTEMR(V,I)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 29 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Tests 29 and 30
+*
+                  CALL DSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                         M, RESULT( 29 ) )
+*
+*           Call DSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+                  CALL DCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*
+                  NTEST = 31
+                  CALL DSTEMR( 'N', 'I', N, D5, WORK, VL, VU, IL, IU,
+     $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSTEMR(N,I)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 31 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Test 31
+*
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+*
+                  DO 240 J = 1, IU - IL + 1
+                     TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
+     $                       ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  240             CONTINUE
+*
+                  RESULT( 31 ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*
+*           Call DSTEMR(V,V) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+                  CALL DCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL DCOPY( N-1, SE, 1, WORK, 1 )
+                  CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+                  NTEST = 32
+*
+                  IF( N.GT.0 ) THEN
+                     IF( IL.NE.1 ) THEN
+                        VL = D2( IL ) - MAX( HALF*
+     $                       ( D2( IL )-D2( IL-1 ) ), ULP*ANORM,
+     $                       TWO*RTUNFL )
+                     ELSE
+                        VL = D2( 1 ) - MAX( HALF*( D2( N )-D2( 1 ) ),
+     $                       ULP*ANORM, TWO*RTUNFL )
+                     END IF
+                     IF( IU.NE.N ) THEN
+                        VU = D2( IU ) + MAX( HALF*
+     $                       ( D2( IU+1 )-D2( IU ) ), ULP*ANORM,
+     $                       TWO*RTUNFL )
+                     ELSE
+                        VU = D2( N ) + MAX( HALF*( D2( N )-D2( 1 ) ),
+     $                       ULP*ANORM, TWO*RTUNFL )
+                     END IF
+                  ELSE
+                     VL = ZERO
+                     VU = ONE
+                  END IF
+*
+                  CALL DSTEMR( 'V', 'V', N, D5, WORK, VL, VU, IL, IU,
+     $                         M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSTEMR(V,V)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 32 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Tests 32 and 33
+*
+                  CALL DSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                         M, RESULT( 32 ) )
+*
+*           Call DSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+                  CALL DCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*
+                  NTEST = 34
+                  CALL DSTEMR( 'N', 'V', N, D5, WORK, VL, VU, IL, IU,
+     $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSTEMR(N,V)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 34 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Test 34
+*
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+*
+                  DO 250 J = 1, IU - IL + 1
+                     TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
+     $                       ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  250             CONTINUE
+*
+                  RESULT( 34 ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+               ELSE
+                  RESULT( 29 ) = ZERO
+                  RESULT( 30 ) = ZERO
+                  RESULT( 31 ) = ZERO
+                  RESULT( 32 ) = ZERO
+                  RESULT( 33 ) = ZERO
+                  RESULT( 34 ) = ZERO
+               END IF
+*
+*
+*           Call DSTEMR(V,A) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+               CALL DCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*
+               NTEST = 35
+*
+               CALL DSTEMR( 'V', 'A', N, D5, WORK, VL, VU, IL, IU,
+     $                      M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                      WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                      LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEMR(V,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 35 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*           Do Tests 35 and 36
+*
+               CALL DSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, M,
+     $                      RESULT( 35 ) )
+*
+*           Call DSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+               CALL DCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, WORK, 1 )
+*
+               NTEST = 37
+               CALL DSTEMR( 'N', 'A', N, D5, WORK, VL, VU, IL, IU,
+     $                      M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                      WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                      LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEMR(N,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 37 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*           Do Test 34
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+*
+               DO 260 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  260          CONTINUE
+*
+               RESULT( 37 ) = TEMP2 / MAX( UNFL,
+     $                        ULP*MAX( TEMP1, TEMP2 ) )
+            END IF
+  270       CONTINUE
+  280       CONTINUE
+            NTESTT = NTESTT + NTEST
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+*
+*           Print out tests which fail.
+*
+            DO 290 JR = 1, NTEST
+               IF( RESULT( JR ).GE.THRESH ) THEN
+*
+*                 If this is the first test to fail,
+*                 print a header to the data file.
+*
+                  IF( NERRS.EQ.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9998 )'DST'
+                     WRITE( NOUNIT, FMT = 9997 )
+                     WRITE( NOUNIT, FMT = 9996 )
+                     WRITE( NOUNIT, FMT = 9995 )'Symmetric'
+                     WRITE( NOUNIT, FMT = 9994 )
+*
+*                    Tests performed
+*
+                     WRITE( NOUNIT, FMT = 9988 )
+                  END IF
+                  NERRS = NERRS + 1
+                  WRITE( NOUNIT, FMT = 9990 )N, IOLDSD, JTYPE, JR,
+     $               RESULT( JR )
+               END IF
+  290       CONTINUE
+  300    CONTINUE
+  310 CONTINUE
+*
+*     Summary
+*
+      CALL DLASUM( 'DST', NOUNIT, NERRS, NTESTT )
+      RETURN
+*
+ 9999 FORMAT( ' DCHKST2STG: ', A, ' returned INFO=', I6, '.', / 9X,
+     $  'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+*
+ 9998 FORMAT( / 1X, A3, ' -- Real Symmetric eigenvalue problem' )
+ 9997 FORMAT( ' Matrix types (see DCHKST2STG for details): ' )
+*
+ 9996 FORMAT( / ' Special Matrices:',
+     $      / '  1=Zero matrix.                        ',
+     $      '  5=Diagonal: clustered entries.',
+     $      / '  2=Identity matrix.                    ',
+     $      '  6=Diagonal: large, evenly spaced.',
+     $      / '  3=Diagonal: evenly spaced entries.    ',
+     $      '  7=Diagonal: small, evenly spaced.',
+     $      / '  4=Diagonal: geometr. spaced entries.' )
+ 9995 FORMAT( ' Dense ', A, ' Matrices:',
+     $      / '  8=Evenly spaced eigenvals.            ',
+     $      ' 12=Small, evenly spaced eigenvals.',
+     $      / '  9=Geometrically spaced eigenvals.     ',
+     $      ' 13=Matrix with random O(1) entries.',
+     $      / ' 10=Clustered eigenvalues.              ',
+     $      ' 14=Matrix with large random entries.',
+     $      / ' 11=Large, evenly spaced eigenvals.     ',
+     $      ' 15=Matrix with small random entries.' )
+ 9994 FORMAT( ' 16=Positive definite, evenly spaced eigenvalues',
+     $      / ' 17=Positive definite, geometrically spaced eigenvlaues',
+     $      / ' 18=Positive definite, clustered eigenvalues',
+     $      / ' 19=Positive definite, small evenly spaced eigenvalues',
+     $      / ' 20=Positive definite, large evenly spaced eigenvalues',
+     $      / ' 21=Diagonally dominant tridiagonal, geometrically',
+     $      ' spaced eigenvalues' )
+*
+ 9990 FORMAT( ' N=', I5, ', seed=', 4( I4, ',' ), ' type ', I2,
+     $      ', test(', I2, ')=', G10.3 )
+*
+ 9988 FORMAT( / 'Test performed:  see DCHKST2STG for details.', / )
+*     End of DCHKST2STG
+*
+      END
diff --git a/TESTING/EIG/ddrvsg2stg.f b/TESTING/EIG/ddrvsg2stg.f
new file mode 100644
index 00000000..ecb44cc6
--- /dev/null
+++ b/TESTING/EIG/ddrvsg2stg.f
@@ -0,0 +1,1362 @@
+*> \brief \b DDRVSG2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                              NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
+*                              BB, AP, BP, WORK, NWORK, IWORK, LIWORK, 
+*                              RESULT, INFO )
+*
+*       IMPLICIT NONE
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
+*      $                   NTYPES, NWORK
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       DOUBLE PRECISION   A( LDA, * ), AB( LDA, * ), AP( * ),
+*      $                   B( LDB, * ), BB( LDB, * ), BP( * ), D( * ),
+*      $                   RESULT( * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>      DDRVSG2STG checks the real symmetric generalized eigenproblem
+*>      drivers.
+*>
+*>              DSYGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem.
+*>
+*>              DSYGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem using a divide and conquer algorithm.
+*>
+*>              DSYGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem.
+*>
+*>              DSPGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem in packed storage.
+*>
+*>              DSPGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem in packed storage using a divide and
+*>              conquer algorithm.
+*>
+*>              DSPGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem in packed storage.
+*>
+*>              DSBGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite banded
+*>              generalized eigenproblem.
+*>
+*>              DSBGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite banded
+*>              generalized eigenproblem using a divide and conquer
+*>              algorithm.
+*>
+*>              DSBGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite banded
+*>              generalized eigenproblem.
+*>
+*>      When DDRVSG2STG is called, a number of matrix "sizes" ("n's") and a
+*>      number of matrix "types" are specified.  For each size ("n")
+*>      and each type of matrix, one matrix A of the given type will be
+*>      generated; a random well-conditioned matrix B is also generated
+*>      and the pair (A,B) is used to test the drivers.
+*>
+*>      For each pair (A,B), the following tests are performed:
+*>
+*>      (1) DSYGV with ITYPE = 1 and UPLO ='U':
+*>
+*>              | A Z - B Z D | / ( |A| |Z| n ulp )
+*>              | D - D2 | / ( |D| ulp )   where D is computed by
+*>                                         DSYGV and  D2 is computed by
+*>                                         DSYGV_2STAGE. This test is
+*>                                         only performed for DSYGV
+*>
+*>      (2) as (1) but calling DSPGV
+*>      (3) as (1) but calling DSBGV
+*>      (4) as (1) but with UPLO = 'L'
+*>      (5) as (4) but calling DSPGV
+*>      (6) as (4) but calling DSBGV
+*>
+*>      (7) DSYGV with ITYPE = 2 and UPLO ='U':
+*>
+*>              | A B Z - Z D | / ( |A| |Z| n ulp )
+*>
+*>      (8) as (7) but calling DSPGV
+*>      (9) as (7) but with UPLO = 'L'
+*>      (10) as (9) but calling DSPGV
+*>
+*>      (11) DSYGV with ITYPE = 3 and UPLO ='U':
+*>
+*>              | B A Z - Z D | / ( |A| |Z| n ulp )
+*>
+*>      (12) as (11) but calling DSPGV
+*>      (13) as (11) but with UPLO = 'L'
+*>      (14) as (13) but calling DSPGV
+*>
+*>      DSYGVD, DSPGVD and DSBGVD performed the same 14 tests.
+*>
+*>      DSYGVX, DSPGVX and DSBGVX performed the above 14 tests with
+*>      the parameter RANGE = 'A', 'N' and 'I', respectively.
+*>
+*>      The "sizes" are specified by an array NN(1:NSIZES); the value
+*>      of each element NN(j) specifies one size.
+*>      The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*>      if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*>      This type is used for the matrix A which has half-bandwidth KA.
+*>      B is generated as a well-conditioned positive definite matrix
+*>      with half-bandwidth KB (<= KA).
+*>      Currently, the list of possible types for A is:
+*>
+*>      (1)  The zero matrix.
+*>      (2)  The identity matrix.
+*>
+*>      (3)  A diagonal matrix with evenly spaced entries
+*>           1, ..., ULP  and random signs.
+*>           (ULP = (first number larger than 1) - 1 )
+*>      (4)  A diagonal matrix with geometrically spaced entries
+*>           1, ..., ULP  and random signs.
+*>      (5)  A diagonal matrix with "clustered" entries
+*>           1, ULP, ..., ULP and random signs.
+*>
+*>      (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*>      (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*>      (8)  A matrix of the form  U* D U, where U is orthogonal and
+*>           D has evenly spaced entries 1, ..., ULP with random signs
+*>           on the diagonal.
+*>
+*>      (9)  A matrix of the form  U* D U, where U is orthogonal and
+*>           D has geometrically spaced entries 1, ..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (10) A matrix of the form  U* D U, where U is orthogonal and
+*>           D has "clustered" entries 1, ULP,..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*>      (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*>      (13) symmetric matrix with random entries chosen from (-1,1).
+*>      (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*>      (15) Same as (13), but multiplied by SQRT( underflow threshold)
+*>
+*>      (16) Same as (8), but with KA = 1 and KB = 1
+*>      (17) Same as (8), but with KA = 2 and KB = 1
+*>      (18) Same as (8), but with KA = 2 and KB = 2
+*>      (19) Same as (8), but with KA = 3 and KB = 1
+*>      (20) Same as (8), but with KA = 3 and KB = 2
+*>      (21) Same as (8), but with KA = 3 and KB = 3
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \verbatim
+*>  NSIZES  INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          DDRVSG2STG does nothing.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NN      INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*>          Not modified.
+*>
+*>  NTYPES  INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, DDRVSG2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*>          Not modified.
+*>
+*>  DOTYPE  LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*>          Not modified.
+*>
+*>  ISEED   INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to DDRVSG2STG to continue the same random number
+*>          sequence.
+*>          Modified.
+*>
+*>  THRESH  DOUBLE PRECISION
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NOUNIT  INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*>          Not modified.
+*>
+*>  A       DOUBLE PRECISION array, dimension (LDA , max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDA     INTEGER
+*>          The leading dimension of A and AB.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  B       DOUBLE PRECISION array, dimension (LDB , max(NN))
+*>          Used to hold the symmetric positive definite matrix for
+*>          the generailzed problem.
+*>          On exit, B contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDB     INTEGER
+*>          The leading dimension of B and BB.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  D       DOUBLE PRECISION array, dimension (max(NN))
+*>          The eigenvalues of A. On exit, the eigenvalues in D
+*>          correspond with the matrix in A.
+*>          Modified.
+*>
+*>  Z       DOUBLE PRECISION array, dimension (LDZ, max(NN))
+*>          The matrix of eigenvectors.
+*>          Modified.
+*>
+*>  LDZ     INTEGER
+*>          The leading dimension of Z.  It must be at least 1 and
+*>          at least max( NN ).
+*>          Not modified.
+*>
+*>  AB      DOUBLE PRECISION array, dimension (LDA, max(NN))
+*>          Workspace.
+*>          Modified.
+*>
+*>  BB      DOUBLE PRECISION array, dimension (LDB, max(NN))
+*>          Workspace.
+*>          Modified.
+*>
+*>  AP      DOUBLE PRECISION array, dimension (max(NN)**2)
+*>          Workspace.
+*>          Modified.
+*>
+*>  BP      DOUBLE PRECISION array, dimension (max(NN)**2)
+*>          Workspace.
+*>          Modified.
+*>
+*>  WORK    DOUBLE PRECISION array, dimension (NWORK)
+*>          Workspace.
+*>          Modified.
+*>
+*>  NWORK   INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          1+5*N+2*N*lg(N)+3*N**2 where N = max( NN(j) ) and
+*>          lg( N ) = smallest integer k such that 2**k >= N.
+*>          Not modified.
+*>
+*>  IWORK   INTEGER array, dimension (LIWORK)
+*>          Workspace.
+*>          Modified.
+*>
+*>  LIWORK  INTEGER
+*>          The number of entries in WORK.  This must be at least 6*N.
+*>          Not modified.
+*>
+*>  RESULT  DOUBLE PRECISION array, dimension (70)
+*>          The values computed by the 70 tests described above.
+*>          Modified.
+*>
+*>  INFO    INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -16: LDZ < 1 or LDZ < NMAX.
+*>          -21: NWORK too small.
+*>          -23: LIWORK too small.
+*>          If  DLATMR, SLATMS, DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD,
+*>              DSBGVD, DSYGVX, DSPGVX or SSBGVX returns an error code,
+*>              the absolute value of it is returned.
+*>          Modified.
+*>
+*> ----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests that have been run
+*>                       on this matrix.
+*>       NTESTT          The total number of tests for this call.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far (computed by DLAFTS).
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup double_eig
+*
+*  =====================================================================
+      SUBROUTINE DDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                       NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
+     $                       BB, AP, BP, WORK, NWORK, IWORK, LIWORK, 
+     $                       RESULT, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
+     $                   NTYPES, NWORK
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      DOUBLE PRECISION   A( LDA, * ), AB( LDA, * ), AP( * ),
+     $                   B( LDB, * ), BB( LDB, * ), BP( * ), D( * ),
+     $                   D2( * ), RESULT( * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE, TEN
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TEN = 10.0D0 )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 21 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN
+      CHARACTER          UPLO
+      INTEGER            I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
+     $                   ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
+     $                   KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
+     $                   NTESTT
+      DOUBLE PRECISION   ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, ULP, ULPINV, UNFL, VL, VU, TEMP1, TEMP2
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      DOUBLE PRECISION   DLAMCH, DLARND
+      EXTERNAL           LSAME, DLAMCH, DLARND
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLABAD, DLACPY, DLAFTS, DLASET, DLASUM, DLATMR,
+     $                   DLATMS, DSBGV, DSBGVD, DSBGVX, DSGT01, DSPGV,
+     $                   DSPGVD, DSPGVX, DSYGV, DSYGVD, DSYGVX, XERBLA,
+     $                   DSYGV_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 6*1 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 6*4 /
+*     ..
+*     .. Executable Statements ..
+*
+*     1)      Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+      BADNN = .FALSE.
+      NMAX = 0
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN
+         INFO = -16
+      ELSE IF( 2*MAX( NMAX, 3 )**2.GT.NWORK ) THEN
+         INFO = -21
+      ELSE IF( 2*MAX( NMAX, 3 )**2.GT.LIWORK ) THEN
+         INFO = -23
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DDRVSG2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = DLAMCH( 'Safe minimum' )
+      OVFL = DLAMCH( 'Overflow' )
+      CALL DLABAD( UNFL, OVFL )
+      ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+   20 CONTINUE
+*
+*     Loop over sizes, types
+*
+      NERRS = 0
+      NMATS = 0
+*
+      DO 650 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         ANINV = ONE / DBLE( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         KA9 = 0
+         KB9 = 0
+         DO 640 JTYPE = 1, MTYPES
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 640
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           2)      Compute "A"
+*
+*                   Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, w/ eigenvalues
+*           =5         random log   hermitian, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random hermitian
+*           =9                      banded, w/ eigenvalues
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 90
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            IINFO = 0
+            COND = ULPINV
+*
+*           Special Matrices -- Identity & Jordan block
+*
+            IF( ITYPE.EQ.1 ) THEN
+*
+*              Zero
+*
+               KA = 0
+               KB = 0
+               CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               KA = 0
+               KB = 0
+               CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+               DO 80 JCOL = 1, N
+                  A( JCOL, JCOL ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               KA = 0
+               KB = 0
+               CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              symmetric, eigenvalues specified
+*
+               KA = MAX( 0, N-1 )
+               KB = KA
+               CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               KA = 0
+               KB = 0
+               CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              symmetric, random eigenvalues
+*
+               KA = MAX( 0, N-1 )
+               KB = KA
+               CALL DLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              symmetric banded, eigenvalues specified
+*
+*              The following values are used for the half-bandwidths:
+*
+*                ka = 1   kb = 1
+*                ka = 2   kb = 1
+*                ka = 2   kb = 2
+*                ka = 3   kb = 1
+*                ka = 3   kb = 2
+*                ka = 3   kb = 3
+*
+               KB9 = KB9 + 1
+               IF( KB9.GT.KA9 ) THEN
+                  KA9 = KA9 + 1
+                  KB9 = 1
+               END IF
+               KA = MAX( 0, MIN( N-1, KA9 ) )
+               KB = MAX( 0, MIN( N-1, KB9 ) )
+               CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, KA, KA, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE
+*
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+   90       CONTINUE
+*
+            ABSTOL = UNFL + UNFL
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
+               IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
+               IF( IL.GT.IU ) THEN
+                  ITEMP = IL
+                  IL = IU
+                  IU = ITEMP
+               END IF
+            END IF
+*
+*           3) Call DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD, SSBGVD,
+*              DSYGVX, DSPGVX, and DSBGVX, do tests.
+*
+*           loop over the three generalized problems
+*                 IBTYPE = 1: A*x = (lambda)*B*x
+*                 IBTYPE = 2: A*B*x = (lambda)*x
+*                 IBTYPE = 3: B*A*x = (lambda)*x
+*
+            DO 630 IBTYPE = 1, 3
+*
+*              loop over the setting UPLO
+*
+               DO 620 IBUPLO = 1, 2
+                  IF( IBUPLO.EQ.1 )
+     $               UPLO = 'U'
+                  IF( IBUPLO.EQ.2 )
+     $               UPLO = 'L'
+*
+*                 Generate random well-conditioned positive definite
+*                 matrix B, of bandwidth not greater than that of A.
+*
+                  CALL DLATMS( N, N, 'U', ISEED, 'P', WORK, 5, TEN, ONE,
+     $                         KB, KB, UPLO, B, LDB, WORK( N+1 ),
+     $                         IINFO )
+*
+*                 Test DSYGV
+*
+                  NTEST = NTEST + 1
+*
+                  CALL DLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL DSYGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
+     $                        WORK, NWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSYGV(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                 Test DSYGV_2STAGE
+*
+                  NTEST = NTEST + 1
+*
+                  CALL DLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL DSYGV_2STAGE( IBTYPE, 'N', UPLO, N, Z, LDZ,
+     $                               BB, LDB, D2, WORK, NWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )
+     $                  'DSYGV_2STAGE(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+C                  CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+C     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*           
+*                 Do Tests | D1 - D2 | / ( |D1| ulp )
+*                 D1 computed using the standard 1-stage reduction as reference
+*                 D2 computed using the 2-stage reduction
+*           
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+                  DO 151 J = 1, N
+                     TEMP1 = MAX( TEMP1, ABS( D( J ) ), 
+     $                                   ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D( J )-D2( J ) ) )
+  151             CONTINUE
+*           
+                  RESULT( NTEST ) = TEMP2 / 
+     $                              MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*                 Test DSYGVD
+*
+                  NTEST = NTEST + 1
+*
+                  CALL DLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL DSYGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
+     $                         WORK, NWORK, IWORK, LIWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSYGVD(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                 Test DSYGVX
+*
+                  NTEST = NTEST + 1
+*
+                  CALL DLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL DSYGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, IWORK( N+1 ), IWORK,
+     $                         IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSYGVX(V,A' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+                  CALL DLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+*                 since we do not know the exact eigenvalues of this
+*                 eigenpair, we just set VL and VU as constants.
+*                 It is quite possible that there are no eigenvalues
+*                 in this interval.
+*
+                  VL = ZERO
+                  VU = ANORM
+                  CALL DSYGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, IWORK( N+1 ), IWORK,
+     $                         IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSYGVX(V,V,' //
+     $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+                  CALL DLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL DSYGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, IWORK( N+1 ), IWORK,
+     $                         IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSYGVX(V,I,' //
+     $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+  100             CONTINUE
+*
+*                 Test DSPGV
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 120 J = 1, N
+                        DO 110 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  110                   CONTINUE
+  120                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 140 J = 1, N
+                        DO 130 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  130                   CONTINUE
+  140                CONTINUE
+                  END IF
+*
+                  CALL DSPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
+     $                        WORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSPGV(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                 Test DSPGVD
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 160 J = 1, N
+                        DO 150 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  150                   CONTINUE
+  160                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 180 J = 1, N
+                        DO 170 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  170                   CONTINUE
+  180                CONTINUE
+                  END IF
+*
+                  CALL DSPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
+     $                         WORK, NWORK, IWORK, LIWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSPGVD(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                 Test DSPGVX
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 200 J = 1, N
+                        DO 190 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  190                   CONTINUE
+  200                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 220 J = 1, N
+                        DO 210 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  210                   CONTINUE
+  220                CONTINUE
+                  END IF
+*
+                  CALL DSPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,A' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 240 J = 1, N
+                        DO 230 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  230                   CONTINUE
+  240                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 260 J = 1, N
+                        DO 250 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  250                   CONTINUE
+  260                CONTINUE
+                  END IF
+*
+                  VL = ZERO
+                  VU = ANORM
+                  CALL DSPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,V' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 280 J = 1, N
+                        DO 270 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  270                   CONTINUE
+  280                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 300 J = 1, N
+                        DO 290 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  290                   CONTINUE
+  300                CONTINUE
+                  END IF
+*
+                  CALL DSPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,I' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+  310             CONTINUE
+*
+                  IF( IBTYPE.EQ.1 ) THEN
+*
+*                    TEST DSBGV
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 340 J = 1, N
+                           DO 320 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  320                      CONTINUE
+                           DO 330 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  330                      CONTINUE
+  340                   CONTINUE
+                     ELSE
+                        DO 370 J = 1, N
+                           DO 350 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  350                      CONTINUE
+                           DO 360 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  360                      CONTINUE
+  370                   CONTINUE
+                     END IF
+*
+                     CALL DSBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB,
+     $                           D, Z, LDZ, WORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'DSBGV(V,' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                    TEST DSBGVD
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 400 J = 1, N
+                           DO 380 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  380                      CONTINUE
+                           DO 390 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  390                      CONTINUE
+  400                   CONTINUE
+                     ELSE
+                        DO 430 J = 1, N
+                           DO 410 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  410                      CONTINUE
+                           DO 420 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  420                      CONTINUE
+  430                   CONTINUE
+                     END IF
+*
+                     CALL DSBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB,
+     $                            LDB, D, Z, LDZ, WORK, NWORK, IWORK,
+     $                            LIWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'DSBGVD(V,' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                    Test DSBGVX
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 460 J = 1, N
+                           DO 440 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  440                      CONTINUE
+                           DO 450 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  450                      CONTINUE
+  460                   CONTINUE
+                     ELSE
+                        DO 490 J = 1, N
+                           DO 470 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  470                      CONTINUE
+                           DO 480 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  480                      CONTINUE
+  490                   CONTINUE
+                     END IF
+*
+                     CALL DSBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'DSBGVX(V,A' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RESULT( NTEST ) )
+*
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 520 J = 1, N
+                           DO 500 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  500                      CONTINUE
+                           DO 510 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  510                      CONTINUE
+  520                   CONTINUE
+                     ELSE
+                        DO 550 J = 1, N
+                           DO 530 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  530                      CONTINUE
+                           DO 540 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  540                      CONTINUE
+  550                   CONTINUE
+                     END IF
+*
+                     VL = ZERO
+                     VU = ANORM
+                     CALL DSBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'DSBGVX(V,V' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RESULT( NTEST ) )
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 580 J = 1, N
+                           DO 560 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  560                      CONTINUE
+                           DO 570 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  570                      CONTINUE
+  580                   CONTINUE
+                     ELSE
+                        DO 610 J = 1, N
+                           DO 590 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  590                      CONTINUE
+                           DO 600 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  600                      CONTINUE
+  610                   CONTINUE
+                     END IF
+*
+                     CALL DSBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'DSBGVX(V,I' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RESULT( NTEST ) )
+*
+                  END IF
+*
+  620          CONTINUE
+  630       CONTINUE
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+            NTESTT = NTESTT + NTEST
+            CALL DLAFTS( 'DSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
+     $                   THRESH, NOUNIT, NERRS )
+  640    CONTINUE
+  650 CONTINUE
+*
+*     Summary
+*
+      CALL DLASUM( 'DSG', NOUNIT, NERRS, NTESTT )
+*
+      RETURN
+*
+*     End of DDRVSG2STG
+*
+ 9999 FORMAT( ' DDRVSG2STG: ', A, ' returned INFO=', I6, '.', / 9X,
+     $    'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+      END
diff --git a/TESTING/EIG/ddrvst2stg.f b/TESTING/EIG/ddrvst2stg.f
new file mode 100644
index 00000000..cf1f8c44
--- /dev/null
+++ b/TESTING/EIG/ddrvst2stg.f
@@ -0,0 +1,2872 @@
+*> \brief \b DDRVST2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                          NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1,
+*                          WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK,
+*                          IWORK, LIWORK, RESULT, INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
+*      $                   NTYPES
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       DOUBLE PRECISION   A( LDA, * ), D1( * ), D2( * ), D3( * ),
+*      $                   D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ),
+*      $                   U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ),
+*      $                   WA3( * ), WORK( * ), Z( LDU, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>      DDRVST2STG  checks the symmetric eigenvalue problem drivers.
+*>
+*>              DSTEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric tridiagonal matrix.
+*>
+*>              DSTEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric tridiagonal matrix.
+*>
+*>              DSTEVR computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric tridiagonal matrix
+*>              using the Relatively Robust Representation where it can.
+*>
+*>              DSYEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix.
+*>
+*>              DSYEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix.
+*>
+*>              DSYEVR computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix
+*>              using the Relatively Robust Representation where it can.
+*>
+*>              DSPEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix in packed
+*>              storage.
+*>
+*>              DSPEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix in packed
+*>              storage.
+*>
+*>              DSBEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric band matrix.
+*>
+*>              DSBEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric band matrix.
+*>
+*>              DSYEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix using
+*>              a divide and conquer algorithm.
+*>
+*>              DSPEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix in packed
+*>              storage, using a divide and conquer algorithm.
+*>
+*>              DSBEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric band matrix,
+*>              using a divide and conquer algorithm.
+*>
+*>      When DDRVST2STG is called, a number of matrix "sizes" ("n's") and a
+*>      number of matrix "types" are specified.  For each size ("n")
+*>      and each type of matrix, one matrix will be generated and used
+*>      to test the appropriate drivers.  For each matrix and each
+*>      driver routine called, the following tests will be performed:
+*>
+*>      (1)     | A - Z D Z' | / ( |A| n ulp )
+*>
+*>      (2)     | I - Z Z' | / ( n ulp )
+*>
+*>      (3)     | D1 - D2 | / ( |D1| ulp )
+*>
+*>      where Z is the matrix of eigenvectors returned when the
+*>      eigenvector option is given and D1 and D2 are the eigenvalues
+*>      returned with and without the eigenvector option.
+*>
+*>      The "sizes" are specified by an array NN(1:NSIZES); the value of
+*>      each element NN(j) specifies one size.
+*>      The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*>      if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*>      Currently, the list of possible types is:
+*>
+*>      (1)  The zero matrix.
+*>      (2)  The identity matrix.
+*>
+*>      (3)  A diagonal matrix with evenly spaced eigenvalues
+*>           1, ..., ULP  and random signs.
+*>           (ULP = (first number larger than 1) - 1 )
+*>      (4)  A diagonal matrix with geometrically spaced eigenvalues
+*>           1, ..., ULP  and random signs.
+*>      (5)  A diagonal matrix with "clustered" eigenvalues
+*>           1, ULP, ..., ULP and random signs.
+*>
+*>      (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*>      (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*>      (8)  A matrix of the form  U' D U, where U is orthogonal and
+*>           D has evenly spaced entries 1, ..., ULP with random signs
+*>           on the diagonal.
+*>
+*>      (9)  A matrix of the form  U' D U, where U is orthogonal and
+*>           D has geometrically spaced entries 1, ..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (10) A matrix of the form  U' D U, where U is orthogonal and
+*>           D has "clustered" entries 1, ULP,..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*>      (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*>      (13) Symmetric matrix with random entries chosen from (-1,1).
+*>      (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*>      (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*>      (16) A band matrix with half bandwidth randomly chosen between
+*>           0 and N-1, with evenly spaced eigenvalues 1, ..., ULP
+*>           with random signs.
+*>      (17) Same as (16), but multiplied by SQRT( overflow threshold )
+*>      (18) Same as (16), but multiplied by SQRT( underflow threshold )
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \verbatim
+*>  NSIZES  INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          DDRVST2STG does nothing.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NN      INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*>          Not modified.
+*>
+*>  NTYPES  INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, DDRVST2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*>          Not modified.
+*>
+*>  DOTYPE  LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*>          Not modified.
+*>
+*>  ISEED   INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to DDRVST2STG to continue the same random number
+*>          sequence.
+*>          Modified.
+*>
+*>  THRESH  DOUBLE PRECISION
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NOUNIT  INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*>          Not modified.
+*>
+*>  A       DOUBLE PRECISION array, dimension (LDA , max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDA     INTEGER
+*>          The leading dimension of A.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  D1      DOUBLE PRECISION array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by DSTEQR simlutaneously
+*>          with Z.  On exit, the eigenvalues in D1 correspond with the
+*>          matrix in A.
+*>          Modified.
+*>
+*>  D2      DOUBLE PRECISION array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by DSTEQR if Z is not
+*>          computed.  On exit, the eigenvalues in D2 correspond with
+*>          the matrix in A.
+*>          Modified.
+*>
+*>  D3      DOUBLE PRECISION array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by DSTERF.  On exit, the
+*>          eigenvalues in D3 correspond with the matrix in A.
+*>          Modified.
+*>
+*>  D4      DOUBLE PRECISION array, dimension
+*>
+*>  EVEIGS  DOUBLE PRECISION array, dimension (max(NN))
+*>          The eigenvalues as computed by DSTEV('N', ... )
+*>          (I reserve the right to change this to the output of
+*>          whichever algorithm computes the most accurate eigenvalues).
+*>
+*>  WA1     DOUBLE PRECISION array, dimension
+*>
+*>  WA2     DOUBLE PRECISION array, dimension
+*>
+*>  WA3     DOUBLE PRECISION array, dimension
+*>
+*>  U       DOUBLE PRECISION array, dimension (LDU, max(NN))
+*>          The orthogonal matrix computed by DSYTRD + DORGTR.
+*>          Modified.
+*>
+*>  LDU     INTEGER
+*>          The leading dimension of U, Z, and V.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  V       DOUBLE PRECISION array, dimension (LDU, max(NN))
+*>          The Housholder vectors computed by DSYTRD in reducing A to
+*>          tridiagonal form.
+*>          Modified.
+*>
+*>  TAU     DOUBLE PRECISION array, dimension (max(NN))
+*>          The Householder factors computed by DSYTRD in reducing A
+*>          to tridiagonal form.
+*>          Modified.
+*>
+*>  Z       DOUBLE PRECISION array, dimension (LDU, max(NN))
+*>          The orthogonal matrix of eigenvectors computed by DSTEQR,
+*>          DPTEQR, and DSTEIN.
+*>          Modified.
+*>
+*>  WORK    DOUBLE PRECISION array, dimension (LWORK)
+*>          Workspace.
+*>          Modified.
+*>
+*>  LWORK   INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 4 * Nmax**2
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*>          Not modified.
+*>
+*>  IWORK   INTEGER array,
+*>             dimension (6 + 6*Nmax + 5 * Nmax * lg Nmax )
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*>          Workspace.
+*>          Modified.
+*>
+*>  RESULT  DOUBLE PRECISION array, dimension (105)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*>          Modified.
+*>
+*>  INFO    INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -16: LDU < 1 or LDU < NMAX.
+*>          -21: LWORK too small.
+*>          If  DLATMR, DLATMS, DSYTRD, DORGTR, DSTEQR, DSTERF,
+*>              or DORMTR returns an error code, the
+*>              absolute value of it is returned.
+*>          Modified.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far (computed by DLAFTS).
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*>
+*>     The tests performed are:                 Routine tested
+*>    1= | A - U S U' | / ( |A| n ulp )         DSTEV('V', ... )
+*>    2= | I - U U' | / ( n ulp )               DSTEV('V', ... )
+*>    3= |D(with Z) - D(w/o Z)| / (|D| ulp)     DSTEV('N', ... )
+*>    4= | A - U S U' | / ( |A| n ulp )         DSTEVX('V','A', ... )
+*>    5= | I - U U' | / ( n ulp )               DSTEVX('V','A', ... )
+*>    6= |D(with Z) - EVEIGS| / (|D| ulp)       DSTEVX('N','A', ... )
+*>    7= | A - U S U' | / ( |A| n ulp )         DSTEVR('V','A', ... )
+*>    8= | I - U U' | / ( n ulp )               DSTEVR('V','A', ... )
+*>    9= |D(with Z) - EVEIGS| / (|D| ulp)       DSTEVR('N','A', ... )
+*>    10= | A - U S U' | / ( |A| n ulp )        DSTEVX('V','I', ... )
+*>    11= | I - U U' | / ( n ulp )              DSTEVX('V','I', ... )
+*>    12= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSTEVX('N','I', ... )
+*>    13= | A - U S U' | / ( |A| n ulp )        DSTEVX('V','V', ... )
+*>    14= | I - U U' | / ( n ulp )              DSTEVX('V','V', ... )
+*>    15= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSTEVX('N','V', ... )
+*>    16= | A - U S U' | / ( |A| n ulp )        DSTEVD('V', ... )
+*>    17= | I - U U' | / ( n ulp )              DSTEVD('V', ... )
+*>    18= |D(with Z) - EVEIGS| / (|D| ulp)      DSTEVD('N', ... )
+*>    19= | A - U S U' | / ( |A| n ulp )        DSTEVR('V','I', ... )
+*>    20= | I - U U' | / ( n ulp )              DSTEVR('V','I', ... )
+*>    21= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSTEVR('N','I', ... )
+*>    22= | A - U S U' | / ( |A| n ulp )        DSTEVR('V','V', ... )
+*>    23= | I - U U' | / ( n ulp )              DSTEVR('V','V', ... )
+*>    24= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSTEVR('N','V', ... )
+*>
+*>    25= | A - U S U' | / ( |A| n ulp )        DSYEV('L','V', ... )
+*>    26= | I - U U' | / ( n ulp )              DSYEV('L','V', ... )
+*>    27= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEV_2STAGE('L','N', ... )
+*>    28= | A - U S U' | / ( |A| n ulp )        DSYEVX('L','V','A', ... )
+*>    29= | I - U U' | / ( n ulp )              DSYEVX('L','V','A', ... )
+*>    30= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVX_2STAGE('L','N','A', ... )
+*>    31= | A - U S U' | / ( |A| n ulp )        DSYEVX('L','V','I', ... )
+*>    32= | I - U U' | / ( n ulp )              DSYEVX('L','V','I', ... )
+*>    33= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVX_2STAGE('L','N','I', ... )
+*>    34= | A - U S U' | / ( |A| n ulp )        DSYEVX('L','V','V', ... )
+*>    35= | I - U U' | / ( n ulp )              DSYEVX('L','V','V', ... )
+*>    36= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVX_2STAGE('L','N','V', ... )
+*>    37= | A - U S U' | / ( |A| n ulp )        DSPEV('L','V', ... )
+*>    38= | I - U U' | / ( n ulp )              DSPEV('L','V', ... )
+*>    39= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEV('L','N', ... )
+*>    40= | A - U S U' | / ( |A| n ulp )        DSPEVX('L','V','A', ... )
+*>    41= | I - U U' | / ( n ulp )              DSPEVX('L','V','A', ... )
+*>    42= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVX('L','N','A', ... )
+*>    43= | A - U S U' | / ( |A| n ulp )        DSPEVX('L','V','I', ... )
+*>    44= | I - U U' | / ( n ulp )              DSPEVX('L','V','I', ... )
+*>    45= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVX('L','N','I', ... )
+*>    46= | A - U S U' | / ( |A| n ulp )        DSPEVX('L','V','V', ... )
+*>    47= | I - U U' | / ( n ulp )              DSPEVX('L','V','V', ... )
+*>    48= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVX('L','N','V', ... )
+*>    49= | A - U S U' | / ( |A| n ulp )        DSBEV('L','V', ... )
+*>    50= | I - U U' | / ( n ulp )              DSBEV('L','V', ... )
+*>    51= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEV_2STAGE('L','N', ... )
+*>    52= | A - U S U' | / ( |A| n ulp )        DSBEVX('L','V','A', ... )
+*>    53= | I - U U' | / ( n ulp )              DSBEVX('L','V','A', ... )
+*>    54= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVX_2STAGE('L','N','A', ... )
+*>    55= | A - U S U' | / ( |A| n ulp )        DSBEVX('L','V','I', ... )
+*>    56= | I - U U' | / ( n ulp )              DSBEVX('L','V','I', ... )
+*>    57= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVX_2STAGE('L','N','I', ... )
+*>    58= | A - U S U' | / ( |A| n ulp )        DSBEVX('L','V','V', ... )
+*>    59= | I - U U' | / ( n ulp )              DSBEVX('L','V','V', ... )
+*>    60= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVX_2STAGE('L','N','V', ... )
+*>    61= | A - U S U' | / ( |A| n ulp )        DSYEVD('L','V', ... )
+*>    62= | I - U U' | / ( n ulp )              DSYEVD('L','V', ... )
+*>    63= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVD_2STAGE('L','N', ... )
+*>    64= | A - U S U' | / ( |A| n ulp )        DSPEVD('L','V', ... )
+*>    65= | I - U U' | / ( n ulp )              DSPEVD('L','V', ... )
+*>    66= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVD('L','N', ... )
+*>    67= | A - U S U' | / ( |A| n ulp )        DSBEVD('L','V', ... )
+*>    68= | I - U U' | / ( n ulp )              DSBEVD('L','V', ... )
+*>    69= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVD_2STAGE('L','N', ... )
+*>    70= | A - U S U' | / ( |A| n ulp )        DSYEVR('L','V','A', ... )
+*>    71= | I - U U' | / ( n ulp )              DSYEVR('L','V','A', ... )
+*>    72= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVR_2STAGE('L','N','A', ... )
+*>    73= | A - U S U' | / ( |A| n ulp )        DSYEVR('L','V','I', ... )
+*>    74= | I - U U' | / ( n ulp )              DSYEVR('L','V','I', ... )
+*>    75= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVR_2STAGE('L','N','I', ... )
+*>    76= | A - U S U' | / ( |A| n ulp )        DSYEVR('L','V','V', ... )
+*>    77= | I - U U' | / ( n ulp )              DSYEVR('L','V','V', ... )
+*>    78= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVR_2STAGE('L','N','V', ... )
+*>
+*>    Tests 25 through 78 are repeated (as tests 79 through 132)
+*>    with UPLO='U'
+*>
+*>    To be added in 1999
+*>
+*>    79= | A - U S U' | / ( |A| n ulp )        DSPEVR('L','V','A', ... )
+*>    80= | I - U U' | / ( n ulp )              DSPEVR('L','V','A', ... )
+*>    81= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVR('L','N','A', ... )
+*>    82= | A - U S U' | / ( |A| n ulp )        DSPEVR('L','V','I', ... )
+*>    83= | I - U U' | / ( n ulp )              DSPEVR('L','V','I', ... )
+*>    84= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVR('L','N','I', ... )
+*>    85= | A - U S U' | / ( |A| n ulp )        DSPEVR('L','V','V', ... )
+*>    86= | I - U U' | / ( n ulp )              DSPEVR('L','V','V', ... )
+*>    87= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVR('L','N','V', ... )
+*>    88= | A - U S U' | / ( |A| n ulp )        DSBEVR('L','V','A', ... )
+*>    89= | I - U U' | / ( n ulp )              DSBEVR('L','V','A', ... )
+*>    90= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVR('L','N','A', ... )
+*>    91= | A - U S U' | / ( |A| n ulp )        DSBEVR('L','V','I', ... )
+*>    92= | I - U U' | / ( n ulp )              DSBEVR('L','V','I', ... )
+*>    93= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVR('L','N','I', ... )
+*>    94= | A - U S U' | / ( |A| n ulp )        DSBEVR('L','V','V', ... )
+*>    95= | I - U U' | / ( n ulp )              DSBEVR('L','V','V', ... )
+*>    96= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVR('L','N','V', ... )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup double_eig
+*
+*  =====================================================================
+      SUBROUTINE DDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                   NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1,
+     $                   WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK,
+     $                   IWORK, LIWORK, RESULT, INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
+     $                   NTYPES
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      DOUBLE PRECISION   A( LDA, * ), D1( * ), D2( * ), D3( * ),
+     $                   D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ),
+     $                   U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ),
+     $                   WA3( * ), WORK( * ), Z( LDU, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE, TWO, TEN
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
+     $                   TEN = 10.0D0 )
+      DOUBLE PRECISION   HALF
+      PARAMETER          ( HALF = 0.5D0 )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 18 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN
+      CHARACTER          UPLO
+      INTEGER            I, IDIAG, IHBW, IINFO, IL, IMODE, INDX, IROW,
+     $                   ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL,
+     $                   JSIZE, JTYPE, KD, LGN, LIWEDC, LWEDC, M, M2,
+     $                   M3, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
+     $                   NTESTT
+      DOUBLE PRECISION   ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL,
+     $                   VL, VU
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMCH, DLARND, DSXT1
+      EXTERNAL           DLAMCH, DLARND, DSXT1
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALASVM, DLABAD, DLACPY, DLAFTS, DLASET, DLATMR,
+     $                   DLATMS, DSBEV, DSBEVD, DSBEVX, DSPEV, DSPEVD,
+     $                   DSPEVX, DSTEV, DSTEVD, DSTEVR, DSTEVX, DSTT21,
+     $                   DSTT22, DSYEV, DSYEVD, DSYEVR, DSYEVX, DSYT21,
+     $                   DSYEVD_2STAGE, DSYEVR_2STAGE, DSYEVX_2STAGE,
+     $                   DSYEV_2STAGE, DSBEV_2STAGE, DSBEVD_2STAGE,
+     $                   DSBEVX_2STAGE, DSYTRD_2STAGE, DSYTRD_SY2SB, 
+     $                   DSYTRD_SB2ST, DSYT22, XERBLA
+*     ..
+*     .. Scalars in Common ..
+      CHARACTER*32       SRNAMT
+*     ..
+*     .. Common blocks ..
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, INT, LOG, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 1, 2, 3 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 4, 4, 4 /
+*     ..
+*     .. Executable Statements ..
+*
+*     Keep ftrnchek happy
+*
+      VL = ZERO
+      VU = ZERO
+*
+*     1)      Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+      BADNN = .FALSE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -16
+      ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
+         INFO = -21
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DDRVST2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if nothing to do
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = DLAMCH( 'Safe minimum' )
+      OVFL = DLAMCH( 'Overflow' )
+      CALL DLABAD( UNFL, OVFL )
+      ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+         ISEED3( I ) = ISEED( I )
+   20 CONTINUE
+*
+      NERRS = 0
+      NMATS = 0
+*
+*
+      DO 1740 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         IF( N.GT.0 ) THEN
+            LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) )
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2
+c           LIWEDC = 6 + 6*N + 5*N*LGN
+            LIWEDC = 3 + 5*N
+         ELSE
+            LWEDC = 9
+c           LIWEDC = 12
+            LIWEDC = 8
+         END IF
+         ANINV = ONE / DBLE( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         DO 1730 JTYPE = 1, MTYPES
+*
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 1730
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           2)      Compute "A"
+*
+*                   Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, (w/ eigenvalues)
+*           =5         random log   symmetric, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random symmetric
+*           =9                      band symmetric, w/ eigenvalues
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 110
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+            IINFO = 0
+            COND = ULPINV
+*
+*           Special Matrices -- Identity & Jordan block
+*
+*                   Zero
+*
+            IF( ITYPE.EQ.1 ) THEN
+               IINFO = 0
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               DO 80 JCOL = 1, N
+                  A( JCOL, JCOL ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              Symmetric, eigenvalues specified
+*
+               CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               IDUMMA( 1 ) = 1
+               CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              Symmetric, random eigenvalues
+*
+               IDUMMA( 1 ) = 1
+               CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              Symmetric banded, eigenvalues specified
+*
+               IHBW = INT( ( N-1 )*DLARND( 1, ISEED3 ) )
+               CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, IHBW, IHBW, 'Z', U, LDU, WORK( N+1 ),
+     $                      IINFO )
+*
+*              Store as dense matrix for most routines.
+*
+               CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+               DO 100 IDIAG = -IHBW, IHBW
+                  IROW = IHBW - IDIAG + 1
+                  J1 = MAX( 1, IDIAG+1 )
+                  J2 = MIN( N, N+IDIAG )
+                  DO 90 J = J1, J2
+                     I = J - IDIAG
+                     A( I, J ) = U( IROW, J )
+   90             CONTINUE
+  100          CONTINUE
+            ELSE
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+  110       CONTINUE
+*
+            ABSTOL = UNFL + UNFL
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
+               IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
+               IF( IL.GT.IU ) THEN
+                  ITEMP = IL
+                  IL = IU
+                  IU = ITEMP
+               END IF
+            END IF
+*
+*           3)      If matrix is tridiagonal, call DSTEV and DSTEVX.
+*
+            IF( JTYPE.LE.7 ) THEN
+               NTEST = 1
+               DO 120 I = 1, N
+                  D1( I ) = DBLE( A( I, I ) )
+  120          CONTINUE
+               DO 130 I = 1, N - 1
+                  D2( I ) = DBLE( A( I+1, I ) )
+  130          CONTINUE
+               SRNAMT = 'DSTEV'
+               CALL DSTEV( 'V', N, D1, D2, Z, LDU, WORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEV(V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 1 ) = ULPINV
+                     RESULT( 2 ) = ULPINV
+                     RESULT( 3 ) = ULPINV
+                     GO TO 180
+                  END IF
+               END IF
+*
+*              Do tests 1 and 2.
+*
+               DO 140 I = 1, N
+                  D3( I ) = DBLE( A( I, I ) )
+  140          CONTINUE
+               DO 150 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  150          CONTINUE
+               CALL DSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK,
+     $                      RESULT( 1 ) )
+*
+               NTEST = 3
+               DO 160 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  160          CONTINUE
+               SRNAMT = 'DSTEV'
+               CALL DSTEV( 'N', N, D3, D4, Z, LDU, WORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEV(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 3 ) = ULPINV
+                     GO TO 180
+                  END IF
+               END IF
+*
+*              Do test 3.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 170 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  170          CONTINUE
+               RESULT( 3 ) = TEMP2 / MAX( UNFL,
+     $                       ULP*MAX( TEMP1, TEMP2 ) )
+*
+  180          CONTINUE
+*
+               NTEST = 4
+               DO 190 I = 1, N
+                  EVEIGS( I ) = D3( I )
+                  D1( I ) = DBLE( A( I, I ) )
+  190          CONTINUE
+               DO 200 I = 1, N - 1
+                  D2( I ) = DBLE( A( I+1, I ) )
+  200          CONTINUE
+               SRNAMT = 'DSTEVX'
+               CALL DSTEVX( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M, WA1, Z, LDU, WORK, IWORK, IWORK( 5*N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 4 ) = ULPINV
+                     RESULT( 5 ) = ULPINV
+                     RESULT( 6 ) = ULPINV
+                     GO TO 250
+                  END IF
+               END IF
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+*
+*              Do tests 4 and 5.
+*
+               DO 210 I = 1, N
+                  D3( I ) = DBLE( A( I, I ) )
+  210          CONTINUE
+               DO 220 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  220          CONTINUE
+               CALL DSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK,
+     $                      RESULT( 4 ) )
+*
+               NTEST = 6
+               DO 230 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  230          CONTINUE
+               SRNAMT = 'DSTEVX'
+               CALL DSTEVX( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, WORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 6 ) = ULPINV
+                     GO TO 250
+                  END IF
+               END IF
+*
+*              Do test 6.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 240 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA2( J ) ),
+     $                    ABS( EVEIGS( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) )
+  240          CONTINUE
+               RESULT( 6 ) = TEMP2 / MAX( UNFL,
+     $                       ULP*MAX( TEMP1, TEMP2 ) )
+*
+  250          CONTINUE
+*
+               NTEST = 7
+               DO 260 I = 1, N
+                  D1( I ) = DBLE( A( I, I ) )
+  260          CONTINUE
+               DO 270 I = 1, N - 1
+                  D2( I ) = DBLE( A( I+1, I ) )
+  270          CONTINUE
+               SRNAMT = 'DSTEVR'
+               CALL DSTEVR( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M, WA1, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 7 ) = ULPINV
+                     RESULT( 8 ) = ULPINV
+                     GO TO 320
+                  END IF
+               END IF
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+*
+*              Do tests 7 and 8.
+*
+               DO 280 I = 1, N
+                  D3( I ) = DBLE( A( I, I ) )
+  280          CONTINUE
+               DO 290 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  290          CONTINUE
+               CALL DSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK,
+     $                      RESULT( 7 ) )
+*
+               NTEST = 9
+               DO 300 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  300          CONTINUE
+               SRNAMT = 'DSTEVR'
+               CALL DSTEVR( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 9 ) = ULPINV
+                     GO TO 320
+                  END IF
+               END IF
+*
+*              Do test 9.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 310 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA2( J ) ),
+     $                    ABS( EVEIGS( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) )
+  310          CONTINUE
+               RESULT( 9 ) = TEMP2 / MAX( UNFL,
+     $                       ULP*MAX( TEMP1, TEMP2 ) )
+*
+  320          CONTINUE
+*
+*
+               NTEST = 10
+               DO 330 I = 1, N
+                  D1( I ) = DBLE( A( I, I ) )
+  330          CONTINUE
+               DO 340 I = 1, N - 1
+                  D2( I ) = DBLE( A( I+1, I ) )
+  340          CONTINUE
+               SRNAMT = 'DSTEVX'
+               CALL DSTEVX( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, WORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,I)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 10 ) = ULPINV
+                     RESULT( 11 ) = ULPINV
+                     RESULT( 12 ) = ULPINV
+                     GO TO 380
+                  END IF
+               END IF
+*
+*              Do tests 10 and 11.
+*
+               DO 350 I = 1, N
+                  D3( I ) = DBLE( A( I, I ) )
+  350          CONTINUE
+               DO 360 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  360          CONTINUE
+               CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
+     $                      MAX( 1, M2 ), RESULT( 10 ) )
+*
+*
+               NTEST = 12
+               DO 370 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  370          CONTINUE
+               SRNAMT = 'DSTEVX'
+               CALL DSTEVX( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M3, WA3, Z, LDU, WORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,I)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 12 ) = ULPINV
+                     GO TO 380
+                  END IF
+               END IF
+*
+*              Do test 12.
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( 12 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 )
+*
+  380          CONTINUE
+*
+               NTEST = 12
+               IF( N.GT.0 ) THEN
+                  IF( IL.NE.1 ) THEN
+                     VL = WA1( IL ) - MAX( HALF*
+     $                    ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3,
+     $                    TEN*RTUNFL )
+                  ELSE
+                     VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = WA1( IU ) + MAX( HALF*
+     $                    ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3,
+     $                    TEN*RTUNFL )
+                  ELSE
+                     VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               DO 390 I = 1, N
+                  D1( I ) = DBLE( A( I, I ) )
+  390          CONTINUE
+               DO 400 I = 1, N - 1
+                  D2( I ) = DBLE( A( I+1, I ) )
+  400          CONTINUE
+               SRNAMT = 'DSTEVX'
+               CALL DSTEVX( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, WORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 13 ) = ULPINV
+                     RESULT( 14 ) = ULPINV
+                     RESULT( 15 ) = ULPINV
+                     GO TO 440
+                  END IF
+               END IF
+*
+               IF( M2.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( 13 ) = ULPINV
+                  RESULT( 14 ) = ULPINV
+                  RESULT( 15 ) = ULPINV
+                  GO TO 440
+               END IF
+*
+*              Do tests 13 and 14.
+*
+               DO 410 I = 1, N
+                  D3( I ) = DBLE( A( I, I ) )
+  410          CONTINUE
+               DO 420 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  420          CONTINUE
+               CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
+     $                      MAX( 1, M2 ), RESULT( 13 ) )
+*
+               NTEST = 15
+               DO 430 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  430          CONTINUE
+               SRNAMT = 'DSTEVX'
+               CALL DSTEVX( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M3, WA3, Z, LDU, WORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 15 ) = ULPINV
+                     GO TO 440
+                  END IF
+               END IF
+*
+*              Do test 15.
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( 15 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
+*
+  440          CONTINUE
+*
+               NTEST = 16
+               DO 450 I = 1, N
+                  D1( I ) = DBLE( A( I, I ) )
+  450          CONTINUE
+               DO 460 I = 1, N - 1
+                  D2( I ) = DBLE( A( I+1, I ) )
+  460          CONTINUE
+               SRNAMT = 'DSTEVD'
+               CALL DSTEVD( 'V', N, D1, D2, Z, LDU, WORK, LWEDC, IWORK,
+     $                      LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVD(V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 16 ) = ULPINV
+                     RESULT( 17 ) = ULPINV
+                     RESULT( 18 ) = ULPINV
+                     GO TO 510
+                  END IF
+               END IF
+*
+*              Do tests 16 and 17.
+*
+               DO 470 I = 1, N
+                  D3( I ) = DBLE( A( I, I ) )
+  470          CONTINUE
+               DO 480 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  480          CONTINUE
+               CALL DSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK,
+     $                      RESULT( 16 ) )
+*
+               NTEST = 18
+               DO 490 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  490          CONTINUE
+               SRNAMT = 'DSTEVD'
+               CALL DSTEVD( 'N', N, D3, D4, Z, LDU, WORK, LWEDC, IWORK,
+     $                      LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVD(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 18 ) = ULPINV
+                     GO TO 510
+                  END IF
+               END IF
+*
+*              Do test 18.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 500 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( EVEIGS( J ) ),
+     $                    ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( EVEIGS( J )-D3( J ) ) )
+  500          CONTINUE
+               RESULT( 18 ) = TEMP2 / MAX( UNFL,
+     $                        ULP*MAX( TEMP1, TEMP2 ) )
+*
+  510          CONTINUE
+*
+               NTEST = 19
+               DO 520 I = 1, N
+                  D1( I ) = DBLE( A( I, I ) )
+  520          CONTINUE
+               DO 530 I = 1, N - 1
+                  D2( I ) = DBLE( A( I+1, I ) )
+  530          CONTINUE
+               SRNAMT = 'DSTEVR'
+               CALL DSTEVR( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,I)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 19 ) = ULPINV
+                     RESULT( 20 ) = ULPINV
+                     RESULT( 21 ) = ULPINV
+                     GO TO 570
+                  END IF
+               END IF
+*
+*              DO tests 19 and 20.
+*
+               DO 540 I = 1, N
+                  D3( I ) = DBLE( A( I, I ) )
+  540          CONTINUE
+               DO 550 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  550          CONTINUE
+               CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
+     $                      MAX( 1, M2 ), RESULT( 19 ) )
+*
+*
+               NTEST = 21
+               DO 560 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  560          CONTINUE
+               SRNAMT = 'DSTEVR'
+               CALL DSTEVR( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M3, WA3, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,I)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 21 ) = ULPINV
+                     GO TO 570
+                  END IF
+               END IF
+*
+*              Do test 21.
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( 21 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 )
+*
+  570          CONTINUE
+*
+               NTEST = 21
+               IF( N.GT.0 ) THEN
+                  IF( IL.NE.1 ) THEN
+                     VL = WA1( IL ) - MAX( HALF*
+     $                    ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3,
+     $                    TEN*RTUNFL )
+                  ELSE
+                     VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = WA1( IU ) + MAX( HALF*
+     $                    ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3,
+     $                    TEN*RTUNFL )
+                  ELSE
+                     VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               DO 580 I = 1, N
+                  D1( I ) = DBLE( A( I, I ) )
+  580          CONTINUE
+               DO 590 I = 1, N - 1
+                  D2( I ) = DBLE( A( I+1, I ) )
+  590          CONTINUE
+               SRNAMT = 'DSTEVR'
+               CALL DSTEVR( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 22 ) = ULPINV
+                     RESULT( 23 ) = ULPINV
+                     RESULT( 24 ) = ULPINV
+                     GO TO 630
+                  END IF
+               END IF
+*
+               IF( M2.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( 22 ) = ULPINV
+                  RESULT( 23 ) = ULPINV
+                  RESULT( 24 ) = ULPINV
+                  GO TO 630
+               END IF
+*
+*              Do tests 22 and 23.
+*
+               DO 600 I = 1, N
+                  D3( I ) = DBLE( A( I, I ) )
+  600          CONTINUE
+               DO 610 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  610          CONTINUE
+               CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
+     $                      MAX( 1, M2 ), RESULT( 22 ) )
+*
+               NTEST = 24
+               DO 620 I = 1, N - 1
+                  D4( I ) = DBLE( A( I+1, I ) )
+  620          CONTINUE
+               SRNAMT = 'DSTEVR'
+               CALL DSTEVR( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M3, WA3, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 24 ) = ULPINV
+                     GO TO 630
+                  END IF
+               END IF
+*
+*              Do test 24.
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( 24 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
+*
+  630          CONTINUE
+*
+*
+*
+            ELSE
+*
+               DO 640 I = 1, 24
+                  RESULT( I ) = ZERO
+  640          CONTINUE
+               NTEST = 24
+            END IF
+*
+*           Perform remaining tests storing upper or lower triangular
+*           part of matrix.
+*
+            DO 1720 IUPLO = 0, 1
+               IF( IUPLO.EQ.0 ) THEN
+                  UPLO = 'L'
+               ELSE
+                  UPLO = 'U'
+               END IF
+*
+*              4)      Call DSYEV and DSYEVX.
+*
+               CALL DLACPY( ' ', N, N, A, LDA, V, LDU )
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'DSYEV'
+               CALL DSYEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK,
+     $                     IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSYEV(V,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 660
+                  END IF
+               END IF
+*
+*              Do tests 25 and 26 (or +54)
+*
+               CALL DSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'DSYEV_2STAGE'
+               CALL DSYEV_2STAGE( 'N', UPLO, N, A, LDU, D3, WORK, LWORK,
+     $                     IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSYEV_2STAGE(N,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 660
+                  END IF
+               END IF
+*
+*              Do test 27 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 650 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  650          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  660          CONTINUE
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 1
+*
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
+                  IF( IL.NE.1 ) THEN
+                     VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  TEMP3 = ZERO
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               SRNAMT = 'DSYEVX'
+               CALL DSYEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, WORK, LWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 680
+                  END IF
+               END IF
+*
+*              Do tests 28 and 29 (or +54)
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL DSYT21( 1, UPLO, N, 0, A, LDU, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'DSYEVX_2STAGE'
+               CALL DSYEVX_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
+     $                      LWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSYEVX_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 680
+                  END IF
+               END IF
+*
+*              Do test 30 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 670 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+  670          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  680          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'DSYEVX'
+               CALL DSYEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 690
+                  END IF
+               END IF
+*
+*              Do tests 31 and 32 (or +54)
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'DSYEVX_2STAGE'
+               CALL DSYEVX_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK,
+     $                      LWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSYEVX_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 690
+                  END IF
+               END IF
+*
+*              Do test 33 (or +54)
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, ULP*TEMP3 )
+  690          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'DSYEVX'
+               CALL DSYEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 700
+                  END IF
+               END IF
+*
+*              Do tests 34 and 35 (or +54)
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'DSYEVX_2STAGE'
+               CALL DSYEVX_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK,
+     $                      LWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSYEVX_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 700
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 700
+               END IF
+*
+*              Do test 36 (or +54)
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  700          CONTINUE
+*
+*              5)      Call DSPEV and DSPEVX.
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+*              Load array WORK with the upper or lower triangular
+*              part of the matrix in packed form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 720 J = 1, N
+                     DO 710 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  710                CONTINUE
+  720             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 740 J = 1, N
+                     DO 730 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  730                CONTINUE
+  740             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'DSPEV'
+               CALL DSPEV( 'V', UPLO, N, WORK, D1, Z, LDU, V, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSPEV(V,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 800
+                  END IF
+               END IF
+*
+*              Do tests 37 and 38 (or +54)
+*
+               CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 760 J = 1, N
+                     DO 750 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  750                CONTINUE
+  760             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 780 J = 1, N
+                     DO 770 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  770                CONTINUE
+  780             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'DSPEV'
+               CALL DSPEV( 'N', UPLO, N, WORK, D3, Z, LDU, V, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSPEV(N,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 800
+                  END IF
+               END IF
+*
+*              Do test 39 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 790 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  790          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*              Load array WORK with the upper or lower triangular part
+*              of the matrix in packed form.
+*
+  800          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 820 J = 1, N
+                     DO 810 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  810                CONTINUE
+  820             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 840 J = 1, N
+                     DO 830 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  830                CONTINUE
+  840             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+*
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
+                  IF( IL.NE.1 ) THEN
+                     VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  TEMP3 = ZERO
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               SRNAMT = 'DSPEVX'
+               CALL DSPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 900
+                  END IF
+               END IF
+*
+*              Do tests 40 and 41 (or +54)
+*
+               CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 860 J = 1, N
+                     DO 850 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  850                CONTINUE
+  860             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 880 J = 1, N
+                     DO 870 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  870                CONTINUE
+  880             CONTINUE
+               END IF
+*
+               SRNAMT = 'DSPEVX'
+               CALL DSPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 900
+                  END IF
+               END IF
+*
+*              Do test 42 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 890 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+  890          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  900          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 920 J = 1, N
+                     DO 910 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  910                CONTINUE
+  920             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 940 J = 1, N
+                     DO 930 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  930                CONTINUE
+  940             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+*
+               SRNAMT = 'DSPEVX'
+               CALL DSPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 990
+                  END IF
+               END IF
+*
+*              Do tests 43 and 44 (or +54)
+*
+               CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 960 J = 1, N
+                     DO 950 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  950                CONTINUE
+  960             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 980 J = 1, N
+                     DO 970 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  970                CONTINUE
+  980             CONTINUE
+               END IF
+*
+               SRNAMT = 'DSPEVX'
+               CALL DSPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M3, WA3, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 990
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 990
+               END IF
+*
+*              Do test 45 (or +54)
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  990          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 1010 J = 1, N
+                     DO 1000 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1000                CONTINUE
+ 1010             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 1030 J = 1, N
+                     DO 1020 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1020                CONTINUE
+ 1030             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+*
+               SRNAMT = 'DSPEVX'
+               CALL DSPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1080
+                  END IF
+               END IF
+*
+*              Do tests 46 and 47 (or +54)
+*
+               CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 1050 J = 1, N
+                     DO 1040 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1040                CONTINUE
+ 1050             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 1070 J = 1, N
+                     DO 1060 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1060                CONTINUE
+ 1070             CONTINUE
+               END IF
+*
+               SRNAMT = 'DSPEVX'
+               CALL DSPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M3, WA3, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1080
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 1080
+               END IF
+*
+*              Do test 48 (or +54)
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+ 1080          CONTINUE
+*
+*              6)      Call DSBEV and DSBEVX.
+*
+               IF( JTYPE.LE.7 ) THEN
+                  KD = 1
+               ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
+                  KD = MAX( N-1, 0 )
+               ELSE
+                  KD = IHBW
+               END IF
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1100 J = 1, N
+                     DO 1090 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1090                CONTINUE
+ 1100             CONTINUE
+               ELSE
+                  DO 1120 J = 1, N
+                     DO 1110 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1110                CONTINUE
+ 1120             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'DSBEV'
+               CALL DSBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
+     $                     IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSBEV(V,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1180
+                  END IF
+               END IF
+*
+*              Do tests 49 and 50 (or ... )
+*
+               CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1140 J = 1, N
+                     DO 1130 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1130                CONTINUE
+ 1140             CONTINUE
+               ELSE
+                  DO 1160 J = 1, N
+                     DO 1150 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1150                CONTINUE
+ 1160             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'DSBEV_2STAGE'
+               CALL DSBEV_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU,
+     $                     WORK, LWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSBEV_2STAGE(N,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1180
+                  END IF
+               END IF
+*
+*              Do test 51 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1170 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1170          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+ 1180          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1200 J = 1, N
+                     DO 1190 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1190                CONTINUE
+ 1200             CONTINUE
+               ELSE
+                  DO 1220 J = 1, N
+                     DO 1210 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1210                CONTINUE
+ 1220             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'DSBEVX'
+               CALL DSBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M, WA2, Z, LDU, WORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1280
+                  END IF
+               END IF
+*
+*              Do tests 52 and 53 (or +54)
+*
+               CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA2, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1240 J = 1, N
+                     DO 1230 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1230                CONTINUE
+ 1240             CONTINUE
+               ELSE
+                  DO 1260 J = 1, N
+                     DO 1250 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1250                CONTINUE
+ 1260             CONTINUE
+               END IF
+*
+               SRNAMT = 'DSBEVX_2STAGE'
+               CALL DSBEVX_2STAGE( 'N', 'A', UPLO, N, KD, V, LDU,
+     $                      U, LDU, VL, VU, IL, IU, ABSTOL, M3, WA3,
+     $                      Z, LDU, WORK, LWORK, IWORK, IWORK( 5*N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSBEVX_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1280
+                  END IF
+               END IF
+*
+*              Do test 54 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1270 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), ABS( WA3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA2( J )-WA3( J ) ) )
+ 1270          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1280          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1300 J = 1, N
+                     DO 1290 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1290                CONTINUE
+ 1300             CONTINUE
+               ELSE
+                  DO 1320 J = 1, N
+                     DO 1310 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1310                CONTINUE
+ 1320             CONTINUE
+               END IF
+*
+               SRNAMT = 'DSBEVX'
+               CALL DSBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1370
+                  END IF
+               END IF
+*
+*              Do tests 55 and 56 (or +54)
+*
+               CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1340 J = 1, N
+                     DO 1330 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1330                CONTINUE
+ 1340             CONTINUE
+               ELSE
+                  DO 1360 J = 1, N
+                     DO 1350 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1350                CONTINUE
+ 1360             CONTINUE
+               END IF
+*
+               SRNAMT = 'DSBEVX_2STAGE'
+               CALL DSBEVX_2STAGE( 'N', 'I', UPLO, N, KD, V, LDU,
+     $                      U, LDU, VL, VU, IL, IU, ABSTOL, M3, WA3,
+     $                      Z, LDU, WORK, LWORK, IWORK, IWORK( 5*N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSBEVX_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1370
+                  END IF
+               END IF
+*
+*              Do test 57 (or +54)
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+ 1370          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1390 J = 1, N
+                     DO 1380 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1380                CONTINUE
+ 1390             CONTINUE
+               ELSE
+                  DO 1410 J = 1, N
+                     DO 1400 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1400                CONTINUE
+ 1410             CONTINUE
+               END IF
+*
+               SRNAMT = 'DSBEVX'
+               CALL DSBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1460
+                  END IF
+               END IF
+*
+*              Do tests 58 and 59 (or +54)
+*
+               CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1430 J = 1, N
+                     DO 1420 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1420                CONTINUE
+ 1430             CONTINUE
+               ELSE
+                  DO 1450 J = 1, N
+                     DO 1440 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1440                CONTINUE
+ 1450             CONTINUE
+               END IF
+*
+               SRNAMT = 'DSBEVX_2STAGE'
+               CALL DSBEVX_2STAGE( 'N', 'V', UPLO, N, KD, V, LDU,
+     $                      U, LDU, VL, VU, IL, IU, ABSTOL, M3, WA3,
+     $                      Z, LDU, WORK, LWORK, IWORK, IWORK( 5*N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSBEVX_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1460
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 1460
+               END IF
+*
+*              Do test 60 (or +54)
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+ 1460          CONTINUE
+*
+*              7)      Call DSYEVD
+*
+               CALL DLACPY( ' ', N, N, A, LDA, V, LDU )
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'DSYEVD'
+               CALL DSYEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC,
+     $                      IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSYEVD(V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1480
+                  END IF
+               END IF
+*
+*              Do tests 61 and 62 (or +54)
+*
+               CALL DSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'DSYEVD_2STAGE'
+               CALL DSYEVD_2STAGE( 'N', UPLO, N, A, LDU, D3, WORK, 
+     $                              LWORK, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSYEVD_2STAGE(N,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1480
+                  END IF
+               END IF
+*
+*              Do test 63 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1470 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1470          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1480          CONTINUE
+*
+*              8)      Call DSPEVD.
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+*              Load array WORK with the upper or lower triangular
+*              part of the matrix in packed form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 1500 J = 1, N
+                     DO 1490 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1490                CONTINUE
+ 1500             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 1520 J = 1, N
+                     DO 1510 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1510                CONTINUE
+ 1520             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'DSPEVD'
+               CALL DSPEVD( 'V', UPLO, N, WORK, D1, Z, LDU,
+     $                      WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSPEVD(V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1580
+                  END IF
+               END IF
+*
+*              Do tests 64 and 65 (or +54)
+*
+               CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 1540 J = 1, N
+                     DO 1530 I = 1, J
+*
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1530                CONTINUE
+ 1540             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 1560 J = 1, N
+                     DO 1550 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1550                CONTINUE
+ 1560             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'DSPEVD'
+               CALL DSPEVD( 'N', UPLO, N, WORK, D3, Z, LDU,
+     $                      WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSPEVD(N,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1580
+                  END IF
+               END IF
+*
+*              Do test 66 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1570 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1570          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+ 1580          CONTINUE
+*
+*              9)      Call DSBEVD.
+*
+               IF( JTYPE.LE.7 ) THEN
+                  KD = 1
+               ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
+                  KD = MAX( N-1, 0 )
+               ELSE
+                  KD = IHBW
+               END IF
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1600 J = 1, N
+                     DO 1590 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1590                CONTINUE
+ 1600             CONTINUE
+               ELSE
+                  DO 1620 J = 1, N
+                     DO 1610 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1610                CONTINUE
+ 1620             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'DSBEVD'
+               CALL DSBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
+     $                      LWEDC, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSBEVD(V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1680
+                  END IF
+               END IF
+*
+*              Do tests 67 and 68 (or +54)
+*
+               CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1640 J = 1, N
+                     DO 1630 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1630                CONTINUE
+ 1640             CONTINUE
+               ELSE
+                  DO 1660 J = 1, N
+                     DO 1650 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1650                CONTINUE
+ 1660             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'DSBEVD_2STAGE'
+               CALL DSBEVD_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU,
+     $                             WORK, LWORK, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSBEVD_2STAGE(N,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1680
+                  END IF
+               END IF
+*
+*              Do test 69 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1670 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1670          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1680          CONTINUE
+*
+*
+               CALL DLACPY( ' ', N, N, A, LDA, V, LDU )
+               NTEST = NTEST + 1
+               SRNAMT = 'DSYEVR'
+               CALL DSYEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1700
+                  END IF
+               END IF
+*
+*              Do tests 70 and 71 (or ... )
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'DSYEVR_2STAGE'
+               CALL DSYEVR_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M2, WA2, Z, LDU, IWORK,
+     $                      WORK, LWORK, IWORK(2*N+1), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSYEVR_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1700
+                  END IF
+               END IF
+*
+*              Do test 72 (or ... )
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1690 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+ 1690          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1700          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'DSYEVR'
+               CALL DSYEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1710
+                  END IF
+               END IF
+*
+*              Do tests 73 and 74 (or +54)
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'DSYEVR_2STAGE'
+               CALL DSYEVR_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M3, WA3, Z, LDU, IWORK,
+     $                      WORK, LWORK, IWORK(2*N+1), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSYEVR_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1710
+                  END IF
+               END IF
+*
+*              Do test 75 (or +54)
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, ULP*TEMP3 )
+ 1710          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'DSYEVR'
+               CALL DSYEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 700
+                  END IF
+               END IF
+*
+*              Do tests 76 and 77 (or +54)
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'DSYEVR_2STAGE'
+               CALL DSYEVR_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M3, WA3, Z, LDU, IWORK,
+     $                      WORK, LWORK, IWORK(2*N+1), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'DSYEVR_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 700
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 700
+               END IF
+*
+*              Do test 78 (or +54)
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+               CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+ 1720       CONTINUE
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+            NTESTT = NTESTT + NTEST
+*
+            CALL DLAFTS( 'DST', N, N, JTYPE, NTEST, RESULT, IOLDSD,
+     $                   THRESH, NOUNIT, NERRS )
+*
+ 1730    CONTINUE
+ 1740 CONTINUE
+*
+*     Summary
+*
+      CALL ALASVM( 'DST', NOUNIT, NERRS, NTESTT, 0 )
+*
+ 9999 FORMAT( ' DDRVST2STG: ', A, ' returned INFO=', I6, '.', / 9X,
+     $    'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+*
+      RETURN
+*
+*     End of DDRVST2STG
+*
+      END
diff --git a/TESTING/EIG/derrst.f b/TESTING/EIG/derrst.f
index dfb3452e..9f149fe0 100644
--- a/TESTING/EIG/derrst.f
+++ b/TESTING/EIG/derrst.f
@@ -25,6 +25,10 @@
 *> DOPGTR, DOPMTR, DSTEQR, SSTERF, SSTEBZ, SSTEIN, DPTEQR, DSBTRD,
 *> DSYEV, SSYEVX, SSYEVD, DSBEV, SSBEVX, SSBEVD,
 *> DSPEV, SSPEVX, SSPEVD, DSTEV, SSTEVX, SSTEVD, and SSTEDC.
+*> DSYEVD_2STAGE, DSYEVR_2STAGE, DSYEVX_2STAGE,
+*> DSYEV_2STAGE, DSBEV_2STAGE, DSBEVD_2STAGE,
+*> DSBEVX_2STAGE, DSYTRD_2STAGE, DSYTRD_SY2SB,
+*> DSYTRD_SB2ST
 *> \endverbatim
 *
 *  Arguments:
@@ -94,7 +98,11 @@
      $                   DSBEV, DSBEVD, DSBEVX, DSBTRD, DSPEV, DSPEVD,
      $                   DSPEVX, DSPTRD, DSTEBZ, DSTEDC, DSTEIN, DSTEQR,
      $                   DSTERF, DSTEV, DSTEVD, DSTEVR, DSTEVX, DSYEV,
-     $                   DSYEVD, DSYEVR, DSYEVX, DSYTRD
+     $                   DSYEVD, DSYEVR, DSYEVX, DSYTRD,
+     $                   DSYEVD_2STAGE, DSYEVR_2STAGE, DSYEVX_2STAGE,
+     $                   DSYEV_2STAGE, DSBEV_2STAGE, DSBEVD_2STAGE,
+     $                   DSBEVX_2STAGE, DSYTRD_2STAGE, DSYTRD_SY2SB,
+     $                   DSYTRD_SB2ST
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -152,6 +160,103 @@
          CALL CHKXER( 'DSYTRD', INFOT, NOUT, LERR, OK )
          NT = NT + 4
 *
+*        DSYTRD_2STAGE
+*
+         SRNAMT = 'DSYTRD_2STAGE'
+         INFOT = 1
+         CALL DSYTRD_2STAGE( '/', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL DSYTRD_2STAGE( 'H', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRD_2STAGE( 'N', '/', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYTRD_2STAGE( 'N', 'U', -1, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYTRD_2STAGE( 'N', 'U', 2, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYTRD_2STAGE( 'N', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 0, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL DSYTRD_2STAGE( 'N', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 0, INFO )
+         CALL CHKXER( 'DSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 7
+*
+*        DSYTRD_SY2SB
+*
+         SRNAMT = 'DSYTRD_SY2SB'
+         INFOT = 1
+         CALL DSYTRD_SY2SB( '/', 0, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRD_SY2SB( 'U', -1, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYTRD_SY2SB( 'U', 0, -1, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYTRD_SY2SB( 'U', 2, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRD_SY2SB( 'U', 0, 2, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYTRD_SY2SB( 'U', 0, 0, A, 1, C, 1, TAU, W, 0, INFO )
+         CALL CHKXER( 'DSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         NT = NT + 6
+*
+*        DSYTRD_SB2ST
+*
+         SRNAMT = 'DSYTRD_SB2ST'
+         INFOT = 1
+         CALL DSYTRD_SB2ST( '/', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRD_SB2ST( 'Y', '/', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRD_SB2ST( 'Y', 'H', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYTRD_SB2ST( 'Y', 'N', '/', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTRD_SB2ST( 'Y', 'N', 'U', -1, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYTRD_SB2ST( 'Y', 'N', 'U', 0, -1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRD_SB2ST( 'Y', 'N', 'U', 0, 1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL DSYTRD_SB2ST( 'Y', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 0, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL DSYTRD_SB2ST( 'Y', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 0, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         NT = NT + 9
+*
 *        DORGTR
 *
          SRNAMT = 'DORGTR'
@@ -536,6 +641,44 @@
          CALL CHKXER( 'DSYEVD', INFOT, NOUT, LERR, OK )
          NT = NT + 10
 *
+*        DSYEVD_2STAGE
+*
+         SRNAMT = 'DSYEVD_2STAGE'
+         INFOT = 1
+         CALL DSYEVD_2STAGE( '/', 'U', 0, A, 1, X, W, 1, IW, 1, INFO )
+         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL DSYEVD_2STAGE( 'V', 'U', 0, A, 1, X, W, 1, IW, 1, INFO )
+         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYEVD_2STAGE( 'N', '/', 0, A, 1, X, W, 1, IW, 1, INFO )
+         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYEVD_2STAGE( 'N', 'U', -1, A, 1, X, W, 1, IW, 1, INFO )
+         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYEVD_2STAGE( 'N', 'U', 2, A, 1, X, W, 3, IW, 1, INFO )
+         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYEVD_2STAGE( 'N', 'U', 1, A, 1, X, W, 0, IW, 1, INFO )
+         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYEVD_2STAGE( 'N', 'U', 2, A, 2, X, W, 4, IW, 1, INFO )
+         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 8
+*         CALL DSYEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 20, IW, 12, INFO )
+*         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYEVD_2STAGE( 'N', 'U', 1, A, 1, X, W, 1, IW, 0, INFO )
+         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYEVD_2STAGE( 'N', 'U', 2, A, 2, X, W, 25, IW, 0, INFO )
+         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 10
+*         CALL DSYEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 27, IW, 11, INFO )
+*         CALL CHKXER( 'DSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 9
+*
 *        DSYEVR
 *
          SRNAMT = 'DSYEVR'
@@ -591,6 +734,74 @@
          CALL CHKXER( 'DSYEVR', INFOT, NOUT, LERR, OK )
          NT = NT + 11
 *
+*        DSYEVR_2STAGE
+*
+         SRNAMT = 'DSYEVR_2STAGE'
+         N = 1
+         INFOT = 1
+         CALL DSYEVR_2STAGE( '/', 'A', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL DSYEVR_2STAGE( 'V', 'A', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYEVR_2STAGE( 'N', '/', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYEVR_2STAGE( 'N', 'A', '/', -1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYEVR_2STAGE( 'N', 'A', 'U', -1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL DSYEVR_2STAGE( 'N', 'A', 'U', 2, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYEVR_2STAGE( 'N', 'V', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL DSYEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 0, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYEVR_2STAGE( 'N', 'I', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 2, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL DSYEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 0, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 18
+         CALL DSYEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 0, IW( 2*N+1 ), 10*N,
+     $                INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 20
+         CALL DSYEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 0,
+     $                INFO )
+         CALL CHKXER( 'DSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 12
+*
 *        DSYEV
 *
          SRNAMT = 'DSYEV '
@@ -611,6 +822,29 @@
          CALL CHKXER( 'DSYEV ', INFOT, NOUT, LERR, OK )
          NT = NT + 5
 *
+*        DSYEV_2STAGE
+*
+         SRNAMT = 'DSYEV_2STAGE '
+         INFOT = 1
+         CALL DSYEV_2STAGE( '/', 'U', 0, A, 1, X, W, 1, INFO )
+         CALL CHKXER( 'DSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL DSYEV_2STAGE( 'V', 'U', 0, A, 1, X, W, 1, INFO )
+         CALL CHKXER( 'DSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYEV_2STAGE( 'N', '/', 0, A, 1, X, W, 1, INFO )
+         CALL CHKXER( 'DSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYEV_2STAGE( 'N', 'U', -1, A, 1, X, W, 1, INFO )
+         CALL CHKXER( 'DSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYEV_2STAGE( 'N', 'U', 2, A, 1, X, W, 3, INFO )
+         CALL CHKXER( 'DSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYEV_2STAGE( 'N', 'U', 1, A, 1, X, W, 1, INFO )
+         CALL CHKXER( 'DSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         NT = NT + 6
+*
 *        DSYEVX
 *
          SRNAMT = 'DSYEVX'
@@ -663,6 +897,75 @@
          CALL CHKXER( 'DSYEVX', INFOT, NOUT, LERR, OK )
          NT = NT + 12
 *
+*        DSYEVX_2STAGE
+*
+         SRNAMT = 'DSYEVX_2STAGE'
+         INFOT = 1
+         CALL DSYEVX_2STAGE( '/', 'A', 'U', 0, A, 1,
+     $                 0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL DSYEVX_2STAGE( 'V', 'A', 'U', 0, A, 1,
+     $                 0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYEVX_2STAGE( 'N', '/', 'U', 0, A, 1,
+     $                0.0D0, 1.0D0, 1, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYEVX_2STAGE( 'N', 'A', '/', 0, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, IW, I3, INFO )
+         INFOT = 4
+         CALL DSYEVX_2STAGE( 'N', 'A', 'U', -1, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL DSYEVX_2STAGE( 'N', 'A', 'U', 2, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 16, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYEVX_2STAGE( 'N', 'V', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 8, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL DSYEVX_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 8, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL DSYEVX_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 2, 1, 0.0D0,
+     $                M, X, Z, 1, W, 8, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYEVX_2STAGE( 'N', 'I', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 2, 1, 0.0D0,
+     $                M, X, Z, 1, W, 16, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYEVX_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 2, 0.0D0,
+     $                M, X, Z, 1, W, 8, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL DSYEVX_2STAGE( 'N', 'A', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 0, W, 16, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 17
+         CALL DSYEVX_2STAGE( 'N', 'A', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 13
+*
 *        DSPEVD
 *
          SRNAMT = 'DSPEVD'
@@ -786,6 +1089,47 @@
          CALL CHKXER( 'DSBTRD', INFOT, NOUT, LERR, OK )
          NT = NT + 6
 *
+*        DSYTRD_SB2ST
+*
+         SRNAMT = 'DSYTRD_SB2ST'
+         INFOT = 1
+         CALL DSYTRD_SB2ST( '/', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRD_SB2ST( 'N', '/', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRD_SB2ST( 'N', 'H', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYTRD_SB2ST( 'N', 'N', '/', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTRD_SB2ST( 'N', 'N', 'U', -1, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYTRD_SB2ST( 'N', 'N', 'U', 0, -1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRD_SB2ST( 'N', 'N', 'U', 0, 1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL DSYTRD_SB2ST( 'N', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 0, W, 1, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL DSYTRD_SB2ST( 'N', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 0, INFO )
+         CALL CHKXER( 'DSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         NT = NT + 9
+*
 *        DSBEVD
 *
          SRNAMT = 'DSBEVD'
@@ -829,6 +1173,60 @@
          CALL CHKXER( 'DSBEVD', INFOT, NOUT, LERR, OK )
          NT = NT + 11
 *
+*        DSBEVD_2STAGE
+*
+         SRNAMT = 'DSBEVD_2STAGE'
+         INFOT = 1
+         CALL DSBEVD_2STAGE( '/', 'U', 0, 0, A, 1, X, Z, 1, W,
+     $                                        1, IW, 1, INFO )
+         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL DSBEVD_2STAGE( 'V', 'U', 0, 0, A, 1, X, Z, 1, W,
+     $                                        1, IW, 1, INFO )
+         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSBEVD_2STAGE( 'N', '/', 0, 0, A, 1, X, Z, 1, W,
+     $                                        1, IW, 1, INFO )
+         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSBEVD_2STAGE( 'N', 'U', -1, 0, A, 1, X, Z, 1, W,
+     $                                         1, IW, 1, INFO )
+         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSBEVD_2STAGE( 'N', 'U', 0, -1, A, 1, X, Z, 1, W,
+     $                                         1, IW, 1, INFO )
+         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL DSBEVD_2STAGE( 'N', 'U', 2, 1, A, 1, X, Z, 1, W,
+     $                                        4, IW, 1, INFO )
+         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 9
+*         CALL DSBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 1, W,
+*     $                                      25, IW, 12, INFO )
+*         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL DSBEVD_2STAGE( 'N', 'U', 1, 0, A, 1, X, Z, 1, W,
+     $                                        0, IW, 1, INFO )
+         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL DSBEVD_2STAGE( 'N', 'U', 2, 0, A, 1, X, Z, 1, W,
+     $                                        3, IW, 1, INFO )
+         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 11
+*         CALL DSBEVD_2STAGE( 'V', 'U', 2, 0, A, 1, X, Z, 2, W,
+*     $                                      18, IW, 12, INFO )
+*         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL DSBEVD_2STAGE( 'N', 'U', 1, 0, A, 1, X, Z, 1, W,
+     $                                        1, IW, 0, INFO )
+         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 13
+*         CALL DSBEVD_2STAGE( 'V', 'U', 2, 0, A, 1, X, Z, 2, W,
+*     $                                      25, IW, 11, INFO )
+*         CALL CHKXER( 'DSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         NT = NT + 12
+         NT = NT + 9
+*
 *        DSBEV
 *
          SRNAMT = 'DSBEV '
@@ -852,6 +1250,35 @@
          CALL CHKXER( 'DSBEV ', INFOT, NOUT, LERR, OK )
          NT = NT + 6
 *
+*        DSBEV_2STAGE
+*
+         SRNAMT = 'DSBEV_2STAGE '
+         INFOT = 1
+         CALL DSBEV_2STAGE( '/', 'U', 0, 0, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'DSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL DSBEV_2STAGE( 'V', 'U', 0, 0, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'DSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSBEV_2STAGE( 'N', '/', 0, 0, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'DSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSBEV_2STAGE( 'N', 'U', -1, 0, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'DSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSBEV_2STAGE( 'N', 'U', 0, -1, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'DSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL DSBEV_2STAGE( 'N', 'U', 2, 1, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'DSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL DSBEV_2STAGE( 'N', 'U', 2, 0, A, 1, X, Z, 0, W, 0, INFO )
+         CALL CHKXER( 'DSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL DSBEV_2STAGE( 'N', 'U', 0, 0, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'DSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         NT = NT + 8
+*
 *        DSBEVX
 *
          SRNAMT = 'DSBEVX'
@@ -866,6 +1293,7 @@
          INFOT = 3
          CALL DSBEVX( 'N', 'A', '/', 0, 0, A, 1, Q, 1, 0.0D0, 0.0D0, 0,
      $                0, 0.0D0, M, X, Z, 1, W, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX', INFOT, NOUT, LERR, OK )
          INFOT = 4
          CALL DSBEVX( 'N', 'A', 'U', -1, 0, A, 1, Q, 1, 0.0D0, 0.0D0, 0,
      $                0, 0.0D0, M, X, Z, 1, W, IW, I3, INFO )
@@ -907,6 +1335,72 @@
      $                0, 0.0D0, M, X, Z, 1, W, IW, I3, INFO )
          CALL CHKXER( 'DSBEVX', INFOT, NOUT, LERR, OK )
          NT = NT + 13
+*
+*        DSBEVX_2STAGE
+*
+         SRNAMT = 'DSBEVX_2STAGE'
+         INFOT = 1
+         CALL DSBEVX_2STAGE( '/', 'A', 'U', 0, 0, A, 1, Q, 1, 0.0D0,
+     $          0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL DSBEVX_2STAGE( 'V', 'A', 'U', 0, 0, A, 1, Q, 1, 0.0D0,
+     $          0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSBEVX_2STAGE( 'N', '/', 'U', 0, 0, A, 1, Q, 1, 0.0D0,
+     $          0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSBEVX_2STAGE( 'N', 'A', '/', 0, 0, A, 1, Q, 1, 0.0D0,
+     $          0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSBEVX_2STAGE( 'N', 'A', 'U', -1, 0, A, 1, Q, 1, 0.0D0,
+     $           0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSBEVX_2STAGE( 'N', 'A', 'U', 0, -1, A, 1, Q, 1, 0.0D0,
+     $           0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSBEVX_2STAGE( 'N', 'A', 'U', 2, 1, A, 1, Q, 1, 0.0D0,
+     $          0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 9
+*         CALL DSBEVX_2STAGE( 'V', 'A', 'U', 2, 0, A, 1, Q, 1, 0.0D0,
+*     $          0.0D0, 0, 0, 0.0D0, M, X, Z, 2, W, 0, IW, I3, INFO )
+*         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL DSBEVX_2STAGE( 'N', 'V', 'U', 1, 0, A, 1, Q, 1, 0.0D0,
+     $          0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL DSBEVX_2STAGE( 'N', 'I', 'U', 1, 0, A, 1, Q, 1, 0.0D0,
+     $          0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL DSBEVX_2STAGE( 'N', 'I', 'U', 1, 0, A, 1, Q, 1, 0.0D0,
+     $          0.0D0, 2, 1, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL DSBEVX_2STAGE( 'N', 'I', 'U', 2, 0, A, 1, Q, 1, 0.0D0,
+     $          0.0D0, 2, 1, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL DSBEVX_2STAGE( 'N', 'I', 'U', 1, 0, A, 1, Q, 1, 0.0D0,
+     $          0.0D0, 1, 2, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 18
+*         CALL DSBEVX_2STAGE( 'V', 'A', 'U', 2, 0, A, 1, Q, 2, 0.0D0,
+*     $          0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+*         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 20
+         CALL DSBEVX_2STAGE( 'N', 'A', 'U', 0, 0, A, 1, Q, 1, 0.0D0,
+     $           0.0D0, 0, 0, 0.0D0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'DSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+*         NT = NT + 15
+         NT = NT + 13
       END IF
 *
 *     Print a summary line.
diff --git a/TESTING/EIG/ilaenv.f b/TESTING/EIG/ilaenv.f
index 90f80077..c2bbe4b3 100644
--- a/TESTING/EIG/ilaenv.f
+++ b/TESTING/EIG/ilaenv.f
@@ -122,7 +122,7 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2011
+*> \date November 2016
 *
 *> \ingroup OTHERauxiliary
 *
@@ -153,10 +153,10 @@
       INTEGER          FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
      $                 N4 )
 *
-*  -- LAPACK test routine (version 3.4.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2011
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*( * )    NAME, OPTS
@@ -169,8 +169,8 @@
       INTRINSIC          INT, MIN, REAL
 *     ..
 *     .. External Functions ..
-      INTEGER            IEEECK
-      EXTERNAL           IEEECK
+      INTEGER            IEEECK, IPARAM2STAGE
+      EXTERNAL           IEEECK, IPARAM2STAGE
 *     ..
 *     .. Arrays in Common ..
       INTEGER            IPARMS( 100 )
@@ -229,6 +229,16 @@ C        ILAENV = 0
 *         WRITE(*,*) 'ISPEC = ',ISPEC,' ILAENV =',ILAENV
 *         ILAENV = IPARMQ( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
 *
+      ELSE IF(( ISPEC.GE.17 ) .AND. (ISPEC.LE.21)) THEN
+*
+*     17 <= ISPEC <= 21: 2stage eigenvalues SVD routines. 
+*
+         IF( ISPEC.EQ.17 ) THEN
+             ILAENV = IPARMS( 1 )
+         ELSE
+             ILAENV = IPARAM2STAGE( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) 
+         ENDIF
+*
       ELSE
 *
 *        Invalid value for ISPEC
diff --git a/TESTING/EIG/schkee.f b/TESTING/EIG/schkee.f
index 99d717e0..7651c0a3 100644
--- a/TESTING/EIG/schkee.f
+++ b/TESTING/EIG/schkee.f
@@ -1106,7 +1106,8 @@
      $                   SDRGEV, SDRGSX, SDRGVX, SDRVBD, SDRVES, SDRVEV,
      $                   SDRVSG, SDRVST, SDRVSX, SDRVVX, SERRBD,
      $                   SERRED, SERRGG, SERRHS, SERRST, ILAVER, XLAENV,
-     $                   SDRGES3, SDRGEV3
+     $                   SDRGES3, SDRGEV3, 
+     $                   SCHKST2STG, SDRVST2STG, SCHKSB2STG, SDRVSG2STG
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          LEN, MIN
@@ -1153,7 +1154,8 @@
       PATH = LINE( 1: 3 )
       NEP = LSAMEN( 3, PATH, 'NEP' ) .OR. LSAMEN( 3, PATH, 'SHS' )
       SEP = LSAMEN( 3, PATH, 'SEP' ) .OR. LSAMEN( 3, PATH, 'SST' ) .OR.
-     $      LSAMEN( 3, PATH, 'SSG' )
+     $      LSAMEN( 3, PATH, 'SSG' ) .OR. LSAMEN( 3, PATH, 'SE2' )
+      SVD = LSAMEN( 3, PATH, 'SVD' ) .OR. LSAMEN( 3, PATH, 'DBD' )
       SVD = LSAMEN( 3, PATH, 'SVD' ) .OR. LSAMEN( 3, PATH, 'SBD' )
       SEV = LSAMEN( 3, PATH, 'SEV' )
       SES = LSAMEN( 3, PATH, 'SES' )
@@ -1839,7 +1841,8 @@
      $         WRITE( NOUT, FMT = 9980 )'SCHKHS', INFO
   270    CONTINUE
 *
-      ELSE IF( LSAMEN( 3, C3, 'SST' ) .OR. LSAMEN( 3, C3, 'SEP' ) ) THEN
+      ELSE IF( LSAMEN( 3, C3, 'SST' ) .OR. LSAMEN( 3, C3, 'SEP' )
+     $                                .OR. LSAMEN( 3, C3, 'SE2' ) ) THEN
 *
 *        ----------------------------------
 *        SEP:  Symmetric Eigenvalue Problem
@@ -1869,6 +1872,15 @@
             WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
      $         NXVAL( I )
             IF( TSTCHK ) THEN
+               IF( LSAMEN( 3, C3, 'SE2' ) ) THEN
+               CALL SCHKST2STG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), D( 1, 1 ),
+     $                      D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), D( 1, 5 ),
+     $                      D( 1, 6 ), D( 1, 7 ), D( 1, 8 ), D( 1, 9 ),
+     $                      D( 1, 10 ), D( 1, 11 ), A( 1, 3 ), NMAX,
+     $                      A( 1, 4 ), A( 1, 5 ), D( 1, 12 ), A( 1, 6 ),
+     $                      WORK, LWORK, IWORK, LIWORK, RESULT, INFO )
+               ELSE
                CALL SCHKST( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
      $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), D( 1, 1 ),
      $                      D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), D( 1, 5 ),
@@ -1876,16 +1888,26 @@
      $                      D( 1, 10 ), D( 1, 11 ), A( 1, 3 ), NMAX,
      $                      A( 1, 4 ), A( 1, 5 ), D( 1, 12 ), A( 1, 6 ),
      $                      WORK, LWORK, IWORK, LIWORK, RESULT, INFO )
+               ENDIF
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'SCHKST', INFO
             END IF
             IF( TSTDRV ) THEN
+               IF( LSAMEN( 3, C3, 'SE2' ) ) THEN
+               CALL SDRVST2STG( NN, NVAL, 18, DOTYPE, ISEED, THRESH,
+     $                      NOUT, A( 1, 1 ), NMAX, D( 1, 3 ), D( 1, 4 ),
+     $                      D( 1, 5 ), D( 1, 6 ), D( 1, 8 ), D( 1, 9 ),
+     $                      D( 1, 10 ), D( 1, 11), A( 1, 2 ), NMAX,
+     $                      A( 1, 3 ), D( 1, 12 ), A( 1, 4 ), WORK,
+     $                      LWORK, IWORK, LIWORK, RESULT, INFO )
+               ELSE
                CALL SDRVST( NN, NVAL, 18, DOTYPE, ISEED, THRESH,
      $                      NOUT, A( 1, 1 ), NMAX, D( 1, 3 ), D( 1, 4 ),
      $                      D( 1, 5 ), D( 1, 6 ), D( 1, 8 ), D( 1, 9 ),
      $                      D( 1, 10 ), D( 1, 11), A( 1, 2 ), NMAX,
      $                      A( 1, 3 ), D( 1, 12 ), A( 1, 4 ), WORK,
      $                      LWORK, IWORK, LIWORK, RESULT, INFO )
+               ENDIF
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'SDRVST', INFO
             END IF
@@ -1918,11 +1940,17 @@
             WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
      $         NXVAL( I )
             IF( TSTCHK ) THEN
-               CALL SDRVSG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
-     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
-     $                      D( 1, 3 ), A( 1, 3 ), NMAX, A( 1, 4 ),
-     $                      A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), WORK,
-     $                      LWORK, IWORK, LIWORK, RESULT, INFO )
+*               CALL SDRVSG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+*     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
+*     $                      D( 1, 3 ), A( 1, 3 ), NMAX, A( 1, 4 ),
+*     $                      A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), WORK,
+*     $                      LWORK, IWORK, LIWORK, RESULT, INFO )
+               CALL SDRVSG2STG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+     $                          NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
+     $                          D( 1, 3 ), D( 1, 3 ), A( 1, 3 ), NMAX,
+     $                          A( 1, 4 ), A( 1, 5 ), A( 1, 6 ),
+     $                          A( 1, 7 ), WORK, LWORK, IWORK, LIWORK,
+     $                          RESULT, INFO )
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'SDRVSG', INFO
             END IF
@@ -2284,9 +2312,13 @@
          CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
          IF( TSTERR )
      $      CALL SERRST( 'SSB', NOUT )
-         CALL SCHKSB( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED, THRESH,
-     $                NOUT, A( 1, 1 ), NMAX, D( 1, 1 ), D( 1, 2 ),
-     $                A( 1, 2 ), NMAX, WORK, LWORK, RESULT, INFO )
+*         CALL SCHKSB( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+*     $                NOUT, A( 1, 1 ), NMAX, D( 1, 1 ), D( 1, 2 ),
+*     $                A( 1, 2 ), NMAX, WORK, LWORK, RESULT, INFO )
+         CALL SCHKSB2STG( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED,
+     $                 THRESH, NOUT, A( 1, 1 ), NMAX, D( 1, 1 ), 
+     $                 D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), D( 1, 5 ),
+     $                 A( 1, 2 ), NMAX, WORK, LWORK, RESULT, INFO )
          IF( INFO.NE.0 )
      $      WRITE( NOUT, FMT = 9980 )'SCHKSB', INFO
 *
diff --git a/TESTING/EIG/schksb2stg.f b/TESTING/EIG/schksb2stg.f
new file mode 100644
index 00000000..dce2b5b1
--- /dev/null
+++ b/TESTING/EIG/schksb2stg.f
@@ -0,0 +1,868 @@
+*> \brief \b SCHKSBSTG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SCHKSB2STG( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE,
+*                          ISEED, THRESH, NOUNIT, A, LDA, SD, SE, D1,
+*                          D2, D3, U, LDU, WORK, LWORK, RESULT, INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
+*      $                   NWDTHS
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), KK( * ), NN( * )
+*       REAL               A( LDA, * ), RESULT( * ), SD( * ), SE( * ),
+*      $                   U( LDU, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SCHKSBSTG tests the reduction of a symmetric band matrix to tridiagonal
+*> form, used with the symmetric eigenvalue problem.
+*>
+*> SSBTRD factors a symmetric band matrix A as  U S U' , where ' means
+*> transpose, S is symmetric tridiagonal, and U is orthogonal.
+*> SSBTRD can use either just the lower or just the upper triangle
+*> of A; SCHKSBSTG checks both cases.
+*>
+*> SSYTRD_SB2ST factors a symmetric band matrix A as  U S U' , 
+*> where ' means transpose, S is symmetric tridiagonal, and U is
+*> orthogonal. SSYTRD_SB2ST can use either just the lower or just
+*> the upper triangle of A; SCHKSBSTG checks both cases.
+*>
+*> SSTEQR factors S as  Z D1 Z'.  
+*> D1 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of SSBTRD "U" (used as reference for SSYTRD_SB2ST)
+*> D2 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of SSYTRD_SB2ST "U".
+*> D3 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of SSYTRD_SB2ST "L".
+*>
+*> When SCHKSBSTG is called, a number of matrix "sizes" ("n's"), a number
+*> of bandwidths ("k's"), and a number of matrix "types" are
+*> specified.  For each size ("n"), each bandwidth ("k") less than or
+*> equal to "n", and each type of matrix, one matrix will be generated
+*> and used to test the symmetric banded reduction routine.  For each
+*> matrix, a number of tests will be performed:
+*>
+*> (1)     | A - V S V' | / ( |A| n ulp )  computed by SSBTRD with
+*>                                         UPLO='U'
+*>
+*> (2)     | I - UU' | / ( n ulp )
+*>
+*> (3)     | A - V S V' | / ( |A| n ulp )  computed by SSBTRD with
+*>                                         UPLO='L'
+*>
+*> (4)     | I - UU' | / ( n ulp )
+*>
+*> (5)     | D1 - D2 | / ( |D1| ulp )      where D1 is computed by
+*>                                         SSBTRD with UPLO='U' and
+*>                                         D2 is computed by
+*>                                         SSYTRD_SB2ST with UPLO='U'
+*>
+*> (6)     | D1 - D3 | / ( |D1| ulp )      where D1 is computed by
+*>                                         SSBTRD with UPLO='U' and
+*>                                         D3 is computed by
+*>                                         SSYTRD_SB2ST with UPLO='L'
+*>
+*> The "sizes" are specified by an array NN(1:NSIZES); the value of
+*> each element NN(j) specifies one size.
+*> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*> Currently, the list of possible types is:
+*>
+*> (1)  The zero matrix.
+*> (2)  The identity matrix.
+*>
+*> (3)  A diagonal matrix with evenly spaced entries
+*>      1, ..., ULP  and random signs.
+*>      (ULP = (first number larger than 1) - 1 )
+*> (4)  A diagonal matrix with geometrically spaced entries
+*>      1, ..., ULP  and random signs.
+*> (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>      and random signs.
+*>
+*> (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*> (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*> (8)  A matrix of the form  U' D U, where U is orthogonal and
+*>      D has evenly spaced entries 1, ..., ULP with random signs
+*>      on the diagonal.
+*>
+*> (9)  A matrix of the form  U' D U, where U is orthogonal and
+*>      D has geometrically spaced entries 1, ..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (10) A matrix of the form  U' D U, where U is orthogonal and
+*>      D has "clustered" entries 1, ULP,..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*> (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*> (13) Symmetric matrix with random entries chosen from (-1,1).
+*> (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*> (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] NSIZES
+*> \verbatim
+*>          NSIZES is INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          SCHKSBSTG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*> \endverbatim
+*>
+*> \param[in] NWDTHS
+*> \verbatim
+*>          NWDTHS is INTEGER
+*>          The number of bandwidths to use.  If it is zero,
+*>          SCHKSBSTG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] KK
+*> \verbatim
+*>          KK is INTEGER array, dimension (NWDTHS)
+*>          An array containing the bandwidths to be used for the band
+*>          matrices.  The values must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NTYPES
+*> \verbatim
+*>          NTYPES is INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, SCHKSBSTG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*> \endverbatim
+*>
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*> \endverbatim
+*>
+*> \param[in,out] ISEED
+*> \verbatim
+*>          ISEED is INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to SCHKSBSTG to continue the same random number
+*>          sequence.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NOUNIT
+*> \verbatim
+*>          NOUNIT is INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension
+*>                            (LDA, max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of A.  It must be at least 2 (not 1!)
+*>          and at least max( KK )+1.
+*> \endverbatim
+*>
+*> \param[out] SD
+*> \verbatim
+*>          SD is REAL array, dimension (max(NN))
+*>          Used to hold the diagonal of the tridiagonal matrix computed
+*>          by SSBTRD.
+*> \endverbatim
+*>
+*> \param[out] SE
+*> \verbatim
+*>          SE is REAL array, dimension (max(NN))
+*>          Used to hold the off-diagonal of the tridiagonal matrix
+*>          computed by SSBTRD.
+*> \endverbatim
+*>
+*> \param[out] U
+*> \verbatim
+*>          U is REAL array, dimension (LDU, max(NN))
+*>          Used to hold the orthogonal matrix computed by SSBTRD.
+*> \endverbatim
+*>
+*> \param[in] LDU
+*> \verbatim
+*>          LDU is INTEGER
+*>          The leading dimension of U.  It must be at least 1
+*>          and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (LWORK)
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          max( LDA+1, max(NN)+1 )*max(NN).
+*> \endverbatim
+*>
+*> \param[out] RESULT
+*> \verbatim
+*>          RESULT is REAL array, dimension (4)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          If 0, then everything ran OK.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far.
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup single_eig
+*
+*  =====================================================================
+      SUBROUTINE SCHKSB2STG( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE,
+     $                   ISEED, THRESH, NOUNIT, A, LDA, SD, SE, D1,
+     $                   D2, D3, U, LDU, WORK, LWORK, RESULT, INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
+     $                   NWDTHS
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), KK( * ), NN( * )
+      REAL               A( LDA, * ), RESULT( * ), SD( * ), SE( * ),
+     $                   D1( * ), D2( * ), D3( * ),
+     $                   U( LDU, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE, TWO, TEN
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
+     $                   TEN = 10.0E0 )
+      REAL               HALF
+      PARAMETER          ( HALF = ONE / TWO )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 15 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN, BADNNB
+      INTEGER            I, IINFO, IMODE, ITYPE, J, JC, JCOL, JR, JSIZE,
+     $                   JTYPE, JWIDTH, K, KMAX, LH, LW, MTYPES, N,
+     $                   NERRS, NMATS, NMAX, NTEST, NTESTT
+      REAL               ANINV, ANORM, COND, OVFL, RTOVFL, RTUNFL,
+     $                   TEMP1, TEMP2, TEMP3, TEMP4, ULP, ULPINV, UNFL
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ),
+     $                   KMODE( MAXTYP ), KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      REAL               SLAMCH
+      EXTERNAL           SLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLACPY, SLASET, SLASUM, SLATMR, SLATMS, SSBT21,
+     $                   SSBTRD, XERBLA, SSBTRD_SB2ST, SSTEQR
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, REAL, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0 /
+*     ..
+*     .. Executable Statements ..
+*
+*     Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+*     Important constants
+*
+      BADNN = .FALSE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+      BADNNB = .FALSE.
+      KMAX = 0
+      DO 20 J = 1, NSIZES
+         KMAX = MAX( KMAX, KK( J ) )
+         IF( KK( J ).LT.0 )
+     $      BADNNB = .TRUE.
+   20 CONTINUE
+      KMAX = MIN( NMAX-1, KMAX )
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NWDTHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( BADNNB ) THEN
+         INFO = -4
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDA.LT.KMAX+1 ) THEN
+         INFO = -11
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -15
+      ELSE IF( ( MAX( LDA, NMAX )+1 )*NMAX.GT.LWORK ) THEN
+         INFO = -17
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SCHKSBSTG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 .OR. NWDTHS.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = SLAMCH( 'Safe minimum' )
+      OVFL = ONE / UNFL
+      ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      NERRS = 0
+      NMATS = 0
+*
+      DO 190 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         ANINV = ONE / REAL( MAX( 1, N ) )
+*
+         DO 180 JWIDTH = 1, NWDTHS
+            K = KK( JWIDTH )
+            IF( K.GT.N )
+     $         GO TO 180
+            K = MAX( 0, MIN( N-1, K ) )
+*
+            IF( NSIZES.NE.1 ) THEN
+               MTYPES = MIN( MAXTYP, NTYPES )
+            ELSE
+               MTYPES = MIN( MAXTYP+1, NTYPES )
+            END IF
+*
+            DO 170 JTYPE = 1, MTYPES
+               IF( .NOT.DOTYPE( JTYPE ) )
+     $            GO TO 170
+               NMATS = NMATS + 1
+               NTEST = 0
+*
+               DO 30 J = 1, 4
+                  IOLDSD( J ) = ISEED( J )
+   30          CONTINUE
+*
+*              Compute "A".
+*              Store as "Upper"; later, we will copy to other format.
+*
+*              Control parameters:
+*
+*                  KMAGN  KMODE        KTYPE
+*              =1  O(1)   clustered 1  zero
+*              =2  large  clustered 2  identity
+*              =3  small  exponential  (none)
+*              =4         arithmetic   diagonal, (w/ eigenvalues)
+*              =5         random log   symmetric, w/ eigenvalues
+*              =6         random       (none)
+*              =7                      random diagonal
+*              =8                      random symmetric
+*              =9                      positive definite
+*              =10                     diagonally dominant tridiagonal
+*
+               IF( MTYPES.GT.MAXTYP )
+     $            GO TO 100
+*
+               ITYPE = KTYPE( JTYPE )
+               IMODE = KMODE( JTYPE )
+*
+*              Compute norm
+*
+               GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40          CONTINUE
+               ANORM = ONE
+               GO TO 70
+*
+   50          CONTINUE
+               ANORM = ( RTOVFL*ULP )*ANINV
+               GO TO 70
+*
+   60          CONTINUE
+               ANORM = RTUNFL*N*ULPINV
+               GO TO 70
+*
+   70          CONTINUE
+*
+               CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+               IINFO = 0
+               IF( JTYPE.LE.15 ) THEN
+                  COND = ULPINV
+               ELSE
+                  COND = ULPINV*ANINV / TEN
+               END IF
+*
+*              Special Matrices -- Identity & Jordan block
+*
+*                 Zero
+*
+               IF( ITYPE.EQ.1 ) THEN
+                  IINFO = 0
+*
+               ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*                 Identity
+*
+                  DO 80 JCOL = 1, N
+                     A( K+1, JCOL ) = ANORM
+   80             CONTINUE
+*
+               ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*                 Diagonal Matrix, [Eigen]values Specified
+*
+                  CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                         ANORM, 0, 0, 'Q', A( K+1, 1 ), LDA,
+     $                         WORK( N+1 ), IINFO )
+*
+               ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*                 Symmetric, eigenvalues specified
+*
+                  CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                         ANORM, K, K, 'Q', A, LDA, WORK( N+1 ),
+     $                         IINFO )
+*
+               ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*                 Diagonal, random eigenvalues
+*
+                  CALL SLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                         'T', 'N', WORK( N+1 ), 1, ONE,
+     $                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                         ZERO, ANORM, 'Q', A( K+1, 1 ), LDA,
+     $                         IDUMMA, IINFO )
+*
+               ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*                 Symmetric, random eigenvalues
+*
+                  CALL SLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                         'T', 'N', WORK( N+1 ), 1, ONE,
+     $                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, K, K,
+     $                         ZERO, ANORM, 'Q', A, LDA, IDUMMA, IINFO )
+*
+               ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*                 Positive definite, eigenvalues specified.
+*
+                  CALL SLATMS( N, N, 'S', ISEED, 'P', WORK, IMODE, COND,
+     $                         ANORM, K, K, 'Q', A, LDA, WORK( N+1 ),
+     $                         IINFO )
+*
+               ELSE IF( ITYPE.EQ.10 ) THEN
+*
+*                 Positive definite tridiagonal, eigenvalues specified.
+*
+                  IF( N.GT.1 )
+     $               K = MAX( 1, K )
+                  CALL SLATMS( N, N, 'S', ISEED, 'P', WORK, IMODE, COND,
+     $                         ANORM, 1, 1, 'Q', A( K, 1 ), LDA,
+     $                         WORK( N+1 ), IINFO )
+                  DO 90 I = 2, N
+                     TEMP1 = ABS( A( K, I ) ) /
+     $                       SQRT( ABS( A( K+1, I-1 )*A( K+1, I ) ) )
+                     IF( TEMP1.GT.HALF ) THEN
+                        A( K, I ) = HALF*SQRT( ABS( A( K+1,
+     $                              I-1 )*A( K+1, I ) ) )
+                     END IF
+   90             CONTINUE
+*
+               ELSE
+*
+                  IINFO = 1
+               END IF
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  RETURN
+               END IF
+*
+  100          CONTINUE
+*
+*              Call SSBTRD to compute S and U from upper triangle.
+*
+               CALL SLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
+*
+               NTEST = 1
+               CALL SSBTRD( 'V', 'U', N, K, WORK, LDA, SD, SE, U, LDU,
+     $                      WORK( LDA*N+1 ), IINFO )
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSBTRD(U)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 1 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Do tests 1 and 2
+*
+               CALL SSBT21( 'Upper', N, K, 1, A, LDA, SD, SE, U, LDU,
+     $                      WORK, RESULT( 1 ) )
+*
+*              Before converting A into lower for SSBTRD, run SSYTRD_SB2ST 
+*              otherwise matrix A will be converted to lower and then need
+*              to be converted back to upper in order to run the upper case 
+*              ofSSYTRD_SB2ST
+*            
+*              Compute D1 the eigenvalues resulting from the tridiagonal
+*              form using the SSBTRD and used as reference to compare
+*              with the SSYTRD_SB2ST routine
+*            
+*              Compute D1 from the SSBTRD and used as reference for the
+*              SSYTRD_SB2ST
+*            
+               CALL SCOPY( N, SD, 1, D1, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*            
+               CALL SSTEQR( 'N', N, D1, WORK, WORK( N+1 ), LDU,
+     $                      WORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 5 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*            
+*              SSYTRD_SB2ST Upper case is used to compute D2.
+*              Note to set SD and SE to zero to be sure not reusing 
+*              the one from above. Compare it with D1 computed 
+*              using the SSBTRD.
+*            
+               CALL SLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+               CALL SLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+               CALL SLACPY( ' ', K+1, N, A, LDA, U, LDU )
+               LH = MAX(1, 4*N)
+               LW = LWORK - LH
+               CALL SSYTRD_SB2ST( 'N', 'N', "U", N, K, U, LDU, SD, SE, 
+     $                      WORK, LH, WORK( LH+1 ), LW, IINFO )
+*            
+*              Compute D2 from the SSYTRD_SB2ST Upper case
+*            
+               CALL SCOPY( N, SD, 1, D2, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*            
+               CALL SSTEQR( 'N', N, D2, WORK, WORK( N+1 ), LDU,
+     $                      WORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 5 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Convert A from Upper-Triangle-Only storage to
+*              Lower-Triangle-Only storage.
+*
+               DO 120 JC = 1, N
+                  DO 110 JR = 0, MIN( K, N-JC )
+                     A( JR+1, JC ) = A( K+1-JR, JC+JR )
+  110             CONTINUE
+  120          CONTINUE
+               DO 140 JC = N + 1 - K, N
+                  DO 130 JR = MIN( K, N-JC ) + 1, K
+                     A( JR+1, JC ) = ZERO
+  130             CONTINUE
+  140          CONTINUE
+*
+*              Call SSBTRD to compute S and U from lower triangle
+*
+               CALL SLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
+*
+               NTEST = 3
+               CALL SSBTRD( 'V', 'L', N, K, WORK, LDA, SD, SE, U, LDU,
+     $                      WORK( LDA*N+1 ), IINFO )
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSBTRD(L)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 3 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+               NTEST = 4
+*
+*              Do tests 3 and 4
+*
+               CALL SSBT21( 'Lower', N, K, 1, A, LDA, SD, SE, U, LDU,
+     $                      WORK, RESULT( 3 ) )
+*
+*              SSYTRD_SB2ST Lower case is used to compute D3.
+*              Note to set SD and SE to zero to be sure not reusing 
+*              the one from above. Compare it with D1 computed 
+*              using the SSBTRD. 
+*           
+               CALL SLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+               CALL SLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+               CALL SLACPY( ' ', K+1, N, A, LDA, U, LDU )
+               LH = MAX(1, 4*N)
+               LW = LWORK - LH
+               CALL SSYTRD_SB2ST( 'N', 'N', "L", N, K, U, LDU, SD, SE, 
+     $                      WORK, LH, WORK( LH+1 ), LW, IINFO )
+*           
+*              Compute D3 from the 2-stage Upper case
+*           
+               CALL SCOPY( N, SD, 1, D3, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*           
+               CALL SSTEQR( 'N', N, D3, WORK, WORK( N+1 ), LDU,
+     $                      WORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 6 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*           
+*           
+*              Do Tests 3 and 4 which are similar to 11 and 12 but with the
+*              D1 computed using the standard 1-stage reduction as reference
+*           
+               NTEST = 6
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               TEMP3 = ZERO
+               TEMP4 = ZERO
+*           
+               DO 151 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+                  TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  151          CONTINUE
+*           
+               RESULT(5) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+               RESULT(6) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*              End of Loop -- Check for RESULT(j) > THRESH
+*
+  150          CONTINUE
+               NTESTT = NTESTT + NTEST
+*
+*              Print out tests which fail.
+*
+               DO 160 JR = 1, NTEST
+                  IF( RESULT( JR ).GE.THRESH ) THEN
+*
+*                    If this is the first test to fail,
+*                    print a header to the data file.
+*
+                     IF( NERRS.EQ.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9998 )'SSB'
+                        WRITE( NOUNIT, FMT = 9997 )
+                        WRITE( NOUNIT, FMT = 9996 )
+                        WRITE( NOUNIT, FMT = 9995 )'Symmetric'
+                        WRITE( NOUNIT, FMT = 9994 )'orthogonal', '''',
+     $                     'transpose', ( '''', J = 1, 6 )
+                     END IF
+                     NERRS = NERRS + 1
+                     WRITE( NOUNIT, FMT = 9993 )N, K, IOLDSD, JTYPE,
+     $                  JR, RESULT( JR )
+                  END IF
+  160          CONTINUE
+*
+  170       CONTINUE
+  180    CONTINUE
+  190 CONTINUE
+*
+*     Summary
+*
+      CALL SLASUM( 'SSB', NOUNIT, NERRS, NTESTT )
+      RETURN
+*
+ 9999 FORMAT( ' SCHKSBSTG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
+     $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+*
+ 9998 FORMAT( / 1X, A3,
+     $      ' -- Real Symmetric Banded Tridiagonal Reduction Routines' )
+ 9997 FORMAT( ' Matrix types (see SCHKSBSTG for details): ' )
+*
+ 9996 FORMAT( / ' Special Matrices:',
+     $      / '  1=Zero matrix.                        ',
+     $      '  5=Diagonal: clustered entries.',
+     $      / '  2=Identity matrix.                    ',
+     $      '  6=Diagonal: large, evenly spaced.',
+     $      / '  3=Diagonal: evenly spaced entries.    ',
+     $      '  7=Diagonal: small, evenly spaced.',
+     $      / '  4=Diagonal: geometr. spaced entries.' )
+ 9995 FORMAT( ' Dense ', A, ' Banded Matrices:',
+     $      / '  8=Evenly spaced eigenvals.            ',
+     $      ' 12=Small, evenly spaced eigenvals.',
+     $      / '  9=Geometrically spaced eigenvals.     ',
+     $      ' 13=Matrix with random O(1) entries.',
+     $      / ' 10=Clustered eigenvalues.              ',
+     $      ' 14=Matrix with large random entries.',
+     $      / ' 11=Large, evenly spaced eigenvals.     ',
+     $      ' 15=Matrix with small random entries.' )
+*
+ 9994 FORMAT( / ' Tests performed:   (S is Tridiag,  U is ', A, ',',
+     $      / 20X, A, ' means ', A, '.', / ' UPLO=''U'':',
+     $      / '  1= | A - U S U', A1, ' | / ( |A| n ulp )     ',
+     $      '  2= | I - U U', A1, ' | / ( n ulp )', / ' UPLO=''L'':',
+     $      / '  3= | A - U S U', A1, ' | / ( |A| n ulp )     ',
+     $      '  4= | I - U U', A1, ' | / ( n ulp )' / ' Eig check:',
+     $      /'  5= | D1 - D2', '', ' | / ( |D1| ulp )         ',
+     $      '  6= | D1 - D3', '', ' | / ( |D1| ulp )          ' )
+ 9993 FORMAT( ' N=', I5, ', K=', I4, ', seed=', 4( I4, ',' ), ' type ',
+     $      I2, ', test(', I2, ')=', G10.3 )
+*
+*     End of SCHKSBSTG
+*
+      END
diff --git a/TESTING/EIG/schkst2stg.f b/TESTING/EIG/schkst2stg.f
new file mode 100644
index 00000000..4bf9f107
--- /dev/null
+++ b/TESTING/EIG/schkst2stg.f
@@ -0,0 +1,2068 @@
+*> \brief \b SCHKST2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                          NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5,
+*                          WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK,
+*                          LWORK, IWORK, LIWORK, RESULT, INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
+*      $                   NTYPES
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       REAL               A( LDA, * ), AP( * ), D1( * ), D2( * ),
+*      $                   D3( * ), D4( * ), D5( * ), RESULT( * ),
+*      $                   SD( * ), SE( * ), TAU( * ), U( LDU, * ),
+*      $                   V( LDU, * ), VP( * ), WA1( * ), WA2( * ),
+*      $                   WA3( * ), WORK( * ), WR( * ), Z( LDU, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SCHKST2STG  checks the symmetric eigenvalue problem routines
+*> using the 2-stage reduction techniques. Since the generation
+*> of Q or the vectors is not available in this release, we only 
+*> compare the eigenvalue resulting when using the 2-stage to the 
+*> one considered as reference using the standard 1-stage reduction
+*> SSYTRD. For that, we call the standard SSYTRD and compute D1 using 
+*> SSTEQR, then we call the 2-stage SSYTRD_2STAGE with Upper and Lower
+*> and we compute D2 and D3 using SSTEQR and then we replaced tests
+*> 3 and 4 by tests 11 and 12. test 1 and 2 remain to verify that 
+*> the 1-stage results are OK and can be trusted.
+*> This testing routine will converge to the SCHKST in the next 
+*> release when vectors and generation of Q will be implemented.
+*>
+*>    SSYTRD factors A as  U S U' , where ' means transpose,
+*>    S is symmetric tridiagonal, and U is orthogonal.
+*>    SSYTRD can use either just the lower or just the upper triangle
+*>    of A; SCHKST2STG checks both cases.
+*>    U is represented as a product of Householder
+*>    transformations, whose vectors are stored in the first
+*>    n-1 columns of V, and whose scale factors are in TAU.
+*>
+*>    SSPTRD does the same as SSYTRD, except that A and V are stored
+*>    in "packed" format.
+*>
+*>    SORGTR constructs the matrix U from the contents of V and TAU.
+*>
+*>    SOPGTR constructs the matrix U from the contents of VP and TAU.
+*>
+*>    SSTEQR factors S as  Z D1 Z' , where Z is the orthogonal
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal.  D2 is the matrix of
+*>    eigenvalues computed when Z is not computed.
+*>
+*>    SSTERF computes D3, the matrix of eigenvalues, by the
+*>    PWK method, which does not yield eigenvectors.
+*>
+*>    SPTEQR factors S as  Z4 D4 Z4' , for a
+*>    symmetric positive definite tridiagonal matrix.
+*>    D5 is the matrix of eigenvalues computed when Z is not
+*>    computed.
+*>
+*>    SSTEBZ computes selected eigenvalues.  WA1, WA2, and
+*>    WA3 will denote eigenvalues computed to high
+*>    absolute accuracy, with different range options.
+*>    WR will denote eigenvalues computed to high relative
+*>    accuracy.
+*>
+*>    SSTEIN computes Y, the eigenvectors of S, given the
+*>    eigenvalues.
+*>
+*>    SSTEDC factors S as Z D1 Z' , where Z is the orthogonal
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal ('I' option). It may also
+*>    update an input orthogonal matrix, usually the output
+*>    from SSYTRD/SORGTR or SSPTRD/SOPGTR ('V' option). It may
+*>    also just compute eigenvalues ('N' option).
+*>
+*>    SSTEMR factors S as Z D1 Z' , where Z is the orthogonal
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal ('I' option).  SSTEMR
+*>    uses the Relatively Robust Representation whenever possible.
+*>
+*> When SCHKST2STG is called, a number of matrix "sizes" ("n's") and a
+*> number of matrix "types" are specified.  For each size ("n")
+*> and each type of matrix, one matrix will be generated and used
+*> to test the symmetric eigenroutines.  For each matrix, a number
+*> of tests will be performed:
+*>
+*> (1)     | A - V S V' | / ( |A| n ulp ) SSYTRD( UPLO='U', ... )
+*>
+*> (2)     | I - UV' | / ( n ulp )        SORGTR( UPLO='U', ... )
+*>
+*> (3)     | A - V S V' | / ( |A| n ulp ) SSYTRD( UPLO='L', ... )
+*>         replaced by | D1 - D2 | / ( |D1| ulp ) where D1 is the 
+*>         eigenvalue matrix computed using S and D2 is the 
+*>         eigenvalue matrix computed using S_2stage the output of
+*>         SSYTRD_2STAGE("N", "U",....). D1 and D2 are computed 
+*>         via SSTEQR('N',...)  
+*>
+*> (4)     | I - UV' | / ( n ulp )        SORGTR( UPLO='L', ... )
+*>         replaced by | D1 - D3 | / ( |D1| ulp ) where D1 is the 
+*>         eigenvalue matrix computed using S and D3 is the 
+*>         eigenvalue matrix computed using S_2stage the output of
+*>         SSYTRD_2STAGE("N", "L",....). D1 and D3 are computed 
+*>         via SSTEQR('N',...)  
+*>
+*> (5-8)   Same as 1-4, but for SSPTRD and SOPGTR.
+*>
+*> (9)     | S - Z D Z' | / ( |S| n ulp ) SSTEQR('V',...)
+*>
+*> (10)    | I - ZZ' | / ( n ulp )        SSTEQR('V',...)
+*>
+*> (11)    | D1 - D2 | / ( |D1| ulp )        SSTEQR('N',...)
+*>
+*> (12)    | D1 - D3 | / ( |D1| ulp )        SSTERF
+*>
+*> (13)    0 if the true eigenvalues (computed by sturm count)
+*>         of S are within THRESH of
+*>         those in D1.  2*THRESH if they are not.  (Tested using
+*>         SSTECH)
+*>
+*> For S positive definite,
+*>
+*> (14)    | S - Z4 D4 Z4' | / ( |S| n ulp ) SPTEQR('V',...)
+*>
+*> (15)    | I - Z4 Z4' | / ( n ulp )        SPTEQR('V',...)
+*>
+*> (16)    | D4 - D5 | / ( 100 |D4| ulp )       SPTEQR('N',...)
+*>
+*> When S is also diagonally dominant by the factor gamma < 1,
+*>
+*> (17)    max | D4(i) - WR(i) | / ( |D4(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              SSTEBZ( 'A', 'E', ...)
+*>
+*> (18)    | WA1 - D3 | / ( |D3| ulp )          SSTEBZ( 'A', 'E', ...)
+*>
+*> (19)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>                                              SSTEBZ( 'I', 'E', ...)
+*>
+*> (20)    | S - Y WA1 Y' | / ( |S| n ulp )  SSTEBZ, SSTEIN
+*>
+*> (21)    | I - Y Y' | / ( n ulp )          SSTEBZ, SSTEIN
+*>
+*> (22)    | S - Z D Z' | / ( |S| n ulp )    SSTEDC('I')
+*>
+*> (23)    | I - ZZ' | / ( n ulp )           SSTEDC('I')
+*>
+*> (24)    | S - Z D Z' | / ( |S| n ulp )    SSTEDC('V')
+*>
+*> (25)    | I - ZZ' | / ( n ulp )           SSTEDC('V')
+*>
+*> (26)    | D1 - D2 | / ( |D1| ulp )           SSTEDC('V') and
+*>                                              SSTEDC('N')
+*>
+*> Test 27 is disabled at the moment because SSTEMR does not
+*> guarantee high relatvie accuracy.
+*>
+*> (27)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              SSTEMR('V', 'A')
+*>
+*> (28)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              SSTEMR('V', 'I')
+*>
+*> Tests 29 through 34 are disable at present because SSTEMR
+*> does not handle partial specturm requests.
+*>
+*> (29)    | S - Z D Z' | / ( |S| n ulp )    SSTEMR('V', 'I')
+*>
+*> (30)    | I - ZZ' | / ( n ulp )           SSTEMR('V', 'I')
+*>
+*> (31)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         SSTEMR('N', 'I') vs. SSTEMR('V', 'I')
+*>
+*> (32)    | S - Z D Z' | / ( |S| n ulp )    SSTEMR('V', 'V')
+*>
+*> (33)    | I - ZZ' | / ( n ulp )           SSTEMR('V', 'V')
+*>
+*> (34)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         SSTEMR('N', 'V') vs. SSTEMR('V', 'V')
+*>
+*> (35)    | S - Z D Z' | / ( |S| n ulp )    SSTEMR('V', 'A')
+*>
+*> (36)    | I - ZZ' | / ( n ulp )           SSTEMR('V', 'A')
+*>
+*> (37)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         SSTEMR('N', 'A') vs. SSTEMR('V', 'A')
+*>
+*> The "sizes" are specified by an array NN(1:NSIZES); the value of
+*> each element NN(j) specifies one size.
+*> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*> Currently, the list of possible types is:
+*>
+*> (1)  The zero matrix.
+*> (2)  The identity matrix.
+*>
+*> (3)  A diagonal matrix with evenly spaced entries
+*>      1, ..., ULP  and random signs.
+*>      (ULP = (first number larger than 1) - 1 )
+*> (4)  A diagonal matrix with geometrically spaced entries
+*>      1, ..., ULP  and random signs.
+*> (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>      and random signs.
+*>
+*> (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*> (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*> (8)  A matrix of the form  U' D U, where U is orthogonal and
+*>      D has evenly spaced entries 1, ..., ULP with random signs
+*>      on the diagonal.
+*>
+*> (9)  A matrix of the form  U' D U, where U is orthogonal and
+*>      D has geometrically spaced entries 1, ..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (10) A matrix of the form  U' D U, where U is orthogonal and
+*>      D has "clustered" entries 1, ULP,..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*> (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*> (13) Symmetric matrix with random entries chosen from (-1,1).
+*> (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*> (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*> (16) Same as (8), but diagonal elements are all positive.
+*> (17) Same as (9), but diagonal elements are all positive.
+*> (18) Same as (10), but diagonal elements are all positive.
+*> (19) Same as (16), but multiplied by SQRT( overflow threshold )
+*> (20) Same as (16), but multiplied by SQRT( underflow threshold )
+*> (21) A diagonally dominant tridiagonal matrix with geometrically
+*>      spaced diagonal entries 1, ..., ULP.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] NSIZES
+*> \verbatim
+*>          NSIZES is INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          SCHKST2STG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*> \endverbatim
+*>
+*> \param[in] NTYPES
+*> \verbatim
+*>          NTYPES is INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, SCHKST2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*> \endverbatim
+*>
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*> \endverbatim
+*>
+*> \param[in,out] ISEED
+*> \verbatim
+*>          ISEED is INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to SCHKST2STG to continue the same random number
+*>          sequence.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NOUNIT
+*> \verbatim
+*>          NOUNIT is INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array of
+*>                                  dimension ( LDA , max(NN) )
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of A.  It must be at
+*>          least 1 and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] AP
+*> \verbatim
+*>          AP is REAL array of
+*>                      dimension( max(NN)*max(NN+1)/2 )
+*>          The matrix A stored in packed format.
+*> \endverbatim
+*>
+*> \param[out] SD
+*> \verbatim
+*>          SD is REAL array of
+*>                             dimension( max(NN) )
+*>          The diagonal of the tridiagonal matrix computed by SSYTRD.
+*>          On exit, SD and SE contain the tridiagonal form of the
+*>          matrix in A.
+*> \endverbatim
+*>
+*> \param[out] SE
+*> \verbatim
+*>          SE is REAL array of
+*>                             dimension( max(NN) )
+*>          The off-diagonal of the tridiagonal matrix computed by
+*>          SSYTRD.  On exit, SD and SE contain the tridiagonal form of
+*>          the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D1
+*> \verbatim
+*>          D1 is REAL array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by SSTEQR simlutaneously
+*>          with Z.  On exit, the eigenvalues in D1 correspond with the
+*>          matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D2
+*> \verbatim
+*>          D2 is REAL array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by SSTEQR if Z is not
+*>          computed.  On exit, the eigenvalues in D2 correspond with
+*>          the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D3
+*> \verbatim
+*>          D3 is REAL array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by SSTERF.  On exit, the
+*>          eigenvalues in D3 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D4
+*> \verbatim
+*>          D4 is REAL array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by SPTEQR(V).
+*>          SPTEQR factors S as  Z4 D4 Z4*
+*>          On exit, the eigenvalues in D4 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D5
+*> \verbatim
+*>          D5 is REAL array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by SPTEQR(N)
+*>          when Z is not computed. On exit, the
+*>          eigenvalues in D4 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] WA1
+*> \verbatim
+*>          WA1 is REAL array of
+*>                             dimension( max(NN) )
+*>          All eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by SSTEBZ.
+*> \endverbatim
+*>
+*> \param[out] WA2
+*> \verbatim
+*>          WA2 is REAL array of
+*>                             dimension( max(NN) )
+*>          Selected eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by SSTEBZ.
+*>          Choose random values for IL and IU, and ask for the
+*>          IL-th through IU-th eigenvalues.
+*> \endverbatim
+*>
+*> \param[out] WA3
+*> \verbatim
+*>          WA3 is REAL array of
+*>                             dimension( max(NN) )
+*>          Selected eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by SSTEBZ.
+*>          Determine the values VL and VU of the IL-th and IU-th
+*>          eigenvalues and ask for all eigenvalues in this range.
+*> \endverbatim
+*>
+*> \param[out] WR
+*> \verbatim
+*>          WR is REAL array of
+*>                             dimension( max(NN) )
+*>          All eigenvalues of A, computed to high
+*>          absolute accuracy, with different options.
+*>          as computed by SSTEBZ.
+*> \endverbatim
+*>
+*> \param[out] U
+*> \verbatim
+*>          U is REAL array of
+*>                             dimension( LDU, max(NN) ).
+*>          The orthogonal matrix computed by SSYTRD + SORGTR.
+*> \endverbatim
+*>
+*> \param[in] LDU
+*> \verbatim
+*>          LDU is INTEGER
+*>          The leading dimension of U, Z, and V.  It must be at least 1
+*>          and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] V
+*> \verbatim
+*>          V is REAL array of
+*>                             dimension( LDU, max(NN) ).
+*>          The Housholder vectors computed by SSYTRD in reducing A to
+*>          tridiagonal form.  The vectors computed with UPLO='U' are
+*>          in the upper triangle, and the vectors computed with UPLO='L'
+*>          are in the lower triangle.  (As described in SSYTRD, the
+*>          sub- and superdiagonal are not set to 1, although the
+*>          true Householder vector has a 1 in that position.  The
+*>          routines that use V, such as SORGTR, set those entries to
+*>          1 before using them, and then restore them later.)
+*> \endverbatim
+*>
+*> \param[out] VP
+*> \verbatim
+*>          VP is REAL array of
+*>                      dimension( max(NN)*max(NN+1)/2 )
+*>          The matrix V stored in packed format.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL array of
+*>                             dimension( max(NN) )
+*>          The Householder factors computed by SSYTRD in reducing A
+*>          to tridiagonal form.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is REAL array of
+*>                             dimension( LDU, max(NN) ).
+*>          The orthogonal matrix of eigenvectors computed by SSTEQR,
+*>          SPTEQR, and SSTEIN.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array of
+*>                      dimension( LWORK )
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 3 * Nmax**2
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array,
+*>          Workspace.
+*> \endverbatim
+*>
+*> \param[out] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The number of entries in IWORK.  This must be at least
+*>                  6 + 6*Nmax + 5 * Nmax * lg Nmax
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*> \endverbatim
+*>
+*> \param[out] RESULT
+*> \verbatim
+*>          RESULT is REAL array, dimension (26)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -23: LDU < 1 or LDU < NMAX.
+*>          -29: LWORK too small.
+*>          If  SLATMR, SLATMS, SSYTRD, SORGTR, SSTEQR, SSTERF,
+*>              or SORMC2 returns an error code, the
+*>              absolute value of it is returned.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NBLOCK          Blocksize as returned by ENVIR.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far.
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup single_eig
+*
+*  =====================================================================
+      SUBROUTINE SCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                   NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5,
+     $                   WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK,
+     $                   LWORK, IWORK, LIWORK, RESULT, INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
+     $                   NTYPES
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      REAL               A( LDA, * ), AP( * ), D1( * ), D2( * ),
+     $                   D3( * ), D4( * ), D5( * ), RESULT( * ),
+     $                   SD( * ), SE( * ), TAU( * ), U( LDU, * ),
+     $                   V( LDU, * ), VP( * ), WA1( * ), WA2( * ),
+     $                   WA3( * ), WORK( * ), WR( * ), Z( LDU, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE, TWO, EIGHT, TEN, HUN
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
+     $                   EIGHT = 8.0E0, TEN = 10.0E0, HUN = 100.0E0 )
+      REAL               HALF
+      PARAMETER          ( HALF = ONE / TWO )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 21 )
+      LOGICAL            SRANGE
+      PARAMETER          ( SRANGE = .FALSE. )
+      LOGICAL            SREL
+      PARAMETER          ( SREL = .FALSE. )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN, TRYRAC
+      INTEGER            I, IINFO, IL, IMODE, ITEMP, ITYPE, IU, J, JC,
+     $                   JR, JSIZE, JTYPE, LGN, LIWEDC, LOG2UI, LWEDC,
+     $                   M, M2, M3, MTYPES, N, NAP, NBLOCK, NERRS,
+     $                   NMATS, NMAX, NSPLIT, NTEST, NTESTT, LH, LW
+      REAL               ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, TEMP1, TEMP2, TEMP3, TEMP4, ULP,
+     $                   ULPINV, UNFL, VL, VU
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+      REAL               DUMMA( 1 )
+*     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLARND, SSXT1
+      EXTERNAL           ILAENV, SLAMCH, SLARND, SSXT1
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SLABAD, SLACPY, SLASET, SLASUM, SLATMR,
+     $                   SLATMS, SOPGTR, SORGTR, SPTEQR, SSPT21, SSPTRD,
+     $                   SSTEBZ, SSTECH, SSTEDC, SSTEMR, SSTEIN, SSTEQR,
+     $                   SSTERF, SSTT21, SSTT22, SSYT21, SSYTRD, XERBLA,
+     $                   SSYTRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, REAL, INT, LOG, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
+     $                   8, 8, 9, 9, 9, 9, 9, 10 /
+      DATA               KMAGN / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 1, 1, 1, 2, 3, 1 /
+      DATA               KMODE / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 4, 3, 1, 4, 4, 3 /
+*     ..
+*     .. Executable Statements ..
+*
+*     Keep ftnchek happy
+      IDUMMA( 1 ) = 1
+*
+*     Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+*     Important constants
+*
+      BADNN = .FALSE.
+      TRYRAC = .TRUE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+      NBLOCK = ILAENV( 1, 'SSYTRD', 'L', NMAX, -1, -1, -1 )
+      NBLOCK = MIN( NMAX, MAX( 1, NBLOCK ) )
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -23
+      ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
+         INFO = -29
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SCHKST2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = SLAMCH( 'Safe minimum' )
+      OVFL = ONE / UNFL
+      CALL SLABAD( UNFL, OVFL )
+      ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) )
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+   20 CONTINUE
+      NERRS = 0
+      NMATS = 0
+*
+      DO 310 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         IF( N.GT.0 ) THEN
+            LGN = INT( LOG( REAL( N ) ) / LOG( TWO ) )
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2
+            LIWEDC = 6 + 6*N + 5*N*LGN
+         ELSE
+            LWEDC = 8
+            LIWEDC = 12
+         END IF
+         NAP = ( N*( N+1 ) ) / 2
+         ANINV = ONE / REAL( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         DO 300 JTYPE = 1, MTYPES
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 300
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           Compute "A"
+*
+*           Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, (w/ eigenvalues)
+*           =5         random log   symmetric, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random symmetric
+*           =9                      positive definite
+*           =10                     diagonally dominant tridiagonal
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 100
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+            IINFO = 0
+            IF( JTYPE.LE.15 ) THEN
+               COND = ULPINV
+            ELSE
+               COND = ULPINV*ANINV / TEN
+            END IF
+*
+*           Special Matrices -- Identity & Jordan block
+*
+*              Zero
+*
+            IF( ITYPE.EQ.1 ) THEN
+               IINFO = 0
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               DO 80 JC = 1, N
+                  A( JC, JC ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              Symmetric, eigenvalues specified
+*
+               CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               CALL SLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              Symmetric, random eigenvalues
+*
+               CALL SLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              Positive definite, eigenvalues specified.
+*
+               CALL SLATMS( N, N, 'S', ISEED, 'P', WORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.10 ) THEN
+*
+*              Positive definite tridiagonal, eigenvalues specified.
+*
+               CALL SLATMS( N, N, 'S', ISEED, 'P', WORK, IMODE, COND,
+     $                      ANORM, 1, 1, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+               DO 90 I = 2, N
+                  TEMP1 = ABS( A( I-1, I ) ) /
+     $                    SQRT( ABS( A( I-1, I-1 )*A( I, I ) ) )
+                  IF( TEMP1.GT.HALF ) THEN
+                     A( I-1, I ) = HALF*SQRT( ABS( A( I-1, I-1 )*A( I,
+     $                             I ) ) )
+                     A( I, I-1 ) = A( I-1, I )
+                  END IF
+   90          CONTINUE
+*
+            ELSE
+*
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+  100       CONTINUE
+*
+*           Call SSYTRD and SORGTR to compute S and U from
+*           upper triangle.
+*
+            CALL SLACPY( 'U', N, N, A, LDA, V, LDU )
+*
+            NTEST = 1
+            CALL SSYTRD( 'U', N, V, LDU, SD, SE, TAU, WORK, LWORK,
+     $                   IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSYTRD(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 1 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL SLACPY( 'U', N, N, V, LDU, U, LDU )
+*
+            NTEST = 2
+            CALL SORGTR( 'U', N, U, LDU, TAU, WORK, LWORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SORGTR(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 2 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 1 and 2
+*
+            CALL SSYT21( 2, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
+     $                   LDU, TAU, WORK, RESULT( 1 ) )
+            CALL SSYT21( 3, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
+     $                   LDU, TAU, WORK, RESULT( 2 ) )
+*
+*           Compute D1 the eigenvalues resulting from the tridiagonal
+*           form using the standard 1-stage algorithm and use it as a
+*           reference to compare with the 2-stage technique
+*
+*           Compute D1 from the 1-stage and used as reference for the
+*           2-stage
+*
+            CALL SCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*
+            CALL SSTEQR( 'N', N, D1, WORK, WORK( N+1 ), LDU,
+     $                   WORK( N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 3 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           2-STAGE TRD Upper case is used to compute D2.
+*           Note to set SD and SE to zero to be sure not reusing 
+*           the one from above. Compare it with D1 computed 
+*           using the 1-stage.
+*
+            CALL SLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+            CALL SLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+            CALL SLACPY( "U", N, N, A, LDA, V, LDU )
+            LH = MAX(1, 4*N)
+            LW = LWORK - LH
+            CALL SSYTRD_2STAGE( 'N', "U", N, V, LDU, SD, SE, TAU, 
+     $                   WORK, LH, WORK( LH+1 ), LW, IINFO )
+*
+*           Compute D2 from the 2-stage Upper case
+*
+            CALL SCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*
+            CALL SSTEQR( 'N', N, D2, WORK, WORK( N+1 ), LDU,
+     $                   WORK( N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 3 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           2-STAGE TRD Lower case is used to compute D3.
+*           Note to set SD and SE to zero to be sure not reusing 
+*           the one from above. Compare it with D1 computed 
+*           using the 1-stage. 
+*
+            CALL SLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+            CALL SLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+            CALL SLACPY( "L", N, N, A, LDA, V, LDU )
+            CALL SSYTRD_2STAGE( 'N', "L", N, V, LDU, SD, SE, TAU, 
+     $                   WORK, LH, WORK( LH+1 ), LW, IINFO )
+*
+*           Compute D3 from the 2-stage Upper case
+*
+            CALL SCOPY( N, SD, 1, D3, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*
+            CALL SSTEQR( 'N', N, D3, WORK, WORK( N+1 ), LDU,
+     $                   WORK( N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 4 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*
+*           Do Tests 3 and 4 which are similar to 11 and 12 but with the
+*           D1 computed using the standard 1-stage reduction as reference
+*
+            NTEST = 4
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            TEMP3 = ZERO
+            TEMP4 = ZERO
+*
+            DO 151 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+               TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+               TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  151       CONTINUE
+*
+            RESULT( 3 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+            RESULT( 4 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*           Store the upper triangle of A in AP
+*
+            I = 0
+            DO 120 JC = 1, N
+               DO 110 JR = 1, JC
+                  I = I + 1
+                  AP( I ) = A( JR, JC )
+  110          CONTINUE
+  120       CONTINUE
+*
+*           Call SSPTRD and SOPGTR to compute S and U from AP
+*
+            CALL SCOPY( NAP, AP, 1, VP, 1 )
+*
+            NTEST = 5
+            CALL SSPTRD( 'U', N, VP, SD, SE, TAU, IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSPTRD(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 5 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            NTEST = 6
+            CALL SOPGTR( 'U', N, VP, TAU, U, LDU, WORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SOPGTR(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 6 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 5 and 6
+*
+            CALL SSPT21( 2, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RESULT( 5 ) )
+            CALL SSPT21( 3, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RESULT( 6 ) )
+*
+*           Store the lower triangle of A in AP
+*
+            I = 0
+            DO 140 JC = 1, N
+               DO 130 JR = JC, N
+                  I = I + 1
+                  AP( I ) = A( JR, JC )
+  130          CONTINUE
+  140       CONTINUE
+*
+*           Call SSPTRD and SOPGTR to compute S and U from AP
+*
+            CALL SCOPY( NAP, AP, 1, VP, 1 )
+*
+            NTEST = 7
+            CALL SSPTRD( 'L', N, VP, SD, SE, TAU, IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSPTRD(L)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 7 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            NTEST = 8
+            CALL SOPGTR( 'L', N, VP, TAU, U, LDU, WORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SOPGTR(L)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 8 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL SSPT21( 2, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RESULT( 7 ) )
+            CALL SSPT21( 3, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RESULT( 8 ) )
+*
+*           Call SSTEQR to compute D1, D2, and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            CALL SCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, WORK, 1 )
+            CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+            NTEST = 9
+            CALL SSTEQR( 'V', N, D1, WORK, Z, LDU, WORK( N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEQR(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 9 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Compute D2
+*
+            CALL SCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*
+            NTEST = 11
+            CALL SSTEQR( 'N', N, D2, WORK, WORK( N+1 ), LDU,
+     $                   WORK( N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 11 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Compute D3 (using PWK method)
+*
+            CALL SCOPY( N, SD, 1, D3, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*
+            NTEST = 12
+            CALL SSTERF( N, D3, WORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTERF', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 12 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 9 and 10
+*
+            CALL SSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                   RESULT( 9 ) )
+*
+*           Do Tests 11 and 12
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            TEMP3 = ZERO
+            TEMP4 = ZERO
+*
+            DO 150 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+               TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+               TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  150       CONTINUE
+*
+            RESULT( 11 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+            RESULT( 12 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*           Do Test 13 -- Sturm Sequence Test of Eigenvalues
+*                         Go up by factors of two until it succeeds
+*
+            NTEST = 13
+            TEMP1 = THRESH*( HALF-ULP )
+*
+            DO 160 J = 0, LOG2UI
+               CALL SSTECH( N, SD, SE, D1, TEMP1, WORK, IINFO )
+               IF( IINFO.EQ.0 )
+     $            GO TO 170
+               TEMP1 = TEMP1*TWO
+  160       CONTINUE
+*
+  170       CONTINUE
+            RESULT( 13 ) = TEMP1
+*
+*           For positive definite matrices ( JTYPE.GT.15 ) call SPTEQR
+*           and do tests 14, 15, and 16 .
+*
+            IF( JTYPE.GT.15 ) THEN
+*
+*              Compute D4 and Z4
+*
+               CALL SCOPY( N, SD, 1, D4, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, WORK, 1 )
+               CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+               NTEST = 14
+               CALL SPTEQR( 'V', N, D4, WORK, Z, LDU, WORK( N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SPTEQR(V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 14 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do Tests 14 and 15
+*
+               CALL SSTT21( N, 0, SD, SE, D4, DUMMA, Z, LDU, WORK,
+     $                      RESULT( 14 ) )
+*
+*              Compute D5
+*
+               CALL SCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*
+               NTEST = 16
+               CALL SPTEQR( 'N', N, D5, WORK, Z, LDU, WORK( N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SPTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 16 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do Test 16
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 180 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D4( J ) ), ABS( D5( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D4( J )-D5( J ) ) )
+  180          CONTINUE
+*
+               RESULT( 16 ) = TEMP2 / MAX( UNFL,
+     $                        HUN*ULP*MAX( TEMP1, TEMP2 ) )
+            ELSE
+               RESULT( 14 ) = ZERO
+               RESULT( 15 ) = ZERO
+               RESULT( 16 ) = ZERO
+            END IF
+*
+*           Call SSTEBZ with different options and do tests 17-18.
+*
+*              If S is positive definite and diagonally dominant,
+*              ask for all eigenvalues with high relative accuracy.
+*
+            VL = ZERO
+            VU = ZERO
+            IL = 0
+            IU = 0
+            IF( JTYPE.EQ.21 ) THEN
+               NTEST = 17
+               ABSTOL = UNFL + UNFL
+               CALL SSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                      M, NSPLIT, WR, IWORK( 1 ), IWORK( N+1 ),
+     $                      WORK, IWORK( 2*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A,rel)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 17 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do test 17
+*
+               TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
+     $                 ( ONE-HALF )**4
+*
+               TEMP1 = ZERO
+               DO 190 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
+     $                    ( ABSTOL+ABS( D4( J ) ) ) )
+  190          CONTINUE
+*
+               RESULT( 17 ) = TEMP1 / TEMP2
+            ELSE
+               RESULT( 17 ) = ZERO
+            END IF
+*
+*           Now ask for all eigenvalues with high absolute accuracy.
+*
+            NTEST = 18
+            ABSTOL = UNFL + UNFL
+            CALL SSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
+     $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), WORK,
+     $                   IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 18 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do test 18
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            DO 200 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D3( J ) ), ABS( WA1( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D3( J )-WA1( J ) ) )
+  200       CONTINUE
+*
+            RESULT( 18 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*           Choose random values for IL and IU, and ask for the
+*           IL-th through IU-th eigenvalues.
+*
+            NTEST = 19
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+               IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+               IF( IU.LT.IL ) THEN
+                  ITEMP = IU
+                  IU = IL
+                  IL = ITEMP
+               END IF
+            END IF
+*
+            CALL SSTEBZ( 'I', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                   M2, NSPLIT, WA2, IWORK( 1 ), IWORK( N+1 ),
+     $                   WORK, IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(I)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 19 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Determine the values VL and VU of the IL-th and IU-th
+*           eigenvalues and ask for all eigenvalues in this range.
+*
+            IF( N.GT.0 ) THEN
+               IF( IL.NE.1 ) THEN
+                  VL = WA1( IL ) - MAX( HALF*( WA1( IL )-WA1( IL-1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               ELSE
+                  VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               END IF
+               IF( IU.NE.N ) THEN
+                  VU = WA1( IU ) + MAX( HALF*( WA1( IU+1 )-WA1( IU ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               ELSE
+                  VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               END IF
+            ELSE
+               VL = ZERO
+               VU = ONE
+            END IF
+*
+            CALL SSTEBZ( 'V', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                   M3, NSPLIT, WA3, IWORK( 1 ), IWORK( N+1 ),
+     $                   WORK, IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 19 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            IF( M3.EQ.0 .AND. N.NE.0 ) THEN
+               RESULT( 19 ) = ULPINV
+               GO TO 280
+            END IF
+*
+*           Do test 19
+*
+            TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+            TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+            IF( N.GT.0 ) THEN
+               TEMP3 = MAX( ABS( WA1( N ) ), ABS( WA1( 1 ) ) )
+            ELSE
+               TEMP3 = ZERO
+            END IF
+*
+            RESULT( 19 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
+*
+*           Call SSTEIN to compute eigenvectors corresponding to
+*           eigenvalues in WA1.  (First call SSTEBZ again, to make sure
+*           it returns these eigenvalues in the correct order.)
+*
+            NTEST = 21
+            CALL SSTEBZ( 'A', 'B', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
+     $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), WORK,
+     $                   IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A,B)', IINFO, N,
+     $            JTYPE, IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 20 ) = ULPINV
+                  RESULT( 21 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL SSTEIN( N, SD, SE, M, WA1, IWORK( 1 ), IWORK( N+1 ), Z,
+     $                   LDU, WORK, IWORK( 2*N+1 ), IWORK( 3*N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEIN', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 20 ) = ULPINV
+                  RESULT( 21 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 20 and 21
+*
+            CALL SSTT21( N, 0, SD, SE, WA1, DUMMA, Z, LDU, WORK,
+     $                   RESULT( 20 ) )
+*
+*           Call SSTEDC(I) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            CALL SCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, WORK, 1 )
+            CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+            NTEST = 22
+            CALL SSTEDC( 'I', N, D1, WORK, Z, LDU, WORK( N+1 ), LWEDC-N,
+     $                   IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEDC(I)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 22 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 22 and 23
+*
+            CALL SSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                   RESULT( 22 ) )
+*
+*           Call SSTEDC(V) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            CALL SCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, WORK, 1 )
+            CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+            NTEST = 24
+            CALL SSTEDC( 'V', N, D1, WORK, Z, LDU, WORK( N+1 ), LWEDC-N,
+     $                   IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEDC(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 24 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 24 and 25
+*
+            CALL SSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                   RESULT( 24 ) )
+*
+*           Call SSTEDC(N) to compute D2, do tests.
+*
+*           Compute D2
+*
+            CALL SCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL SCOPY( N-1, SE, 1, WORK, 1 )
+            CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+            NTEST = 26
+            CALL SSTEDC( 'N', N, D2, WORK, Z, LDU, WORK( N+1 ), LWEDC-N,
+     $                   IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'SSTEDC(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 26 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Test 26
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+*
+            DO 210 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  210       CONTINUE
+*
+            RESULT( 26 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*           Only test SSTEMR if IEEE compliant
+*
+            IF( ILAENV( 10, 'SSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 .AND.
+     $          ILAENV( 11, 'SSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 ) THEN
+*
+*           Call SSTEMR, do test 27 (relative eigenvalue accuracy)
+*
+*              If S is positive definite and diagonally dominant,
+*              ask for all eigenvalues with high relative accuracy.
+*
+               VL = ZERO
+               VU = ZERO
+               IL = 0
+               IU = 0
+               IF( JTYPE.EQ.21 .AND. SREL ) THEN
+                  NTEST = 27
+                  ABSTOL = UNFL + UNFL
+                  CALL SSTEMR( 'V', 'A', N, SD, SE, VL, VU, IL, IU,
+     $                         M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         WORK, LWORK, IWORK( 2*N+1 ), LWORK-2*N,
+     $                         IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSTEMR(V,A,rel)',
+     $                  IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 27 ) = ULPINV
+                        GO TO 270
+                     END IF
+                  END IF
+*
+*              Do test 27
+*
+                  TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
+     $                    ( ONE-HALF )**4
+*
+                  TEMP1 = ZERO
+                  DO 220 J = 1, N
+                     TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
+     $                       ( ABSTOL+ABS( D4( J ) ) ) )
+  220             CONTINUE
+*
+                  RESULT( 27 ) = TEMP1 / TEMP2
+*
+                  IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+                  IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+                  IF( IU.LT.IL ) THEN
+                     ITEMP = IU
+                     IU = IL
+                     IL = ITEMP
+                  END IF
+*
+                  IF( SRANGE ) THEN
+                     NTEST = 28
+                     ABSTOL = UNFL + UNFL
+                     CALL SSTEMR( 'V', 'I', N, SD, SE, VL, VU, IL, IU,
+     $                            M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                            WORK, LWORK, IWORK( 2*N+1 ),
+     $                            LWORK-2*N, IINFO )
+*
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'SSTEMR(V,I,rel)',
+     $                     IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( 28 ) = ULPINV
+                           GO TO 270
+                        END IF
+                     END IF
+*
+*
+*                 Do test 28
+*
+                     TEMP2 = TWO*( TWO*N-ONE )*ULP*
+     $                       ( ONE+EIGHT*HALF**2 ) / ( ONE-HALF )**4
+*
+                     TEMP1 = ZERO
+                     DO 230 J = IL, IU
+                        TEMP1 = MAX( TEMP1, ABS( WR( J-IL+1 )-D4( N-J+
+     $                          1 ) ) / ( ABSTOL+ABS( WR( J-IL+1 ) ) ) )
+  230                CONTINUE
+*
+                     RESULT( 28 ) = TEMP1 / TEMP2
+                  ELSE
+                     RESULT( 28 ) = ZERO
+                  END IF
+               ELSE
+                  RESULT( 27 ) = ZERO
+                  RESULT( 28 ) = ZERO
+               END IF
+*
+*           Call SSTEMR(V,I) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+               CALL SCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, WORK, 1 )
+               CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+               IF( SRANGE ) THEN
+                  NTEST = 29
+                  IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+                  IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
+                  IF( IU.LT.IL ) THEN
+                     ITEMP = IU
+                     IU = IL
+                     IL = ITEMP
+                  END IF
+                  CALL SSTEMR( 'V', 'I', N, D5, WORK, VL, VU, IL, IU,
+     $                         M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSTEMR(V,I)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 29 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Tests 29 and 30
+*
+                  CALL SSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                         M, RESULT( 29 ) )
+*
+*           Call SSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+                  CALL SCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*
+                  NTEST = 31
+                  CALL SSTEMR( 'N', 'I', N, D5, WORK, VL, VU, IL, IU,
+     $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSTEMR(N,I)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 31 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Test 31
+*
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+*
+                  DO 240 J = 1, IU - IL + 1
+                     TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
+     $                       ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  240             CONTINUE
+*
+                  RESULT( 31 ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*
+*           Call SSTEMR(V,V) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+                  CALL SCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL SCOPY( N-1, SE, 1, WORK, 1 )
+                  CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDU )
+*
+                  NTEST = 32
+*
+                  IF( N.GT.0 ) THEN
+                     IF( IL.NE.1 ) THEN
+                        VL = D2( IL ) - MAX( HALF*
+     $                       ( D2( IL )-D2( IL-1 ) ), ULP*ANORM,
+     $                       TWO*RTUNFL )
+                     ELSE
+                        VL = D2( 1 ) - MAX( HALF*( D2( N )-D2( 1 ) ),
+     $                       ULP*ANORM, TWO*RTUNFL )
+                     END IF
+                     IF( IU.NE.N ) THEN
+                        VU = D2( IU ) + MAX( HALF*
+     $                       ( D2( IU+1 )-D2( IU ) ), ULP*ANORM,
+     $                       TWO*RTUNFL )
+                     ELSE
+                        VU = D2( N ) + MAX( HALF*( D2( N )-D2( 1 ) ),
+     $                       ULP*ANORM, TWO*RTUNFL )
+                     END IF
+                  ELSE
+                     VL = ZERO
+                     VU = ONE
+                  END IF
+*
+                  CALL SSTEMR( 'V', 'V', N, D5, WORK, VL, VU, IL, IU,
+     $                         M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSTEMR(V,V)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 32 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Tests 32 and 33
+*
+                  CALL SSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                         M, RESULT( 32 ) )
+*
+*           Call SSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+                  CALL SCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*
+                  NTEST = 34
+                  CALL SSTEMR( 'N', 'V', N, D5, WORK, VL, VU, IL, IU,
+     $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSTEMR(N,V)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 34 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Test 34
+*
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+*
+                  DO 250 J = 1, IU - IL + 1
+                     TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
+     $                       ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  250             CONTINUE
+*
+                  RESULT( 34 ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+               ELSE
+                  RESULT( 29 ) = ZERO
+                  RESULT( 30 ) = ZERO
+                  RESULT( 31 ) = ZERO
+                  RESULT( 32 ) = ZERO
+                  RESULT( 33 ) = ZERO
+                  RESULT( 34 ) = ZERO
+               END IF
+*
+*
+*           Call SSTEMR(V,A) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+               CALL SCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*
+               NTEST = 35
+*
+               CALL SSTEMR( 'V', 'A', N, D5, WORK, VL, VU, IL, IU,
+     $                      M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                      WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                      LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEMR(V,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 35 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*           Do Tests 35 and 36
+*
+               CALL SSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, M,
+     $                      RESULT( 35 ) )
+*
+*           Call SSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+               CALL SCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL SCOPY( N-1, SE, 1, WORK, 1 )
+*
+               NTEST = 37
+               CALL SSTEMR( 'N', 'A', N, D5, WORK, VL, VU, IL, IU,
+     $                      M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                      WORK( N+1 ), LWORK-N, IWORK( 2*N+1 ),
+     $                      LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEMR(N,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 37 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*           Do Test 34
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+*
+               DO 260 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  260          CONTINUE
+*
+               RESULT( 37 ) = TEMP2 / MAX( UNFL,
+     $                        ULP*MAX( TEMP1, TEMP2 ) )
+            END IF
+  270       CONTINUE
+  280       CONTINUE
+            NTESTT = NTESTT + NTEST
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+*
+*           Print out tests which fail.
+*
+            DO 290 JR = 1, NTEST
+               IF( RESULT( JR ).GE.THRESH ) THEN
+*
+*                 If this is the first test to fail,
+*                 print a header to the data file.
+*
+                  IF( NERRS.EQ.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9998 )'SST'
+                     WRITE( NOUNIT, FMT = 9997 )
+                     WRITE( NOUNIT, FMT = 9996 )
+                     WRITE( NOUNIT, FMT = 9995 )'Symmetric'
+                     WRITE( NOUNIT, FMT = 9994 )
+*
+*                    Tests performed
+*
+                     WRITE( NOUNIT, FMT = 9988 )
+                  END IF
+                  NERRS = NERRS + 1
+                  WRITE( NOUNIT, FMT = 9990 )N, IOLDSD, JTYPE, JR,
+     $               RESULT( JR )
+               END IF
+  290       CONTINUE
+  300    CONTINUE
+  310 CONTINUE
+*
+*     Summary
+*
+      CALL SLASUM( 'SST', NOUNIT, NERRS, NTESTT )
+      RETURN
+*
+ 9999 FORMAT( ' SCHKST2STG: ', A, ' returned INFO=', I6, '.', / 9X,
+     $  'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+*
+ 9998 FORMAT( / 1X, A3, ' -- Real Symmetric eigenvalue problem' )
+ 9997 FORMAT( ' Matrix types (see SCHKST2STG for details): ' )
+*
+ 9996 FORMAT( / ' Special Matrices:',
+     $      / '  1=Zero matrix.                        ',
+     $      '  5=Diagonal: clustered entries.',
+     $      / '  2=Identity matrix.                    ',
+     $      '  6=Diagonal: large, evenly spaced.',
+     $      / '  3=Diagonal: evenly spaced entries.    ',
+     $      '  7=Diagonal: small, evenly spaced.',
+     $      / '  4=Diagonal: geometr. spaced entries.' )
+ 9995 FORMAT( ' Dense ', A, ' Matrices:',
+     $      / '  8=Evenly spaced eigenvals.            ',
+     $      ' 12=Small, evenly spaced eigenvals.',
+     $      / '  9=Geometrically spaced eigenvals.     ',
+     $      ' 13=Matrix with random O(1) entries.',
+     $      / ' 10=Clustered eigenvalues.              ',
+     $      ' 14=Matrix with large random entries.',
+     $      / ' 11=Large, evenly spaced eigenvals.     ',
+     $      ' 15=Matrix with small random entries.' )
+ 9994 FORMAT( ' 16=Positive definite, evenly spaced eigenvalues',
+     $      / ' 17=Positive definite, geometrically spaced eigenvlaues',
+     $      / ' 18=Positive definite, clustered eigenvalues',
+     $      / ' 19=Positive definite, small evenly spaced eigenvalues',
+     $      / ' 20=Positive definite, large evenly spaced eigenvalues',
+     $      / ' 21=Diagonally dominant tridiagonal, geometrically',
+     $      ' spaced eigenvalues' )
+*
+ 9990 FORMAT( ' N=', I5, ', seed=', 4( I4, ',' ), ' type ', I2,
+     $      ', test(', I2, ')=', G10.3 )
+*
+ 9988 FORMAT( / 'Test performed:  see SCHKST2STG for details.', / )
+*     End of SCHKST2STG
+*
+      END
diff --git a/TESTING/EIG/sdrvsg2stg.f b/TESTING/EIG/sdrvsg2stg.f
new file mode 100644
index 00000000..c56cd65d
--- /dev/null
+++ b/TESTING/EIG/sdrvsg2stg.f
@@ -0,0 +1,1363 @@
+*> \brief \b SDRVSG2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                              NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
+*                              BB, AP, BP, WORK, NWORK, IWORK, LIWORK, 
+*                              RESULT, INFO )
+*
+*       IMPLICIT NONE
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
+*      $                   NTYPES, NWORK
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       REAL               A( LDA, * ), AB( LDA, * ), AP( * ),
+*      $                   B( LDB, * ), BB( LDB, * ), BP( * ), D( * ),
+*      $                   RESULT( * ), WORK( * ), Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>      SDRVSG2STG checks the real symmetric generalized eigenproblem
+*>      drivers.
+*>
+*>              SSYGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem.
+*>
+*>              SSYGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem using a divide and conquer algorithm.
+*>
+*>              SSYGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem.
+*>
+*>              SSPGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem in packed storage.
+*>
+*>              SSPGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem in packed storage using a divide and
+*>              conquer algorithm.
+*>
+*>              SSPGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite generalized
+*>              eigenproblem in packed storage.
+*>
+*>              SSBGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite banded
+*>              generalized eigenproblem.
+*>
+*>              SSBGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite banded
+*>              generalized eigenproblem using a divide and conquer
+*>              algorithm.
+*>
+*>              SSBGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric-definite banded
+*>              generalized eigenproblem.
+*>
+*>      When SDRVSG2STG is called, a number of matrix "sizes" ("n's") and a
+*>      number of matrix "types" are specified.  For each size ("n")
+*>      and each type of matrix, one matrix A of the given type will be
+*>      generated; a random well-conditioned matrix B is also generated
+*>      and the pair (A,B) is used to test the drivers.
+*>
+*>      For each pair (A,B), the following tests are performed:
+*>
+*>      (1) SSYGV with ITYPE = 1 and UPLO ='U':
+*>
+*>              | A Z - B Z D | / ( |A| |Z| n ulp )
+*>              | D - D2 | / ( |D| ulp )   where D is computed by
+*>                                         SSYGV and  D2 is computed by
+*>                                         SSYGV_2STAGE. This test is
+*>                                         only performed for SSYGV
+*>
+*>      (2) as (1) but calling SSPGV
+*>      (3) as (1) but calling SSBGV
+*>      (4) as (1) but with UPLO = 'L'
+*>      (5) as (4) but calling SSPGV
+*>      (6) as (4) but calling SSBGV
+*>
+*>      (7) SSYGV with ITYPE = 2 and UPLO ='U':
+*>
+*>              | A B Z - Z D | / ( |A| |Z| n ulp )
+*>
+*>      (8) as (7) but calling SSPGV
+*>      (9) as (7) but with UPLO = 'L'
+*>      (10) as (9) but calling SSPGV
+*>
+*>      (11) SSYGV with ITYPE = 3 and UPLO ='U':
+*>
+*>              | B A Z - Z D | / ( |A| |Z| n ulp )
+*>
+*>      (12) as (11) but calling SSPGV
+*>      (13) as (11) but with UPLO = 'L'
+*>      (14) as (13) but calling SSPGV
+*>
+*>      SSYGVD, SSPGVD and SSBGVD performed the same 14 tests.
+*>
+*>      SSYGVX, SSPGVX and SSBGVX performed the above 14 tests with
+*>      the parameter RANGE = 'A', 'N' and 'I', respectively.
+*>
+*>      The "sizes" are specified by an array NN(1:NSIZES); the value
+*>      of each element NN(j) specifies one size.
+*>      The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*>      if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*>      This type is used for the matrix A which has half-bandwidth KA.
+*>      B is generated as a well-conditioned positive definite matrix
+*>      with half-bandwidth KB (<= KA).
+*>      Currently, the list of possible types for A is:
+*>
+*>      (1)  The zero matrix.
+*>      (2)  The identity matrix.
+*>
+*>      (3)  A diagonal matrix with evenly spaced entries
+*>           1, ..., ULP  and random signs.
+*>           (ULP = (first number larger than 1) - 1 )
+*>      (4)  A diagonal matrix with geometrically spaced entries
+*>           1, ..., ULP  and random signs.
+*>      (5)  A diagonal matrix with "clustered" entries
+*>           1, ULP, ..., ULP and random signs.
+*>
+*>      (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*>      (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*>      (8)  A matrix of the form  U* D U, where U is orthogonal and
+*>           D has evenly spaced entries 1, ..., ULP with random signs
+*>           on the diagonal.
+*>
+*>      (9)  A matrix of the form  U* D U, where U is orthogonal and
+*>           D has geometrically spaced entries 1, ..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (10) A matrix of the form  U* D U, where U is orthogonal and
+*>           D has "clustered" entries 1, ULP,..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*>      (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*>      (13) symmetric matrix with random entries chosen from (-1,1).
+*>      (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*>      (15) Same as (13), but multiplied by SQRT( underflow threshold)
+*>
+*>      (16) Same as (8), but with KA = 1 and KB = 1
+*>      (17) Same as (8), but with KA = 2 and KB = 1
+*>      (18) Same as (8), but with KA = 2 and KB = 2
+*>      (19) Same as (8), but with KA = 3 and KB = 1
+*>      (20) Same as (8), but with KA = 3 and KB = 2
+*>      (21) Same as (8), but with KA = 3 and KB = 3
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \verbatim
+*>  NSIZES  INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          SDRVSG2STG does nothing.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NN      INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*>          Not modified.
+*>
+*>  NTYPES  INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, SDRVSG2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*>          Not modified.
+*>
+*>  DOTYPE  LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*>          Not modified.
+*>
+*>  ISEED   INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to SDRVSG2STG to continue the same random number
+*>          sequence.
+*>          Modified.
+*>
+*>  THRESH  REAL
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. real)
+*>          or the size of the matrix.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NOUNIT  INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*>          Not modified.
+*>
+*>  A       REAL             array, dimension (LDA , max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDA     INTEGER
+*>          The leading dimension of A and AB.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  B       REAL             array, dimension (LDB , max(NN))
+*>          Used to hold the symmetric positive definite matrix for
+*>          the generailzed problem.
+*>          On exit, B contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDB     INTEGER
+*>          The leading dimension of B and BB.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  D       REAL             array, dimension (max(NN))
+*>          The eigenvalues of A. On exit, the eigenvalues in D
+*>          correspond with the matrix in A.
+*>          Modified.
+*>
+*>  Z       REAL             array, dimension (LDZ, max(NN))
+*>          The matrix of eigenvectors.
+*>          Modified.
+*>
+*>  LDZ     INTEGER
+*>          The leading dimension of Z.  It must be at least 1 and
+*>          at least max( NN ).
+*>          Not modified.
+*>
+*>  AB      REAL             array, dimension (LDA, max(NN))
+*>          Workspace.
+*>          Modified.
+*>
+*>  BB      REAL             array, dimension (LDB, max(NN))
+*>          Workspace.
+*>          Modified.
+*>
+*>  AP      REAL             array, dimension (max(NN)**2)
+*>          Workspace.
+*>          Modified.
+*>
+*>  BP      REAL             array, dimension (max(NN)**2)
+*>          Workspace.
+*>          Modified.
+*>
+*>  WORK    REAL array, dimension (NWORK)
+*>          Workspace.
+*>          Modified.
+*>
+*>  NWORK   INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          1+5*N+2*N*lg(N)+3*N**2 where N = max( NN(j) ) and
+*>          lg( N ) = smallest integer k such that 2**k >= N.
+*>          Not modified.
+*>
+*>  IWORK   INTEGER array, dimension (LIWORK)
+*>          Workspace.
+*>          Modified.
+*>
+*>  LIWORK  INTEGER
+*>          The number of entries in WORK.  This must be at least 6*N.
+*>          Not modified.
+*>
+*>  RESULT  REAL array, dimension (70)
+*>          The values computed by the 70 tests described above.
+*>          Modified.
+*>
+*>  INFO    INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -16: LDZ < 1 or LDZ < NMAX.
+*>          -21: NWORK too small.
+*>          -23: LIWORK too small.
+*>          If  SLATMR, SLATMS, SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD,
+*>              SSBGVD, SSYGVX, SSPGVX or SSBGVX returns an error code,
+*>              the absolute value of it is returned.
+*>          Modified.
+*>
+*> ----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests that have been run
+*>                       on this matrix.
+*>       NTESTT          The total number of tests for this call.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far (computed by SLAFTS).
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup real_eig
+*
+*  =====================================================================
+      SUBROUTINE SDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                       NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
+     $                       BB, AP, BP, WORK, NWORK, IWORK, LIWORK, 
+     $                       RESULT, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
+     $                   NTYPES, NWORK
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      REAL               A( LDA, * ), AB( LDA, * ), AP( * ),
+     $                   B( LDB, * ), BB( LDB, * ), BP( * ), D( * ),
+     $                   D2( * ), RESULT( * ), WORK( * ), Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE, TEN
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TEN = 10.0E0 )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 21 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN
+      CHARACTER          UPLO
+      INTEGER            I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
+     $                   ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
+     $                   KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
+     $                   NTESTT
+      REAL               ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, ULP, ULPINV, UNFL, VL, VU, TEMP1, TEMP2
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      REAL               SLAMCH, SLARND
+      EXTERNAL           LSAME, SLAMCH, SLARND
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLABAD, SLACPY, SLAFTS, SLASET, SLASUM, SLATMR,
+     $                   SLATMS, SSBGV, SSBGVD, SSBGVX, SSGT01, SSPGV,
+     $                   SSPGVD, SSPGVX, SSYGV, SSYGVD, SSYGVX, XERBLA,
+     $                   SSYGV_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, REAL, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 6*1 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 6*4 /
+*     ..
+*     .. Executable Statements ..
+*
+*     1)      Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+      BADNN = .FALSE.
+      NMAX = 0
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN
+         INFO = -16
+      ELSE IF( 2*MAX( NMAX, 3 )**2.GT.NWORK ) THEN
+         INFO = -21
+      ELSE IF( 2*MAX( NMAX, 3 )**2.GT.LIWORK ) THEN
+         INFO = -23
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SDRVSG2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = SLAMCH( 'Safe minimum' )
+      OVFL = SLAMCH( 'Overflow' )
+      CALL SLABAD( UNFL, OVFL )
+      ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+   20 CONTINUE
+*
+*     Loop over sizes, types
+*
+      NERRS = 0
+      NMATS = 0
+*
+      DO 650 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         ANINV = ONE / REAL( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         KA9 = 0
+         KB9 = 0
+         DO 640 JTYPE = 1, MTYPES
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 640
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           2)      Compute "A"
+*
+*                   Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, w/ eigenvalues
+*           =5         random log   hermitian, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random hermitian
+*           =9                      banded, w/ eigenvalues
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 90
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            IINFO = 0
+            COND = ULPINV
+*
+*           Special Matrices -- Identity & Jordan block
+*
+            IF( ITYPE.EQ.1 ) THEN
+*
+*              Zero
+*
+               KA = 0
+               KB = 0
+               CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               KA = 0
+               KB = 0
+               CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+               DO 80 JCOL = 1, N
+                  A( JCOL, JCOL ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               KA = 0
+               KB = 0
+               CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              symmetric, eigenvalues specified
+*
+               KA = MAX( 0, N-1 )
+               KB = KA
+               CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               KA = 0
+               KB = 0
+               CALL SLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              symmetric, random eigenvalues
+*
+               KA = MAX( 0, N-1 )
+               KB = KA
+               CALL SLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              symmetric banded, eigenvalues specified
+*
+*              The following values are used for the half-bandwidths:
+*
+*                ka = 1   kb = 1
+*                ka = 2   kb = 1
+*                ka = 2   kb = 2
+*                ka = 3   kb = 1
+*                ka = 3   kb = 2
+*                ka = 3   kb = 3
+*
+               KB9 = KB9 + 1
+               IF( KB9.GT.KA9 ) THEN
+                  KA9 = KA9 + 1
+                  KB9 = 1
+               END IF
+               KA = MAX( 0, MIN( N-1, KA9 ) )
+               KB = MAX( 0, MIN( N-1, KB9 ) )
+               CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, KA, KA, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE
+*
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+   90       CONTINUE
+*
+            ABSTOL = UNFL + UNFL
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) )
+               IU = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) )
+               IF( IL.GT.IU ) THEN
+                  ITEMP = IL
+                  IL = IU
+                  IU = ITEMP
+               END IF
+            END IF
+*
+*           3) Call SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD, SSBGVD,
+*              SSYGVX, SSPGVX, and SSBGVX, do tests.
+*
+*           loop over the three generalized problems
+*                 IBTYPE = 1: A*x = (lambda)*B*x
+*                 IBTYPE = 2: A*B*x = (lambda)*x
+*                 IBTYPE = 3: B*A*x = (lambda)*x
+*
+            DO 630 IBTYPE = 1, 3
+*
+*              loop over the setting UPLO
+*
+               DO 620 IBUPLO = 1, 2
+                  IF( IBUPLO.EQ.1 )
+     $               UPLO = 'U'
+                  IF( IBUPLO.EQ.2 )
+     $               UPLO = 'L'
+*
+*                 Generate random well-conditioned positive definite
+*                 matrix B, of bandwidth not greater than that of A.
+*
+                  CALL SLATMS( N, N, 'U', ISEED, 'P', WORK, 5, TEN, ONE,
+     $                         KB, KB, UPLO, B, LDB, WORK( N+1 ),
+     $                         IINFO )
+*
+*                 Test SSYGV
+*
+                  NTEST = NTEST + 1
+*
+                  CALL SLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL SSYGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
+     $                        WORK, NWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSYGV(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                 Test SSYGV_2STAGE
+*
+                  NTEST = NTEST + 1
+*
+                  CALL SLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL SSYGV_2STAGE( IBTYPE, 'N', UPLO, N, Z, LDZ,
+     $                               BB, LDB, D2, WORK, NWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )
+     $                  'SSYGV_2STAGE(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+C                  CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+C     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*           
+*           
+*                 Do Tests | D1 - D2 | / ( |D1| ulp )
+*                 D1 computed using the standard 1-stage reduction as reference
+*                 D2 computed using the 2-stage reduction
+*           
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+                  DO 151 J = 1, N
+                     TEMP1 = MAX( TEMP1, ABS( D( J ) ), 
+     $                                   ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D( J )-D2( J ) ) )
+  151             CONTINUE
+*           
+                  RESULT( NTEST ) = TEMP2 / 
+     $                              MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*                 Test SSYGVD
+*
+                  NTEST = NTEST + 1
+*
+                  CALL SLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL SSYGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
+     $                         WORK, NWORK, IWORK, LIWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSYGVD(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                 Test SSYGVX
+*
+                  NTEST = NTEST + 1
+*
+                  CALL SLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL SSYGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, IWORK( N+1 ), IWORK,
+     $                         IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSYGVX(V,A' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+                  CALL SLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+*                 since we do not know the exact eigenvalues of this
+*                 eigenpair, we just set VL and VU as constants.
+*                 It is quite possible that there are no eigenvalues
+*                 in this interval.
+*
+                  VL = ZERO
+                  VU = ANORM
+                  CALL SSYGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, IWORK( N+1 ), IWORK,
+     $                         IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSYGVX(V,V,' //
+     $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+                  CALL SLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL SSYGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, IWORK( N+1 ), IWORK,
+     $                         IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSYGVX(V,I,' //
+     $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+  100             CONTINUE
+*
+*                 Test SSPGV
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 120 J = 1, N
+                        DO 110 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  110                   CONTINUE
+  120                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 140 J = 1, N
+                        DO 130 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  130                   CONTINUE
+  140                CONTINUE
+                  END IF
+*
+                  CALL SSPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
+     $                        WORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSPGV(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                 Test SSPGVD
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 160 J = 1, N
+                        DO 150 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  150                   CONTINUE
+  160                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 180 J = 1, N
+                        DO 170 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  170                   CONTINUE
+  180                CONTINUE
+                  END IF
+*
+                  CALL SSPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
+     $                         WORK, NWORK, IWORK, LIWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSPGVD(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                 Test SSPGVX
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 200 J = 1, N
+                        DO 190 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  190                   CONTINUE
+  200                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 220 J = 1, N
+                        DO 210 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  210                   CONTINUE
+  220                CONTINUE
+                  END IF
+*
+                  CALL SSPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSPGVX(V,A' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 240 J = 1, N
+                        DO 230 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  230                   CONTINUE
+  240                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 260 J = 1, N
+                        DO 250 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  250                   CONTINUE
+  260                CONTINUE
+                  END IF
+*
+                  VL = ZERO
+                  VU = ANORM
+                  CALL SSPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSPGVX(V,V' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 280 J = 1, N
+                        DO 270 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  270                   CONTINUE
+  280                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 300 J = 1, N
+                        DO 290 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  290                   CONTINUE
+  300                CONTINUE
+                  END IF
+*
+                  CALL SSPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'SSPGVX(V,I' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RESULT( NTEST ) )
+*
+  310             CONTINUE
+*
+                  IF( IBTYPE.EQ.1 ) THEN
+*
+*                    TEST SSBGV
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 340 J = 1, N
+                           DO 320 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  320                      CONTINUE
+                           DO 330 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  330                      CONTINUE
+  340                   CONTINUE
+                     ELSE
+                        DO 370 J = 1, N
+                           DO 350 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  350                      CONTINUE
+                           DO 360 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  360                      CONTINUE
+  370                   CONTINUE
+                     END IF
+*
+                     CALL SSBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB,
+     $                           D, Z, LDZ, WORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'SSBGV(V,' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                    TEST SSBGVD
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 400 J = 1, N
+                           DO 380 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  380                      CONTINUE
+                           DO 390 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  390                      CONTINUE
+  400                   CONTINUE
+                     ELSE
+                        DO 430 J = 1, N
+                           DO 410 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  410                      CONTINUE
+                           DO 420 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  420                      CONTINUE
+  430                   CONTINUE
+                     END IF
+*
+                     CALL SSBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB,
+     $                            LDB, D, Z, LDZ, WORK, NWORK, IWORK,
+     $                            LIWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'SSBGVD(V,' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RESULT( NTEST ) )
+*
+*                    Test SSBGVX
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 460 J = 1, N
+                           DO 440 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  440                      CONTINUE
+                           DO 450 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  450                      CONTINUE
+  460                   CONTINUE
+                     ELSE
+                        DO 490 J = 1, N
+                           DO 470 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  470                      CONTINUE
+                           DO 480 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  480                      CONTINUE
+  490                   CONTINUE
+                     END IF
+*
+                     CALL SSBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'SSBGVX(V,A' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RESULT( NTEST ) )
+*
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 520 J = 1, N
+                           DO 500 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  500                      CONTINUE
+                           DO 510 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  510                      CONTINUE
+  520                   CONTINUE
+                     ELSE
+                        DO 550 J = 1, N
+                           DO 530 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  530                      CONTINUE
+                           DO 540 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  540                      CONTINUE
+  550                   CONTINUE
+                     END IF
+*
+                     VL = ZERO
+                     VU = ANORM
+                     CALL SSBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'SSBGVX(V,V' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RESULT( NTEST ) )
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 580 J = 1, N
+                           DO 560 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  560                      CONTINUE
+                           DO 570 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  570                      CONTINUE
+  580                   CONTINUE
+                     ELSE
+                        DO 610 J = 1, N
+                           DO 590 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  590                      CONTINUE
+                           DO 600 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  600                      CONTINUE
+  610                   CONTINUE
+                     END IF
+*
+                     CALL SSBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'SSBGVX(V,I' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RESULT( NTEST ) )
+*
+                  END IF
+*
+  620          CONTINUE
+  630       CONTINUE
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+            NTESTT = NTESTT + NTEST
+            CALL SLAFTS( 'SSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
+     $                   THRESH, NOUNIT, NERRS )
+  640    CONTINUE
+  650 CONTINUE
+*
+*     Summary
+*
+      CALL SLASUM( 'SSG', NOUNIT, NERRS, NTESTT )
+*
+      RETURN
+*
+*     End of SDRVSG2STG
+*
+ 9999 FORMAT( ' SDRVSG2STG: ', A, ' returned INFO=', I6, '.', / 9X,
+     $    'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+      END
diff --git a/TESTING/EIG/sdrvst2stg.f b/TESTING/EIG/sdrvst2stg.f
new file mode 100644
index 00000000..ebbbcc90
--- /dev/null
+++ b/TESTING/EIG/sdrvst2stg.f
@@ -0,0 +1,2872 @@
+*> \brief \b SDRVST2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                          NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1,
+*                          WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK,
+*                          IWORK, LIWORK, RESULT, INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
+*      $                   NTYPES
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       REAL               A( LDA, * ), D1( * ), D2( * ), D3( * ),
+*      $                   D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ),
+*      $                   U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ),
+*      $                   WA3( * ), WORK( * ), Z( LDU, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>      SDRVST2STG  checks the symmetric eigenvalue problem drivers.
+*>
+*>              SSTEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric tridiagonal matrix.
+*>
+*>              SSTEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric tridiagonal matrix.
+*>
+*>              SSTEVR computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric tridiagonal matrix
+*>              using the Relatively Robust Representation where it can.
+*>
+*>              SSYEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix.
+*>
+*>              SSYEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix.
+*>
+*>              SSYEVR computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix
+*>              using the Relatively Robust Representation where it can.
+*>
+*>              SSPEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix in packed
+*>              storage.
+*>
+*>              SSPEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix in packed
+*>              storage.
+*>
+*>              SSBEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric band matrix.
+*>
+*>              SSBEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric band matrix.
+*>
+*>              SSYEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix using
+*>              a divide and conquer algorithm.
+*>
+*>              SSPEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric matrix in packed
+*>              storage, using a divide and conquer algorithm.
+*>
+*>              SSBEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a real symmetric band matrix,
+*>              using a divide and conquer algorithm.
+*>
+*>      When SDRVST2STG is called, a number of matrix "sizes" ("n's") and a
+*>      number of matrix "types" are specified.  For each size ("n")
+*>      and each type of matrix, one matrix will be generated and used
+*>      to test the appropriate drivers.  For each matrix and each
+*>      driver routine called, the following tests will be performed:
+*>
+*>      (1)     | A - Z D Z' | / ( |A| n ulp )
+*>
+*>      (2)     | I - Z Z' | / ( n ulp )
+*>
+*>      (3)     | D1 - D2 | / ( |D1| ulp )
+*>
+*>      where Z is the matrix of eigenvectors returned when the
+*>      eigenvector option is given and D1 and D2 are the eigenvalues
+*>      returned with and without the eigenvector option.
+*>
+*>      The "sizes" are specified by an array NN(1:NSIZES); the value of
+*>      each element NN(j) specifies one size.
+*>      The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*>      if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*>      Currently, the list of possible types is:
+*>
+*>      (1)  The zero matrix.
+*>      (2)  The identity matrix.
+*>
+*>      (3)  A diagonal matrix with evenly spaced eigenvalues
+*>           1, ..., ULP  and random signs.
+*>           (ULP = (first number larger than 1) - 1 )
+*>      (4)  A diagonal matrix with geometrically spaced eigenvalues
+*>           1, ..., ULP  and random signs.
+*>      (5)  A diagonal matrix with "clustered" eigenvalues
+*>           1, ULP, ..., ULP and random signs.
+*>
+*>      (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*>      (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*>      (8)  A matrix of the form  U' D U, where U is orthogonal and
+*>           D has evenly spaced entries 1, ..., ULP with random signs
+*>           on the diagonal.
+*>
+*>      (9)  A matrix of the form  U' D U, where U is orthogonal and
+*>           D has geometrically spaced entries 1, ..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (10) A matrix of the form  U' D U, where U is orthogonal and
+*>           D has "clustered" entries 1, ULP,..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*>      (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*>      (13) Symmetric matrix with random entries chosen from (-1,1).
+*>      (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*>      (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*>      (16) A band matrix with half bandwidth randomly chosen between
+*>           0 and N-1, with evenly spaced eigenvalues 1, ..., ULP
+*>           with random signs.
+*>      (17) Same as (16), but multiplied by SQRT( overflow threshold )
+*>      (18) Same as (16), but multiplied by SQRT( underflow threshold )
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \verbatim
+*>  NSIZES  INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          SDRVST2STG does nothing.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NN      INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*>          Not modified.
+*>
+*>  NTYPES  INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, SDRVST2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*>          Not modified.
+*>
+*>  DOTYPE  LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*>          Not modified.
+*>
+*>  ISEED   INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to SDRVST2STG to continue the same random number
+*>          sequence.
+*>          Modified.
+*>
+*>  THRESH  REAL
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NOUNIT  INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*>          Not modified.
+*>
+*>  A       REAL             array, dimension (LDA , max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDA     INTEGER
+*>          The leading dimension of A.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  D1      REAL             array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by SSTEQR simlutaneously
+*>          with Z.  On exit, the eigenvalues in D1 correspond with the
+*>          matrix in A.
+*>          Modified.
+*>
+*>  D2      REAL             array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by SSTEQR if Z is not
+*>          computed.  On exit, the eigenvalues in D2 correspond with
+*>          the matrix in A.
+*>          Modified.
+*>
+*>  D3      REAL             array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by SSTERF.  On exit, the
+*>          eigenvalues in D3 correspond with the matrix in A.
+*>          Modified.
+*>
+*>  D4      REAL             array, dimension
+*>
+*>  EVEIGS  REAL array, dimension (max(NN))
+*>          The eigenvalues as computed by SSTEV('N', ... )
+*>          (I reserve the right to change this to the output of
+*>          whichever algorithm computes the most accurate eigenvalues).
+*>
+*>  WA1     REAL array, dimension
+*>
+*>  WA2     REAL array, dimension
+*>
+*>  WA3     REAL array, dimension
+*>
+*>  U       REAL             array, dimension (LDU, max(NN))
+*>          The orthogonal matrix computed by SSYTRD + SORGTR.
+*>          Modified.
+*>
+*>  LDU     INTEGER
+*>          The leading dimension of U, Z, and V.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  V       REAL             array, dimension (LDU, max(NN))
+*>          The Housholder vectors computed by SSYTRD in reducing A to
+*>          tridiagonal form.
+*>          Modified.
+*>
+*>  TAU     REAL array, dimension (max(NN))
+*>          The Householder factors computed by SSYTRD in reducing A
+*>          to tridiagonal form.
+*>          Modified.
+*>
+*>  Z       REAL             array, dimension (LDU, max(NN))
+*>          The orthogonal matrix of eigenvectors computed by SSTEQR,
+*>          SPTEQR, and SSTEIN.
+*>          Modified.
+*>
+*>  WORK    REAL array, dimension (LWORK)
+*>          Workspace.
+*>          Modified.
+*>
+*>  LWORK   INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 4 * Nmax**2
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*>          Not modified.
+*>
+*>  IWORK   INTEGER array,
+*>             dimension (6 + 6*Nmax + 5 * Nmax * lg Nmax )
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*>          Workspace.
+*>          Modified.
+*>
+*>  RESULT  REAL array, dimension (105)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*>          Modified.
+*>
+*>  INFO    INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -16: LDU < 1 or LDU < NMAX.
+*>          -21: LWORK too small.
+*>          If  SLATMR, SLATMS, SSYTRD, SORGTR, SSTEQR, SSTERF,
+*>              or SORMTR returns an error code, the
+*>              absolute value of it is returned.
+*>          Modified.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far (computed by SLAFTS).
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*>
+*>     The tests performed are:                 Routine tested
+*>    1= | A - U S U' | / ( |A| n ulp )         SSTEV('V', ... )
+*>    2= | I - U U' | / ( n ulp )               SSTEV('V', ... )
+*>    3= |D(with Z) - D(w/o Z)| / (|D| ulp)     SSTEV('N', ... )
+*>    4= | A - U S U' | / ( |A| n ulp )         SSTEVX('V','A', ... )
+*>    5= | I - U U' | / ( n ulp )               SSTEVX('V','A', ... )
+*>    6= |D(with Z) - EVEIGS| / (|D| ulp)       SSTEVX('N','A', ... )
+*>    7= | A - U S U' | / ( |A| n ulp )         SSTEVR('V','A', ... )
+*>    8= | I - U U' | / ( n ulp )               SSTEVR('V','A', ... )
+*>    9= |D(with Z) - EVEIGS| / (|D| ulp)       SSTEVR('N','A', ... )
+*>    10= | A - U S U' | / ( |A| n ulp )        SSTEVX('V','I', ... )
+*>    11= | I - U U' | / ( n ulp )              SSTEVX('V','I', ... )
+*>    12= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSTEVX('N','I', ... )
+*>    13= | A - U S U' | / ( |A| n ulp )        SSTEVX('V','V', ... )
+*>    14= | I - U U' | / ( n ulp )              SSTEVX('V','V', ... )
+*>    15= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSTEVX('N','V', ... )
+*>    16= | A - U S U' | / ( |A| n ulp )        SSTEVD('V', ... )
+*>    17= | I - U U' | / ( n ulp )              SSTEVD('V', ... )
+*>    18= |D(with Z) - EVEIGS| / (|D| ulp)      SSTEVD('N', ... )
+*>    19= | A - U S U' | / ( |A| n ulp )        SSTEVR('V','I', ... )
+*>    20= | I - U U' | / ( n ulp )              SSTEVR('V','I', ... )
+*>    21= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSTEVR('N','I', ... )
+*>    22= | A - U S U' | / ( |A| n ulp )        SSTEVR('V','V', ... )
+*>    23= | I - U U' | / ( n ulp )              SSTEVR('V','V', ... )
+*>    24= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSTEVR('N','V', ... )
+*>
+*>    25= | A - U S U' | / ( |A| n ulp )        SSYEV('L','V', ... )
+*>    26= | I - U U' | / ( n ulp )              SSYEV('L','V', ... )
+*>    27= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEV_2STAGE('L','N', ... )
+*>    28= | A - U S U' | / ( |A| n ulp )        SSYEVX('L','V','A', ... )
+*>    29= | I - U U' | / ( n ulp )              SSYEVX('L','V','A', ... )
+*>    30= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVX_2STAGE('L','N','A', ... )
+*>    31= | A - U S U' | / ( |A| n ulp )        SSYEVX('L','V','I', ... )
+*>    32= | I - U U' | / ( n ulp )              SSYEVX('L','V','I', ... )
+*>    33= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVX_2STAGE('L','N','I', ... )
+*>    34= | A - U S U' | / ( |A| n ulp )        SSYEVX('L','V','V', ... )
+*>    35= | I - U U' | / ( n ulp )              SSYEVX('L','V','V', ... )
+*>    36= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVX_2STAGE('L','N','V', ... )
+*>    37= | A - U S U' | / ( |A| n ulp )        SSPEV('L','V', ... )
+*>    38= | I - U U' | / ( n ulp )              SSPEV('L','V', ... )
+*>    39= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEV('L','N', ... )
+*>    40= | A - U S U' | / ( |A| n ulp )        SSPEVX('L','V','A', ... )
+*>    41= | I - U U' | / ( n ulp )              SSPEVX('L','V','A', ... )
+*>    42= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVX('L','N','A', ... )
+*>    43= | A - U S U' | / ( |A| n ulp )        SSPEVX('L','V','I', ... )
+*>    44= | I - U U' | / ( n ulp )              SSPEVX('L','V','I', ... )
+*>    45= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVX('L','N','I', ... )
+*>    46= | A - U S U' | / ( |A| n ulp )        SSPEVX('L','V','V', ... )
+*>    47= | I - U U' | / ( n ulp )              SSPEVX('L','V','V', ... )
+*>    48= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVX('L','N','V', ... )
+*>    49= | A - U S U' | / ( |A| n ulp )        SSBEV('L','V', ... )
+*>    50= | I - U U' | / ( n ulp )              SSBEV('L','V', ... )
+*>    51= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEV_2STAGE('L','N', ... )
+*>    52= | A - U S U' | / ( |A| n ulp )        SSBEVX('L','V','A', ... )
+*>    53= | I - U U' | / ( n ulp )              SSBEVX('L','V','A', ... )
+*>    54= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVX_2STAGE('L','N','A', ... )
+*>    55= | A - U S U' | / ( |A| n ulp )        SSBEVX('L','V','I', ... )
+*>    56= | I - U U' | / ( n ulp )              SSBEVX('L','V','I', ... )
+*>    57= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVX_2STAGE('L','N','I', ... )
+*>    58= | A - U S U' | / ( |A| n ulp )        SSBEVX('L','V','V', ... )
+*>    59= | I - U U' | / ( n ulp )              SSBEVX('L','V','V', ... )
+*>    60= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVX_2STAGE('L','N','V', ... )
+*>    61= | A - U S U' | / ( |A| n ulp )        SSYEVD('L','V', ... )
+*>    62= | I - U U' | / ( n ulp )              SSYEVD('L','V', ... )
+*>    63= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVD_2STAGE('L','N', ... )
+*>    64= | A - U S U' | / ( |A| n ulp )        SSPEVD('L','V', ... )
+*>    65= | I - U U' | / ( n ulp )              SSPEVD('L','V', ... )
+*>    66= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVD('L','N', ... )
+*>    67= | A - U S U' | / ( |A| n ulp )        SSBEVD('L','V', ... )
+*>    68= | I - U U' | / ( n ulp )              SSBEVD('L','V', ... )
+*>    69= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVD_2STAGE('L','N', ... )
+*>    70= | A - U S U' | / ( |A| n ulp )        SSYEVR('L','V','A', ... )
+*>    71= | I - U U' | / ( n ulp )              SSYEVR('L','V','A', ... )
+*>    72= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVR_2STAGE('L','N','A', ... )
+*>    73= | A - U S U' | / ( |A| n ulp )        SSYEVR('L','V','I', ... )
+*>    74= | I - U U' | / ( n ulp )              SSYEVR('L','V','I', ... )
+*>    75= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVR_2STAGE('L','N','I', ... )
+*>    76= | A - U S U' | / ( |A| n ulp )        SSYEVR('L','V','V', ... )
+*>    77= | I - U U' | / ( n ulp )              SSYEVR('L','V','V', ... )
+*>    78= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVR_2STAGE('L','N','V', ... )
+*>
+*>    Tests 25 through 78 are repeated (as tests 79 through 132)
+*>    with UPLO='U'
+*>
+*>    To be added in 1999
+*>
+*>    79= | A - U S U' | / ( |A| n ulp )        SSPEVR('L','V','A', ... )
+*>    80= | I - U U' | / ( n ulp )              SSPEVR('L','V','A', ... )
+*>    81= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVR('L','N','A', ... )
+*>    82= | A - U S U' | / ( |A| n ulp )        SSPEVR('L','V','I', ... )
+*>    83= | I - U U' | / ( n ulp )              SSPEVR('L','V','I', ... )
+*>    84= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVR('L','N','I', ... )
+*>    85= | A - U S U' | / ( |A| n ulp )        SSPEVR('L','V','V', ... )
+*>    86= | I - U U' | / ( n ulp )              SSPEVR('L','V','V', ... )
+*>    87= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVR('L','N','V', ... )
+*>    88= | A - U S U' | / ( |A| n ulp )        SSBEVR('L','V','A', ... )
+*>    89= | I - U U' | / ( n ulp )              SSBEVR('L','V','A', ... )
+*>    90= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVR('L','N','A', ... )
+*>    91= | A - U S U' | / ( |A| n ulp )        SSBEVR('L','V','I', ... )
+*>    92= | I - U U' | / ( n ulp )              SSBEVR('L','V','I', ... )
+*>    93= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVR('L','N','I', ... )
+*>    94= | A - U S U' | / ( |A| n ulp )        SSBEVR('L','V','V', ... )
+*>    95= | I - U U' | / ( n ulp )              SSBEVR('L','V','V', ... )
+*>    96= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVR('L','N','V', ... )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup single_eig
+*
+*  =====================================================================
+      SUBROUTINE SDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                   NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1,
+     $                   WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK,
+     $                   IWORK, LIWORK, RESULT, INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
+     $                   NTYPES
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      REAL               A( LDA, * ), D1( * ), D2( * ), D3( * ),
+     $                   D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ),
+     $                   U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ),
+     $                   WA3( * ), WORK( * ), Z( LDU, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE, TWO, TEN
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
+     $                   TEN = 10.0E0 )
+      REAL               HALF
+      PARAMETER          ( HALF = 0.5E+0 )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 18 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN
+      CHARACTER          UPLO
+      INTEGER            I, IDIAG, IHBW, IINFO, IL, IMODE, INDX, IROW,
+     $                   ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL,
+     $                   JSIZE, JTYPE, KD, LGN, LIWEDC, LWEDC, M, M2,
+     $                   M3, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
+     $                   NTESTT
+      REAL               ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL,
+     $                   VL, VU
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      REAL               SLAMCH, SLARND, SSXT1
+      EXTERNAL           SLAMCH, SLARND, SSXT1
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALASVM, SLABAD, SLACPY, SLAFTS, SLASET, SLATMR,
+     $                   SLATMS, SSBEV, SSBEVD, SSBEVX, SSPEV, SSPEVD,
+     $                   SSPEVX, SSTEV, SSTEVD, SSTEVR, SSTEVX, SSTT21,
+     $                   SSTT22, SSYEV, SSYEVD, SSYEVR, SSYEVX, SSYT21,
+     $                   SSYEVD_2STAGE, SSYEVR_2STAGE, SSYEVX_2STAGE,
+     $                   SSYEV_2STAGE, SSBEV_2STAGE, SSBEVD_2STAGE,
+     $                   SSBEVX_2STAGE, SSYTRD_2STAGE, SSYTRD_SY2SB, 
+     $                   SSYTRD_SB2ST, SSYT22, XERBLA
+*     ..
+*     .. Scalars in Common ..
+      CHARACTER*32       SRNAMT
+*     ..
+*     .. Common blocks ..
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, REAL, INT, LOG, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 1, 2, 3 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 4, 4, 4 /
+*     ..
+*     .. Executable Statements ..
+*
+*     Keep ftrnchek happy
+*
+      VL = ZERO
+      VU = ZERO
+*
+*     1)      Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+      BADNN = .FALSE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -16
+      ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
+         INFO = -21
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SDRVST2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if nothing to do
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = SLAMCH( 'Safe minimum' )
+      OVFL = SLAMCH( 'Overflow' )
+      CALL SLABAD( UNFL, OVFL )
+      ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+         ISEED3( I ) = ISEED( I )
+   20 CONTINUE
+*
+      NERRS = 0
+      NMATS = 0
+*
+*
+      DO 1740 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         IF( N.GT.0 ) THEN
+            LGN = INT( LOG( REAL( N ) ) / LOG( TWO ) )
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2
+c           LIWEDC = 6 + 6*N + 5*N*LGN
+            LIWEDC = 3 + 5*N
+         ELSE
+            LWEDC = 9
+c           LIWEDC = 12
+            LIWEDC = 8
+         END IF
+         ANINV = ONE / REAL( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         DO 1730 JTYPE = 1, MTYPES
+*
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 1730
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           2)      Compute "A"
+*
+*                   Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, (w/ eigenvalues)
+*           =5         random log   symmetric, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random symmetric
+*           =9                      band symmetric, w/ eigenvalues
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 110
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+            IINFO = 0
+            COND = ULPINV
+*
+*           Special Matrices -- Identity & Jordan block
+*
+*                   Zero
+*
+            IF( ITYPE.EQ.1 ) THEN
+               IINFO = 0
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               DO 80 JCOL = 1, N
+                  A( JCOL, JCOL ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              Symmetric, eigenvalues specified
+*
+               CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
+     $                      IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               IDUMMA( 1 ) = 1
+               CALL SLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              Symmetric, random eigenvalues
+*
+               IDUMMA( 1 ) = 1
+               CALL SLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              Symmetric banded, eigenvalues specified
+*
+               IHBW = INT( ( N-1 )*SLARND( 1, ISEED3 ) )
+               CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
+     $                      ANORM, IHBW, IHBW, 'Z', U, LDU, WORK( N+1 ),
+     $                      IINFO )
+*
+*              Store as dense matrix for most routines.
+*
+               CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
+               DO 100 IDIAG = -IHBW, IHBW
+                  IROW = IHBW - IDIAG + 1
+                  J1 = MAX( 1, IDIAG+1 )
+                  J2 = MIN( N, N+IDIAG )
+                  DO 90 J = J1, J2
+                     I = J - IDIAG
+                     A( I, J ) = U( IROW, J )
+   90             CONTINUE
+  100          CONTINUE
+            ELSE
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+  110       CONTINUE
+*
+            ABSTOL = UNFL + UNFL
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) )
+               IU = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) )
+               IF( IL.GT.IU ) THEN
+                  ITEMP = IL
+                  IL = IU
+                  IU = ITEMP
+               END IF
+            END IF
+*
+*           3)      If matrix is tridiagonal, call SSTEV and SSTEVX.
+*
+            IF( JTYPE.LE.7 ) THEN
+               NTEST = 1
+               DO 120 I = 1, N
+                  D1( I ) = REAL( A( I, I ) )
+  120          CONTINUE
+               DO 130 I = 1, N - 1
+                  D2( I ) = REAL( A( I+1, I ) )
+  130          CONTINUE
+               SRNAMT = 'SSTEV'
+               CALL SSTEV( 'V', N, D1, D2, Z, LDU, WORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEV(V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 1 ) = ULPINV
+                     RESULT( 2 ) = ULPINV
+                     RESULT( 3 ) = ULPINV
+                     GO TO 180
+                  END IF
+               END IF
+*
+*              Do tests 1 and 2.
+*
+               DO 140 I = 1, N
+                  D3( I ) = REAL( A( I, I ) )
+  140          CONTINUE
+               DO 150 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  150          CONTINUE
+               CALL SSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK,
+     $                      RESULT( 1 ) )
+*
+               NTEST = 3
+               DO 160 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  160          CONTINUE
+               SRNAMT = 'SSTEV'
+               CALL SSTEV( 'N', N, D3, D4, Z, LDU, WORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEV(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 3 ) = ULPINV
+                     GO TO 180
+                  END IF
+               END IF
+*
+*              Do test 3.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 170 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  170          CONTINUE
+               RESULT( 3 ) = TEMP2 / MAX( UNFL,
+     $                       ULP*MAX( TEMP1, TEMP2 ) )
+*
+  180          CONTINUE
+*
+               NTEST = 4
+               DO 190 I = 1, N
+                  EVEIGS( I ) = D3( I )
+                  D1( I ) = REAL( A( I, I ) )
+  190          CONTINUE
+               DO 200 I = 1, N - 1
+                  D2( I ) = REAL( A( I+1, I ) )
+  200          CONTINUE
+               SRNAMT = 'SSTEVX'
+               CALL SSTEVX( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M, WA1, Z, LDU, WORK, IWORK, IWORK( 5*N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVX(V,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 4 ) = ULPINV
+                     RESULT( 5 ) = ULPINV
+                     RESULT( 6 ) = ULPINV
+                     GO TO 250
+                  END IF
+               END IF
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+*
+*              Do tests 4 and 5.
+*
+               DO 210 I = 1, N
+                  D3( I ) = REAL( A( I, I ) )
+  210          CONTINUE
+               DO 220 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  220          CONTINUE
+               CALL SSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK,
+     $                      RESULT( 4 ) )
+*
+               NTEST = 6
+               DO 230 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  230          CONTINUE
+               SRNAMT = 'SSTEVX'
+               CALL SSTEVX( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, WORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVX(N,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 6 ) = ULPINV
+                     GO TO 250
+                  END IF
+               END IF
+*
+*              Do test 6.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 240 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA2( J ) ),
+     $                    ABS( EVEIGS( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) )
+  240          CONTINUE
+               RESULT( 6 ) = TEMP2 / MAX( UNFL,
+     $                       ULP*MAX( TEMP1, TEMP2 ) )
+*
+  250          CONTINUE
+*
+               NTEST = 7
+               DO 260 I = 1, N
+                  D1( I ) = REAL( A( I, I ) )
+  260          CONTINUE
+               DO 270 I = 1, N - 1
+                  D2( I ) = REAL( A( I+1, I ) )
+  270          CONTINUE
+               SRNAMT = 'SSTEVR'
+               CALL SSTEVR( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M, WA1, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVR(V,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 7 ) = ULPINV
+                     RESULT( 8 ) = ULPINV
+                     GO TO 320
+                  END IF
+               END IF
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+*
+*              Do tests 7 and 8.
+*
+               DO 280 I = 1, N
+                  D3( I ) = REAL( A( I, I ) )
+  280          CONTINUE
+               DO 290 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  290          CONTINUE
+               CALL SSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK,
+     $                      RESULT( 7 ) )
+*
+               NTEST = 9
+               DO 300 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  300          CONTINUE
+               SRNAMT = 'SSTEVR'
+               CALL SSTEVR( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVR(N,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 9 ) = ULPINV
+                     GO TO 320
+                  END IF
+               END IF
+*
+*              Do test 9.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 310 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA2( J ) ),
+     $                    ABS( EVEIGS( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) )
+  310          CONTINUE
+               RESULT( 9 ) = TEMP2 / MAX( UNFL,
+     $                       ULP*MAX( TEMP1, TEMP2 ) )
+*
+  320          CONTINUE
+*
+*
+               NTEST = 10
+               DO 330 I = 1, N
+                  D1( I ) = REAL( A( I, I ) )
+  330          CONTINUE
+               DO 340 I = 1, N - 1
+                  D2( I ) = REAL( A( I+1, I ) )
+  340          CONTINUE
+               SRNAMT = 'SSTEVX'
+               CALL SSTEVX( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, WORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVX(V,I)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 10 ) = ULPINV
+                     RESULT( 11 ) = ULPINV
+                     RESULT( 12 ) = ULPINV
+                     GO TO 380
+                  END IF
+               END IF
+*
+*              Do tests 10 and 11.
+*
+               DO 350 I = 1, N
+                  D3( I ) = REAL( A( I, I ) )
+  350          CONTINUE
+               DO 360 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  360          CONTINUE
+               CALL SSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
+     $                      MAX( 1, M2 ), RESULT( 10 ) )
+*
+*
+               NTEST = 12
+               DO 370 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  370          CONTINUE
+               SRNAMT = 'SSTEVX'
+               CALL SSTEVX( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M3, WA3, Z, LDU, WORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVX(N,I)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 12 ) = ULPINV
+                     GO TO 380
+                  END IF
+               END IF
+*
+*              Do test 12.
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( 12 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 )
+*
+  380          CONTINUE
+*
+               NTEST = 12
+               IF( N.GT.0 ) THEN
+                  IF( IL.NE.1 ) THEN
+                     VL = WA1( IL ) - MAX( HALF*
+     $                    ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3,
+     $                    TEN*RTUNFL )
+                  ELSE
+                     VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = WA1( IU ) + MAX( HALF*
+     $                    ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3,
+     $                    TEN*RTUNFL )
+                  ELSE
+                     VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               DO 390 I = 1, N
+                  D1( I ) = REAL( A( I, I ) )
+  390          CONTINUE
+               DO 400 I = 1, N - 1
+                  D2( I ) = REAL( A( I+1, I ) )
+  400          CONTINUE
+               SRNAMT = 'SSTEVX'
+               CALL SSTEVX( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, WORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVX(V,V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 13 ) = ULPINV
+                     RESULT( 14 ) = ULPINV
+                     RESULT( 15 ) = ULPINV
+                     GO TO 440
+                  END IF
+               END IF
+*
+               IF( M2.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( 13 ) = ULPINV
+                  RESULT( 14 ) = ULPINV
+                  RESULT( 15 ) = ULPINV
+                  GO TO 440
+               END IF
+*
+*              Do tests 13 and 14.
+*
+               DO 410 I = 1, N
+                  D3( I ) = REAL( A( I, I ) )
+  410          CONTINUE
+               DO 420 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  420          CONTINUE
+               CALL SSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
+     $                      MAX( 1, M2 ), RESULT( 13 ) )
+*
+               NTEST = 15
+               DO 430 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  430          CONTINUE
+               SRNAMT = 'SSTEVX'
+               CALL SSTEVX( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M3, WA3, Z, LDU, WORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVX(N,V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 15 ) = ULPINV
+                     GO TO 440
+                  END IF
+               END IF
+*
+*              Do test 15.
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( 15 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
+*
+  440          CONTINUE
+*
+               NTEST = 16
+               DO 450 I = 1, N
+                  D1( I ) = REAL( A( I, I ) )
+  450          CONTINUE
+               DO 460 I = 1, N - 1
+                  D2( I ) = REAL( A( I+1, I ) )
+  460          CONTINUE
+               SRNAMT = 'SSTEVD'
+               CALL SSTEVD( 'V', N, D1, D2, Z, LDU, WORK, LWEDC, IWORK,
+     $                      LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVD(V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 16 ) = ULPINV
+                     RESULT( 17 ) = ULPINV
+                     RESULT( 18 ) = ULPINV
+                     GO TO 510
+                  END IF
+               END IF
+*
+*              Do tests 16 and 17.
+*
+               DO 470 I = 1, N
+                  D3( I ) = REAL( A( I, I ) )
+  470          CONTINUE
+               DO 480 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  480          CONTINUE
+               CALL SSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK,
+     $                      RESULT( 16 ) )
+*
+               NTEST = 18
+               DO 490 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  490          CONTINUE
+               SRNAMT = 'SSTEVD'
+               CALL SSTEVD( 'N', N, D3, D4, Z, LDU, WORK, LWEDC, IWORK,
+     $                      LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVD(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 18 ) = ULPINV
+                     GO TO 510
+                  END IF
+               END IF
+*
+*              Do test 18.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 500 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( EVEIGS( J ) ),
+     $                    ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( EVEIGS( J )-D3( J ) ) )
+  500          CONTINUE
+               RESULT( 18 ) = TEMP2 / MAX( UNFL,
+     $                        ULP*MAX( TEMP1, TEMP2 ) )
+*
+  510          CONTINUE
+*
+               NTEST = 19
+               DO 520 I = 1, N
+                  D1( I ) = REAL( A( I, I ) )
+  520          CONTINUE
+               DO 530 I = 1, N - 1
+                  D2( I ) = REAL( A( I+1, I ) )
+  530          CONTINUE
+               SRNAMT = 'SSTEVR'
+               CALL SSTEVR( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVR(V,I)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 19 ) = ULPINV
+                     RESULT( 20 ) = ULPINV
+                     RESULT( 21 ) = ULPINV
+                     GO TO 570
+                  END IF
+               END IF
+*
+*              DO tests 19 and 20.
+*
+               DO 540 I = 1, N
+                  D3( I ) = REAL( A( I, I ) )
+  540          CONTINUE
+               DO 550 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  550          CONTINUE
+               CALL SSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
+     $                      MAX( 1, M2 ), RESULT( 19 ) )
+*
+*
+               NTEST = 21
+               DO 560 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  560          CONTINUE
+               SRNAMT = 'SSTEVR'
+               CALL SSTEVR( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M3, WA3, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVR(N,I)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 21 ) = ULPINV
+                     GO TO 570
+                  END IF
+               END IF
+*
+*              Do test 21.
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( 21 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 )
+*
+  570          CONTINUE
+*
+               NTEST = 21
+               IF( N.GT.0 ) THEN
+                  IF( IL.NE.1 ) THEN
+                     VL = WA1( IL ) - MAX( HALF*
+     $                    ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3,
+     $                    TEN*RTUNFL )
+                  ELSE
+                     VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = WA1( IU ) + MAX( HALF*
+     $                    ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3,
+     $                    TEN*RTUNFL )
+                  ELSE
+                     VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               DO 580 I = 1, N
+                  D1( I ) = REAL( A( I, I ) )
+  580          CONTINUE
+               DO 590 I = 1, N - 1
+                  D2( I ) = REAL( A( I+1, I ) )
+  590          CONTINUE
+               SRNAMT = 'SSTEVR'
+               CALL SSTEVR( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL,
+     $                      M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVR(V,V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 22 ) = ULPINV
+                     RESULT( 23 ) = ULPINV
+                     RESULT( 24 ) = ULPINV
+                     GO TO 630
+                  END IF
+               END IF
+*
+               IF( M2.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( 22 ) = ULPINV
+                  RESULT( 23 ) = ULPINV
+                  RESULT( 24 ) = ULPINV
+                  GO TO 630
+               END IF
+*
+*              Do tests 22 and 23.
+*
+               DO 600 I = 1, N
+                  D3( I ) = REAL( A( I, I ) )
+  600          CONTINUE
+               DO 610 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  610          CONTINUE
+               CALL SSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
+     $                      MAX( 1, M2 ), RESULT( 22 ) )
+*
+               NTEST = 24
+               DO 620 I = 1, N - 1
+                  D4( I ) = REAL( A( I+1, I ) )
+  620          CONTINUE
+               SRNAMT = 'SSTEVR'
+               CALL SSTEVR( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL,
+     $                      M3, WA3, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSTEVR(N,V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 24 ) = ULPINV
+                     GO TO 630
+                  END IF
+               END IF
+*
+*              Do test 24.
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( 24 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
+*
+  630          CONTINUE
+*
+*
+*
+            ELSE
+*
+               DO 640 I = 1, 24
+                  RESULT( I ) = ZERO
+  640          CONTINUE
+               NTEST = 24
+            END IF
+*
+*           Perform remaining tests storing upper or lower triangular
+*           part of matrix.
+*
+            DO 1720 IUPLO = 0, 1
+               IF( IUPLO.EQ.0 ) THEN
+                  UPLO = 'L'
+               ELSE
+                  UPLO = 'U'
+               END IF
+*
+*              4)      Call SSYEV and SSYEVX.
+*
+               CALL SLACPY( ' ', N, N, A, LDA, V, LDU )
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'SSYEV'
+               CALL SSYEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK,
+     $                     IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSYEV(V,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 660
+                  END IF
+               END IF
+*
+*              Do tests 25 and 26 (or +54)
+*
+               CALL SSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'SSYEV_2STAGE'
+               CALL SSYEV_2STAGE( 'N', UPLO, N, A, LDU, D3, WORK, LWORK,
+     $                     IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSYEV_2STAGE(N,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 660
+                  END IF
+               END IF
+*
+*              Do test 27 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 650 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  650          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  660          CONTINUE
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 1
+*
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
+                  IF( IL.NE.1 ) THEN
+                     VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  TEMP3 = ZERO
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               SRNAMT = 'SSYEVX'
+               CALL SSYEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, WORK, LWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSYEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 680
+                  END IF
+               END IF
+*
+*              Do tests 28 and 29 (or +54)
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL SSYT21( 1, UPLO, N, 0, A, LDU, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'SSYEVX_2STAGE'
+               CALL SSYEVX_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
+     $                      LWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSYEVX_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 680
+                  END IF
+               END IF
+*
+*              Do test 30 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 670 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+  670          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  680          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'SSYEVX'
+               CALL SSYEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSYEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 690
+                  END IF
+               END IF
+*
+*              Do tests 31 and 32 (or +54)
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'SSYEVX_2STAGE'
+               CALL SSYEVX_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK,
+     $                      LWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSYEVX_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 690
+                  END IF
+               END IF
+*
+*              Do test 33 (or +54)
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, ULP*TEMP3 )
+  690          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'SSYEVX'
+               CALL SSYEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSYEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 700
+                  END IF
+               END IF
+*
+*              Do tests 34 and 35 (or +54)
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'SSYEVX_2STAGE'
+               CALL SSYEVX_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK,
+     $                      LWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSYEVX_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 700
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 700
+               END IF
+*
+*              Do test 36 (or +54)
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  700          CONTINUE
+*
+*              5)      Call SSPEV and SSPEVX.
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+*              Load array WORK with the upper or lower triangular
+*              part of the matrix in packed form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 720 J = 1, N
+                     DO 710 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  710                CONTINUE
+  720             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 740 J = 1, N
+                     DO 730 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  730                CONTINUE
+  740             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'SSPEV'
+               CALL SSPEV( 'V', UPLO, N, WORK, D1, Z, LDU, V, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSPEV(V,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 800
+                  END IF
+               END IF
+*
+*              Do tests 37 and 38 (or +54)
+*
+               CALL SSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 760 J = 1, N
+                     DO 750 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  750                CONTINUE
+  760             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 780 J = 1, N
+                     DO 770 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  770                CONTINUE
+  780             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'SSPEV'
+               CALL SSPEV( 'N', UPLO, N, WORK, D3, Z, LDU, V, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSPEV(N,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 800
+                  END IF
+               END IF
+*
+*              Do test 39 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 790 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  790          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*              Load array WORK with the upper or lower triangular part
+*              of the matrix in packed form.
+*
+  800          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 820 J = 1, N
+                     DO 810 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  810                CONTINUE
+  820             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 840 J = 1, N
+                     DO 830 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  830                CONTINUE
+  840             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+*
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
+                  IF( IL.NE.1 ) THEN
+                     VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  TEMP3 = ZERO
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               SRNAMT = 'SSPEVX'
+               CALL SSPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSPEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 900
+                  END IF
+               END IF
+*
+*              Do tests 40 and 41 (or +54)
+*
+               CALL SSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 860 J = 1, N
+                     DO 850 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  850                CONTINUE
+  860             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 880 J = 1, N
+                     DO 870 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  870                CONTINUE
+  880             CONTINUE
+               END IF
+*
+               SRNAMT = 'SSPEVX'
+               CALL SSPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSPEVX(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 900
+                  END IF
+               END IF
+*
+*              Do test 42 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 890 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+  890          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  900          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 920 J = 1, N
+                     DO 910 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  910                CONTINUE
+  920             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 940 J = 1, N
+                     DO 930 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  930                CONTINUE
+  940             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+*
+               SRNAMT = 'SSPEVX'
+               CALL SSPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSPEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 990
+                  END IF
+               END IF
+*
+*              Do tests 43 and 44 (or +54)
+*
+               CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 960 J = 1, N
+                     DO 950 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  950                CONTINUE
+  960             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 980 J = 1, N
+                     DO 970 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  970                CONTINUE
+  980             CONTINUE
+               END IF
+*
+               SRNAMT = 'SSPEVX'
+               CALL SSPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M3, WA3, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSPEVX(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 990
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 990
+               END IF
+*
+*              Do test 45 (or +54)
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  990          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 1010 J = 1, N
+                     DO 1000 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1000                CONTINUE
+ 1010             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 1030 J = 1, N
+                     DO 1020 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1020                CONTINUE
+ 1030             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+*
+               SRNAMT = 'SSPEVX'
+               CALL SSPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSPEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1080
+                  END IF
+               END IF
+*
+*              Do tests 46 and 47 (or +54)
+*
+               CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 1050 J = 1, N
+                     DO 1040 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1040                CONTINUE
+ 1050             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 1070 J = 1, N
+                     DO 1060 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1060                CONTINUE
+ 1070             CONTINUE
+               END IF
+*
+               SRNAMT = 'SSPEVX'
+               CALL SSPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M3, WA3, Z, LDU, V, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSPEVX(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1080
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 1080
+               END IF
+*
+*              Do test 48 (or +54)
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+ 1080          CONTINUE
+*
+*              6)      Call SSBEV and SSBEVX.
+*
+               IF( JTYPE.LE.7 ) THEN
+                  KD = 1
+               ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
+                  KD = MAX( N-1, 0 )
+               ELSE
+                  KD = IHBW
+               END IF
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1100 J = 1, N
+                     DO 1090 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1090                CONTINUE
+ 1100             CONTINUE
+               ELSE
+                  DO 1120 J = 1, N
+                     DO 1110 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1110                CONTINUE
+ 1120             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'SSBEV'
+               CALL SSBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
+     $                     IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSBEV(V,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1180
+                  END IF
+               END IF
+*
+*              Do tests 49 and 50 (or ... )
+*
+               CALL SSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1140 J = 1, N
+                     DO 1130 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1130                CONTINUE
+ 1140             CONTINUE
+               ELSE
+                  DO 1160 J = 1, N
+                     DO 1150 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1150                CONTINUE
+ 1160             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'SSBEV_2STAGE'
+               CALL SSBEV_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU,
+     $                     WORK, LWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSBEV_2STAGE(N,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1180
+                  END IF
+               END IF
+*
+*              Do test 51 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1170 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1170          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+ 1180          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1200 J = 1, N
+                     DO 1190 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1190                CONTINUE
+ 1200             CONTINUE
+               ELSE
+                  DO 1220 J = 1, N
+                     DO 1210 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1210                CONTINUE
+ 1220             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'SSBEVX'
+               CALL SSBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M, WA2, Z, LDU, WORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSBEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1280
+                  END IF
+               END IF
+*
+*              Do tests 52 and 53 (or +54)
+*
+               CALL SSYT21( 1, UPLO, N, 0, A, LDU, WA2, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1240 J = 1, N
+                     DO 1230 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1230                CONTINUE
+ 1240             CONTINUE
+               ELSE
+                  DO 1260 J = 1, N
+                     DO 1250 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1250                CONTINUE
+ 1260             CONTINUE
+               END IF
+*
+               SRNAMT = 'SSBEVX_2STAGE'
+               CALL SSBEVX_2STAGE( 'N', 'A', UPLO, N, KD, V, LDU,
+     $                      U, LDU, VL, VU, IL, IU, ABSTOL, M3, WA3,
+     $                      Z, LDU, WORK, LWORK, IWORK, IWORK( 5*N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSBEVX_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1280
+                  END IF
+               END IF
+*
+*              Do test 54 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1270 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), ABS( WA3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA2( J )-WA3( J ) ) )
+ 1270          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1280          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1300 J = 1, N
+                     DO 1290 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1290                CONTINUE
+ 1300             CONTINUE
+               ELSE
+                  DO 1320 J = 1, N
+                     DO 1310 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1310                CONTINUE
+ 1320             CONTINUE
+               END IF
+*
+               SRNAMT = 'SSBEVX'
+               CALL SSBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSBEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1370
+                  END IF
+               END IF
+*
+*              Do tests 55 and 56 (or +54)
+*
+               CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1340 J = 1, N
+                     DO 1330 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1330                CONTINUE
+ 1340             CONTINUE
+               ELSE
+                  DO 1360 J = 1, N
+                     DO 1350 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1350                CONTINUE
+ 1360             CONTINUE
+               END IF
+*
+               SRNAMT = 'SSBEVX_2STAGE'
+               CALL SSBEVX_2STAGE( 'N', 'I', UPLO, N, KD, V, LDU,
+     $                      U, LDU, VL, VU, IL, IU, ABSTOL, M3, WA3,
+     $                      Z, LDU, WORK, LWORK, IWORK, IWORK( 5*N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSBEVX_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1370
+                  END IF
+               END IF
+*
+*              Do test 57 (or +54)
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+ 1370          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1390 J = 1, N
+                     DO 1380 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1380                CONTINUE
+ 1390             CONTINUE
+               ELSE
+                  DO 1410 J = 1, N
+                     DO 1400 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1400                CONTINUE
+ 1410             CONTINUE
+               END IF
+*
+               SRNAMT = 'SSBEVX'
+               CALL SSBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSBEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1460
+                  END IF
+               END IF
+*
+*              Do tests 58 and 59 (or +54)
+*
+               CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1430 J = 1, N
+                     DO 1420 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1420                CONTINUE
+ 1430             CONTINUE
+               ELSE
+                  DO 1450 J = 1, N
+                     DO 1440 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1440                CONTINUE
+ 1450             CONTINUE
+               END IF
+*
+               SRNAMT = 'SSBEVX_2STAGE'
+               CALL SSBEVX_2STAGE( 'N', 'V', UPLO, N, KD, V, LDU,
+     $                      U, LDU, VL, VU, IL, IU, ABSTOL, M3, WA3,
+     $                      Z, LDU, WORK, LWORK, IWORK, IWORK( 5*N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSBEVX_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1460
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 1460
+               END IF
+*
+*              Do test 60 (or +54)
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+ 1460          CONTINUE
+*
+*              7)      Call SSYEVD
+*
+               CALL SLACPY( ' ', N, N, A, LDA, V, LDU )
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'SSYEVD'
+               CALL SSYEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC,
+     $                      IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSYEVD(V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1480
+                  END IF
+               END IF
+*
+*              Do tests 61 and 62 (or +54)
+*
+               CALL SSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'SSYEVD_2STAGE'
+               CALL SSYEVD_2STAGE( 'N', UPLO, N, A, LDU, D3, WORK, 
+     $                              LWORK, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSYEVD_2STAGE(N,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1480
+                  END IF
+               END IF
+*
+*              Do test 63 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1470 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1470          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1480          CONTINUE
+*
+*              8)      Call SSPEVD.
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+*              Load array WORK with the upper or lower triangular
+*              part of the matrix in packed form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 1500 J = 1, N
+                     DO 1490 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1490                CONTINUE
+ 1500             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 1520 J = 1, N
+                     DO 1510 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1510                CONTINUE
+ 1520             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'SSPEVD'
+               CALL SSPEVD( 'V', UPLO, N, WORK, D1, Z, LDU,
+     $                      WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSPEVD(V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1580
+                  END IF
+               END IF
+*
+*              Do tests 64 and 65 (or +54)
+*
+               CALL SSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 1540 J = 1, N
+                     DO 1530 I = 1, J
+*
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1530                CONTINUE
+ 1540             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 1560 J = 1, N
+                     DO 1550 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1550                CONTINUE
+ 1560             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'SSPEVD'
+               CALL SSPEVD( 'N', UPLO, N, WORK, D3, Z, LDU,
+     $                      WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSPEVD(N,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1580
+                  END IF
+               END IF
+*
+*              Do test 66 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1570 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1570          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+ 1580          CONTINUE
+*
+*              9)      Call SSBEVD.
+*
+               IF( JTYPE.LE.7 ) THEN
+                  KD = 1
+               ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
+                  KD = MAX( N-1, 0 )
+               ELSE
+                  KD = IHBW
+               END IF
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1600 J = 1, N
+                     DO 1590 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1590                CONTINUE
+ 1600             CONTINUE
+               ELSE
+                  DO 1620 J = 1, N
+                     DO 1610 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1610                CONTINUE
+ 1620             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               SRNAMT = 'SSBEVD'
+               CALL SSBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
+     $                      LWEDC, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSBEVD(V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1680
+                  END IF
+               END IF
+*
+*              Do tests 67 and 68 (or +54)
+*
+               CALL SSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1640 J = 1, N
+                     DO 1630 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1630                CONTINUE
+ 1640             CONTINUE
+               ELSE
+                  DO 1660 J = 1, N
+                     DO 1650 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1650                CONTINUE
+ 1660             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'SSBEVD_2STAGE'
+               CALL SSBEVD_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU,
+     $                             WORK, LWORK, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSBEVD_2STAGE(N,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1680
+                  END IF
+               END IF
+*
+*              Do test 69 (or +54)
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1670 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1670          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1680          CONTINUE
+*
+*
+               CALL SLACPY( ' ', N, N, A, LDA, V, LDU )
+               NTEST = NTEST + 1
+               SRNAMT = 'SSYEVR'
+               CALL SSYEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSYEVR(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1700
+                  END IF
+               END IF
+*
+*              Do tests 70 and 71 (or ... )
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL SSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               SRNAMT = 'SSYEVR_2STAGE'
+               CALL SSYEVR_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M2, WA2, Z, LDU, IWORK,
+     $                      WORK, LWORK, IWORK(2*N+1), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSYEVR_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1700
+                  END IF
+               END IF
+*
+*              Do test 72 (or ... )
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1690 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+ 1690          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1700          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'SSYEVR'
+               CALL SSYEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSYEVR(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1710
+                  END IF
+               END IF
+*
+*              Do tests 73 and 74 (or +54)
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'SSYEVR_2STAGE'
+               CALL SSYEVR_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M3, WA3, Z, LDU, IWORK,
+     $                      WORK, LWORK, IWORK(2*N+1), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSYEVR_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1710
+                  END IF
+               END IF
+*
+*              Do test 75 (or +54)
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, ULP*TEMP3 )
+ 1710          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'SSYEVR'
+               CALL SSYEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'SSYEVR(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 700
+                  END IF
+               END IF
+*
+*              Do tests 76 and 77 (or +54)
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+               SRNAMT = 'SSYEVR_2STAGE'
+               CALL SSYEVR_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU,
+     $                      IL, IU, ABSTOL, M3, WA3, Z, LDU, IWORK,
+     $                      WORK, LWORK, IWORK(2*N+1), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'SSYEVR_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 700
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 700
+               END IF
+*
+*              Do test 78 (or +54)
+*
+               TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+               CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+ 1720       CONTINUE
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+            NTESTT = NTESTT + NTEST
+*
+            CALL SLAFTS( 'SST', N, N, JTYPE, NTEST, RESULT, IOLDSD,
+     $                   THRESH, NOUNIT, NERRS )
+*
+ 1730    CONTINUE
+ 1740 CONTINUE
+*
+*     Summary
+*
+      CALL ALASVM( 'SST', NOUNIT, NERRS, NTESTT, 0 )
+*
+ 9999 FORMAT( ' SDRVST2STG: ', A, ' returned INFO=', I6, '.', / 9X,
+     $    'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+*
+      RETURN
+*
+*     End of SDRVST2STG
+*
+      END
diff --git a/TESTING/EIG/serrst.f b/TESTING/EIG/serrst.f
index 266e9ec1..dd341aea 100644
--- a/TESTING/EIG/serrst.f
+++ b/TESTING/EIG/serrst.f
@@ -25,6 +25,10 @@
 *> SOPGTR, SOPMTR, SSTEQR, SSTERF, SSTEBZ, SSTEIN, SPTEQR, SSBTRD,
 *> SSYEV, SSYEVX, SSYEVD, SSBEV, SSBEVX, SSBEVD,
 *> SSPEV, SSPEVX, SSPEVD, SSTEV, SSTEVX, SSTEVD, and SSTEDC.
+*> SSYEVD_2STAGE, SSYEVR_2STAGE, SSYEVX_2STAGE,
+*> SSYEV_2STAGE, SSBEV_2STAGE, SSBEVD_2STAGE,
+*> SSBEVX_2STAGE, SSYTRD_2STAGE, SSYTRD_SY2SB,
+*> SSYTRD_SB2ST
 *> \endverbatim
 *
 *  Arguments:
@@ -94,7 +98,11 @@
      $                   SSBEV, SSBEVD, SSBEVX, SSBTRD, SSPEV, SSPEVD,
      $                   SSPEVX, SSPTRD, SSTEBZ, SSTEDC, SSTEIN, SSTEQR,
      $                   SSTERF, SSTEV, SSTEVD, SSTEVR, SSTEVX, SSYEV,
-     $                   SSYEVD, SSYEVR, SSYEVX, SSYTRD
+     $                   SSYEVD, SSYEVR, SSYEVX, SSYTRD,
+     $                   SSYEVD_2STAGE, SSYEVR_2STAGE, SSYEVX_2STAGE,
+     $                   SSYEV_2STAGE, SSBEV_2STAGE, SSBEVD_2STAGE,
+     $                   SSBEVX_2STAGE, SSYTRD_2STAGE, SSYTRD_SY2SB,
+     $                   SSYTRD_SB2ST
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -152,6 +160,103 @@
          CALL CHKXER( 'SSYTRD', INFOT, NOUT, LERR, OK )
          NT = NT + 4
 *
+*        SSYTRD_2STAGE
+*
+         SRNAMT = 'SSYTRD_2STAGE'
+         INFOT = 1
+         CALL SSYTRD_2STAGE( '/', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL SSYTRD_2STAGE( 'H', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRD_2STAGE( 'N', '/', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYTRD_2STAGE( 'N', 'U', -1, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSYTRD_2STAGE( 'N', 'U', 2, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYTRD_2STAGE( 'N', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 0, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL SSYTRD_2STAGE( 'N', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 0, INFO )
+         CALL CHKXER( 'SSYTRD_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 7
+*
+*        SSYTRD_SY2SB
+*
+         SRNAMT = 'SSYTRD_SY2SB'
+         INFOT = 1
+         CALL SSYTRD_SY2SB( '/', 0, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRD_SY2SB( 'U', -1, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYTRD_SY2SB( 'U', 0, -1, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSYTRD_SY2SB( 'U', 2, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRD_SY2SB( 'U', 0, 2, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYTRD_SY2SB( 'U', 0, 0, A, 1, C, 1, TAU, W, 0, INFO )
+         CALL CHKXER( 'SSYTRD_SY2SB', INFOT, NOUT, LERR, OK )
+         NT = NT + 6
+*
+*        SSYTRD_SB2ST
+*
+         SRNAMT = 'SSYTRD_SB2ST'
+         INFOT = 1
+         CALL SSYTRD_SB2ST( '/', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRD_SB2ST( 'Y', '/', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRD_SB2ST( 'Y', 'H', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYTRD_SB2ST( 'Y', 'N', '/', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTRD_SB2ST( 'Y', 'N', 'U', -1, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSYTRD_SB2ST( 'Y', 'N', 'U', 0, -1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRD_SB2ST( 'Y', 'N', 'U', 0, 1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL SSYTRD_SB2ST( 'Y', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 0, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL SSYTRD_SB2ST( 'Y', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 0, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         NT = NT + 9
+*
 *        SORGTR
 *
          SRNAMT = 'SORGTR'
@@ -536,6 +641,44 @@
          CALL CHKXER( 'SSYEVD', INFOT, NOUT, LERR, OK )
          NT = NT + 10
 *
+*        SSYEVD_2STAGE
+*
+         SRNAMT = 'SSYEVD_2STAGE'
+         INFOT = 1
+         CALL SSYEVD_2STAGE( '/', 'U', 0, A, 1, X, W, 1, IW, 1, INFO )
+         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL SSYEVD_2STAGE( 'V', 'U', 0, A, 1, X, W, 1, IW, 1, INFO )
+         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYEVD_2STAGE( 'N', '/', 0, A, 1, X, W, 1, IW, 1, INFO )
+         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYEVD_2STAGE( 'N', 'U', -1, A, 1, X, W, 1, IW, 1, INFO )
+         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSYEVD_2STAGE( 'N', 'U', 2, A, 1, X, W, 3, IW, 1, INFO )
+         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYEVD_2STAGE( 'N', 'U', 1, A, 1, X, W, 0, IW, 1, INFO )
+         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYEVD_2STAGE( 'N', 'U', 2, A, 2, X, W, 4, IW, 1, INFO )
+         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 8
+*         CALL SSYEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 20, IW, 12, INFO )
+*         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYEVD_2STAGE( 'N', 'U', 1, A, 1, X, W, 1, IW, 0, INFO )
+         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYEVD_2STAGE( 'N', 'U', 2, A, 2, X, W, 25, IW, 0, INFO )
+         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 10
+*         CALL SSYEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 27, IW, 11, INFO )
+*         CALL CHKXER( 'SSYEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 9
+*
 *        SSYEVR
 *
          SRNAMT = 'SSYEVR'
@@ -589,6 +732,74 @@
          CALL CHKXER( 'SSYEVR', INFOT, NOUT, LERR, OK )
          NT = NT + 11
 *
+*        SSYEVR_2STAGE
+*
+         SRNAMT = 'SSYEVR_2STAGE'
+         N = 1
+         INFOT = 1
+         CALL SSYEVR_2STAGE( '/', 'A', 'U', 0, A, 1,
+     $                0.0E0, 0.0E0, 1, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL SSYEVR_2STAGE( 'V', 'A', 'U', 0, A, 1,
+     $                0.0E0, 0.0E0, 1, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYEVR_2STAGE( 'N', '/', 'U', 0, A, 1,
+     $                0.0E0, 0.0E0, 1, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYEVR_2STAGE( 'N', 'A', '/', -1, A, 1,
+     $                0.0E0, 0.0E0, 1, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYEVR_2STAGE( 'N', 'A', 'U', -1, A, 1,
+     $                0.0E0, 0.0E0, 1, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL SSYEVR_2STAGE( 'N', 'A', 'U', 2, A, 1,
+     $                0.0E0, 0.0E0, 1, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYEVR_2STAGE( 'N', 'V', 'U', 1, A, 1,
+     $                0.0E0, 0.0E0, 1, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL SSYEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0E0, 0.0E0, 0, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYEVR_2STAGE( 'N', 'I', 'U', 2, A, 2,
+     $                0.0E0, 0.0E0, 2, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL SSYEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0E0, 0.0E0, 1, 1, 0.0E0,
+     $                M, R, Z, 0, IW, Q, 26*N, IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 18
+         CALL SSYEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0E0, 0.0E0, 1, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 0, IW( 2*N+1 ), 10*N,
+     $                INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 20
+         CALL SSYEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0E0, 0.0E0, 1, 1, 0.0E0,
+     $                M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 0,
+     $                INFO )
+         CALL CHKXER( 'SSYEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 12
+*
 *        SSYEV
 *
          SRNAMT = 'SSYEV '
@@ -609,6 +820,29 @@
          CALL CHKXER( 'SSYEV ', INFOT, NOUT, LERR, OK )
          NT = NT + 5
 *
+*        SSYEV_2STAGE
+*
+         SRNAMT = 'SSYEV_2STAGE '
+         INFOT = 1
+         CALL SSYEV_2STAGE( '/', 'U', 0, A, 1, X, W, 1, INFO )
+         CALL CHKXER( 'SSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL SSYEV_2STAGE( 'V', 'U', 0, A, 1, X, W, 1, INFO )
+         CALL CHKXER( 'SSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYEV_2STAGE( 'N', '/', 0, A, 1, X, W, 1, INFO )
+         CALL CHKXER( 'SSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYEV_2STAGE( 'N', 'U', -1, A, 1, X, W, 1, INFO )
+         CALL CHKXER( 'SSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSYEV_2STAGE( 'N', 'U', 2, A, 1, X, W, 3, INFO )
+         CALL CHKXER( 'SSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYEV_2STAGE( 'N', 'U', 1, A, 1, X, W, 1, INFO )
+         CALL CHKXER( 'SSYEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         NT = NT + 6
+*
 *        SSYEVX
 *
          SRNAMT = 'SSYEVX'
@@ -661,6 +895,75 @@
          CALL CHKXER( 'SSYEVX', INFOT, NOUT, LERR, OK )
          NT = NT + 12
 *
+*        SSYEVX_2STAGE
+*
+         SRNAMT = 'SSYEVX_2STAGE'
+         INFOT = 1
+         CALL SSYEVX_2STAGE( '/', 'A', 'U', 0, A, 1,
+     $                 0.0E0, 0.0E0, 0, 0, 0.0E0,
+     $                M, X, Z, 1, W, 1, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL SSYEVX_2STAGE( 'V', 'A', 'U', 0, A, 1,
+     $                 0.0E0, 0.0E0, 0, 0, 0.0E0,
+     $                M, X, Z, 1, W, 1, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYEVX_2STAGE( 'N', '/', 'U', 0, A, 1,
+     $                0.0E0, 1.0E0, 1, 0, 0.0E0,
+     $                M, X, Z, 1, W, 1, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYEVX_2STAGE( 'N', 'A', '/', 0, A, 1,
+     $                0.0E0, 0.0E0, 0, 0, 0.0E0,
+     $                M, X, Z, 1, W, 1, IW, I3, INFO )
+         INFOT = 4
+         CALL SSYEVX_2STAGE( 'N', 'A', 'U', -1, A, 1,
+     $                0.0E0, 0.0E0, 0, 0, 0.0E0,
+     $                M, X, Z, 1, W, 1, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL SSYEVX_2STAGE( 'N', 'A', 'U', 2, A, 1,
+     $                0.0E0, 0.0E0, 0, 0, 0.0E0,
+     $                M, X, Z, 1, W, 16, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYEVX_2STAGE( 'N', 'V', 'U', 1, A, 1,
+     $                0.0E0, 0.0E0, 0, 0, 0.0E0,
+     $                M, X, Z, 1, W, 8, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL SSYEVX_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0E0, 0.0E0, 0, 0, 0.0E0,
+     $                M, X, Z, 1, W, 8, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL SSYEVX_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0E0, 0.0E0, 2, 1, 0.0E0,
+     $                M, X, Z, 1, W, 8, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYEVX_2STAGE( 'N', 'I', 'U', 2, A, 2,
+     $                0.0E0, 0.0E0, 2, 1, 0.0E0,
+     $                M, X, Z, 1, W, 16, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYEVX_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0E0, 0.0E0, 1, 2, 0.0E0,
+     $                M, X, Z, 1, W, 8, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL SSYEVX_2STAGE( 'N', 'A', 'U', 2, A, 2,
+     $                0.0E0, 0.0E0, 0, 0, 0.0E0,
+     $                M, X, Z, 0, W, 16, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 17
+         CALL SSYEVX_2STAGE( 'N', 'A', 'U', 1, A, 1,
+     $                0.0E0, 0.0E0, 0, 0, 0.0E0,
+     $                M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSYEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 13
+*
 *        SSPEVD
 *
          SRNAMT = 'SSPEVD'
@@ -784,6 +1087,47 @@
          CALL CHKXER( 'SSBTRD', INFOT, NOUT, LERR, OK )
          NT = NT + 6
 *
+*        SSYTRD_SB2ST
+*
+         SRNAMT = 'SSYTRD_SB2ST'
+         INFOT = 1
+         CALL SSYTRD_SB2ST( '/', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRD_SB2ST( 'N', '/', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRD_SB2ST( 'N', 'H', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYTRD_SB2ST( 'N', 'N', '/', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTRD_SB2ST( 'N', 'N', 'U', -1, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSYTRD_SB2ST( 'N', 'N', 'U', 0, -1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRD_SB2ST( 'N', 'N', 'U', 0, 1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL SSYTRD_SB2ST( 'N', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 0, W, 1, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL SSYTRD_SB2ST( 'N', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 0, INFO )
+         CALL CHKXER( 'SSYTRD_SB2ST', INFOT, NOUT, LERR, OK )
+         NT = NT + 9
+*
 *        SSBEVD
 *
          SRNAMT = 'SSBEVD'
@@ -827,6 +1171,60 @@
          CALL CHKXER( 'SSBEVD', INFOT, NOUT, LERR, OK )
          NT = NT + 11
 *
+*        SSBEVD_2STAGE
+*
+         SRNAMT = 'SSBEVD_2STAGE'
+         INFOT = 1
+         CALL SSBEVD_2STAGE( '/', 'U', 0, 0, A, 1, X, Z, 1, W,
+     $                                        1, IW, 1, INFO )
+         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL SSBEVD_2STAGE( 'V', 'U', 0, 0, A, 1, X, Z, 1, W,
+     $                                        1, IW, 1, INFO )
+         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSBEVD_2STAGE( 'N', '/', 0, 0, A, 1, X, Z, 1, W,
+     $                                        1, IW, 1, INFO )
+         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSBEVD_2STAGE( 'N', 'U', -1, 0, A, 1, X, Z, 1, W,
+     $                                         1, IW, 1, INFO )
+         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSBEVD_2STAGE( 'N', 'U', 0, -1, A, 1, X, Z, 1, W,
+     $                                         1, IW, 1, INFO )
+         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL SSBEVD_2STAGE( 'N', 'U', 2, 1, A, 1, X, Z, 1, W,
+     $                                        4, IW, 1, INFO )
+         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 9
+*         CALL SSBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 1, W,
+*     $                                      25, IW, 12, INFO )
+*         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL SSBEVD_2STAGE( 'N', 'U', 1, 0, A, 1, X, Z, 1, W,
+     $                                        0, IW, 1, INFO )
+         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL SSBEVD_2STAGE( 'N', 'U', 2, 0, A, 1, X, Z, 1, W,
+     $                                        3, IW, 1, INFO )
+         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 11
+*         CALL SSBEVD_2STAGE( 'V', 'U', 2, 0, A, 1, X, Z, 2, W,
+*     $                                      18, IW, 12, INFO )
+*         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL SSBEVD_2STAGE( 'N', 'U', 1, 0, A, 1, X, Z, 1, W,
+     $                                        1, IW, 0, INFO )
+         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 13
+*         CALL SSBEVD_2STAGE( 'V', 'U', 2, 0, A, 1, X, Z, 2, W,
+*     $                                      25, IW, 11, INFO )
+*         CALL CHKXER( 'SSBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         NT = NT + 12
+         NT = NT + 9
+*
 *        SSBEV
 *
          SRNAMT = 'SSBEV '
@@ -850,6 +1248,35 @@
          CALL CHKXER( 'SSBEV ', INFOT, NOUT, LERR, OK )
          NT = NT + 6
 *
+*        SSBEV_2STAGE
+*
+         SRNAMT = 'SSBEV_2STAGE '
+         INFOT = 1
+         CALL SSBEV_2STAGE( '/', 'U', 0, 0, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'SSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL SSBEV_2STAGE( 'V', 'U', 0, 0, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'SSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSBEV_2STAGE( 'N', '/', 0, 0, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'SSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSBEV_2STAGE( 'N', 'U', -1, 0, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'SSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSBEV_2STAGE( 'N', 'U', 0, -1, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'SSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL SSBEV_2STAGE( 'N', 'U', 2, 1, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'SSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL SSBEV_2STAGE( 'N', 'U', 2, 0, A, 1, X, Z, 0, W, 0, INFO )
+         CALL CHKXER( 'SSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL SSBEV_2STAGE( 'N', 'U', 0, 0, A, 1, X, Z, 1, W, 0, INFO )
+         CALL CHKXER( 'SSBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         NT = NT + 8
+*
 *        SSBEVX
 *
          SRNAMT = 'SSBEVX'
@@ -864,6 +1291,7 @@
          INFOT = 3
          CALL SSBEVX( 'N', 'A', '/', 0, 0, A, 1, Q, 1, 0.0, 0.0, 0, 0,
      $                0.0, M, X, Z, 1, W, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX', INFOT, NOUT, LERR, OK )
          INFOT = 4
          CALL SSBEVX( 'N', 'A', 'U', -1, 0, A, 1, Q, 1, 0.0, 0.0, 0, 0,
      $                0.0, M, X, Z, 1, W, IW, I3, INFO )
@@ -905,6 +1333,72 @@
      $                0.0, M, X, Z, 1, W, IW, I3, INFO )
          CALL CHKXER( 'SSBEVX', INFOT, NOUT, LERR, OK )
          NT = NT + 13
+*
+*        SSBEVX_2STAGE
+*
+         SRNAMT = 'SSBEVX_2STAGE'
+         INFOT = 1
+         CALL SSBEVX_2STAGE( '/', 'A', 'U', 0, 0, A, 1, Q, 1, 0.0E0,
+     $          0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL SSBEVX_2STAGE( 'V', 'A', 'U', 0, 0, A, 1, Q, 1, 0.0E0,
+     $          0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSBEVX_2STAGE( 'N', '/', 'U', 0, 0, A, 1, Q, 1, 0.0E0,
+     $          0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSBEVX_2STAGE( 'N', 'A', '/', 0, 0, A, 1, Q, 1, 0.0E0,
+     $          0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSBEVX_2STAGE( 'N', 'A', 'U', -1, 0, A, 1, Q, 1, 0.0E0,
+     $           0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSBEVX_2STAGE( 'N', 'A', 'U', 0, -1, A, 1, Q, 1, 0.0E0,
+     $           0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSBEVX_2STAGE( 'N', 'A', 'U', 2, 1, A, 1, Q, 1, 0.0E0,
+     $          0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 9
+*         CALL SSBEVX_2STAGE( 'V', 'A', 'U', 2, 0, A, 1, Q, 1, 0.0E0,
+*     $          0.0E0, 0, 0, 0.0E0, M, X, Z, 2, W, 0, IW, I3, INFO )
+*         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL SSBEVX_2STAGE( 'N', 'V', 'U', 1, 0, A, 1, Q, 1, 0.0E0,
+     $          0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL SSBEVX_2STAGE( 'N', 'I', 'U', 1, 0, A, 1, Q, 1, 0.0E0,
+     $          0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL SSBEVX_2STAGE( 'N', 'I', 'U', 1, 0, A, 1, Q, 1, 0.0E0,
+     $          0.0E0, 2, 1, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL SSBEVX_2STAGE( 'N', 'I', 'U', 2, 0, A, 1, Q, 1, 0.0E0,
+     $          0.0E0, 2, 1, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL SSBEVX_2STAGE( 'N', 'I', 'U', 1, 0, A, 1, Q, 1, 0.0E0,
+     $          0.0E0, 1, 2, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 18
+*         CALL SSBEVX_2STAGE( 'V', 'A', 'U', 2, 0, A, 1, Q, 2, 0.0E0,
+*     $          0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+*         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 20
+         CALL SSBEVX_2STAGE( 'N', 'A', 'U', 0, 0, A, 1, Q, 1, 0.0E0,
+     $           0.0E0, 0, 0, 0.0E0, M, X, Z, 1, W, 0, IW, I3, INFO )
+         CALL CHKXER( 'SSBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+*         NT = NT + 15
+         NT = NT + 13
       END IF
 *
 *     Print a summary line.
diff --git a/TESTING/EIG/zchkee.f b/TESTING/EIG/zchkee.f
index 9ca71cee..768ed7c8 100644
--- a/TESTING/EIG/zchkee.f
+++ b/TESTING/EIG/zchkee.f
@@ -1102,7 +1102,8 @@
      $                   ZDRGES, ZDRGEV, ZDRGSX, ZDRGVX, ZDRVBD, ZDRVES,
      $                   ZDRVEV, ZDRVSG, ZDRVST, ZDRVSX, ZDRVVX,
      $                   ZERRBD, ZERRED, ZERRGG, ZERRHS, ZERRST, ILAVER,
-     $                   ZDRGES3, ZDRGEV3
+     $                   ZDRGES3, ZDRGEV3, 
+     $                   ZCHKST2STG, ZDRVST2STG, ZCHKHB2STG
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          LEN, MIN
@@ -1149,7 +1150,7 @@
       PATH = LINE( 1: 3 )
       NEP = LSAMEN( 3, PATH, 'NEP' ) .OR. LSAMEN( 3, PATH, 'ZHS' )
       SEP = LSAMEN( 3, PATH, 'SEP' ) .OR. LSAMEN( 3, PATH, 'ZST' ) .OR.
-     $      LSAMEN( 3, PATH, 'ZSG' )
+     $      LSAMEN( 3, PATH, 'ZSG' ) .OR. LSAMEN( 3, PATH, 'SE2' )
       SVD = LSAMEN( 3, PATH, 'SVD' ) .OR. LSAMEN( 3, PATH, 'ZBD' )
       ZEV = LSAMEN( 3, PATH, 'ZEV' )
       ZES = LSAMEN( 3, PATH, 'ZES' )
@@ -1829,7 +1830,8 @@
      $         WRITE( NOUT, FMT = 9980 )'ZCHKHS', INFO
   270    CONTINUE
 *
-      ELSE IF( LSAMEN( 3, C3, 'ZST' ) .OR. LSAMEN( 3, C3, 'SEP' ) ) THEN
+      ELSE IF( LSAMEN( 3, C3, 'ZST' ) .OR. LSAMEN( 3, C3, 'SEP' ) 
+     $                                .OR. LSAMEN( 3, C3, 'SE2' ) ) THEN
 *
 *        ----------------------------------
 *        SEP:  Symmetric Eigenvalue Problem
@@ -1859,6 +1861,17 @@
             WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
      $         NXVAL( I )
             IF( TSTCHK ) THEN
+               IF( LSAMEN( 3, C3, 'SE2' ) ) THEN
+               CALL ZCHKST2STG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ),
+     $                      DR( 1, 1 ), DR( 1, 2 ), DR( 1, 3 ),
+     $                      DR( 1, 4 ), DR( 1, 5 ), DR( 1, 6 ),
+     $                      DR( 1, 7 ), DR( 1, 8 ), DR( 1, 9 ),
+     $                      DR( 1, 10 ), DR( 1, 11 ), A( 1, 3 ), NMAX,
+     $                      A( 1, 4 ), A( 1, 5 ), DC( 1, 1 ), A( 1, 6 ),
+     $                      WORK, LWORK, RWORK, LWORK, IWORK, LIWORK,
+     $                      RESULT, INFO )
+               ELSE
                CALL ZCHKST( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
      $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ),
      $                      DR( 1, 1 ), DR( 1, 2 ), DR( 1, 3 ),
@@ -1868,16 +1881,26 @@
      $                      A( 1, 4 ), A( 1, 5 ), DC( 1, 1 ), A( 1, 6 ),
      $                      WORK, LWORK, RWORK, LWORK, IWORK, LIWORK,
      $                      RESULT, INFO )
+               ENDIF
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'ZCHKST', INFO
             END IF
             IF( TSTDRV ) THEN
+               IF( LSAMEN( 3, C3, 'SE2' ) ) THEN
+               CALL ZDRVST2STG( NN, NVAL, 18, DOTYPE, ISEED, THRESH,
+     $                    NOUT, A( 1, 1 ), NMAX, DR( 1, 3 ), DR( 1, 4 ),
+     $                    DR( 1, 5 ), DR( 1, 8 ), DR( 1, 9 ),
+     $                    DR( 1, 10 ), A( 1, 2 ), NMAX, A( 1, 3 ),
+     $                    DC( 1, 1 ), A( 1, 4 ), WORK, LWORK, RWORK,
+     $                    LWORK, IWORK, LIWORK, RESULT, INFO )
+           ELSE
                CALL ZDRVST( NN, NVAL, 18, DOTYPE, ISEED, THRESH, NOUT,
-     $                      A( 1, 1 ), NMAX, DR( 1, 3 ), DR( 1, 4 ),
-     $                      DR( 1, 5 ), DR( 1, 8 ), DR( 1, 9 ),
-     $                      DR( 1, 10 ), A( 1, 2 ), NMAX, A( 1, 3 ),
-     $                      DC( 1, 1 ), A( 1, 4 ), WORK, LWORK, RWORK,
-     $                      LWORK, IWORK, LIWORK, RESULT, INFO )
+     $                    A( 1, 1 ), NMAX, DR( 1, 3 ), DR( 1, 4 ),
+     $                    DR( 1, 5 ), DR( 1, 8 ), DR( 1, 9 ),
+     $                    DR( 1, 10 ), A( 1, 2 ), NMAX, A( 1, 3 ),
+     $                    DC( 1, 1 ), A( 1, 4 ), WORK, LWORK, RWORK,
+     $                    LWORK, IWORK, LIWORK, RESULT, INFO )
+               ENDIF
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'ZDRVST', INFO
             END IF
@@ -1910,12 +1933,18 @@
             WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
      $         NXVAL( I )
             IF( TSTCHK ) THEN
-               CALL ZDRVSG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
-     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
-     $                      DR( 1, 3 ), A( 1, 3 ), NMAX, A( 1, 4 ),
-     $                      A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), WORK,
-     $                      LWORK, RWORK, LWORK, IWORK, LIWORK, RESULT,
-     $                      INFO )
+*               CALL ZDRVSG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+*     $                      NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
+*     $                      DR( 1, 3 ), A( 1, 3 ), NMAX, A( 1, 4 ),
+*     $                      A( 1, 5 ), A( 1, 6 ), A( 1, 7 ), WORK,
+*     $                      LWORK, RWORK, LWORK, IWORK, LIWORK, RESULT,
+*     $                      INFO )
+               CALL ZDRVSG2STG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+     $                          NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
+     $                          DR( 1, 3 ), DR( 1, 4 ), A( 1, 3 ), NMAX,
+     $                          A( 1, 4 ), A( 1, 5 ), A( 1, 6 ),
+     $                          A( 1, 7 ), WORK, LWORK, RWORK, LWORK,
+     $                          IWORK, LIWORK, RESULT, INFO )
                IF( INFO.NE.0 )
      $            WRITE( NOUT, FMT = 9980 )'ZDRVSG', INFO
             END IF
@@ -2276,10 +2305,15 @@
          CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
          IF( TSTERR )
      $      CALL ZERRST( 'ZHB', NOUT )
-         CALL ZCHKHB( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED, THRESH,
-     $                NOUT, A( 1, 1 ), NMAX, DR( 1, 1 ), DR( 1, 2 ),
-     $                A( 1, 2 ), NMAX, WORK, LWORK, RWORK, RESULT,
-     $                INFO )
+*         CALL ZCHKHB( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED, THRESH,
+*     $                NOUT, A( 1, 1 ), NMAX, DR( 1, 1 ), DR( 1, 2 ),
+*     $                A( 1, 2 ), NMAX, WORK, LWORK, RWORK, RESULT,
+*     $                INFO )
+         CALL ZCHKHB2STG( NN, NVAL, NK, KVAL, MAXTYP, DOTYPE, ISEED,
+     $                 THRESH, NOUT, A( 1, 1 ), NMAX, DR( 1, 1 ), 
+     $                 DR( 1, 2 ), DR( 1, 3 ), DR( 1, 4 ), DR( 1, 5 ),
+     $                 A( 1, 2 ), NMAX, WORK, LWORK, RWORK, RESULT, 
+     $                 INFO )
          IF( INFO.NE.0 )
      $      WRITE( NOUT, FMT = 9980 )'ZCHKHB', INFO
 *
diff --git a/TESTING/EIG/zchkhb2stg.f b/TESTING/EIG/zchkhb2stg.f
new file mode 100644
index 00000000..c9ed5531
--- /dev/null
+++ b/TESTING/EIG/zchkhb2stg.f
@@ -0,0 +1,878 @@
+*> \brief \b ZCHKHBSTG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZCHKHBSTG( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE,
+*                          ISEED, THRESH, NOUNIT, A, LDA, SD, SE, D1,
+*                          D2, D3, U, LDU, WORK, LWORK, RWORK RESULT, 
+*                          INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
+*      $                   NWDTHS
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), KK( * ), NN( * )
+*       DOUBLE PRECISION   RESULT( * ), RWORK( * ), SD( * ), SE( * )
+*       COMPLEX*16         A( LDA, * ), U( LDU, * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZCHKHBSTG tests the reduction of a Hermitian band matrix to tridiagonal
+*> from, used with the Hermitian eigenvalue problem.
+*>
+*> ZHBTRD factors a Hermitian band matrix A as  U S U* , where * means
+*> conjugate transpose, S is symmetric tridiagonal, and U is unitary.
+*> ZHBTRD can use either just the lower or just the upper triangle
+*> of A; ZCHKHBSTG checks both cases.
+*>
+*> ZHETRD_HB2ST factors a Hermitian band matrix A as  U S U* , 
+*> where * means conjugate transpose, S is symmetric tridiagonal, and U is
+*> unitary. ZHETRD_HB2ST can use either just the lower or just
+*> the upper triangle of A; ZCHKHBSTG checks both cases.
+*>
+*> DSTEQR factors S as  Z D1 Z'.  
+*> D1 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of DSBTRD "U" (used as reference for DSYTRD_SB2ST)
+*> D2 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of DSYTRD_SB2ST "U".
+*> D3 is the matrix of eigenvalues computed when Z is not computed
+*> and from the S resulting of DSYTRD_SB2ST "L".
+*>
+*> When ZCHKHBSTG is called, a number of matrix "sizes" ("n's"), a number
+*> of bandwidths ("k's"), and a number of matrix "types" are
+*> specified.  For each size ("n"), each bandwidth ("k") less than or
+*> equal to "n", and each type of matrix, one matrix will be generated
+*> and used to test the hermitian banded reduction routine.  For each
+*> matrix, a number of tests will be performed:
+*>
+*> (1)     | A - V S V* | / ( |A| n ulp )  computed by ZHBTRD with
+*>                                         UPLO='U'
+*>
+*> (2)     | I - UU* | / ( n ulp )
+*>
+*> (3)     | A - V S V* | / ( |A| n ulp )  computed by ZHBTRD with
+*>                                         UPLO='L'
+*>
+*> (4)     | I - UU* | / ( n ulp )
+*>
+*> (5)     | D1 - D2 | / ( |D1| ulp )      where D1 is computed by
+*>                                         DSBTRD with UPLO='U' and
+*>                                         D2 is computed by
+*>                                         ZHETRD_HB2ST with UPLO='U'
+*>
+*> (6)     | D1 - D3 | / ( |D1| ulp )      where D1 is computed by
+*>                                         DSBTRD with UPLO='U' and
+*>                                         D3 is computed by
+*>                                         ZHETRD_HB2ST with UPLO='L'
+*>
+*> The "sizes" are specified by an array NN(1:NSIZES); the value of
+*> each element NN(j) specifies one size.
+*> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*> Currently, the list of possible types is:
+*>
+*> (1)  The zero matrix.
+*> (2)  The identity matrix.
+*>
+*> (3)  A diagonal matrix with evenly spaced entries
+*>      1, ..., ULP  and random signs.
+*>      (ULP = (first number larger than 1) - 1 )
+*> (4)  A diagonal matrix with geometrically spaced entries
+*>      1, ..., ULP  and random signs.
+*> (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>      and random signs.
+*>
+*> (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*> (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*> (8)  A matrix of the form  U* D U, where U is unitary and
+*>      D has evenly spaced entries 1, ..., ULP with random signs
+*>      on the diagonal.
+*>
+*> (9)  A matrix of the form  U* D U, where U is unitary and
+*>      D has geometrically spaced entries 1, ..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (10) A matrix of the form  U* D U, where U is unitary and
+*>      D has "clustered" entries 1, ULP,..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*> (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*> (13) Hermitian matrix with random entries chosen from (-1,1).
+*> (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*> (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] NSIZES
+*> \verbatim
+*>          NSIZES is INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          ZCHKHBSTG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*> \endverbatim
+*>
+*> \param[in] NWDTHS
+*> \verbatim
+*>          NWDTHS is INTEGER
+*>          The number of bandwidths to use.  If it is zero,
+*>          ZCHKHBSTG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] KK
+*> \verbatim
+*>          KK is INTEGER array, dimension (NWDTHS)
+*>          An array containing the bandwidths to be used for the band
+*>          matrices.  The values must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NTYPES
+*> \verbatim
+*>          NTYPES is INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, ZCHKHBSTG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*> \endverbatim
+*>
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*> \endverbatim
+*>
+*> \param[in,out] ISEED
+*> \verbatim
+*>          ISEED is INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to ZCHKHBSTG to continue the same random number
+*>          sequence.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is DOUBLE PRECISION
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NOUNIT
+*> \verbatim
+*>          NOUNIT is INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension
+*>                            (LDA, max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of A.  It must be at least 2 (not 1!)
+*>          and at least max( KK )+1.
+*> \endverbatim
+*>
+*> \param[out] SD
+*> \verbatim
+*>          SD is DOUBLE PRECISION array, dimension (max(NN))
+*>          Used to hold the diagonal of the tridiagonal matrix computed
+*>          by ZHBTRD.
+*> \endverbatim
+*>
+*> \param[out] SE
+*> \verbatim
+*>          SE is DOUBLE PRECISION array, dimension (max(NN))
+*>          Used to hold the off-diagonal of the tridiagonal matrix
+*>          computed by ZHBTRD.
+*> \endverbatim
+*>
+*> \param[out] U
+*> \verbatim
+*>          U is COMPLEX*16 array, dimension (LDU, max(NN))
+*>          Used to hold the unitary matrix computed by ZHBTRD.
+*> \endverbatim
+*>
+*> \param[in] LDU
+*> \verbatim
+*>          LDU is INTEGER
+*>          The leading dimension of U.  It must be at least 1
+*>          and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (LWORK)
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          max( LDA+1, max(NN)+1 )*max(NN).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array
+*> \endverbatim
+*>
+*> \param[out] RESULT
+*> \verbatim
+*>          RESULT is DOUBLE PRECISION array, dimension (4)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          If 0, then everything ran OK.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far.
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16_eig
+*
+*  =====================================================================
+      SUBROUTINE ZCHKHB2STG( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE,
+     $                   ISEED, THRESH, NOUNIT, A, LDA, SD, SE, D1,
+     $                   D2, D3, U, LDU, WORK, LWORK, RWORK, RESULT, 
+     $                   INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
+     $                   NWDTHS
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), KK( * ), NN( * )
+      DOUBLE PRECISION   RESULT( * ), RWORK( * ), SD( * ), SE( * ),
+     $                   D1( * ), D2( * ), D3( * )
+      COMPLEX*16         A( LDA, * ), U( LDU, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
+      DOUBLE PRECISION   ZERO, ONE, TWO, TEN
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
+     $                   TEN = 10.0D+0 )
+      DOUBLE PRECISION   HALF
+      PARAMETER          ( HALF = ONE / TWO )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 15 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN, BADNNB
+      INTEGER            I, IINFO, IMODE, ITYPE, J, JC, JCOL, JR, JSIZE,
+     $                   JTYPE, JWIDTH, K, KMAX, LH, LW, MTYPES, N,
+     $                   NERRS, NMATS, NMAX, NTEST, NTESTT
+      DOUBLE PRECISION   ANINV, ANORM, COND, OVFL, RTOVFL, RTUNFL,
+     $                   TEMP1, TEMP2, TEMP3, TEMP4, ULP, ULPINV, UNFL
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ),
+     $                   KMODE( MAXTYP ), KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           DLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLASUM, XERBLA, ZHBT21, ZHBTRD, ZLACPY, ZLASET,
+     $                   ZLATMR, ZLATMS, ZHBTRD_HB2ST, ZSTEQR
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, DCONJG, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0 /
+*     ..
+*     .. Executable Statements ..
+*
+*     Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+*     Important constants
+*
+      BADNN = .FALSE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+      BADNNB = .FALSE.
+      KMAX = 0
+      DO 20 J = 1, NSIZES
+         KMAX = MAX( KMAX, KK( J ) )
+         IF( KK( J ).LT.0 )
+     $      BADNNB = .TRUE.
+   20 CONTINUE
+      KMAX = MIN( NMAX-1, KMAX )
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NWDTHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( BADNNB ) THEN
+         INFO = -4
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( LDA.LT.KMAX+1 ) THEN
+         INFO = -11
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -15
+      ELSE IF( ( MAX( LDA, NMAX )+1 )*NMAX.GT.LWORK ) THEN
+         INFO = -17
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZCHKHBSTG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 .OR. NWDTHS.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = DLAMCH( 'Safe minimum' )
+      OVFL = ONE / UNFL
+      ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      NERRS = 0
+      NMATS = 0
+*
+      DO 190 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         ANINV = ONE / DBLE( MAX( 1, N ) )
+*
+         DO 180 JWIDTH = 1, NWDTHS
+            K = KK( JWIDTH )
+            IF( K.GT.N )
+     $         GO TO 180
+            K = MAX( 0, MIN( N-1, K ) )
+*
+            IF( NSIZES.NE.1 ) THEN
+               MTYPES = MIN( MAXTYP, NTYPES )
+            ELSE
+               MTYPES = MIN( MAXTYP+1, NTYPES )
+            END IF
+*
+            DO 170 JTYPE = 1, MTYPES
+               IF( .NOT.DOTYPE( JTYPE ) )
+     $            GO TO 170
+               NMATS = NMATS + 1
+               NTEST = 0
+*
+               DO 30 J = 1, 4
+                  IOLDSD( J ) = ISEED( J )
+   30          CONTINUE
+*
+*              Compute "A".
+*              Store as "Upper"; later, we will copy to other format.
+*
+*              Control parameters:
+*
+*                  KMAGN  KMODE        KTYPE
+*              =1  O(1)   clustered 1  zero
+*              =2  large  clustered 2  identity
+*              =3  small  exponential  (none)
+*              =4         arithmetic   diagonal, (w/ eigenvalues)
+*              =5         random log   hermitian, w/ eigenvalues
+*              =6         random       (none)
+*              =7                      random diagonal
+*              =8                      random hermitian
+*              =9                      positive definite
+*              =10                     diagonally dominant tridiagonal
+*
+               IF( MTYPES.GT.MAXTYP )
+     $            GO TO 100
+*
+               ITYPE = KTYPE( JTYPE )
+               IMODE = KMODE( JTYPE )
+*
+*              Compute norm
+*
+               GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40          CONTINUE
+               ANORM = ONE
+               GO TO 70
+*
+   50          CONTINUE
+               ANORM = ( RTOVFL*ULP )*ANINV
+               GO TO 70
+*
+   60          CONTINUE
+               ANORM = RTUNFL*N*ULPINV
+               GO TO 70
+*
+   70          CONTINUE
+*
+               CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+               IINFO = 0
+               IF( JTYPE.LE.15 ) THEN
+                  COND = ULPINV
+               ELSE
+                  COND = ULPINV*ANINV / TEN
+               END IF
+*
+*              Special Matrices -- Identity & Jordan block
+*
+*                 Zero
+*
+               IF( ITYPE.EQ.1 ) THEN
+                  IINFO = 0
+*
+               ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*                 Identity
+*
+                  DO 80 JCOL = 1, N
+                     A( K+1, JCOL ) = ANORM
+   80             CONTINUE
+*
+               ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*                 Diagonal Matrix, [Eigen]values Specified
+*
+                  CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE,
+     $                         COND, ANORM, 0, 0, 'Q', A( K+1, 1 ), LDA,
+     $                         WORK, IINFO )
+*
+               ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*                 Hermitian, eigenvalues specified
+*
+                  CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE,
+     $                         COND, ANORM, K, K, 'Q', A, LDA, WORK,
+     $                         IINFO )
+*
+               ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*                 Diagonal, random eigenvalues
+*
+                  CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE,
+     $                         CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
+     $                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                         ZERO, ANORM, 'Q', A( K+1, 1 ), LDA,
+     $                         IDUMMA, IINFO )
+*
+               ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*                 Hermitian, random eigenvalues
+*
+                  CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE,
+     $                         CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
+     $                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, K, K,
+     $                         ZERO, ANORM, 'Q', A, LDA, IDUMMA, IINFO )
+*
+               ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*                 Positive definite, eigenvalues specified.
+*
+                  CALL ZLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE,
+     $                         COND, ANORM, K, K, 'Q', A, LDA,
+     $                         WORK( N+1 ), IINFO )
+*
+               ELSE IF( ITYPE.EQ.10 ) THEN
+*
+*                 Positive definite tridiagonal, eigenvalues specified.
+*
+                  IF( N.GT.1 )
+     $               K = MAX( 1, K )
+                  CALL ZLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE,
+     $                         COND, ANORM, 1, 1, 'Q', A( K, 1 ), LDA,
+     $                         WORK, IINFO )
+                  DO 90 I = 2, N
+                     TEMP1 = ABS( A( K, I ) ) /
+     $                       SQRT( ABS( A( K+1, I-1 )*A( K+1, I ) ) )
+                     IF( TEMP1.GT.HALF ) THEN
+                        A( K, I ) = HALF*SQRT( ABS( A( K+1,
+     $                              I-1 )*A( K+1, I ) ) )
+                     END IF
+   90             CONTINUE
+*
+               ELSE
+*
+                  IINFO = 1
+               END IF
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  RETURN
+               END IF
+*
+  100          CONTINUE
+*
+*              Call ZHBTRD to compute S and U from upper triangle.
+*
+               CALL ZLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
+*
+               NTEST = 1
+               CALL ZHBTRD( 'V', 'U', N, K, WORK, LDA, SD, SE, U, LDU,
+     $                      WORK( LDA*N+1 ), IINFO )
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHBTRD(U)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 1 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Do tests 1 and 2
+*
+               CALL ZHBT21( 'Upper', N, K, 1, A, LDA, SD, SE, U, LDU,
+     $                      WORK, RWORK, RESULT( 1 ) )
+*
+*              Before converting A into lower for DSBTRD, run DSYTRD_SB2ST 
+*              otherwise matrix A will be converted to lower and then need
+*              to be converted back to upper in order to run the upper case 
+*              ofDSYTRD_SB2ST
+*            
+*              Compute D1 the eigenvalues resulting from the tridiagonal
+*              form using the DSBTRD and used as reference to compare
+*              with the DSYTRD_SB2ST routine
+*            
+*              Compute D1 from the DSBTRD and used as reference for the
+*              DSYTRD_SB2ST
+*            
+               CALL DCOPY( N, SD, 1, D1, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+               CALL ZSTEQR( 'N', N, D1, RWORK, WORK, LDU,
+     $                      RWORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 5 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*            
+*              DSYTRD_SB2ST Upper case is used to compute D2.
+*              Note to set SD and SE to zero to be sure not reusing 
+*              the one from above. Compare it with D1 computed 
+*              using the DSBTRD.
+*            
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+               CALL ZLACPY( ' ', K+1, N, A, LDA, U, LDU )
+               LH = MAX(1, 4*N)
+               LW = LWORK - LH
+               CALL ZHETRD_HB2ST( 'N', 'N', "U", N, K, U, LDU, SD, SE, 
+     $                      WORK, LH, WORK( LH+1 ), LW, IINFO )
+*            
+*              Compute D2 from the DSYTRD_SB2ST Upper case
+*            
+               CALL DCOPY( N, SD, 1, D2, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*            
+               CALL ZSTEQR( 'N', N, D2, RWORK, WORK, LDU,
+     $                      RWORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 5 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Convert A from Upper-Triangle-Only storage to
+*              Lower-Triangle-Only storage.
+*
+               DO 120 JC = 1, N
+                  DO 110 JR = 0, MIN( K, N-JC )
+                     A( JR+1, JC ) = DCONJG( A( K+1-JR, JC+JR ) )
+  110             CONTINUE
+  120          CONTINUE
+               DO 140 JC = N + 1 - K, N
+                  DO 130 JR = MIN( K, N-JC ) + 1, K
+                     A( JR+1, JC ) = ZERO
+  130             CONTINUE
+  140          CONTINUE
+*
+*              Call ZHBTRD to compute S and U from lower triangle
+*
+               CALL ZLACPY( ' ', K+1, N, A, LDA, WORK, LDA )
+*
+               NTEST = 3
+               CALL ZHBTRD( 'V', 'L', N, K, WORK, LDA, SD, SE, U, LDU,
+     $                      WORK( LDA*N+1 ), IINFO )
+*
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHBTRD(L)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 3 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+               NTEST = 4
+*
+*              Do tests 3 and 4
+*
+               CALL ZHBT21( 'Lower', N, K, 1, A, LDA, SD, SE, U, LDU,
+     $                      WORK, RWORK, RESULT( 3 ) )
+*
+*              DSYTRD_SB2ST Lower case is used to compute D3.
+*              Note to set SD and SE to zero to be sure not reusing 
+*              the one from above. Compare it with D1 computed 
+*              using the DSBTRD. 
+*           
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+               CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+               CALL ZLACPY( ' ', K+1, N, A, LDA, U, LDU )
+               LH = MAX(1, 4*N)
+               LW = LWORK - LH
+               CALL ZHETRD_HB2ST( 'N', 'N', "L", N, K, U, LDU, SD, SE, 
+     $                      WORK, LH, WORK( LH+1 ), LW, IINFO )
+*           
+*              Compute D3 from the 2-stage Upper case
+*           
+               CALL DCOPY( N, SD, 1, D3, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*           
+               CALL ZSTEQR( 'N', N, D3, RWORK, WORK, LDU,
+     $                      RWORK( N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZSTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 6 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*           
+*           
+*              Do Tests 3 and 4 which are similar to 11 and 12 but with the
+*              D1 computed using the standard 1-stage reduction as reference
+*           
+               NTEST = 6
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               TEMP3 = ZERO
+               TEMP4 = ZERO
+*           
+               DO 151 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+                  TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  151          CONTINUE
+*           
+               RESULT(5) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+               RESULT(6) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*              End of Loop -- Check for RESULT(j) > THRESH
+*
+  150          CONTINUE
+               NTESTT = NTESTT + NTEST
+*
+*              Print out tests which fail.
+*
+               DO 160 JR = 1, NTEST
+                  IF( RESULT( JR ).GE.THRESH ) THEN
+*
+*                    If this is the first test to fail,
+*                    print a header to the data file.
+*
+                     IF( NERRS.EQ.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9998 )'ZHB'
+                        WRITE( NOUNIT, FMT = 9997 )
+                        WRITE( NOUNIT, FMT = 9996 )
+                        WRITE( NOUNIT, FMT = 9995 )'Hermitian'
+                        WRITE( NOUNIT, FMT = 9994 )'unitary', '*',
+     $                     'conjugate transpose', ( '*', J = 1, 6 )
+                     END IF
+                     NERRS = NERRS + 1
+                     WRITE( NOUNIT, FMT = 9993 )N, K, IOLDSD, JTYPE,
+     $                  JR, RESULT( JR )
+                  END IF
+  160          CONTINUE
+*
+  170       CONTINUE
+  180    CONTINUE
+  190 CONTINUE
+*
+*     Summary
+*
+      CALL DLASUM( 'ZHB', NOUNIT, NERRS, NTESTT )
+      RETURN
+*
+ 9999 FORMAT( ' ZCHKHBSTG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
+     $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+ 9998 FORMAT( / 1X, A3,
+     $     ' -- Complex Hermitian Banded Tridiagonal Reduction Routines'
+     $       )
+ 9997 FORMAT( ' Matrix types (see DCHK23 for details): ' )
+*
+ 9996 FORMAT( / ' Special Matrices:',
+     $      / '  1=Zero matrix.                        ',
+     $      '  5=Diagonal: clustered entries.',
+     $      / '  2=Identity matrix.                    ',
+     $      '  6=Diagonal: large, evenly spaced.',
+     $      / '  3=Diagonal: evenly spaced entries.    ',
+     $      '  7=Diagonal: small, evenly spaced.',
+     $      / '  4=Diagonal: geometr. spaced entries.' )
+ 9995 FORMAT( ' Dense ', A, ' Banded Matrices:',
+     $      / '  8=Evenly spaced eigenvals.            ',
+     $      ' 12=Small, evenly spaced eigenvals.',
+     $      / '  9=Geometrically spaced eigenvals.     ',
+     $      ' 13=Matrix with random O(1) entries.',
+     $      / ' 10=Clustered eigenvalues.              ',
+     $      ' 14=Matrix with large random entries.',
+     $      / ' 11=Large, evenly spaced eigenvals.     ',
+     $      ' 15=Matrix with small random entries.' )
+*
+ 9994 FORMAT( / ' Tests performed:   (S is Tridiag,  U is ', A, ',',
+     $      / 20X, A, ' means ', A, '.', / ' UPLO=''U'':',
+     $      / '  1= | A - U S U', A1, ' | / ( |A| n ulp )     ',
+     $      '  2= | I - U U', A1, ' | / ( n ulp )', / ' UPLO=''L'':',
+     $      / '  3= | A - U S U', A1, ' | / ( |A| n ulp )     ',
+     $      '  4= | I - U U', A1, ' | / ( n ulp )' / ' Eig check:',
+     $      /'  5= | D1 - D2', '', ' | / ( |D1| ulp )         ',
+     $      '  6= | D1 - D3', '', ' | / ( |D1| ulp )          ' )
+ 9993 FORMAT( ' N=', I5, ', K=', I4, ', seed=', 4( I4, ',' ), ' type ',
+     $      I2, ', test(', I2, ')=', G10.3 )
+*
+*     End of ZCHKHBSTG
+*
+      END
diff --git a/TESTING/EIG/zchkst2stg.f b/TESTING/EIG/zchkst2stg.f
new file mode 100644
index 00000000..d93191a6
--- /dev/null
+++ b/TESTING/EIG/zchkst2stg.f
@@ -0,0 +1,2093 @@
+*> \brief \b ZCHKST2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                          NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5,
+*                          WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK,
+*                          LWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT,
+*                          INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
+*      $                   NSIZES, NTYPES
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       DOUBLE PRECISION   D1( * ), D2( * ), D3( * ), D4( * ), D5( * ),
+*      $                   RESULT( * ), RWORK( * ), SD( * ), SE( * ),
+*      $                   WA1( * ), WA2( * ), WA3( * ), WR( * )
+*       COMPLEX*16         A( LDA, * ), AP( * ), TAU( * ), U( LDU, * ),
+*      $                   V( LDU, * ), VP( * ), WORK( * ), Z( LDU, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZCHKST2STG  checks the Hermitian eigenvalue problem routines
+*> using the 2-stage reduction techniques. Since the generation
+*> of Q or the vectors is not available in this release, we only 
+*> compare the eigenvalue resulting when using the 2-stage to the 
+*> one considered as reference using the standard 1-stage reduction
+*> ZHETRD. For that, we call the standard ZHETRD and compute D1 using 
+*> DSTEQR, then we call the 2-stage ZHETRD_2STAGE with Upper and Lower
+*> and we compute D2 and D3 using DSTEQR and then we replaced tests
+*> 3 and 4 by tests 11 and 12. test 1 and 2 remain to verify that 
+*> the 1-stage results are OK and can be trusted.
+*> This testing routine will converge to the ZCHKST in the next 
+*> release when vectors and generation of Q will be implemented.
+*>
+*>    ZHETRD factors A as  U S U* , where * means conjugate transpose,
+*>    S is real symmetric tridiagonal, and U is unitary.
+*>    ZHETRD can use either just the lower or just the upper triangle
+*>    of A; ZCHKST2STG checks both cases.
+*>    U is represented as a product of Householder
+*>    transformations, whose vectors are stored in the first
+*>    n-1 columns of V, and whose scale factors are in TAU.
+*>
+*>    ZHPTRD does the same as ZHETRD, except that A and V are stored
+*>    in "packed" format.
+*>
+*>    ZUNGTR constructs the matrix U from the contents of V and TAU.
+*>
+*>    ZUPGTR constructs the matrix U from the contents of VP and TAU.
+*>
+*>    ZSTEQR factors S as  Z D1 Z* , where Z is the unitary
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal.  D2 is the matrix of
+*>    eigenvalues computed when Z is not computed.
+*>
+*>    DSTERF computes D3, the matrix of eigenvalues, by the
+*>    PWK method, which does not yield eigenvectors.
+*>
+*>    ZPTEQR factors S as  Z4 D4 Z4* , for a
+*>    Hermitian positive definite tridiagonal matrix.
+*>    D5 is the matrix of eigenvalues computed when Z is not
+*>    computed.
+*>
+*>    DSTEBZ computes selected eigenvalues.  WA1, WA2, and
+*>    WA3 will denote eigenvalues computed to high
+*>    absolute accuracy, with different range options.
+*>    WR will denote eigenvalues computed to high relative
+*>    accuracy.
+*>
+*>    ZSTEIN computes Y, the eigenvectors of S, given the
+*>    eigenvalues.
+*>
+*>    ZSTEDC factors S as Z D1 Z* , where Z is the unitary
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal ('I' option). It may also
+*>    update an input unitary matrix, usually the output
+*>    from ZHETRD/ZUNGTR or ZHPTRD/ZUPGTR ('V' option). It may
+*>    also just compute eigenvalues ('N' option).
+*>
+*>    ZSTEMR factors S as Z D1 Z* , where Z is the unitary
+*>    matrix of eigenvectors and D1 is a diagonal matrix with
+*>    the eigenvalues on the diagonal ('I' option).  ZSTEMR
+*>    uses the Relatively Robust Representation whenever possible.
+*>
+*> When ZCHKST2STG is called, a number of matrix "sizes" ("n's") and a
+*> number of matrix "types" are specified.  For each size ("n")
+*> and each type of matrix, one matrix will be generated and used
+*> to test the Hermitian eigenroutines.  For each matrix, a number
+*> of tests will be performed:
+*>
+*> (1)     | A - V S V* | / ( |A| n ulp ) ZHETRD( UPLO='U', ... )
+*>
+*> (2)     | I - UV* | / ( n ulp )        ZUNGTR( UPLO='U', ... )
+*>
+*> (3)     | A - V S V* | / ( |A| n ulp ) ZHETRD( UPLO='L', ... )
+*>         replaced by | D1 - D2 | / ( |D1| ulp ) where D1 is the 
+*>         eigenvalue matrix computed using S and D2 is the 
+*>         eigenvalue matrix computed using S_2stage the output of
+*>         ZHETRD_2STAGE("N", "U",....). D1 and D2 are computed 
+*>         via DSTEQR('N',...) 
+*>
+*> (4)     | I - UV* | / ( n ulp )        ZUNGTR( UPLO='L', ... )
+*>         replaced by | D1 - D3 | / ( |D1| ulp ) where D1 is the 
+*>         eigenvalue matrix computed using S and D3 is the 
+*>         eigenvalue matrix computed using S_2stage the output of
+*>         ZHETRD_2STAGE("N", "L",....). D1 and D3 are computed 
+*>         via DSTEQR('N',...)  
+*>
+*> (5-8)   Same as 1-4, but for ZHPTRD and ZUPGTR.
+*>
+*> (9)     | S - Z D Z* | / ( |S| n ulp ) ZSTEQR('V',...)
+*>
+*> (10)    | I - ZZ* | / ( n ulp )        ZSTEQR('V',...)
+*>
+*> (11)    | D1 - D2 | / ( |D1| ulp )        ZSTEQR('N',...)
+*>
+*> (12)    | D1 - D3 | / ( |D1| ulp )        DSTERF
+*>
+*> (13)    0 if the true eigenvalues (computed by sturm count)
+*>         of S are within THRESH of
+*>         those in D1.  2*THRESH if they are not.  (Tested using
+*>         DSTECH)
+*>
+*> For S positive definite,
+*>
+*> (14)    | S - Z4 D4 Z4* | / ( |S| n ulp ) ZPTEQR('V',...)
+*>
+*> (15)    | I - Z4 Z4* | / ( n ulp )        ZPTEQR('V',...)
+*>
+*> (16)    | D4 - D5 | / ( 100 |D4| ulp )       ZPTEQR('N',...)
+*>
+*> When S is also diagonally dominant by the factor gamma < 1,
+*>
+*> (17)    max | D4(i) - WR(i) | / ( |D4(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              DSTEBZ( 'A', 'E', ...)
+*>
+*> (18)    | WA1 - D3 | / ( |D3| ulp )          DSTEBZ( 'A', 'E', ...)
+*>
+*> (19)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>                                              DSTEBZ( 'I', 'E', ...)
+*>
+*> (20)    | S - Y WA1 Y* | / ( |S| n ulp )  DSTEBZ, ZSTEIN
+*>
+*> (21)    | I - Y Y* | / ( n ulp )          DSTEBZ, ZSTEIN
+*>
+*> (22)    | S - Z D Z* | / ( |S| n ulp )    ZSTEDC('I')
+*>
+*> (23)    | I - ZZ* | / ( n ulp )           ZSTEDC('I')
+*>
+*> (24)    | S - Z D Z* | / ( |S| n ulp )    ZSTEDC('V')
+*>
+*> (25)    | I - ZZ* | / ( n ulp )           ZSTEDC('V')
+*>
+*> (26)    | D1 - D2 | / ( |D1| ulp )           ZSTEDC('V') and
+*>                                              ZSTEDC('N')
+*>
+*> Test 27 is disabled at the moment because ZSTEMR does not
+*> guarantee high relatvie accuracy.
+*>
+*> (27)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              ZSTEMR('V', 'A')
+*>
+*> (28)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
+*>          i
+*>         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
+*>                                              ZSTEMR('V', 'I')
+*>
+*> Tests 29 through 34 are disable at present because ZSTEMR
+*> does not handle partial specturm requests.
+*>
+*> (29)    | S - Z D Z* | / ( |S| n ulp )    ZSTEMR('V', 'I')
+*>
+*> (30)    | I - ZZ* | / ( n ulp )           ZSTEMR('V', 'I')
+*>
+*> (31)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         ZSTEMR('N', 'I') vs. CSTEMR('V', 'I')
+*>
+*> (32)    | S - Z D Z* | / ( |S| n ulp )    ZSTEMR('V', 'V')
+*>
+*> (33)    | I - ZZ* | / ( n ulp )           ZSTEMR('V', 'V')
+*>
+*> (34)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         ZSTEMR('N', 'V') vs. CSTEMR('V', 'V')
+*>
+*> (35)    | S - Z D Z* | / ( |S| n ulp )    ZSTEMR('V', 'A')
+*>
+*> (36)    | I - ZZ* | / ( n ulp )           ZSTEMR('V', 'A')
+*>
+*> (37)    ( max { min | WA2(i)-WA3(j) | } +
+*>            i     j
+*>           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
+*>            i     j
+*>         ZSTEMR('N', 'A') vs. CSTEMR('V', 'A')
+*>
+*> The "sizes" are specified by an array NN(1:NSIZES); the value of
+*> each element NN(j) specifies one size.
+*> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*> Currently, the list of possible types is:
+*>
+*> (1)  The zero matrix.
+*> (2)  The identity matrix.
+*>
+*> (3)  A diagonal matrix with evenly spaced entries
+*>      1, ..., ULP  and random signs.
+*>      (ULP = (first number larger than 1) - 1 )
+*> (4)  A diagonal matrix with geometrically spaced entries
+*>      1, ..., ULP  and random signs.
+*> (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>      and random signs.
+*>
+*> (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*> (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*> (8)  A matrix of the form  U* D U, where U is unitary and
+*>      D has evenly spaced entries 1, ..., ULP with random signs
+*>      on the diagonal.
+*>
+*> (9)  A matrix of the form  U* D U, where U is unitary and
+*>      D has geometrically spaced entries 1, ..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (10) A matrix of the form  U* D U, where U is unitary and
+*>      D has "clustered" entries 1, ULP,..., ULP with random
+*>      signs on the diagonal.
+*>
+*> (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*> (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*> (13) Hermitian matrix with random entries chosen from (-1,1).
+*> (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*> (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*> (16) Same as (8), but diagonal elements are all positive.
+*> (17) Same as (9), but diagonal elements are all positive.
+*> (18) Same as (10), but diagonal elements are all positive.
+*> (19) Same as (16), but multiplied by SQRT( overflow threshold )
+*> (20) Same as (16), but multiplied by SQRT( underflow threshold )
+*> (21) A diagonally dominant tridiagonal matrix with geometrically
+*>      spaced diagonal entries 1, ..., ULP.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] NSIZES
+*> \verbatim
+*>          NSIZES is INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          ZCHKST2STG does nothing.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*> \endverbatim
+*>
+*> \param[in] NTYPES
+*> \verbatim
+*>          NTYPES is INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, ZCHKST2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*> \endverbatim
+*>
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*> \endverbatim
+*>
+*> \param[in,out] ISEED
+*> \verbatim
+*>          ISEED is INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to ZCHKST2STG to continue the same random number
+*>          sequence.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is DOUBLE PRECISION
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] NOUNIT
+*> \verbatim
+*>          NOUNIT is INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array of
+*>                                  dimension ( LDA , max(NN) )
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of A.  It must be at
+*>          least 1 and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] AP
+*> \verbatim
+*>          AP is COMPLEX*16 array of
+*>                      dimension( max(NN)*max(NN+1)/2 )
+*>          The matrix A stored in packed format.
+*> \endverbatim
+*>
+*> \param[out] SD
+*> \verbatim
+*>          SD is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The diagonal of the tridiagonal matrix computed by ZHETRD.
+*>          On exit, SD and SE contain the tridiagonal form of the
+*>          matrix in A.
+*> \endverbatim
+*>
+*> \param[out] SE
+*> \verbatim
+*>          SE is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The off-diagonal of the tridiagonal matrix computed by
+*>          ZHETRD.  On exit, SD and SE contain the tridiagonal form of
+*>          the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D1
+*> \verbatim
+*>          D1 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by ZSTEQR simlutaneously
+*>          with Z.  On exit, the eigenvalues in D1 correspond with the
+*>          matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D2
+*> \verbatim
+*>          D2 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by ZSTEQR if Z is not
+*>          computed.  On exit, the eigenvalues in D2 correspond with
+*>          the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D3
+*> \verbatim
+*>          D3 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by DSTERF.  On exit, the
+*>          eigenvalues in D3 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D4
+*> \verbatim
+*>          D4 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by ZPTEQR(V).
+*>          ZPTEQR factors S as  Z4 D4 Z4*
+*>          On exit, the eigenvalues in D4 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] D5
+*> \verbatim
+*>          D5 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          The eigenvalues of A, as computed by ZPTEQR(N)
+*>          when Z is not computed. On exit, the
+*>          eigenvalues in D4 correspond with the matrix in A.
+*> \endverbatim
+*>
+*> \param[out] WA1
+*> \verbatim
+*>          WA1 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          All eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by DSTEBZ.
+*> \endverbatim
+*>
+*> \param[out] WA2
+*> \verbatim
+*>          WA2 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          Selected eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by DSTEBZ.
+*>          Choose random values for IL and IU, and ask for the
+*>          IL-th through IU-th eigenvalues.
+*> \endverbatim
+*>
+*> \param[out] WA3
+*> \verbatim
+*>          WA3 is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          Selected eigenvalues of A, computed to high
+*>          absolute accuracy, with different range options.
+*>          as computed by DSTEBZ.
+*>          Determine the values VL and VU of the IL-th and IU-th
+*>          eigenvalues and ask for all eigenvalues in this range.
+*> \endverbatim
+*>
+*> \param[out] WR
+*> \verbatim
+*>          WR is DOUBLE PRECISION array of
+*>                             dimension( max(NN) )
+*>          All eigenvalues of A, computed to high
+*>          absolute accuracy, with different options.
+*>          as computed by DSTEBZ.
+*> \endverbatim
+*>
+*> \param[out] U
+*> \verbatim
+*>          U is COMPLEX*16 array of
+*>                             dimension( LDU, max(NN) ).
+*>          The unitary matrix computed by ZHETRD + ZUNGTR.
+*> \endverbatim
+*>
+*> \param[in] LDU
+*> \verbatim
+*>          LDU is INTEGER
+*>          The leading dimension of U, Z, and V.  It must be at least 1
+*>          and at least max( NN ).
+*> \endverbatim
+*>
+*> \param[out] V
+*> \verbatim
+*>          V is COMPLEX*16 array of
+*>                             dimension( LDU, max(NN) ).
+*>          The Housholder vectors computed by ZHETRD in reducing A to
+*>          tridiagonal form.  The vectors computed with UPLO='U' are
+*>          in the upper triangle, and the vectors computed with UPLO='L'
+*>          are in the lower triangle.  (As described in ZHETRD, the
+*>          sub- and superdiagonal are not set to 1, although the
+*>          true Householder vector has a 1 in that position.  The
+*>          routines that use V, such as ZUNGTR, set those entries to
+*>          1 before using them, and then restore them later.)
+*> \endverbatim
+*>
+*> \param[out] VP
+*> \verbatim
+*>          VP is COMPLEX*16 array of
+*>                      dimension( max(NN)*max(NN+1)/2 )
+*>          The matrix V stored in packed format.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is COMPLEX*16 array of
+*>                             dimension( max(NN) )
+*>          The Householder factors computed by ZHETRD in reducing A
+*>          to tridiagonal form.
+*> \endverbatim
+*>
+*> \param[out] Z
+*> \verbatim
+*>          Z is COMPLEX*16 array of
+*>                             dimension( LDU, max(NN) ).
+*>          The unitary matrix of eigenvectors computed by ZSTEQR,
+*>          ZPTEQR, and ZSTEIN.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array of
+*>                      dimension( LWORK )
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 3 * Nmax**2
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array,
+*>          Workspace.
+*> \endverbatim
+*>
+*> \param[out] LIWORK
+*> \verbatim
+*>          LIWORK is INTEGER
+*>          The number of entries in IWORK.  This must be at least
+*>                  6 + 6*Nmax + 5 * Nmax * lg Nmax
+*>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array
+*> \endverbatim
+*>
+*> \param[in] LRWORK
+*> \verbatim
+*>          LRWORK is INTEGER
+*>          The number of entries in LRWORK (dimension( ??? )
+*> \endverbatim
+*>
+*> \param[out] RESULT
+*> \verbatim
+*>          RESULT is DOUBLE PRECISION array, dimension (26)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -23: LDU < 1 or LDU < NMAX.
+*>          -29: LWORK too small.
+*>          If  ZLATMR, CLATMS, ZHETRD, ZUNGTR, ZSTEQR, DSTERF,
+*>              or ZUNMC2 returns an error code, the
+*>              absolute value of it is returned.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NBLOCK          Blocksize as returned by ENVIR.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far.
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16_eig
+*
+*  =====================================================================
+      SUBROUTINE ZCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                   NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5,
+     $                   WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK,
+     $                   LWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT,
+     $                   INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
+     $                   NSIZES, NTYPES
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      DOUBLE PRECISION   D1( * ), D2( * ), D3( * ), D4( * ), D5( * ),
+     $                   RESULT( * ), RWORK( * ), SD( * ), SE( * ),
+     $                   WA1( * ), WA2( * ), WA3( * ), WR( * )
+      COMPLEX*16         A( LDA, * ), AP( * ), TAU( * ), U( LDU, * ),
+     $                   V( LDU, * ), VP( * ), WORK( * ), Z( LDU, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE, TWO, EIGHT, TEN, HUN
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
+     $                   EIGHT = 8.0D0, TEN = 10.0D0, HUN = 100.0D0 )
+      COMPLEX*16         CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
+      DOUBLE PRECISION   HALF
+      PARAMETER          ( HALF = ONE / TWO )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 21 )
+      LOGICAL            CRANGE
+      PARAMETER          ( CRANGE = .FALSE. )
+      LOGICAL            CREL
+      PARAMETER          ( CREL = .FALSE. )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN, TRYRAC
+      INTEGER            I, IINFO, IL, IMODE, INDE, INDRWK, ITEMP,
+     $                   ITYPE, IU, J, JC, JR, JSIZE, JTYPE, LGN,
+     $                   LIWEDC, LOG2UI, LRWEDC, LWEDC, M, M2, M3,
+     $                   MTYPES, N, NAP, NBLOCK, NERRS, NMATS, NMAX,
+     $                   NSPLIT, NTEST, NTESTT, LH, LW
+      DOUBLE PRECISION   ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, TEMP1, TEMP2, TEMP3, TEMP4, ULP,
+     $                   ULPINV, UNFL, VL, VU
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+      DOUBLE PRECISION   DUMMA( 1 )
+*     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, DLARND, DSXT1
+      EXTERNAL           ILAENV, DLAMCH, DLARND, DSXT1
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DCOPY, DLABAD, DLASUM, DSTEBZ, DSTECH, DSTERF,
+     $                   XERBLA, ZCOPY, ZHET21, ZHETRD, ZHPT21, ZHPTRD,
+     $                   ZLACPY, ZLASET, ZLATMR, ZLATMS, ZPTEQR, ZSTEDC,
+     $                   ZSTEMR, ZSTEIN, ZSTEQR, ZSTT21, ZSTT22, ZUNGTR,
+     $                   ZUPGTR, ZHETRD_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, DCONJG, INT, LOG, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
+     $                   8, 8, 9, 9, 9, 9, 9, 10 /
+      DATA               KMAGN / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 1, 1, 1, 2, 3, 1 /
+      DATA               KMODE / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 4, 3, 1, 4, 4, 3 /
+*     ..
+*     .. Executable Statements ..
+*
+*     Keep ftnchek happy
+      IDUMMA( 1 ) = 1
+*
+*     Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+*     Important constants
+*
+      BADNN = .FALSE.
+      TRYRAC = .TRUE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+      NBLOCK = ILAENV( 1, 'ZHETRD', 'L', NMAX, -1, -1, -1 )
+      NBLOCK = MIN( NMAX, MAX( 1, NBLOCK ) )
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -23
+      ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
+         INFO = -29
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZCHKST2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = DLAMCH( 'Safe minimum' )
+      OVFL = ONE / UNFL
+      CALL DLABAD( UNFL, OVFL )
+      ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) )
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+   20 CONTINUE
+      NERRS = 0
+      NMATS = 0
+*
+      DO 310 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         IF( N.GT.0 ) THEN
+            LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) )
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2
+            LRWEDC = 1 + 3*N + 2*N*LGN + 4*N**2
+            LIWEDC = 6 + 6*N + 5*N*LGN
+         ELSE
+            LWEDC = 8
+            LRWEDC = 7
+            LIWEDC = 12
+         END IF
+         NAP = ( N*( N+1 ) ) / 2
+         ANINV = ONE / DBLE( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         DO 300 JTYPE = 1, MTYPES
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 300
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           Compute "A"
+*
+*           Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, (w/ eigenvalues)
+*           =5         random log   Hermitian, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random Hermitian
+*           =9                      positive definite
+*           =10                     diagonally dominant tridiagonal
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 100
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+            IINFO = 0
+            IF( JTYPE.LE.15 ) THEN
+               COND = ULPINV
+            ELSE
+               COND = ULPINV*ANINV / TEN
+            END IF
+*
+*           Special Matrices -- Identity & Jordan block
+*
+*              Zero
+*
+            IF( ITYPE.EQ.1 ) THEN
+               IINFO = 0
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               DO 80 JC = 1, N
+                  A( JC, JC ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
+*
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              Hermitian, eigenvalues specified
+*
+               CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              Hermitian, random eigenvalues
+*
+               CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              Positive definite, eigenvalues specified.
+*
+               CALL ZLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.10 ) THEN
+*
+*              Positive definite tridiagonal, eigenvalues specified.
+*
+               CALL ZLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE, COND,
+     $                      ANORM, 1, 1, 'N', A, LDA, WORK, IINFO )
+               DO 90 I = 2, N
+                  TEMP1 = ABS( A( I-1, I ) )
+                  TEMP2 = SQRT( ABS( A( I-1, I-1 )*A( I, I ) ) )
+                  IF( TEMP1.GT.HALF*TEMP2 ) THEN
+                     A( I-1, I ) = A( I-1, I )*
+     $                             ( HALF*TEMP2 / ( UNFL+TEMP1 ) )
+                     A( I, I-1 ) = DCONJG( A( I-1, I ) )
+                  END IF
+   90          CONTINUE
+*
+            ELSE
+*
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+  100       CONTINUE
+*
+*           Call ZHETRD and ZUNGTR to compute S and U from
+*           upper triangle.
+*
+            CALL ZLACPY( 'U', N, N, A, LDA, V, LDU )
+*
+            NTEST = 1
+            CALL ZHETRD( 'U', N, V, LDU, SD, SE, TAU, WORK, LWORK,
+     $                   IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZHETRD(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 1 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL ZLACPY( 'U', N, N, V, LDU, U, LDU )
+*
+            NTEST = 2
+            CALL ZUNGTR( 'U', N, U, LDU, TAU, WORK, LWORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZUNGTR(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 2 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 1 and 2
+*
+            CALL ZHET21( 2, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
+     $                   LDU, TAU, WORK, RWORK, RESULT( 1 ) )
+            CALL ZHET21( 3, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
+     $                   LDU, TAU, WORK, RWORK, RESULT( 2 ) )
+*
+*           Compute D1 the eigenvalues resulting from the tridiagonal
+*           form using the standard 1-stage algorithm and use it as a
+*           reference to compare with the 2-stage technique
+*
+*           Compute D1 from the 1-stage and used as reference for the
+*           2-stage
+*
+            CALL DCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+            CALL ZSTEQR( 'N', N, D1, RWORK, WORK, LDU, RWORK( N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 3 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           2-STAGE TRD Upper case is used to compute D2.
+*           Note to set SD and SE to zero to be sure not reusing 
+*           the one from above. Compare it with D1 computed 
+*           using the 1-stage.
+*
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+            CALL ZLACPY( 'U', N, N, A, LDA, V, LDU )
+            LH = MAX(1, 4*N)
+            LW = LWORK - LH
+            CALL ZHETRD_2STAGE( 'N', "U", N, V, LDU, SD, SE, TAU, 
+     $                   WORK, LH, WORK( LH+1 ), LW, IINFO )
+*
+*           Compute D2 from the 2-stage Upper case
+*
+            CALL DCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+            NTEST = 3
+            CALL ZSTEQR( 'N', N, D2, RWORK, WORK, LDU, RWORK( N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 3 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           2-STAGE TRD Lower case is used to compute D3.
+*           Note to set SD and SE to zero to be sure not reusing 
+*           the one from above. Compare it with D1 computed 
+*           using the 1-stage. 
+*
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SD, 1 )
+            CALL DLASET( 'Full', N, 1, ZERO, ZERO, SE, 1 )
+            CALL ZLACPY( 'L', N, N, A, LDA, V, LDU )
+            CALL ZHETRD_2STAGE( 'N', "L", N, V, LDU, SD, SE, TAU, 
+     $                   WORK, LH, WORK( LH+1 ), LW, IINFO )
+*
+*           Compute D3 from the 2-stage Upper case
+*
+            CALL DCOPY( N, SD, 1, D3, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+            NTEST = 4
+            CALL ZSTEQR( 'N', N, D3, RWORK, WORK, LDU, RWORK( N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 4 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*
+*           Do Tests 3 and 4 which are similar to 11 and 12 but with the
+*           D1 computed using the standard 1-stage reduction as reference
+*
+            NTEST = 4
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            TEMP3 = ZERO
+            TEMP4 = ZERO
+*
+            DO 151 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+               TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+               TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  151       CONTINUE
+*
+            RESULT( 3 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+            RESULT( 4 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*           Store the upper triangle of A in AP
+*
+            I = 0
+            DO 120 JC = 1, N
+               DO 110 JR = 1, JC
+                  I = I + 1
+                  AP( I ) = A( JR, JC )
+  110          CONTINUE
+  120       CONTINUE
+*
+*           Call ZHPTRD and ZUPGTR to compute S and U from AP
+*
+            CALL ZCOPY( NAP, AP, 1, VP, 1 )
+*
+            NTEST = 5
+            CALL ZHPTRD( 'U', N, VP, SD, SE, TAU, IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZHPTRD(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 5 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            NTEST = 6
+            CALL ZUPGTR( 'U', N, VP, TAU, U, LDU, WORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZUPGTR(U)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 6 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 5 and 6
+*
+            CALL ZHPT21( 2, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RWORK, RESULT( 5 ) )
+            CALL ZHPT21( 3, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RWORK, RESULT( 6 ) )
+*
+*           Store the lower triangle of A in AP
+*
+            I = 0
+            DO 140 JC = 1, N
+               DO 130 JR = JC, N
+                  I = I + 1
+                  AP( I ) = A( JR, JC )
+  130          CONTINUE
+  140       CONTINUE
+*
+*           Call ZHPTRD and ZUPGTR to compute S and U from AP
+*
+            CALL ZCOPY( NAP, AP, 1, VP, 1 )
+*
+            NTEST = 7
+            CALL ZHPTRD( 'L', N, VP, SD, SE, TAU, IINFO )
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZHPTRD(L)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 7 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            NTEST = 8
+            CALL ZUPGTR( 'L', N, VP, TAU, U, LDU, WORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZUPGTR(L)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 8 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL ZHPT21( 2, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RWORK, RESULT( 7 ) )
+            CALL ZHPT21( 3, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
+     $                   WORK, RWORK, RESULT( 8 ) )
+*
+*           Call ZSTEQR to compute D1, D2, and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            CALL DCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+            CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+            NTEST = 9
+            CALL ZSTEQR( 'V', N, D1, RWORK, Z, LDU, RWORK( N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZSTEQR(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 9 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Compute D2
+*
+            CALL DCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+            NTEST = 11
+            CALL ZSTEQR( 'N', N, D2, RWORK, WORK, LDU, RWORK( N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZSTEQR(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 11 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Compute D3 (using PWK method)
+*
+            CALL DCOPY( N, SD, 1, D3, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+            NTEST = 12
+            CALL DSTERF( N, D3, RWORK, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTERF', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 12 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 9 and 10
+*
+            CALL ZSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
+     $                   RESULT( 9 ) )
+*
+*           Do Tests 11 and 12
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            TEMP3 = ZERO
+            TEMP4 = ZERO
+*
+            DO 150 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+               TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
+               TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
+  150       CONTINUE
+*
+            RESULT( 11 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+            RESULT( 12 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
+*
+*           Do Test 13 -- Sturm Sequence Test of Eigenvalues
+*                         Go up by factors of two until it succeeds
+*
+            NTEST = 13
+            TEMP1 = THRESH*( HALF-ULP )
+*
+            DO 160 J = 0, LOG2UI
+               CALL DSTECH( N, SD, SE, D1, TEMP1, RWORK, IINFO )
+               IF( IINFO.EQ.0 )
+     $            GO TO 170
+               TEMP1 = TEMP1*TWO
+  160       CONTINUE
+*
+  170       CONTINUE
+            RESULT( 13 ) = TEMP1
+*
+*           For positive definite matrices ( JTYPE.GT.15 ) call ZPTEQR
+*           and do tests 14, 15, and 16 .
+*
+            IF( JTYPE.GT.15 ) THEN
+*
+*              Compute D4 and Z4
+*
+               CALL DCOPY( N, SD, 1, D4, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+               CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+               NTEST = 14
+               CALL ZPTEQR( 'V', N, D4, RWORK, Z, LDU, RWORK( N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZPTEQR(V)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 14 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do Tests 14 and 15
+*
+               CALL ZSTT21( N, 0, SD, SE, D4, DUMMA, Z, LDU, WORK,
+     $                      RWORK, RESULT( 14 ) )
+*
+*              Compute D5
+*
+               CALL DCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+               NTEST = 16
+               CALL ZPTEQR( 'N', N, D5, RWORK, Z, LDU, RWORK( N+1 ),
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZPTEQR(N)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 16 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do Test 16
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 180 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D4( J ) ), ABS( D5( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D4( J )-D5( J ) ) )
+  180          CONTINUE
+*
+               RESULT( 16 ) = TEMP2 / MAX( UNFL,
+     $                        HUN*ULP*MAX( TEMP1, TEMP2 ) )
+            ELSE
+               RESULT( 14 ) = ZERO
+               RESULT( 15 ) = ZERO
+               RESULT( 16 ) = ZERO
+            END IF
+*
+*           Call DSTEBZ with different options and do tests 17-18.
+*
+*              If S is positive definite and diagonally dominant,
+*              ask for all eigenvalues with high relative accuracy.
+*
+            VL = ZERO
+            VU = ZERO
+            IL = 0
+            IU = 0
+            IF( JTYPE.EQ.21 ) THEN
+               NTEST = 17
+               ABSTOL = UNFL + UNFL
+               CALL DSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                      M, NSPLIT, WR, IWORK( 1 ), IWORK( N+1 ),
+     $                      RWORK, IWORK( 2*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(A,rel)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 17 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*              Do test 17
+*
+               TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
+     $                 ( ONE-HALF )**4
+*
+               TEMP1 = ZERO
+               DO 190 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
+     $                    ( ABSTOL+ABS( D4( J ) ) ) )
+  190          CONTINUE
+*
+               RESULT( 17 ) = TEMP1 / TEMP2
+            ELSE
+               RESULT( 17 ) = ZERO
+            END IF
+*
+*           Now ask for all eigenvalues with high absolute accuracy.
+*
+            NTEST = 18
+            ABSTOL = UNFL + UNFL
+            CALL DSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
+     $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), RWORK,
+     $                   IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(A)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 18 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do test 18
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+            DO 200 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D3( J ) ), ABS( WA1( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D3( J )-WA1( J ) ) )
+  200       CONTINUE
+*
+            RESULT( 18 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*           Choose random values for IL and IU, and ask for the
+*           IL-th through IU-th eigenvalues.
+*
+            NTEST = 19
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+               IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+               IF( IU.LT.IL ) THEN
+                  ITEMP = IU
+                  IU = IL
+                  IL = ITEMP
+               END IF
+            END IF
+*
+            CALL DSTEBZ( 'I', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                   M2, NSPLIT, WA2, IWORK( 1 ), IWORK( N+1 ),
+     $                   RWORK, IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(I)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 19 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Determine the values VL and VU of the IL-th and IU-th
+*           eigenvalues and ask for all eigenvalues in this range.
+*
+            IF( N.GT.0 ) THEN
+               IF( IL.NE.1 ) THEN
+                  VL = WA1( IL ) - MAX( HALF*( WA1( IL )-WA1( IL-1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               ELSE
+                  VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               END IF
+               IF( IU.NE.N ) THEN
+                  VU = WA1( IU ) + MAX( HALF*( WA1( IU+1 )-WA1( IU ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               ELSE
+                  VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
+     $                 ULP*ANORM, TWO*RTUNFL )
+               END IF
+            ELSE
+               VL = ZERO
+               VU = ONE
+            END IF
+*
+            CALL DSTEBZ( 'V', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
+     $                   M3, NSPLIT, WA3, IWORK( 1 ), IWORK( N+1 ),
+     $                   RWORK, IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 19 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            IF( M3.EQ.0 .AND. N.NE.0 ) THEN
+               RESULT( 19 ) = ULPINV
+               GO TO 280
+            END IF
+*
+*           Do test 19
+*
+            TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+            TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+            IF( N.GT.0 ) THEN
+               TEMP3 = MAX( ABS( WA1( N ) ), ABS( WA1( 1 ) ) )
+            ELSE
+               TEMP3 = ZERO
+            END IF
+*
+            RESULT( 19 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
+*
+*           Call ZSTEIN to compute eigenvectors corresponding to
+*           eigenvalues in WA1.  (First call DSTEBZ again, to make sure
+*           it returns these eigenvalues in the correct order.)
+*
+            NTEST = 21
+            CALL DSTEBZ( 'A', 'B', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
+     $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), RWORK,
+     $                   IWORK( 2*N+1 ), IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'DSTEBZ(A,B)', IINFO, N,
+     $            JTYPE, IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 20 ) = ULPINV
+                  RESULT( 21 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+            CALL ZSTEIN( N, SD, SE, M, WA1, IWORK( 1 ), IWORK( N+1 ), Z,
+     $                   LDU, RWORK, IWORK( 2*N+1 ), IWORK( 3*N+1 ),
+     $                   IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZSTEIN', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 20 ) = ULPINV
+                  RESULT( 21 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do tests 20 and 21
+*
+            CALL ZSTT21( N, 0, SD, SE, WA1, DUMMA, Z, LDU, WORK, RWORK,
+     $                   RESULT( 20 ) )
+*
+*           Call ZSTEDC(I) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            INDE = 1
+            INDRWK = INDE + N
+            CALL DCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
+            CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+            NTEST = 22
+            CALL ZSTEDC( 'I', N, D1, RWORK( INDE ), Z, LDU, WORK, LWEDC,
+     $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZSTEDC(I)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 22 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 22 and 23
+*
+            CALL ZSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
+     $                   RESULT( 22 ) )
+*
+*           Call ZSTEDC(V) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+            CALL DCOPY( N, SD, 1, D1, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
+            CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+            NTEST = 24
+            CALL ZSTEDC( 'V', N, D1, RWORK( INDE ), Z, LDU, WORK, LWEDC,
+     $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZSTEDC(V)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 24 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Tests 24 and 25
+*
+            CALL ZSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
+     $                   RESULT( 24 ) )
+*
+*           Call ZSTEDC(N) to compute D2, do tests.
+*
+*           Compute D2
+*
+            CALL DCOPY( N, SD, 1, D2, 1 )
+            IF( N.GT.0 )
+     $         CALL DCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
+            CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+            NTEST = 26
+            CALL ZSTEDC( 'N', N, D2, RWORK( INDE ), Z, LDU, WORK, LWEDC,
+     $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'ZSTEDC(N)', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               IF( IINFO.LT.0 ) THEN
+                  RETURN
+               ELSE
+                  RESULT( 26 ) = ULPINV
+                  GO TO 280
+               END IF
+            END IF
+*
+*           Do Test 26
+*
+            TEMP1 = ZERO
+            TEMP2 = ZERO
+*
+            DO 210 J = 1, N
+               TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+               TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  210       CONTINUE
+*
+            RESULT( 26 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*           Only test ZSTEMR if IEEE compliant
+*
+            IF( ILAENV( 10, 'ZSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 .AND.
+     $          ILAENV( 11, 'ZSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 ) THEN
+*
+*           Call ZSTEMR, do test 27 (relative eigenvalue accuracy)
+*
+*              If S is positive definite and diagonally dominant,
+*              ask for all eigenvalues with high relative accuracy.
+*
+               VL = ZERO
+               VU = ZERO
+               IL = 0
+               IU = 0
+               IF( JTYPE.EQ.21 .AND. CREL ) THEN
+                  NTEST = 27
+                  ABSTOL = UNFL + UNFL
+                  CALL ZSTEMR( 'V', 'A', N, SD, SE, VL, VU, IL, IU,
+     $                         M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         RWORK, LRWORK, IWORK( 2*N+1 ), LWORK-2*N,
+     $                         IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(V,A,rel)',
+     $                  IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 27 ) = ULPINV
+                        GO TO 270
+                     END IF
+                  END IF
+*
+*              Do test 27
+*
+                  TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
+     $                    ( ONE-HALF )**4
+*
+                  TEMP1 = ZERO
+                  DO 220 J = 1, N
+                     TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
+     $                       ( ABSTOL+ABS( D4( J ) ) ) )
+  220             CONTINUE
+*
+                  RESULT( 27 ) = TEMP1 / TEMP2
+*
+                  IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+                  IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+                  IF( IU.LT.IL ) THEN
+                     ITEMP = IU
+                     IU = IL
+                     IL = ITEMP
+                  END IF
+*
+                  IF( CRANGE ) THEN
+                     NTEST = 28
+                     ABSTOL = UNFL + UNFL
+                     CALL ZSTEMR( 'V', 'I', N, SD, SE, VL, VU, IL, IU,
+     $                            M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                            RWORK, LRWORK, IWORK( 2*N+1 ),
+     $                            LWORK-2*N, IINFO )
+*
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(V,I,rel)',
+     $                     IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( 28 ) = ULPINV
+                           GO TO 270
+                        END IF
+                     END IF
+*
+*
+*                 Do test 28
+*
+                     TEMP2 = TWO*( TWO*N-ONE )*ULP*
+     $                       ( ONE+EIGHT*HALF**2 ) / ( ONE-HALF )**4
+*
+                     TEMP1 = ZERO
+                     DO 230 J = IL, IU
+                        TEMP1 = MAX( TEMP1, ABS( WR( J-IL+1 )-D4( N-J+
+     $                          1 ) ) / ( ABSTOL+ABS( WR( J-IL+1 ) ) ) )
+  230                CONTINUE
+*
+                     RESULT( 28 ) = TEMP1 / TEMP2
+                  ELSE
+                     RESULT( 28 ) = ZERO
+                  END IF
+               ELSE
+                  RESULT( 27 ) = ZERO
+                  RESULT( 28 ) = ZERO
+               END IF
+*
+*           Call ZSTEMR(V,I) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+               CALL DCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+               CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+               IF( CRANGE ) THEN
+                  NTEST = 29
+                  IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+                  IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
+                  IF( IU.LT.IL ) THEN
+                     ITEMP = IU
+                     IU = IL
+                     IL = ITEMP
+                  END IF
+                  CALL ZSTEMR( 'V', 'I', N, D5, RWORK, VL, VU, IL, IU,
+     $                         M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(V,I)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 29 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Tests 29 and 30
+*
+*
+*           Call ZSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+                  CALL DCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+                  NTEST = 31
+                  CALL ZSTEMR( 'N', 'I', N, D5, RWORK, VL, VU, IL, IU,
+     $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(N,I)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 31 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Test 31
+*
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+*
+                  DO 240 J = 1, IU - IL + 1
+                     TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
+     $                       ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  240             CONTINUE
+*
+                  RESULT( 31 ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*
+*           Call ZSTEMR(V,V) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+                  CALL DCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+                  CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
+*
+                  NTEST = 32
+*
+                  IF( N.GT.0 ) THEN
+                     IF( IL.NE.1 ) THEN
+                        VL = D2( IL ) - MAX( HALF*
+     $                       ( D2( IL )-D2( IL-1 ) ), ULP*ANORM,
+     $                       TWO*RTUNFL )
+                     ELSE
+                        VL = D2( 1 ) - MAX( HALF*( D2( N )-D2( 1 ) ),
+     $                       ULP*ANORM, TWO*RTUNFL )
+                     END IF
+                     IF( IU.NE.N ) THEN
+                        VU = D2( IU ) + MAX( HALF*
+     $                       ( D2( IU+1 )-D2( IU ) ), ULP*ANORM,
+     $                       TWO*RTUNFL )
+                     ELSE
+                        VU = D2( N ) + MAX( HALF*( D2( N )-D2( 1 ) ),
+     $                       ULP*ANORM, TWO*RTUNFL )
+                     END IF
+                  ELSE
+                     VL = ZERO
+                     VU = ONE
+                  END IF
+*
+                  CALL ZSTEMR( 'V', 'V', N, D5, RWORK, VL, VU, IL, IU,
+     $                         M, D1, Z, LDU, M, IWORK( 1 ), TRYRAC,
+     $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(V,V)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 32 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Tests 32 and 33
+*
+                  CALL ZSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
+     $                         M, RWORK, RESULT( 32 ) )
+*
+*           Call ZSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+                  CALL DCOPY( N, SD, 1, D5, 1 )
+                  IF( N.GT.0 )
+     $               CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+                  NTEST = 34
+                  CALL ZSTEMR( 'N', 'V', N, D5, RWORK, VL, VU, IL, IU,
+     $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                         LIWORK-2*N, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(N,V)', IINFO,
+     $                  N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( 34 ) = ULPINV
+                        GO TO 280
+                     END IF
+                  END IF
+*
+*           Do Test 34
+*
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+*
+                  DO 250 J = 1, IU - IL + 1
+                     TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
+     $                       ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  250             CONTINUE
+*
+                  RESULT( 34 ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+               ELSE
+                  RESULT( 29 ) = ZERO
+                  RESULT( 30 ) = ZERO
+                  RESULT( 31 ) = ZERO
+                  RESULT( 32 ) = ZERO
+                  RESULT( 33 ) = ZERO
+                  RESULT( 34 ) = ZERO
+               END IF
+*
+*
+*           Call ZSTEMR(V,A) to compute D1 and Z, do tests.
+*
+*           Compute D1 and Z
+*
+               CALL DCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+               NTEST = 35
+*
+               CALL ZSTEMR( 'V', 'A', N, D5, RWORK, VL, VU, IL, IU,
+     $                      M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                      RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                      LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(V,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 35 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*           Do Tests 35 and 36
+*
+               CALL ZSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, M,
+     $                      RWORK, RESULT( 35 ) )
+*
+*           Call ZSTEMR to compute D2, do tests.
+*
+*           Compute D2
+*
+               CALL DCOPY( N, SD, 1, D5, 1 )
+               IF( N.GT.0 )
+     $            CALL DCOPY( N-1, SE, 1, RWORK, 1 )
+*
+               NTEST = 37
+               CALL ZSTEMR( 'N', 'A', N, D5, RWORK, VL, VU, IL, IU,
+     $                      M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
+     $                      RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
+     $                      LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZSTEMR(N,A)', IINFO, N,
+     $               JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( 37 ) = ULPINV
+                     GO TO 280
+                  END IF
+               END IF
+*
+*           Do Test 34
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+*
+               DO 260 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
+  260          CONTINUE
+*
+               RESULT( 37 ) = TEMP2 / MAX( UNFL,
+     $                        ULP*MAX( TEMP1, TEMP2 ) )
+            END IF
+  270       CONTINUE
+  280       CONTINUE
+            NTESTT = NTESTT + NTEST
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+*
+*           Print out tests which fail.
+*
+            DO 290 JR = 1, NTEST
+               IF( RESULT( JR ).GE.THRESH ) THEN
+*
+*                 If this is the first test to fail,
+*                 print a header to the data file.
+*
+                  IF( NERRS.EQ.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9998 )'ZST'
+                     WRITE( NOUNIT, FMT = 9997 )
+                     WRITE( NOUNIT, FMT = 9996 )
+                     WRITE( NOUNIT, FMT = 9995 )'Hermitian'
+                     WRITE( NOUNIT, FMT = 9994 )
+*
+*                    Tests performed
+*
+                     WRITE( NOUNIT, FMT = 9987 )
+                  END IF
+                  NERRS = NERRS + 1
+                  IF( RESULT( JR ).LT.10000.0D0 ) THEN
+                     WRITE( NOUNIT, FMT = 9989 )N, JTYPE, IOLDSD, JR,
+     $                  RESULT( JR )
+                  ELSE
+                     WRITE( NOUNIT, FMT = 9988 )N, JTYPE, IOLDSD, JR,
+     $                  RESULT( JR )
+                  END IF
+               END IF
+  290       CONTINUE
+  300    CONTINUE
+  310 CONTINUE
+*
+*     Summary
+*
+      CALL DLASUM( 'ZST', NOUNIT, NERRS, NTESTT )
+      RETURN
+*
+ 9999 FORMAT( ' ZCHKST2STG: ', A, ' returned INFO=', I6, '.', / 9X,
+     $   'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+*
+ 9998 FORMAT( / 1X, A3, ' -- Complex Hermitian eigenvalue problem' )
+ 9997 FORMAT( ' Matrix types (see ZCHKST2STG for details): ' )
+*
+ 9996 FORMAT( / ' Special Matrices:',
+     $      / '  1=Zero matrix.                        ',
+     $      '  5=Diagonal: clustered entries.',
+     $      / '  2=Identity matrix.                    ',
+     $      '  6=Diagonal: large, evenly spaced.',
+     $      / '  3=Diagonal: evenly spaced entries.    ',
+     $      '  7=Diagonal: small, evenly spaced.',
+     $      / '  4=Diagonal: geometr. spaced entries.' )
+ 9995 FORMAT( ' Dense ', A, ' Matrices:',
+     $      / '  8=Evenly spaced eigenvals.            ',
+     $      ' 12=Small, evenly spaced eigenvals.',
+     $      / '  9=Geometrically spaced eigenvals.     ',
+     $      ' 13=Matrix with random O(1) entries.',
+     $      / ' 10=Clustered eigenvalues.              ',
+     $      ' 14=Matrix with large random entries.',
+     $      / ' 11=Large, evenly spaced eigenvals.     ',
+     $      ' 15=Matrix with small random entries.' )
+ 9994 FORMAT( ' 16=Positive definite, evenly spaced eigenvalues',
+     $      / ' 17=Positive definite, geometrically spaced eigenvlaues',
+     $      / ' 18=Positive definite, clustered eigenvalues',
+     $      / ' 19=Positive definite, small evenly spaced eigenvalues',
+     $      / ' 20=Positive definite, large evenly spaced eigenvalues',
+     $      / ' 21=Diagonally dominant tridiagonal, geometrically',
+     $      ' spaced eigenvalues' )
+*
+ 9989 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=',
+     $      4( I4, ',' ), ' result ', I3, ' is', 0P, F8.2 )
+ 9988 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=',
+     $      4( I4, ',' ), ' result ', I3, ' is', 1P, D10.3 )
+*
+ 9987 FORMAT( / 'Test performed:  see ZCHKST2STG for details.', / )
+*     End of ZCHKST2STG
+*
+      END
diff --git a/TESTING/EIG/zdrvsg2stg.f b/TESTING/EIG/zdrvsg2stg.f
new file mode 100644
index 00000000..f2a000c7
--- /dev/null
+++ b/TESTING/EIG/zdrvsg2stg.f
@@ -0,0 +1,1382 @@
+*> \brief \b ZDRVSG2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                              NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
+*                              BB, AP, BP, WORK, NWORK, RWORK, LRWORK,
+*                              IWORK, LIWORK, RESULT, INFO )
+*
+*       IMPLICIT NONE
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
+*      $                   NSIZES, NTYPES, NWORK
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       DOUBLE PRECISION   D( * ), RESULT( * ), RWORK( * )
+*       COMPLEX*16         A( LDA, * ), AB( LDA, * ), AP( * ),
+*      $                   B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ),
+*      $                   Z( LDZ, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>      ZDRVSG2STG checks the complex Hermitian generalized eigenproblem
+*>      drivers.
+*>
+*>              ZHEGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem.
+*>
+*>              ZHEGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem using a divide and conquer algorithm.
+*>
+*>              ZHEGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem.
+*>
+*>              ZHPGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem in packed storage.
+*>
+*>              ZHPGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem in packed storage using a divide and
+*>              conquer algorithm.
+*>
+*>              ZHPGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite generalized
+*>              eigenproblem in packed storage.
+*>
+*>              ZHBGV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite banded
+*>              generalized eigenproblem.
+*>
+*>              ZHBGVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite banded
+*>              generalized eigenproblem using a divide and conquer
+*>              algorithm.
+*>
+*>              ZHBGVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian-definite banded
+*>              generalized eigenproblem.
+*>
+*>      When ZDRVSG2STG is called, a number of matrix "sizes" ("n's") and a
+*>      number of matrix "types" are specified.  For each size ("n")
+*>      and each type of matrix, one matrix A of the given type will be
+*>      generated; a random well-conditioned matrix B is also generated
+*>      and the pair (A,B) is used to test the drivers.
+*>
+*>      For each pair (A,B), the following tests are performed:
+*>
+*>      (1) ZHEGV with ITYPE = 1 and UPLO ='U':
+*>
+*>              | A Z - B Z D | / ( |A| |Z| n ulp )
+*>              | D - D2 | / ( |D| ulp )   where D is computed by
+*>                                         ZHEGV and  D2 is computed by
+*>                                         ZHEGV_2STAGE. This test is
+*>                                         only performed for DSYGV
+*>
+*>      (2) as (1) but calling ZHPGV
+*>      (3) as (1) but calling ZHBGV
+*>      (4) as (1) but with UPLO = 'L'
+*>      (5) as (4) but calling ZHPGV
+*>      (6) as (4) but calling ZHBGV
+*>
+*>      (7) ZHEGV with ITYPE = 2 and UPLO ='U':
+*>
+*>              | A B Z - Z D | / ( |A| |Z| n ulp )
+*>
+*>      (8) as (7) but calling ZHPGV
+*>      (9) as (7) but with UPLO = 'L'
+*>      (10) as (9) but calling ZHPGV
+*>
+*>      (11) ZHEGV with ITYPE = 3 and UPLO ='U':
+*>
+*>              | B A Z - Z D | / ( |A| |Z| n ulp )
+*>
+*>      (12) as (11) but calling ZHPGV
+*>      (13) as (11) but with UPLO = 'L'
+*>      (14) as (13) but calling ZHPGV
+*>
+*>      ZHEGVD, ZHPGVD and ZHBGVD performed the same 14 tests.
+*>
+*>      ZHEGVX, ZHPGVX and ZHBGVX performed the above 14 tests with
+*>      the parameter RANGE = 'A', 'N' and 'I', respectively.
+*>
+*>      The "sizes" are specified by an array NN(1:NSIZES); the value of
+*>      each element NN(j) specifies one size.
+*>      The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*>      if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*>      This type is used for the matrix A which has half-bandwidth KA.
+*>      B is generated as a well-conditioned positive definite matrix
+*>      with half-bandwidth KB (<= KA).
+*>      Currently, the list of possible types for A is:
+*>
+*>      (1)  The zero matrix.
+*>      (2)  The identity matrix.
+*>
+*>      (3)  A diagonal matrix with evenly spaced entries
+*>           1, ..., ULP  and random signs.
+*>           (ULP = (first number larger than 1) - 1 )
+*>      (4)  A diagonal matrix with geometrically spaced entries
+*>           1, ..., ULP  and random signs.
+*>      (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>           and random signs.
+*>
+*>      (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*>      (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*>      (8)  A matrix of the form  U* D U, where U is unitary and
+*>           D has evenly spaced entries 1, ..., ULP with random signs
+*>           on the diagonal.
+*>
+*>      (9)  A matrix of the form  U* D U, where U is unitary and
+*>           D has geometrically spaced entries 1, ..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (10) A matrix of the form  U* D U, where U is unitary and
+*>           D has "clustered" entries 1, ULP,..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*>      (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*>      (13) Hermitian matrix with random entries chosen from (-1,1).
+*>      (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*>      (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*>
+*>      (16) Same as (8), but with KA = 1 and KB = 1
+*>      (17) Same as (8), but with KA = 2 and KB = 1
+*>      (18) Same as (8), but with KA = 2 and KB = 2
+*>      (19) Same as (8), but with KA = 3 and KB = 1
+*>      (20) Same as (8), but with KA = 3 and KB = 2
+*>      (21) Same as (8), but with KA = 3 and KB = 3
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \verbatim
+*>  NSIZES  INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          ZDRVSG2STG does nothing.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NN      INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*>          Not modified.
+*>
+*>  NTYPES  INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, ZDRVSG2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*>          Not modified.
+*>
+*>  DOTYPE  LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*>          Not modified.
+*>
+*>  ISEED   INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to ZDRVSG2STG to continue the same random number
+*>          sequence.
+*>          Modified.
+*>
+*>  THRESH  DOUBLE PRECISION
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NOUNIT  INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*>          Not modified.
+*>
+*>  A       COMPLEX*16 array, dimension (LDA , max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDA     INTEGER
+*>          The leading dimension of A.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  B       COMPLEX*16 array, dimension (LDB , max(NN))
+*>          Used to hold the Hermitian positive definite matrix for
+*>          the generailzed problem.
+*>          On exit, B contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDB     INTEGER
+*>          The leading dimension of B.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  D       DOUBLE PRECISION array, dimension (max(NN))
+*>          The eigenvalues of A. On exit, the eigenvalues in D
+*>          correspond with the matrix in A.
+*>          Modified.
+*>
+*>  Z       COMPLEX*16 array, dimension (LDZ, max(NN))
+*>          The matrix of eigenvectors.
+*>          Modified.
+*>
+*>  LDZ     INTEGER
+*>          The leading dimension of ZZ.  It must be at least 1 and
+*>          at least max( NN ).
+*>          Not modified.
+*>
+*>  AB      COMPLEX*16 array, dimension (LDA, max(NN))
+*>          Workspace.
+*>          Modified.
+*>
+*>  BB      COMPLEX*16 array, dimension (LDB, max(NN))
+*>          Workspace.
+*>          Modified.
+*>
+*>  AP      COMPLEX*16 array, dimension (max(NN)**2)
+*>          Workspace.
+*>          Modified.
+*>
+*>  BP      COMPLEX*16 array, dimension (max(NN)**2)
+*>          Workspace.
+*>          Modified.
+*>
+*>  WORK    COMPLEX*16 array, dimension (NWORK)
+*>          Workspace.
+*>          Modified.
+*>
+*>  NWORK   INTEGER
+*>          The number of entries in WORK.  This must be at least
+*>          2*N + N**2  where  N = max( NN(j), 2 ).
+*>          Not modified.
+*>
+*>  RWORK   DOUBLE PRECISION array, dimension (LRWORK)
+*>          Workspace.
+*>          Modified.
+*>
+*>  LRWORK  INTEGER
+*>          The number of entries in RWORK.  This must be at least
+*>          max( 7*N, 1 + 4*N + 2*N*lg(N) + 3*N**2 ) where
+*>          N = max( NN(j) ) and lg( N ) = smallest integer k such
+*>          that 2**k >= N .
+*>          Not modified.
+*>
+*>  IWORK   INTEGER array, dimension (LIWORK))
+*>          Workspace.
+*>          Modified.
+*>
+*>  LIWORK  INTEGER
+*>          The number of entries in IWORK.  This must be at least
+*>          2 + 5*max( NN(j) ).
+*>          Not modified.
+*>
+*>  RESULT  DOUBLE PRECISION array, dimension (70)
+*>          The values computed by the 70 tests described above.
+*>          Modified.
+*>
+*>  INFO    INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -16: LDZ < 1 or LDZ < NMAX.
+*>          -21: NWORK too small.
+*>          -23: LRWORK too small.
+*>          -25: LIWORK too small.
+*>          If  ZLATMR, CLATMS, ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD,
+*>              ZHPGVD, ZHEGVX, CHPGVX, ZHBGVX returns an error code,
+*>              the absolute value of it is returned.
+*>          Modified.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests that have been run
+*>                       on this matrix.
+*>       NTESTT          The total number of tests for this call.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far (computed by DLAFTS).
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16_eig
+*
+*  =====================================================================
+      SUBROUTINE ZDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                       NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
+     $                       BB, AP, BP, WORK, NWORK, RWORK, LRWORK,
+     $                       IWORK, LIWORK, RESULT, INFO )
+*
+      IMPLICIT NONE
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
+     $                   NSIZES, NTYPES, NWORK
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      DOUBLE PRECISION   D( * ), D2( * ), RESULT( * ), RWORK( * )
+      COMPLEX*16         A( LDA, * ), AB( LDA, * ), AP( * ),
+     $                   B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ),
+     $                   Z( LDZ, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE, TEN
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TEN = 10.0D+0 )
+      COMPLEX*16         CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 21 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN
+      CHARACTER          UPLO
+      INTEGER            I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
+     $                   ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
+     $                   KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
+     $                   NTESTT
+      DOUBLE PRECISION   ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, ULP, ULPINV, UNFL, VL, VU, TEMP1, TEMP2
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      DOUBLE PRECISION   DLAMCH, DLARND
+      EXTERNAL           LSAME, DLAMCH, DLARND
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLABAD, DLAFTS, DLASUM, XERBLA, ZHBGV, ZHBGVD,
+     $                   ZHBGVX, ZHEGV, ZHEGVD, ZHEGVX, ZHPGV, ZHPGVD,
+     $                   ZHPGVX, ZLACPY, ZLASET, ZLATMR, ZLATMS, ZSGT01,
+     $                   ZHEGV_2STAGE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 6*1 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 6*4 /
+*     ..
+*     .. Executable Statements ..
+*
+*     1)      Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+      BADNN = .FALSE.
+      NMAX = 0
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN
+         INFO = -16
+      ELSE IF( 2*MAX( NMAX, 2 )**2.GT.NWORK ) THEN
+         INFO = -21
+      ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LRWORK ) THEN
+         INFO = -23
+      ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LIWORK ) THEN
+         INFO = -25
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZDRVSG2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = DLAMCH( 'Safe minimum' )
+      OVFL = DLAMCH( 'Overflow' )
+      CALL DLABAD( UNFL, OVFL )
+      ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+   20 CONTINUE
+*
+*     Loop over sizes, types
+*
+      NERRS = 0
+      NMATS = 0
+*
+      DO 650 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         ANINV = ONE / DBLE( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         KA9 = 0
+         KB9 = 0
+         DO 640 JTYPE = 1, MTYPES
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 640
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           2)      Compute "A"
+*
+*                   Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, w/ eigenvalues
+*           =5         random log   hermitian, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random hermitian
+*           =9                      banded, w/ eigenvalues
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 90
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            IINFO = 0
+            COND = ULPINV
+*
+*           Special Matrices -- Identity & Jordan block
+*
+            IF( ITYPE.EQ.1 ) THEN
+*
+*              Zero
+*
+               KA = 0
+               KB = 0
+               CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               KA = 0
+               KB = 0
+               CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+               DO 80 JCOL = 1, N
+                  A( JCOL, JCOL ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               KA = 0
+               KB = 0
+               CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              Hermitian, eigenvalues specified
+*
+               KA = MAX( 0, N-1 )
+               KB = KA
+               CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               KA = 0
+               KB = 0
+               CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              Hermitian, random eigenvalues
+*
+               KA = MAX( 0, N-1 )
+               KB = KA
+               CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              Hermitian banded, eigenvalues specified
+*
+*              The following values are used for the half-bandwidths:
+*
+*                ka = 1   kb = 1
+*                ka = 2   kb = 1
+*                ka = 2   kb = 2
+*                ka = 3   kb = 1
+*                ka = 3   kb = 2
+*                ka = 3   kb = 3
+*
+               KB9 = KB9 + 1
+               IF( KB9.GT.KA9 ) THEN
+                  KA9 = KA9 + 1
+                  KB9 = 1
+               END IF
+               KA = MAX( 0, MIN( N-1, KA9 ) )
+               KB = MAX( 0, MIN( N-1, KB9 ) )
+               CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, KA, KA, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE
+*
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+   90       CONTINUE
+*
+            ABSTOL = UNFL + UNFL
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
+               IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
+               IF( IL.GT.IU ) THEN
+                  ITEMP = IL
+                  IL = IU
+                  IU = ITEMP
+               END IF
+            END IF
+*
+*           3) Call ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD, CHBGVD,
+*              ZHEGVX, ZHPGVX and ZHBGVX, do tests.
+*
+*           loop over the three generalized problems
+*                 IBTYPE = 1: A*x = (lambda)*B*x
+*                 IBTYPE = 2: A*B*x = (lambda)*x
+*                 IBTYPE = 3: B*A*x = (lambda)*x
+*
+            DO 630 IBTYPE = 1, 3
+*
+*              loop over the setting UPLO
+*
+               DO 620 IBUPLO = 1, 2
+                  IF( IBUPLO.EQ.1 )
+     $               UPLO = 'U'
+                  IF( IBUPLO.EQ.2 )
+     $               UPLO = 'L'
+*
+*                 Generate random well-conditioned positive definite
+*                 matrix B, of bandwidth not greater than that of A.
+*
+                  CALL ZLATMS( N, N, 'U', ISEED, 'P', RWORK, 5, TEN,
+     $                         ONE, KB, KB, UPLO, B, LDB, WORK( N+1 ),
+     $                         IINFO )
+*
+*                 Test ZHEGV
+*
+                  NTEST = NTEST + 1
+*
+                  CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL ZHEGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
+     $                        WORK, NWORK, RWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZHEGV(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                 Test ZHEGV_2STAGE
+*
+                  NTEST = NTEST + 1
+*
+                  CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL ZHEGV_2STAGE( IBTYPE, 'N', UPLO, N, Z, LDZ,
+     $                               BB, LDB, D2, WORK, NWORK, RWORK, 
+     $                               IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )
+     $                  'ZHEGV_2STAGE(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+C                  CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+C     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*           
+*                 Do Tests | D1 - D2 | / ( |D1| ulp )
+*                 D1 computed using the standard 1-stage reduction as reference
+*                 D2 computed using the 2-stage reduction
+*           
+                  TEMP1 = ZERO
+                  TEMP2 = ZERO
+                  DO 151 J = 1, N
+                     TEMP1 = MAX( TEMP1, ABS( D( J ) ), 
+     $                                   ABS( D2( J ) ) )
+                     TEMP2 = MAX( TEMP2, ABS( D( J )-D2( J ) ) )
+  151             CONTINUE
+*           
+                  RESULT( NTEST ) = TEMP2 / 
+     $                              MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
+*
+*                 Test ZHEGVD
+*
+                  NTEST = NTEST + 1
+*
+                  CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ )
+                  CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL ZHEGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
+     $                         WORK, NWORK, RWORK, LRWORK, IWORK,
+     $                         LIWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZHEGVD(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                 Test ZHEGVX
+*
+                  NTEST = NTEST + 1
+*
+                  CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL ZHEGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
+     $                         IWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,A' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+                  CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+*                 since we do not know the exact eigenvalues of this
+*                 eigenpair, we just set VL and VU as constants.
+*                 It is quite possible that there are no eigenvalues
+*                 in this interval.
+*
+                  VL = ZERO
+                  VU = ANORM
+                  CALL ZHEGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
+     $                         IWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,V,' //
+     $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+                  CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
+                  CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
+*
+                  CALL ZHEGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB,
+     $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
+     $                         LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
+     $                         IWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,I,' //
+     $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+  100             CONTINUE
+*
+*                 Test ZHPGV
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 120 J = 1, N
+                        DO 110 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  110                   CONTINUE
+  120                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 140 J = 1, N
+                        DO 130 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  130                   CONTINUE
+  140                CONTINUE
+                  END IF
+*
+                  CALL ZHPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
+     $                        WORK, RWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZHPGV(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                 Test ZHPGVD
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 160 J = 1, N
+                        DO 150 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  150                   CONTINUE
+  160                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 180 J = 1, N
+                        DO 170 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  170                   CONTINUE
+  180                CONTINUE
+                  END IF
+*
+                  CALL ZHPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
+     $                         WORK, NWORK, RWORK, LRWORK, IWORK,
+     $                         LIWORK, IINFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZHPGVD(V,' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                 Test ZHPGVX
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 200 J = 1, N
+                        DO 190 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  190                   CONTINUE
+  200                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 220 J = 1, N
+                        DO 210 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  210                   CONTINUE
+  220                CONTINUE
+                  END IF
+*
+                  CALL ZHPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         RWORK, IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,A' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 240 J = 1, N
+                        DO 230 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  230                   CONTINUE
+  240                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 260 J = 1, N
+                        DO 250 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  250                   CONTINUE
+  260                CONTINUE
+                  END IF
+*
+                  VL = ZERO
+                  VU = ANORM
+                  CALL ZHPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         RWORK, IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,V' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                  NTEST = NTEST + 1
+*
+*                 Copy the matrices into packed storage.
+*
+                  IF( LSAME( UPLO, 'U' ) ) THEN
+                     IJ = 1
+                     DO 280 J = 1, N
+                        DO 270 I = 1, J
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  270                   CONTINUE
+  280                CONTINUE
+                  ELSE
+                     IJ = 1
+                     DO 300 J = 1, N
+                        DO 290 I = J, N
+                           AP( IJ ) = A( I, J )
+                           BP( IJ ) = B( I, J )
+                           IJ = IJ + 1
+  290                   CONTINUE
+  300                CONTINUE
+                  END IF
+*
+                  CALL ZHPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
+     $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
+     $                         RWORK, IWORK( N+1 ), IWORK, INFO )
+                  IF( IINFO.NE.0 ) THEN
+                     WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,I' // UPLO //
+     $                  ')', IINFO, N, JTYPE, IOLDSD
+                     INFO = ABS( IINFO )
+                     IF( IINFO.LT.0 ) THEN
+                        RETURN
+                     ELSE
+                        RESULT( NTEST ) = ULPINV
+                        GO TO 310
+                     END IF
+                  END IF
+*
+*                 Do Test
+*
+                  CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                         LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+  310             CONTINUE
+*
+                  IF( IBTYPE.EQ.1 ) THEN
+*
+*                    TEST ZHBGV
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 340 J = 1, N
+                           DO 320 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  320                      CONTINUE
+                           DO 330 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  330                      CONTINUE
+  340                   CONTINUE
+                     ELSE
+                        DO 370 J = 1, N
+                           DO 350 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  350                      CONTINUE
+                           DO 360 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  360                      CONTINUE
+  370                   CONTINUE
+                     END IF
+*
+                     CALL ZHBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB,
+     $                           D, Z, LDZ, WORK, RWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'ZHBGV(V,' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                    TEST ZHBGVD
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 400 J = 1, N
+                           DO 380 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  380                      CONTINUE
+                           DO 390 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  390                      CONTINUE
+  400                   CONTINUE
+                     ELSE
+                        DO 430 J = 1, N
+                           DO 410 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  410                      CONTINUE
+                           DO 420 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  420                      CONTINUE
+  430                   CONTINUE
+                     END IF
+*
+                     CALL ZHBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB,
+     $                            LDB, D, Z, LDZ, WORK, NWORK, RWORK,
+     $                            LRWORK, IWORK, LIWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'ZHBGVD(V,' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+*                    Test ZHBGVX
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 460 J = 1, N
+                           DO 440 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  440                      CONTINUE
+                           DO 450 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  450                      CONTINUE
+  460                   CONTINUE
+                     ELSE
+                        DO 490 J = 1, N
+                           DO 470 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  470                      CONTINUE
+                           DO 480 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  480                      CONTINUE
+  490                   CONTINUE
+                     END IF
+*
+                     CALL ZHBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,A' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 520 J = 1, N
+                           DO 500 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  500                      CONTINUE
+                           DO 510 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  510                      CONTINUE
+  520                   CONTINUE
+                     ELSE
+                        DO 550 J = 1, N
+                           DO 530 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  530                      CONTINUE
+                           DO 540 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  540                      CONTINUE
+  550                   CONTINUE
+                     END IF
+*
+                     VL = ZERO
+                     VU = ANORM
+                     CALL ZHBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,V' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                     NTEST = NTEST + 1
+*
+*                    Copy the matrices into band storage.
+*
+                     IF( LSAME( UPLO, 'U' ) ) THEN
+                        DO 580 J = 1, N
+                           DO 560 I = MAX( 1, J-KA ), J
+                              AB( KA+1+I-J, J ) = A( I, J )
+  560                      CONTINUE
+                           DO 570 I = MAX( 1, J-KB ), J
+                              BB( KB+1+I-J, J ) = B( I, J )
+  570                      CONTINUE
+  580                   CONTINUE
+                     ELSE
+                        DO 610 J = 1, N
+                           DO 590 I = J, MIN( N, J+KA )
+                              AB( 1+I-J, J ) = A( I, J )
+  590                      CONTINUE
+                           DO 600 I = J, MIN( N, J+KB )
+                              BB( 1+I-J, J ) = B( I, J )
+  600                      CONTINUE
+  610                   CONTINUE
+                     END IF
+*
+                     CALL ZHBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA,
+     $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
+     $                            IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
+     $                            IWORK( N+1 ), IWORK, IINFO )
+                     IF( IINFO.NE.0 ) THEN
+                        WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,I' //
+     $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
+                        INFO = ABS( IINFO )
+                        IF( IINFO.LT.0 ) THEN
+                           RETURN
+                        ELSE
+                           RESULT( NTEST ) = ULPINV
+                           GO TO 620
+                        END IF
+                     END IF
+*
+*                    Do Test
+*
+                     CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
+     $                            LDZ, D, WORK, RWORK, RESULT( NTEST ) )
+*
+                  END IF
+*
+  620          CONTINUE
+  630       CONTINUE
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+            NTESTT = NTESTT + NTEST
+            CALL DLAFTS( 'ZSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
+     $                   THRESH, NOUNIT, NERRS )
+  640    CONTINUE
+  650 CONTINUE
+*
+*     Summary
+*
+      CALL DLASUM( 'ZSG', NOUNIT, NERRS, NTESTT )
+*
+      RETURN
+*
+ 9999 FORMAT( ' ZDRVSG2STG: ', A, ' returned INFO=', I6, '.', / 9X,
+     $  'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+*
+*     End of ZDRVSG2STG
+*
+      END
diff --git a/TESTING/EIG/zdrvst2stg.f b/TESTING/EIG/zdrvst2stg.f
new file mode 100644
index 00000000..f809d18d
--- /dev/null
+++ b/TESTING/EIG/zdrvst2stg.f
@@ -0,0 +1,2116 @@
+*> \brief \b ZDRVST2STG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+*                          NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U,
+*                          LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK,
+*                          IWORK, LIWORK, RESULT, INFO )
+*
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
+*      $                   NSIZES, NTYPES
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+*       DOUBLE PRECISION   D1( * ), D2( * ), D3( * ), RESULT( * ),
+*      $                   RWORK( * ), WA1( * ), WA2( * ), WA3( * )
+*       COMPLEX*16         A( LDA, * ), TAU( * ), U( LDU, * ),
+*      $                   V( LDU, * ), WORK( * ), Z( LDU, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>      ZDRVST2STG  checks the Hermitian eigenvalue problem drivers.
+*>
+*>              ZHEEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix,
+*>              using a divide-and-conquer algorithm.
+*>
+*>              ZHEEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix.
+*>
+*>              ZHEEVR computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix
+*>              using the Relatively Robust Representation where it can.
+*>
+*>              ZHPEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix in packed
+*>              storage, using a divide-and-conquer algorithm.
+*>
+*>              ZHPEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix in packed
+*>              storage.
+*>
+*>              ZHBEVD computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian band matrix,
+*>              using a divide-and-conquer algorithm.
+*>
+*>              ZHBEVX computes selected eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian band matrix.
+*>
+*>              ZHEEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix.
+*>
+*>              ZHPEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian matrix in packed
+*>              storage.
+*>
+*>              ZHBEV computes all eigenvalues and, optionally,
+*>              eigenvectors of a complex Hermitian band matrix.
+*>
+*>      When ZDRVST2STG is called, a number of matrix "sizes" ("n's") and a
+*>      number of matrix "types" are specified.  For each size ("n")
+*>      and each type of matrix, one matrix will be generated and used
+*>      to test the appropriate drivers.  For each matrix and each
+*>      driver routine called, the following tests will be performed:
+*>
+*>      (1)     | A - Z D Z' | / ( |A| n ulp )
+*>
+*>      (2)     | I - Z Z' | / ( n ulp )
+*>
+*>      (3)     | D1 - D2 | / ( |D1| ulp )
+*>
+*>      where Z is the matrix of eigenvectors returned when the
+*>      eigenvector option is given and D1 and D2 are the eigenvalues
+*>      returned with and without the eigenvector option.
+*>
+*>      The "sizes" are specified by an array NN(1:NSIZES); the value of
+*>      each element NN(j) specifies one size.
+*>      The "types" are specified by a logical array DOTYPE( 1:NTYPES );
+*>      if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
+*>      Currently, the list of possible types is:
+*>
+*>      (1)  The zero matrix.
+*>      (2)  The identity matrix.
+*>
+*>      (3)  A diagonal matrix with evenly spaced entries
+*>           1, ..., ULP  and random signs.
+*>           (ULP = (first number larger than 1) - 1 )
+*>      (4)  A diagonal matrix with geometrically spaced entries
+*>           1, ..., ULP  and random signs.
+*>      (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
+*>           and random signs.
+*>
+*>      (6)  Same as (4), but multiplied by SQRT( overflow threshold )
+*>      (7)  Same as (4), but multiplied by SQRT( underflow threshold )
+*>
+*>      (8)  A matrix of the form  U* D U, where U is unitary and
+*>           D has evenly spaced entries 1, ..., ULP with random signs
+*>           on the diagonal.
+*>
+*>      (9)  A matrix of the form  U* D U, where U is unitary and
+*>           D has geometrically spaced entries 1, ..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (10) A matrix of the form  U* D U, where U is unitary and
+*>           D has "clustered" entries 1, ULP,..., ULP with random
+*>           signs on the diagonal.
+*>
+*>      (11) Same as (8), but multiplied by SQRT( overflow threshold )
+*>      (12) Same as (8), but multiplied by SQRT( underflow threshold )
+*>
+*>      (13) Symmetric matrix with random entries chosen from (-1,1).
+*>      (14) Same as (13), but multiplied by SQRT( overflow threshold )
+*>      (15) Same as (13), but multiplied by SQRT( underflow threshold )
+*>      (16) A band matrix with half bandwidth randomly chosen between
+*>           0 and N-1, with evenly spaced eigenvalues 1, ..., ULP
+*>           with random signs.
+*>      (17) Same as (16), but multiplied by SQRT( overflow threshold )
+*>      (18) Same as (16), but multiplied by SQRT( underflow threshold )
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \verbatim
+*>  NSIZES  INTEGER
+*>          The number of sizes of matrices to use.  If it is zero,
+*>          ZDRVST2STG does nothing.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NN      INTEGER array, dimension (NSIZES)
+*>          An array containing the sizes to be used for the matrices.
+*>          Zero values will be skipped.  The values must be at least
+*>          zero.
+*>          Not modified.
+*>
+*>  NTYPES  INTEGER
+*>          The number of elements in DOTYPE.   If it is zero, ZDRVST2STG
+*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
+*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
+*>          defined, which is to use whatever matrix is in A.  This
+*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
+*>          DOTYPE(MAXTYP+1) is .TRUE. .
+*>          Not modified.
+*>
+*>  DOTYPE  LOGICAL array, dimension (NTYPES)
+*>          If DOTYPE(j) is .TRUE., then for each size in NN a
+*>          matrix of that size and of type j will be generated.
+*>          If NTYPES is smaller than the maximum number of types
+*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
+*>          MAXTYP will not be generated.  If NTYPES is larger
+*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
+*>          will be ignored.
+*>          Not modified.
+*>
+*>  ISEED   INTEGER array, dimension (4)
+*>          On entry ISEED specifies the seed of the random number
+*>          generator. The array elements should be between 0 and 4095;
+*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
+*>          be odd.  The random number generator uses a linear
+*>          congruential sequence limited to small integers, and so
+*>          should produce machine independent random numbers. The
+*>          values of ISEED are changed on exit, and can be used in the
+*>          next call to ZDRVST2STG to continue the same random number
+*>          sequence.
+*>          Modified.
+*>
+*>  THRESH  DOUBLE PRECISION
+*>          A test will count as "failed" if the "error", computed as
+*>          described above, exceeds THRESH.  Note that the error
+*>          is scaled to be O(1), so THRESH should be a reasonably
+*>          small multiple of 1, e.g., 10 or 100.  In particular,
+*>          it should not depend on the precision (single vs. double)
+*>          or the size of the matrix.  It must be at least zero.
+*>          Not modified.
+*>
+*>  NOUNIT  INTEGER
+*>          The FORTRAN unit number for printing out error messages
+*>          (e.g., if a routine returns IINFO not equal to 0.)
+*>          Not modified.
+*>
+*>  A       COMPLEX*16 array, dimension (LDA , max(NN))
+*>          Used to hold the matrix whose eigenvalues are to be
+*>          computed.  On exit, A contains the last matrix actually
+*>          used.
+*>          Modified.
+*>
+*>  LDA     INTEGER
+*>          The leading dimension of A.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  D1      DOUBLE PRECISION array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by ZSTEQR simlutaneously
+*>          with Z.  On exit, the eigenvalues in D1 correspond with the
+*>          matrix in A.
+*>          Modified.
+*>
+*>  D2      DOUBLE PRECISION array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by ZSTEQR if Z is not
+*>          computed.  On exit, the eigenvalues in D2 correspond with
+*>          the matrix in A.
+*>          Modified.
+*>
+*>  D3      DOUBLE PRECISION array, dimension (max(NN))
+*>          The eigenvalues of A, as computed by DSTERF.  On exit, the
+*>          eigenvalues in D3 correspond with the matrix in A.
+*>          Modified.
+*>
+*>  WA1     DOUBLE PRECISION array, dimension
+*>
+*>  WA2     DOUBLE PRECISION array, dimension
+*>
+*>  WA3     DOUBLE PRECISION array, dimension
+*>
+*>  U       COMPLEX*16 array, dimension (LDU, max(NN))
+*>          The unitary matrix computed by ZHETRD + ZUNGC3.
+*>          Modified.
+*>
+*>  LDU     INTEGER
+*>          The leading dimension of U, Z, and V.  It must be at
+*>          least 1 and at least max( NN ).
+*>          Not modified.
+*>
+*>  V       COMPLEX*16 array, dimension (LDU, max(NN))
+*>          The Housholder vectors computed by ZHETRD in reducing A to
+*>          tridiagonal form.
+*>          Modified.
+*>
+*>  TAU     COMPLEX*16 array, dimension (max(NN))
+*>          The Householder factors computed by ZHETRD in reducing A
+*>          to tridiagonal form.
+*>          Modified.
+*>
+*>  Z       COMPLEX*16 array, dimension (LDU, max(NN))
+*>          The unitary matrix of eigenvectors computed by ZHEEVD,
+*>          ZHEEVX, ZHPEVD, CHPEVX, ZHBEVD, and CHBEVX.
+*>          Modified.
+*>
+*>  WORK  - COMPLEX*16 array of dimension ( LWORK )
+*>           Workspace.
+*>           Modified.
+*>
+*>  LWORK - INTEGER
+*>           The number of entries in WORK.  This must be at least
+*>           2*max( NN(j), 2 )**2.
+*>           Not modified.
+*>
+*>  RWORK   DOUBLE PRECISION array, dimension (3*max(NN))
+*>           Workspace.
+*>           Modified.
+*>
+*>  LRWORK - INTEGER
+*>           The number of entries in RWORK.
+*>
+*>  IWORK   INTEGER array, dimension (6*max(NN))
+*>          Workspace.
+*>          Modified.
+*>
+*>  LIWORK - INTEGER
+*>           The number of entries in IWORK.
+*>
+*>  RESULT  DOUBLE PRECISION array, dimension (??)
+*>          The values computed by the tests described above.
+*>          The values are currently limited to 1/ulp, to avoid
+*>          overflow.
+*>          Modified.
+*>
+*>  INFO    INTEGER
+*>          If 0, then everything ran OK.
+*>           -1: NSIZES < 0
+*>           -2: Some NN(j) < 0
+*>           -3: NTYPES < 0
+*>           -5: THRESH < 0
+*>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
+*>          -16: LDU < 1 or LDU < NMAX.
+*>          -21: LWORK too small.
+*>          If  DLATMR, SLATMS, ZHETRD, DORGC3, ZSTEQR, DSTERF,
+*>              or DORMC2 returns an error code, the
+*>              absolute value of it is returned.
+*>          Modified.
+*>
+*>-----------------------------------------------------------------------
+*>
+*>       Some Local Variables and Parameters:
+*>       ---- ----- --------- --- ----------
+*>       ZERO, ONE       Real 0 and 1.
+*>       MAXTYP          The number of types defined.
+*>       NTEST           The number of tests performed, or which can
+*>                       be performed so far, for the current matrix.
+*>       NTESTT          The total number of tests performed so far.
+*>       NMAX            Largest value in NN.
+*>       NMATS           The number of matrices generated so far.
+*>       NERRS           The number of tests which have exceeded THRESH
+*>                       so far (computed by DLAFTS).
+*>       COND, IMODE     Values to be passed to the matrix generators.
+*>       ANORM           Norm of A; passed to matrix generators.
+*>
+*>       OVFL, UNFL      Overflow and underflow thresholds.
+*>       ULP, ULPINV     Finest relative precision and its inverse.
+*>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
+*>               The following four arrays decode JTYPE:
+*>       KTYPE(j)        The general type (1-10) for type "j".
+*>       KMODE(j)        The MODE value to be passed to the matrix
+*>                       generator for type "j".
+*>       KMAGN(j)        The order of magnitude ( O(1),
+*>                       O(overflow^(1/2) ), O(underflow^(1/2) )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16_eig
+*
+*  =====================================================================
+      SUBROUTINE ZDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
+     $                   NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U,
+     $                   LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK,
+     $                   IWORK, LIWORK, RESULT, INFO )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
+     $                   NSIZES, NTYPES
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
+      DOUBLE PRECISION   D1( * ), D2( * ), D3( * ), RESULT( * ),
+     $                   RWORK( * ), WA1( * ), WA2( * ), WA3( * )
+      COMPLEX*16         A( LDA, * ), TAU( * ), U( LDU, * ),
+     $                   V( LDU, * ), WORK( * ), Z( LDU, * )
+*     ..
+*
+*  =====================================================================
+*
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE, TWO, TEN
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
+     $                   TEN = 10.0D+0 )
+      DOUBLE PRECISION   HALF
+      PARAMETER          ( HALF = ONE / TWO )
+      COMPLEX*16         CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
+      INTEGER            MAXTYP
+      PARAMETER          ( MAXTYP = 18 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            BADNN
+      CHARACTER          UPLO
+      INTEGER            I, IDIAG, IHBW, IINFO, IL, IMODE, INDWRK, INDX,
+     $                   IROW, ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL,
+     $                   JSIZE, JTYPE, KD, LGN, LIWEDC, LRWEDC, LWEDC,
+     $                   M, M2, M3, MTYPES, N, NERRS, NMATS, NMAX,
+     $                   NTEST, NTESTT
+      DOUBLE PRECISION   ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
+     $                   RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL,
+     $                   VL, VU
+*     ..
+*     .. Local Arrays ..
+      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
+     $                   ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
+     $                   KTYPE( MAXTYP )
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLAMCH, DLARND, DSXT1
+      EXTERNAL           DLAMCH, DLARND, DSXT1
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALASVM, DLABAD, DLAFTS, XERBLA, ZHBEV, ZHBEVD,
+     $                   ZHBEVX, ZHEEV, ZHEEVD, ZHEEVR, ZHEEVX, ZHET21,
+     $                   ZHET22, ZHPEV, ZHPEVD, ZHPEVX, ZLACPY, ZLASET,
+     $                   ZHEEVD_2STAGE, ZHEEVR_2STAGE, ZHEEVX_2STAGE,
+     $                   ZHEEV_2STAGE, ZHBEV_2STAGE, ZHBEVD_2STAGE,
+     $                   ZHBEVX_2STAGE, ZHETRD_2STAGE, ZHETRD_SY2SB, 
+     $                   ZHETRD_SB2ST, ZLATMR, ZLATMS
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, DBLE, INT, LOG, MAX, MIN, SQRT
+*     ..
+*     .. Data statements ..
+      DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 /
+      DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
+     $                   2, 3, 1, 2, 3 /
+      DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
+     $                   0, 0, 4, 4, 4 /
+*     ..
+*     .. Executable Statements ..
+*
+*     1)      Check for errors
+*
+      NTESTT = 0
+      INFO = 0
+*
+      BADNN = .FALSE.
+      NMAX = 1
+      DO 10 J = 1, NSIZES
+         NMAX = MAX( NMAX, NN( J ) )
+         IF( NN( J ).LT.0 )
+     $      BADNN = .TRUE.
+   10 CONTINUE
+*
+*     Check for errors
+*
+      IF( NSIZES.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( BADNN ) THEN
+         INFO = -2
+      ELSE IF( NTYPES.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.NMAX ) THEN
+         INFO = -9
+      ELSE IF( LDU.LT.NMAX ) THEN
+         INFO = -16
+      ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
+         INFO = -22
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZDRVST2STG', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if nothing to do
+*
+      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
+     $   RETURN
+*
+*     More Important constants
+*
+      UNFL = DLAMCH( 'Safe minimum' )
+      OVFL = DLAMCH( 'Overflow' )
+      CALL DLABAD( UNFL, OVFL )
+      ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
+      ULPINV = ONE / ULP
+      RTUNFL = SQRT( UNFL )
+      RTOVFL = SQRT( OVFL )
+*
+*     Loop over sizes, types
+*
+      DO 20 I = 1, 4
+         ISEED2( I ) = ISEED( I )
+         ISEED3( I ) = ISEED( I )
+   20 CONTINUE
+*
+      NERRS = 0
+      NMATS = 0
+*
+      DO 1220 JSIZE = 1, NSIZES
+         N = NN( JSIZE )
+         IF( N.GT.0 ) THEN
+            LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) )
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            IF( 2**LGN.LT.N )
+     $         LGN = LGN + 1
+            LWEDC = MAX( 2*N+N*N, 2*N*N )
+            LRWEDC = 1 + 4*N + 2*N*LGN + 3*N**2
+            LIWEDC = 3 + 5*N
+         ELSE
+            LWEDC = 2
+            LRWEDC = 8
+            LIWEDC = 8
+         END IF
+         ANINV = ONE / DBLE( MAX( 1, N ) )
+*
+         IF( NSIZES.NE.1 ) THEN
+            MTYPES = MIN( MAXTYP, NTYPES )
+         ELSE
+            MTYPES = MIN( MAXTYP+1, NTYPES )
+         END IF
+*
+         DO 1210 JTYPE = 1, MTYPES
+            IF( .NOT.DOTYPE( JTYPE ) )
+     $         GO TO 1210
+            NMATS = NMATS + 1
+            NTEST = 0
+*
+            DO 30 J = 1, 4
+               IOLDSD( J ) = ISEED( J )
+   30       CONTINUE
+*
+*           2)      Compute "A"
+*
+*                   Control parameters:
+*
+*               KMAGN  KMODE        KTYPE
+*           =1  O(1)   clustered 1  zero
+*           =2  large  clustered 2  identity
+*           =3  small  exponential  (none)
+*           =4         arithmetic   diagonal, (w/ eigenvalues)
+*           =5         random log   Hermitian, w/ eigenvalues
+*           =6         random       (none)
+*           =7                      random diagonal
+*           =8                      random Hermitian
+*           =9                      band Hermitian, w/ eigenvalues
+*
+            IF( MTYPES.GT.MAXTYP )
+     $         GO TO 110
+*
+            ITYPE = KTYPE( JTYPE )
+            IMODE = KMODE( JTYPE )
+*
+*           Compute norm
+*
+            GO TO ( 40, 50, 60 )KMAGN( JTYPE )
+*
+   40       CONTINUE
+            ANORM = ONE
+            GO TO 70
+*
+   50       CONTINUE
+            ANORM = ( RTOVFL*ULP )*ANINV
+            GO TO 70
+*
+   60       CONTINUE
+            ANORM = RTUNFL*N*ULPINV
+            GO TO 70
+*
+   70       CONTINUE
+*
+            CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+            IINFO = 0
+            COND = ULPINV
+*
+*           Special Matrices -- Identity & Jordan block
+*
+*                   Zero
+*
+            IF( ITYPE.EQ.1 ) THEN
+               IINFO = 0
+*
+            ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*              Identity
+*
+               DO 80 JCOL = 1, N
+                  A( JCOL, JCOL ) = ANORM
+   80          CONTINUE
+*
+            ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*              Diagonal Matrix, [Eigen]values Specified
+*
+               CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*              Hermitian, eigenvalues specified
+*
+               CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.7 ) THEN
+*
+*              Diagonal, random eigenvalues
+*
+               CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.8 ) THEN
+*
+*              Hermitian, random eigenvalues
+*
+               CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
+     $                      'T', 'N', WORK( N+1 ), 1, ONE,
+     $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
+     $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
+*
+            ELSE IF( ITYPE.EQ.9 ) THEN
+*
+*              Hermitian banded, eigenvalues specified
+*
+               IHBW = INT( ( N-1 )*DLARND( 1, ISEED3 ) )
+               CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
+     $                      ANORM, IHBW, IHBW, 'Z', U, LDU, WORK,
+     $                      IINFO )
+*
+*              Store as dense matrix for most routines.
+*
+               CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
+               DO 100 IDIAG = -IHBW, IHBW
+                  IROW = IHBW - IDIAG + 1
+                  J1 = MAX( 1, IDIAG+1 )
+                  J2 = MIN( N, N+IDIAG )
+                  DO 90 J = J1, J2
+                     I = J - IDIAG
+                     A( I, J ) = U( IROW, J )
+   90             CONTINUE
+  100          CONTINUE
+            ELSE
+               IINFO = 1
+            END IF
+*
+            IF( IINFO.NE.0 ) THEN
+               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
+     $            IOLDSD
+               INFO = ABS( IINFO )
+               RETURN
+            END IF
+*
+  110       CONTINUE
+*
+            ABSTOL = UNFL + UNFL
+            IF( N.LE.1 ) THEN
+               IL = 1
+               IU = N
+            ELSE
+               IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
+               IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
+               IF( IL.GT.IU ) THEN
+                  ITEMP = IL
+                  IL = IU
+                  IU = ITEMP
+               END IF
+            END IF
+*
+*           Perform tests storing upper or lower triangular
+*           part of matrix.
+*
+            DO 1200 IUPLO = 0, 1
+               IF( IUPLO.EQ.0 ) THEN
+                  UPLO = 'L'
+               ELSE
+                  UPLO = 'U'
+               END IF
+*
+*              Call ZHEEVD and CHEEVX.
+*
+               CALL ZLACPY( ' ', N, N, A, LDA, V, LDU )
+*
+               NTEST = NTEST + 1
+               CALL ZHEEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC,
+     $                      RWORK, LRWEDC, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHEEVD(V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 130
+                  END IF
+               END IF
+*
+*              Do tests 1 and 2.
+*
+               CALL ZHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 2
+               CALL ZHEEVD_2STAGE( 'N', UPLO, N, A, LDU, D3, WORK,
+     $                      LWORK, RWORK, LRWEDC, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'ZHEEVD_2STAGE(N,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 130
+                  END IF
+               END IF
+*
+*              Do test 3.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 120 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  120          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  130          CONTINUE
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 1
+*
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
+                  IF( IL.NE.1 ) THEN
+                     VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  TEMP3 = ZERO
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               CALL ZHEEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, WORK, LWORK, RWORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Do tests 4 and 5.
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL ZHEEVX_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M2, WA2, Z, LDU,
+     $                             WORK, LWORK, RWORK, IWORK, 
+     $                             IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'ZHEEVX_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 150
+                  END IF
+               END IF
+*
+*              Do test 6.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 140 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+  140          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  150          CONTINUE
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 1
+*
+               CALL ZHEEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 160
+                  END IF
+               END IF
+*
+*              Do tests 7 and 8.
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               CALL ZHEEVX_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M3, WA3, Z, LDU,
+     $                             WORK, LWORK, RWORK, IWORK, 
+     $                             IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'ZHEEVX_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 160
+                  END IF
+               END IF
+*
+*              Do test 9.
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  160          CONTINUE
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 1
+*
+               CALL ZHEEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK,
+     $                      IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 170
+                  END IF
+               END IF
+*
+*              Do tests 10 and 11.
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               CALL ZHEEVX_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M3, WA3, Z, LDU,
+     $                             WORK, LWORK, RWORK, IWORK, 
+     $                             IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'ZHEEVX_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 170
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 170
+               END IF
+*
+*              Do test 12.
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  170          CONTINUE
+*
+*              Call ZHPEVD and CHPEVX.
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+*              Load array WORK with the upper or lower triangular
+*              part of the matrix in packed form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 190 J = 1, N
+                     DO 180 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  180                CONTINUE
+  190             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 210 J = 1, N
+                     DO 200 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  200                CONTINUE
+  210             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               INDWRK = N*( N+1 ) / 2 + 1
+               CALL ZHPEVD( 'V', UPLO, N, WORK, D1, Z, LDU,
+     $                      WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK,
+     $                      LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHPEVD(V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 270
+                  END IF
+               END IF
+*
+*              Do tests 13 and 14.
+*
+               CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 230 J = 1, N
+                     DO 220 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  220                CONTINUE
+  230             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 250 J = 1, N
+                     DO 240 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  240                CONTINUE
+  250             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               INDWRK = N*( N+1 ) / 2 + 1
+               CALL ZHPEVD( 'N', UPLO, N, WORK, D3, Z, LDU,
+     $                      WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK,
+     $                      LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHPEVD(N,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 270
+                  END IF
+               END IF
+*
+*              Do test 15.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 260 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  260          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*              Load array WORK with the upper or lower triangular part
+*              of the matrix in packed form.
+*
+  270          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 290 J = 1, N
+                     DO 280 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  280                CONTINUE
+  290             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 310 J = 1, N
+                     DO 300 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  300                CONTINUE
+  310             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+*
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
+                  IF( IL.NE.1 ) THEN
+                     VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+                  IF( IU.NE.N ) THEN
+                     VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  ELSE IF( N.GT.0 ) THEN
+                     VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
+     $                    TEN*ULP*TEMP3, TEN*RTUNFL )
+                  END IF
+               ELSE
+                  TEMP3 = ZERO
+                  VL = ZERO
+                  VU = ONE
+               END IF
+*
+               CALL ZHPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 370
+                  END IF
+               END IF
+*
+*              Do tests 16 and 17.
+*
+               CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 330 J = 1, N
+                     DO 320 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  320                CONTINUE
+  330             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 350 J = 1, N
+                     DO 340 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  340                CONTINUE
+  350             CONTINUE
+               END IF
+*
+               CALL ZHPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 370
+                  END IF
+               END IF
+*
+*              Do test 18.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 360 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+  360          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  370          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 390 J = 1, N
+                     DO 380 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  380                CONTINUE
+  390             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 410 J = 1, N
+                     DO 400 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  400                CONTINUE
+  410             CONTINUE
+               END IF
+*
+               CALL ZHPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 460
+                  END IF
+               END IF
+*
+*              Do tests 19 and 20.
+*
+               CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 430 J = 1, N
+                     DO 420 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  420                CONTINUE
+  430             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 450 J = 1, N
+                     DO 440 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  440                CONTINUE
+  450             CONTINUE
+               END IF
+*
+               CALL ZHPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 460
+                  END IF
+               END IF
+*
+*              Do test 21.
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  460          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 480 J = 1, N
+                     DO 470 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  470                CONTINUE
+  480             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 500 J = 1, N
+                     DO 490 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  490                CONTINUE
+  500             CONTINUE
+               END IF
+*
+               CALL ZHPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 550
+                  END IF
+               END IF
+*
+*              Do tests 22 and 23.
+*
+               CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 520 J = 1, N
+                     DO 510 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  510                CONTINUE
+  520             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 540 J = 1, N
+                     DO 530 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  530                CONTINUE
+  540             CONTINUE
+               END IF
+*
+               CALL ZHPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU,
+     $                      ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK,
+     $                      IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 550
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 550
+               END IF
+*
+*              Do test 24.
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  550          CONTINUE
+*
+*              Call ZHBEVD and CHBEVX.
+*
+               IF( JTYPE.LE.7 ) THEN
+                  KD = 0
+               ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
+                  KD = MAX( N-1, 0 )
+               ELSE
+                  KD = IHBW
+               END IF
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 570 J = 1, N
+                     DO 560 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  560                CONTINUE
+  570             CONTINUE
+               ELSE
+                  DO 590 J = 1, N
+                     DO 580 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  580                CONTINUE
+  590             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               CALL ZHBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
+     $                      LWEDC, RWORK, LRWEDC, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )'ZHBEVD(V,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 650
+                  END IF
+               END IF
+*
+*              Do tests 25 and 26.
+*
+               CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 610 J = 1, N
+                     DO 600 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  600                CONTINUE
+  610             CONTINUE
+               ELSE
+                  DO 630 J = 1, N
+                     DO 620 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  620                CONTINUE
+  630             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               CALL ZHBEVD_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, 
+     $                             Z, LDU, WORK, LWORK, RWORK,
+     $                             LRWEDC, IWORK, LIWEDC, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )
+     $               'ZHBEVD_2STAGE(N,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 650
+                  END IF
+               END IF
+*
+*              Do test 27.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 640 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  640          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+  650          CONTINUE
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 670 J = 1, N
+                     DO 660 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  660                CONTINUE
+  670             CONTINUE
+               ELSE
+                  DO 690 J = 1, N
+                     DO 680 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  680                CONTINUE
+  690             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               CALL ZHBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M, WA1, Z, LDU, WORK,
+     $                      RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHBEVX(V,A,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 750
+                  END IF
+               END IF
+*
+*              Do tests 28 and 29.
+*
+               CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 710 J = 1, N
+                     DO 700 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  700                CONTINUE
+  710             CONTINUE
+               ELSE
+                  DO 730 J = 1, N
+                     DO 720 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  720                CONTINUE
+  730             CONTINUE
+               END IF
+*
+               CALL ZHBEVX_2STAGE( 'N', 'A', UPLO, N, KD, V, LDU,
+     $                             U, LDU, VL, VU, IL, IU, ABSTOL,
+     $                             M2, WA2, Z, LDU, WORK, LWORK,
+     $                             RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )
+     $               'ZHBEVX_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 750
+                  END IF
+               END IF
+*
+*              Do test 30.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 740 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+  740          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+  750          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 770 J = 1, N
+                     DO 760 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  760                CONTINUE
+  770             CONTINUE
+               ELSE
+                  DO 790 J = 1, N
+                     DO 780 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  780                CONTINUE
+  790             CONTINUE
+               END IF
+*
+               CALL ZHBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
+     $                      RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(V,I,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 840
+                  END IF
+               END IF
+*
+*              Do tests 31 and 32.
+*
+               CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 810 J = 1, N
+                     DO 800 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  800                CONTINUE
+  810             CONTINUE
+               ELSE
+                  DO 830 J = 1, N
+                     DO 820 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  820                CONTINUE
+  830             CONTINUE
+               END IF
+               CALL ZHBEVX_2STAGE( 'N', 'I', UPLO, N, KD, V, LDU,
+     $                             U, LDU, VL, VU, IL, IU, ABSTOL,
+     $                             M3, WA3, Z, LDU, WORK, LWORK,
+     $                             RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )
+     $               'ZHBEVX_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 840
+                  END IF
+               END IF
+*
+*              Do test 33.
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+  840          CONTINUE
+               NTEST = NTEST + 1
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 860 J = 1, N
+                     DO 850 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  850                CONTINUE
+  860             CONTINUE
+               ELSE
+                  DO 880 J = 1, N
+                     DO 870 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  870                CONTINUE
+  880             CONTINUE
+               END IF
+               CALL ZHBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL,
+     $                      VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
+     $                      RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(V,V,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 930
+                  END IF
+               END IF
+*
+*              Do tests 34 and 35.
+*
+               CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 900 J = 1, N
+                     DO 890 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+  890                CONTINUE
+  900             CONTINUE
+               ELSE
+                  DO 920 J = 1, N
+                     DO 910 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+  910                CONTINUE
+  920             CONTINUE
+               END IF
+               CALL ZHBEVX_2STAGE( 'N', 'V', UPLO, N, KD, V, LDU,
+     $                             U, LDU, VL, VU, IL, IU, ABSTOL,
+     $                             M3, WA3, Z, LDU, WORK, LWORK,
+     $                             RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )
+     $               'ZHBEVX_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 930
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 930
+               END IF
+*
+*              Do test 36.
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+  930          CONTINUE
+*
+*              Call ZHEEV
+*
+               CALL ZLACPY( ' ', N, N, A, LDA, V, LDU )
+*
+               NTEST = NTEST + 1
+               CALL ZHEEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK, RWORK,
+     $                     IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHEEV(V,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 950
+                  END IF
+               END IF
+*
+*              Do tests 37 and 38
+*
+               CALL ZHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               NTEST = NTEST + 2
+               CALL ZHEEV_2STAGE( 'N', UPLO, N, A, LDU, D3,
+     $                            WORK, LWORK, RWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'ZHEEV_2STAGE(N,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 950
+                  END IF
+               END IF
+*
+*              Do test 39
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 940 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+  940          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+  950          CONTINUE
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+*              Call ZHPEV
+*
+*              Load array WORK with the upper or lower triangular
+*              part of the matrix in packed form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 970 J = 1, N
+                     DO 960 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  960                CONTINUE
+  970             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 990 J = 1, N
+                     DO 980 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+  980                CONTINUE
+  990             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               INDWRK = N*( N+1 ) / 2 + 1
+               CALL ZHPEV( 'V', UPLO, N, WORK, D1, Z, LDU,
+     $                     WORK( INDWRK ), RWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHPEV(V,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1050
+                  END IF
+               END IF
+*
+*              Do tests 40 and 41.
+*
+               CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  INDX = 1
+                  DO 1010 J = 1, N
+                     DO 1000 I = 1, J
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1000                CONTINUE
+ 1010             CONTINUE
+               ELSE
+                  INDX = 1
+                  DO 1030 J = 1, N
+                     DO 1020 I = J, N
+                        WORK( INDX ) = A( I, J )
+                        INDX = INDX + 1
+ 1020                CONTINUE
+ 1030             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               INDWRK = N*( N+1 ) / 2 + 1
+               CALL ZHPEV( 'N', UPLO, N, WORK, D3, Z, LDU,
+     $                     WORK( INDWRK ), RWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHPEV(N,' // UPLO // ')',
+     $               IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1050
+                  END IF
+               END IF
+*
+*              Do test 42
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1040 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1040          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1050          CONTINUE
+*
+*              Call ZHBEV
+*
+               IF( JTYPE.LE.7 ) THEN
+                  KD = 0
+               ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
+                  KD = MAX( N-1, 0 )
+               ELSE
+                  KD = IHBW
+               END IF
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1070 J = 1, N
+                     DO 1060 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1060                CONTINUE
+ 1070             CONTINUE
+               ELSE
+                  DO 1090 J = 1, N
+                     DO 1080 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1080                CONTINUE
+ 1090             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 1
+               CALL ZHBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
+     $                     RWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )'ZHBEV(V,' // UPLO // ')',
+     $               IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1140
+                  END IF
+               END IF
+*
+*              Do tests 43 and 44.
+*
+               CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               IF( IUPLO.EQ.1 ) THEN
+                  DO 1110 J = 1, N
+                     DO 1100 I = MAX( 1, J-KD ), J
+                        V( KD+1+I-J, J ) = A( I, J )
+ 1100                CONTINUE
+ 1110             CONTINUE
+               ELSE
+                  DO 1130 J = 1, N
+                     DO 1120 I = J, MIN( N, J+KD )
+                        V( 1+I-J, J ) = A( I, J )
+ 1120                CONTINUE
+ 1130             CONTINUE
+               END IF
+*
+               NTEST = NTEST + 2
+               CALL ZHBEV_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU,
+     $                            WORK, LWORK, RWORK, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9998 )
+     $               'ZHBEV_2STAGE(N,' // UPLO // ')',
+     $               IINFO, N, KD, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1140
+                  END IF
+               END IF
+*
+ 1140          CONTINUE
+*
+*              Do test 45.
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1150 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
+ 1150          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+               CALL ZLACPY( ' ', N, N, A, LDA, V, LDU )
+               NTEST = NTEST + 1
+               CALL ZHEEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK,
+     $                      RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1170
+                  END IF
+               END IF
+*
+*              Do tests 45 and 46 (or ... )
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
+     $                      LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL ZHEEVR_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M2, WA2, Z, LDU,
+     $                             IWORK, WORK, LWORK, RWORK, LRWORK,
+     $                             IWORK( 2*N+1 ), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'ZHEEVR_2STAGE(N,A,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1170
+                  END IF
+               END IF
+*
+*              Do test 47 (or ... )
+*
+               TEMP1 = ZERO
+               TEMP2 = ZERO
+               DO 1160 J = 1, N
+                  TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
+                  TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
+ 1160          CONTINUE
+               RESULT( NTEST ) = TEMP2 / MAX( UNFL,
+     $                           ULP*MAX( TEMP1, TEMP2 ) )
+*
+ 1170          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+               CALL ZHEEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1180
+                  END IF
+               END IF
+*
+*              Do tests 48 and 49 (or +??)
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+               CALL ZHEEVR_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M3, WA3, Z, LDU,
+     $                             IWORK, WORK, LWORK, RWORK, LRWORK,
+     $                             IWORK( 2*N+1 ), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'ZHEEVR_2STAGE(N,I,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1180
+                  END IF
+               END IF
+*
+*              Do test 50 (or +??)
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, ULP*TEMP3 )
+ 1180          CONTINUE
+*
+               NTEST = NTEST + 1
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+               CALL ZHEEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
+     $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
+     $                      RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N,
+     $                      IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     RESULT( NTEST+1 ) = ULPINV
+                     RESULT( NTEST+2 ) = ULPINV
+                     GO TO 1190
+                  END IF
+               END IF
+*
+*              Do tests 51 and 52 (or +??)
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+               CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
+     $                      V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
+*
+               NTEST = NTEST + 2
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+               CALL ZHEEVR_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU,
+     $                             IL, IU, ABSTOL, M3, WA3, Z, LDU,
+     $                             IWORK, WORK, LWORK, RWORK, LRWORK,
+     $                             IWORK( 2*N+1 ), LIWORK-2*N, IINFO )
+               IF( IINFO.NE.0 ) THEN
+                  WRITE( NOUNIT, FMT = 9999 )
+     $               'ZHEEVR_2STAGE(N,V,' // UPLO //
+     $               ')', IINFO, N, JTYPE, IOLDSD
+                  INFO = ABS( IINFO )
+                  IF( IINFO.LT.0 ) THEN
+                     RETURN
+                  ELSE
+                     RESULT( NTEST ) = ULPINV
+                     GO TO 1190
+                  END IF
+               END IF
+*
+               IF( M3.EQ.0 .AND. N.GT.0 ) THEN
+                  RESULT( NTEST ) = ULPINV
+                  GO TO 1190
+               END IF
+*
+*              Do test 52 (or +??)
+*
+               TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
+               TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
+               IF( N.GT.0 ) THEN
+                  TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
+               ELSE
+                  TEMP3 = ZERO
+               END IF
+               RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
+     $                           MAX( UNFL, TEMP3*ULP )
+*
+               CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+*
+*
+*
+*              Load array V with the upper or lower triangular part
+*              of the matrix in band form.
+*
+ 1190          CONTINUE
+*
+ 1200       CONTINUE
+*
+*           End of Loop -- Check for RESULT(j) > THRESH
+*
+            NTESTT = NTESTT + NTEST
+            CALL DLAFTS( 'ZST', N, N, JTYPE, NTEST, RESULT, IOLDSD,
+     $                   THRESH, NOUNIT, NERRS )
+*
+ 1210    CONTINUE
+ 1220 CONTINUE
+*
+*     Summary
+*
+      CALL ALASVM( 'ZST', NOUNIT, NERRS, NTESTT, 0 )
+*
+ 9999 FORMAT( ' ZDRVST2STG: ', A, ' returned INFO=', I6, / 9X, 'N=', I6,
+     $      ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
+ 9998 FORMAT( ' ZDRVST2STG: ', A, ' returned INFO=', I6, / 9X, 'N=', I6,
+     $      ', KD=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5,
+     $      ')' )
+*
+      RETURN
+*
+*     End of ZDRVST2STG
+*
+      END
diff --git a/TESTING/EIG/zerrst.f b/TESTING/EIG/zerrst.f
index 92c9e52c..8afa1dce 100644
--- a/TESTING/EIG/zerrst.f
+++ b/TESTING/EIG/zerrst.f
@@ -1,5 +1,7 @@
 *> \brief \b ZERRST
 *
+*  @precisions fortran z -> c
+*
 *  =========== DOCUMENTATION ===========
 *
 * Online html documentation available at
@@ -25,6 +27,10 @@
 *> ZUNGTR, ZUPMTR, ZSTEQR, CSTEIN, ZPTEQR, ZHBTRD,
 *> ZHEEV, CHEEVX, CHEEVD, ZHBEV, CHBEVX, CHBEVD,
 *> ZHPEV, CHPEVX, CHPEVD, and ZSTEDC.
+*> ZHEEVD_2STAGE, ZHEEVR_2STAGE, ZHEEVX_2STAGE,
+*> ZHEEV_2STAGE, ZHBEV_2STAGE, ZHBEVD_2STAGE,
+*> ZHBEVX_2STAGE, ZHETRD_2STAGE, ZHETRD_SY2SB,
+*> ZHETRD_SB2ST
 *> \endverbatim
 *
 *  Arguments:
@@ -93,7 +99,11 @@
       EXTERNAL           CHKXER, ZHBEV, ZHBEVD, ZHBEVX, ZHBTRD, ZHEEV,
      $                   ZHEEVD, ZHEEVR, ZHEEVX, ZHETRD, ZHPEV, ZHPEVD,
      $                   ZHPEVX, ZHPTRD, ZPTEQR, ZSTEDC, ZSTEIN, ZSTEQR,
-     $                   ZUNGTR, ZUNMTR, ZUPGTR, ZUPMTR
+     $                   ZUNGTR, ZUNMTR, ZUPGTR, ZUPMTR,
+     $                   ZHEEVD_2STAGE, ZHEEVR_2STAGE, ZHEEVX_2STAGE,
+     $                   ZHEEV_2STAGE, ZHBEV_2STAGE, ZHBEVD_2STAGE,
+     $                   ZHBEVX_2STAGE, ZHETRD_2STAGE, ZHETRD_SY2SB,
+     $                   ZHETRD_SB2ST
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -151,6 +161,103 @@
          CALL CHKXER( 'ZHETRD', INFOT, NOUT, LERR, OK )
          NT = NT + 4
 *
+*        ZHETRD_2STAGE
+*
+         SRNAMT = 'ZHETRD_2STAGE'
+         INFOT = 1
+         CALL ZHETRD_2STAGE( '/', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL ZHETRD_2STAGE( 'H', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRD_2STAGE( 'N', '/', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHETRD_2STAGE( 'N', 'U', -1, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHETRD_2STAGE( 'N', 'U', 2, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHETRD_2STAGE( 'N', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 0, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL ZHETRD_2STAGE( 'N', 'U', 0, A, 1, D, E, TAU, 
+     $                                  C, 1, W, 0, INFO )
+         CALL CHKXER( 'ZHETRD_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 7
+*
+*        ZHETRD_HE2HB
+*
+         SRNAMT = 'ZHETRD_HE2HB'
+         INFOT = 1
+         CALL ZHETRD_HE2HB( '/', 0, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRD_HE2HB( 'U', -1, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHETRD_HE2HB( 'U', 0, -1, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHETRD_HE2HB( 'U', 2, 0, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRD_HE2HB( 'U', 0, 2, A, 1, C, 1, TAU, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHETRD_HE2HB( 'U', 0, 0, A, 1, C, 1, TAU, W, 0, INFO )
+         CALL CHKXER( 'ZHETRD_HE2HB', INFOT, NOUT, LERR, OK )
+         NT = NT + 6
+*
+*        ZHETRD_HB2ST
+*
+         SRNAMT = 'ZHETRD_HB2ST'
+         INFOT = 1
+         CALL ZHETRD_HB2ST( '/', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRD_HB2ST( 'Y', '/', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRD_HB2ST( 'Y', 'H', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHETRD_HB2ST( 'Y', 'N', '/', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETRD_HB2ST( 'Y', 'N', 'U', -1, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHETRD_HB2ST( 'Y', 'N', 'U', 0, -1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRD_HB2ST( 'Y', 'N', 'U', 0, 1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZHETRD_HB2ST( 'Y', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 0, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL ZHETRD_HB2ST( 'Y', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 0, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         NT = NT + 9
+*
 *        ZUNGTR
 *
          SRNAMT = 'ZUNGTR'
@@ -377,6 +484,63 @@
          CALL CHKXER( 'ZHEEVD', INFOT, NOUT, LERR, OK )
          NT = NT + 12
 *
+*        ZHEEVD_2STAGE
+*
+         SRNAMT = 'ZHEEVD_2STAGE'
+         INFOT = 1
+         CALL ZHEEVD_2STAGE( '/', 'U', 0, A, 1, X, W, 1,
+     $                              RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL ZHEEVD_2STAGE( 'V', 'U', 0, A, 1, X, W, 1,
+     $                              RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHEEVD_2STAGE( 'N', '/', 0, A, 1, X, W, 1,
+     $                              RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHEEVD_2STAGE( 'N', 'U', -1, A, 1, X, W, 1,
+     $                               RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHEEVD_2STAGE( 'N', 'U', 2, A, 1, X, W, 3,
+     $                              RW, 2, IW, 1, INFO )
+         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHEEVD_2STAGE( 'N', 'U', 1, A, 1, X, W, 0,
+     $                              RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHEEVD_2STAGE( 'N', 'U', 2, A, 2, X, W, 2,
+     $                              RW, 2, IW, 1, INFO )
+         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 8
+*         CALL ZHEEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 3,
+*     $                            RW, 25, IW, 12, INFO )
+*         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHEEVD_2STAGE( 'N', 'U', 1, A, 1, X, W, 1,
+     $                              RW, 0, IW, 1, INFO )
+         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHEEVD_2STAGE( 'N', 'U', 2, A, 2, X, W, 25,
+     $                              RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 10
+*         CALL ZHEEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 8,
+*     $                            RW, 18, IW, 12, INFO )
+*         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL ZHEEVD_2STAGE( 'N', 'U', 1, A, 1, X, W, 1,
+     $                              RW, 1, IW, 0, INFO )
+         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+*         CALL ZHEEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 8,
+*     $                            RW, 25, IW, 11, INFO )
+*         CALL CHKXER( 'ZHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 10
+*
 *        ZHEEV
 *
          SRNAMT = 'ZHEEV '
@@ -397,6 +561,29 @@
          CALL CHKXER( 'ZHEEV ', INFOT, NOUT, LERR, OK )
          NT = NT + 5
 *
+*        ZHEEV_2STAGE
+*
+         SRNAMT = 'ZHEEV_2STAGE '
+         INFOT = 1
+         CALL ZHEEV_2STAGE( '/', 'U', 0, A, 1, X, W, 1, RW, INFO )
+         CALL CHKXER( 'ZHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL ZHEEV_2STAGE( 'V', 'U', 0, A, 1, X, W, 1, RW, INFO )
+         CALL CHKXER( 'ZHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHEEV_2STAGE( 'N', '/', 0, A, 1, X, W, 1, RW, INFO )
+         CALL CHKXER( 'ZHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHEEV_2STAGE( 'N', 'U', -1, A, 1, X, W, 1, RW, INFO )
+         CALL CHKXER( 'ZHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHEEV_2STAGE( 'N', 'U', 2, A, 1, X, W, 3, RW, INFO )
+         CALL CHKXER( 'ZHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHEEV_2STAGE( 'N', 'U', 2, A, 2, X, W, 2, RW, INFO )
+         CALL CHKXER( 'ZHEEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         NT = NT + 6
+*
 *        ZHEEVX
 *
          SRNAMT = 'ZHEEVX'
@@ -441,6 +628,65 @@
          CALL CHKXER( 'ZHEEVX', INFOT, NOUT, LERR, OK )
          NT = NT + 10
 *
+*        ZHEEVX_2STAGE
+*
+         SRNAMT = 'ZHEEVX_2STAGE'
+         INFOT = 1
+         CALL ZHEEVX_2STAGE( '/', 'A', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL ZHEEVX_2STAGE( 'V', 'A', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHEEVX_2STAGE( 'N', '/', 'U', 0, A, 1,
+     $                0.0D0, 1.0D0, 1, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHEEVX_2STAGE( 'N', 'A', '/', 0, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         INFOT = 4
+         CALL ZHEEVX_2STAGE( 'N', 'A', 'U', -1, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL ZHEEVX_2STAGE( 'N', 'A', 'U', 2, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 2, W, 3, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHEEVX_2STAGE( 'N', 'V', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZHEEVX_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 1, W, 1, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHEEVX_2STAGE( 'N', 'I', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 2, 1, 0.0D0,
+     $                M, X, Z, 2, W, 3, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL ZHEEVX_2STAGE( 'N', 'A', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 0, W, 3, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 17
+         CALL ZHEEVX_2STAGE( 'N', 'A', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                M, X, Z, 2, W, 0, RW, IW, I1, INFO )
+         CALL CHKXER( 'ZHEEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 11
+*
 *        ZHEEVR
 *
          SRNAMT = 'ZHEEVR'
@@ -508,6 +754,90 @@
          CALL CHKXER( 'ZHEEVR', INFOT, NOUT, LERR, OK )
          NT = NT + 12
 *
+*        ZHEEVR_2STAGE
+*
+         SRNAMT = 'ZHEEVR_2STAGE'
+         N = 1
+         INFOT = 1
+         CALL ZHEEVR_2STAGE( '/', 'A', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL ZHEEVR_2STAGE( 'V', 'A', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHEEVR_2STAGE( 'N', '/', 'U', 0, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHEEVR_2STAGE( 'N', 'A', '/', -1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N,
+     $                IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHEEVR_2STAGE( 'N', 'A', 'U', -1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N,
+     $                IW( 2*N+1 ), 10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL ZHEEVR_2STAGE( 'N', 'A', 'U', 2, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHEEVR_2STAGE( 'N', 'V', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 0, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHEEVR_2STAGE( 'N', 'I', 'U', 2, A, 2,
+     $                0.0D0, 0.0D0, 2, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL ZHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 0, IW, Q, 2*N, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 18
+         CALL ZHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 2*N-1, RW, 24*N, IW( 2*N+1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 20
+         CALL ZHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, RW, 24*N-1, IW( 2*N-1 ),
+     $                10*N, INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 22
+         CALL ZHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1,
+     $                0.0D0, 0.0D0, 1, 1, 0.0D0,
+     $                M, R, Z, 1, IW, Q, 26*N, RW, 24*N, IW, 10*N-1,
+     $                INFO )
+         CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 13
+*
 *        ZHPEVD
 *
          SRNAMT = 'ZHPEVD'
@@ -646,6 +976,47 @@
          CALL CHKXER( 'ZHBTRD', INFOT, NOUT, LERR, OK )
          NT = NT + 6
 *
+*        ZHETRD_HB2ST
+*
+         SRNAMT = 'ZHETRD_HB2ST'
+         INFOT = 1
+         CALL ZHETRD_HB2ST( '/', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRD_HB2ST( 'N', '/', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRD_HB2ST( 'N', 'H', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHETRD_HB2ST( 'N', 'N', '/', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETRD_HB2ST( 'N', 'N', 'U', -1, 0, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHETRD_HB2ST( 'N', 'N', 'U', 0, -1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRD_HB2ST( 'N', 'N', 'U', 0, 1, A, 1, D, E, 
+     $                                    C, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZHETRD_HB2ST( 'N', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 0, W, 1, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL ZHETRD_HB2ST( 'N', 'N', 'U', 0, 0, A, 1, D, E, 
+     $                                    C, 1, W, 0, INFO )
+         CALL CHKXER( 'ZHETRD_HB2ST', INFOT, NOUT, LERR, OK )
+         NT = NT + 9
+*
 *        ZHBEVD
 *
          SRNAMT = 'ZHBEVD'
@@ -711,6 +1082,75 @@
          CALL CHKXER( 'ZHBEVD', INFOT, NOUT, LERR, OK )
          NT = NT + 15
 *
+*        ZHBEVD_2STAGE
+*
+         SRNAMT = 'ZHBEVD_2STAGE'
+         INFOT = 1
+         CALL ZHBEVD_2STAGE( '/', 'U', 0, 0, A, 1, X, Z, 1, 
+     $                           W, 1, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL ZHBEVD_2STAGE( 'V', 'U', 0, 0, A, 1, X, Z, 1, 
+     $                           W, 1, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHBEVD_2STAGE( 'N', '/', 0, 0, A, 1, X, Z, 1,
+     $                           W, 1, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHBEVD_2STAGE( 'N', 'U', -1, 0, A, 1, X, Z, 1,
+     $                            W, 1, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHBEVD_2STAGE( 'N', 'U', 0, -1, A, 1, X, Z, 1,
+     $                            W, 1, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL ZHBEVD_2STAGE( 'N', 'U', 2, 1, A, 1, X, Z, 1,
+     $                           W, 2, RW, 2, IW, 1, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZHBEVD_2STAGE( 'N', 'U', 2, 1, A, 2, X, Z, 0,
+     $                         W, 8, RW, 25, IW, 12, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZHBEVD_2STAGE( 'N', 'U', 1, 0, A, 1, X, Z, 1,
+     $                           W, 0, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZHBEVD_2STAGE( 'N', 'U', 2, 1, A, 2, X, Z, 2,
+     $                           W, 1, RW, 2, IW, 1, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 11
+*         CALL ZHBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 2,
+*     $                         W, 2, RW, 25, IW, 12, INFO )
+*         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL ZHBEVD_2STAGE( 'N', 'U', 1, 0, A, 1, X, Z, 1,
+     $                           W, 1, RW, 0, IW, 1, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL ZHBEVD_2STAGE( 'N', 'U', 2, 1, A, 2, X, Z, 2,
+     $                           W, 25, RW, 1, IW, 1, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 13
+*         CALL ZHBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 2,
+*     $                          W, 25, RW, 2, IW, 12, INFO )
+*         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL ZHBEVD_2STAGE( 'N', 'U', 1, 0, A, 1, X, Z, 1,
+     $                           W, 1, RW, 1, IW, 0, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 15
+         CALL ZHBEVD_2STAGE( 'N', 'U', 2, 1, A, 2, X, Z, 2,
+     $                           W, 25, RW, 2, IW, 0, INFO )
+         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 15
+*         CALL ZHBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 2,
+*     $                          W, 25, RW, 25, IW, 2, INFO )
+*         CALL CHKXER( 'ZHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 13
+*
 *        ZHBEV
 *
          SRNAMT = 'ZHBEV '
@@ -734,6 +1174,43 @@
          CALL CHKXER( 'ZHBEV ', INFOT, NOUT, LERR, OK )
          NT = NT + 6
 *
+*        ZHBEV_2STAGE
+*
+         SRNAMT = 'ZHBEV_2STAGE '
+         INFOT = 1
+         CALL ZHBEV_2STAGE( '/', 'U', 0, 0, A, 1, X,
+     $                        Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'ZHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 1
+         CALL ZHBEV_2STAGE( 'V', 'U', 0, 0, A, 1, X,
+     $                        Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'ZHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHBEV_2STAGE( 'N', '/', 0, 0, A, 1, X,
+     $                        Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'ZHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHBEV_2STAGE( 'N', 'U', -1, 0, A, 1, X,
+     $                         Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'ZHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHBEV_2STAGE( 'N', 'U', 0, -1, A, 1, X,
+     $                         Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'ZHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 6
+         CALL ZHBEV_2STAGE( 'N', 'U', 2, 1, A, 1, X,
+     $                        Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'ZHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZHBEV_2STAGE( 'N', 'U', 2, 0, A, 1, X,
+     $                        Z, 0, W, 0, RW, INFO )
+         CALL CHKXER( 'ZHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZHBEV_2STAGE( 'N', 'U', 2, 0, A, 1, X,
+     $                        Z, 1, W, 0, RW, INFO )
+         CALL CHKXER( 'ZHBEV_2STAGE ', INFOT, NOUT, LERR, OK )
+         NT = NT + 8
+*
 *        ZHBEVX
 *
          SRNAMT = 'ZHBEVX'
@@ -781,6 +1258,74 @@
      $                0, 0.0D0, M, X, Z, 1, W, RW, IW, I3, INFO )
          CALL CHKXER( 'ZHBEVX', INFOT, NOUT, LERR, OK )
          NT = NT + 11
+*
+*        ZHBEVX_2STAGE
+*
+         SRNAMT = 'ZHBEVX_2STAGE'
+         INFOT = 1
+         CALL ZHBEVX_2STAGE( '/', 'A', 'U', 0, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         INFOT = 1
+         CALL ZHBEVX_2STAGE( 'V', 'A', 'U', 0, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHBEVX_2STAGE( 'N', '/', 'U', 0, 0, A, 1, Q, 1,
+     $                       0.0D0, 1.0D0, 1, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHBEVX_2STAGE( 'N', 'A', '/', 0, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         INFOT = 4
+         CALL ZHBEVX_2STAGE( 'N', 'A', 'U', -1, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHBEVX_2STAGE( 'N', 'A', 'U', 0, -1, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHBEVX_2STAGE( 'N', 'A', 'U', 2, 1, A, 1, Q, 2,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 2, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+*         INFOT = 9
+*         CALL ZHBEVX_2STAGE( 'V', 'A', 'U', 2, 0, A, 1, Q, 1,
+*     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+*     $                       M, X, Z, 2, W, 0, RW, IW, I3, INFO )
+*         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZHBEVX_2STAGE( 'N', 'V', 'U', 1, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 12
+         CALL ZHBEVX_2STAGE( 'N', 'I', 'U', 1, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 13
+         CALL ZHBEVX_2STAGE( 'N', 'I', 'U', 1, 0, A, 1, Q, 1,
+     $                       0.0D0, 0.0D0, 1, 2, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 18
+         CALL ZHBEVX_2STAGE( 'N', 'A', 'U', 2, 0, A, 1, Q, 2,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 0, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         INFOT = 20
+         CALL ZHBEVX_2STAGE( 'N', 'A', 'U', 2, 0, A, 1, Q, 2,
+     $                       0.0D0, 0.0D0, 0, 0, 0.0D0,
+     $                       M, X, Z, 1, W, 0, RW, IW, I3, INFO )
+         CALL CHKXER( 'ZHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
+         NT = NT + 12
       END IF
 *
 *     Print a summary line.
diff --git a/TESTING/LIN/CMakeLists.txt b/TESTING/LIN/CMakeLists.txt
index 02a18e14..715f32ec 100644
--- a/TESTING/LIN/CMakeLists.txt
+++ b/TESTING/LIN/CMakeLists.txt
@@ -4,16 +4,16 @@ set(ALINTST
 
 set(SCLNTST slaord.f)
 
-set(DZLNTST dlaord.f )
+set(DZLNTST dlaord.f)
 
-set(SLINTST  schkaa.f
+set(SLINTST schkaa.f
    schkeq.f schkgb.f schkge.f schkgt.f
    schklq.f schkpb.f schkpo.f schkps.f schkpp.f
    schkpt.f schkq3.f schkql.f schkqr.f schkrq.f
-   schksp.f schksy.f schksy_rook.f schksy_aa.f schktb.f schktp.f schktr.f
+   schksp.f schksy.f schksy_rook.f schksy_rk.f schksy_aa.f schktb.f schktp.f schktr.f
    schktz.f
    sdrvgt.f sdrvls.f sdrvpb.f
-   sdrvpp.f sdrvpt.f sdrvsp.f sdrvsy.f sdrvsy_rook.f sdrvsy_aa.f
+   sdrvpp.f sdrvpt.f sdrvsp.f sdrvsy.f sdrvsy_rook.f sdrvsy_rk.f sdrvsy_aa.f
    serrgt.f serrlq.f serrls.f
    serrpo.f serrps.f serrql.f serrqp.f serrqr.f
    serrrq.f serrsy.f serrtr.f serrtz.f serrvx.f
@@ -29,7 +29,7 @@ set(SLINTST  schkaa.f
    sqrt01.f sqrt01p.f sqrt02.f sqrt03.f sqrt11.f sqrt12.f
    sqrt13.f sqrt14.f sqrt15.f sqrt16.f sqrt17.f
    srqt01.f srqt02.f srqt03.f srzt01.f srzt02.f
-   sspt01.f ssyt01.f ssyt01_rook.f ssyt01_aa.f 
+   sspt01.f ssyt01.f ssyt01_rook.f ssyt01_3.f ssyt01_aa.f
    stbt02.f stbt03.f stbt05.f stbt06.f stpt01.f
    stpt02.f stpt03.f stpt05.f stpt06.f strt01.f
    strt02.f strt03.f strt05.f strt06.f
@@ -44,15 +44,15 @@ else()
   list(APPEND SLINTST sdrvge.f serrge.f sdrvgb.f sdrvpo.f)
 endif()
 
-set(CLINTST  cchkaa.f
+set(CLINTST cchkaa.f
    cchkeq.f cchkgb.f cchkge.f cchkgt.f
-   cchkhe.f cchkhe_rook.f cchkhe_aa.f cchkhp.f cchklq.f cchkpb.f
+   cchkhe.f cchkhe_rook.f cchkhe_rk.f cchkhe_aa.f cchkhp.f cchklq.f cchkpb.f
    cchkpo.f cchkps.f cchkpp.f cchkpt.f cchkq3.f cchkql.f
-   cchkqr.f cchkrq.f cchksp.f cchksy.f cchksy_rook.f cchktb.f
+   cchkqr.f cchkrq.f cchksp.f cchksy.f cchksy_rook.f cchksy_rk.f cchksy_aa.f cchktb.f
    cchktp.f cchktr.f cchktz.f
-   cdrvgt.f cdrvhe.f cdrvhe_rook.f cdrvhe_aa.f cdrvhp.f
+   cdrvgt.f cdrvhe.f cdrvhe_rook.f cdrvhe_rk.f cdrvhe_aa.f cdrvhp.f
    cdrvls.f cdrvpb.f cdrvpp.f cdrvpt.f
-   cdrvsp.f cdrvsy.f cdrvsy_rook.f
+   cdrvsp.f cdrvsy.f cdrvsy_rook.f cdrvsy_rk.f cdrvsy_aa.f
    cerrgt.f cerrhe.f cerrlq.f
    cerrls.f cerrps.f cerrql.f cerrqp.f
    cerrqr.f cerrrq.f cerrsy.f cerrtr.f cerrtz.f
@@ -60,7 +60,8 @@ set(CLINTST  cchkaa.f
    cgbt01.f cgbt02.f cgbt05.f cgelqs.f cgeqls.f cgeqrs.f
    cgerqs.f cget01.f cget02.f
    cget03.f cget04.f cget07.f cgtt01.f cgtt02.f
-   cgtt05.f chet01.f chet01_rook.f chet01_aa.f chpt01.f claipd.f claptm.f clarhs.f clatb4.f clatb5.f
+   cgtt05.f chet01.f chet01_rook.f chet01_3.f chet01_aa.f
+   chpt01.f claipd.f claptm.f clarhs.f clatb4.f clatb5.f
    clatsp.f clatsy.f clattb.f clattp.f clattr.f
    clavhe.f clavhe_rook.f clavhp.f clavsp.f clavsy.f clavsy_rook.f clqt01.f
    clqt02.f clqt03.f cpbt01.f cpbt02.f cpbt05.f
@@ -71,14 +72,14 @@ set(CLINTST  cchkaa.f
    cqrt12.f cqrt13.f cqrt14.f cqrt15.f cqrt16.f
    cqrt17.f crqt01.f crqt02.f crqt03.f crzt01.f crzt02.f
    csbmv.f  cspt01.f
-   cspt02.f cspt03.f csyt01.f csyt01_rook.f csyt02.f csyt03.f
+   cspt02.f cspt03.f csyt01.f csyt01_rook.f csyt01_3.f csyt01_aa.f csyt02.f csyt03.f
    ctbt02.f ctbt03.f ctbt05.f ctbt06.f ctpt01.f
    ctpt02.f ctpt03.f ctpt05.f ctpt06.f ctrt01.f
    ctrt02.f ctrt03.f ctrt05.f ctrt06.f
    sget06.f cgennd.f
-   cqrt04.f cqrt05.f cchkqrt.f cerrqrt.f cchkqrtp.f cerrqrtp.f 
+   cqrt04.f cqrt05.f cchkqrt.f cerrqrt.f cchkqrtp.f cerrqrtp.f
    cchklqt.f cchklqtp.f cchktsqr.f
-   cerrlqt.f cerrlqtp.f cerrtsqr.f ctsqr01.f clqt04.f clqt05.f )
+   cerrlqt.f cerrlqtp.f cerrtsqr.f ctsqr01.f clqt04.f clqt05.f)
 
 if(USEXBLAS)
   list(APPEND
@@ -87,14 +88,14 @@ else()
   list(APPEND CLINTST cdrvge.f cdrvgb.f cerrge.f cdrvpo.f cerrpo.f)
 endif()
 
-set(DLINTST  dchkaa.f
+set(DLINTST dchkaa.f
    dchkeq.f dchkgb.f dchkge.f dchkgt.f
    dchklq.f dchkpb.f dchkpo.f dchkps.f dchkpp.f
    dchkpt.f dchkq3.f dchkql.f dchkqr.f dchkrq.f
-   dchksp.f dchksy.f dchksy_rook.f dchksy_aa.f dchktb.f dchktp.f dchktr.f
+   dchksp.f dchksy.f dchksy_rook.f dchksy_rk.f dchksy_aa.f dchktb.f dchktp.f dchktr.f
    dchktz.f
    ddrvgt.f ddrvls.f ddrvpb.f
-   ddrvpp.f ddrvpt.f ddrvsp.f ddrvsy.f ddrvsy_rook.f ddrvsy_aa.f
+   ddrvpp.f ddrvpt.f ddrvsp.f ddrvsy.f ddrvsy_rook.f ddrvsy_rk.f ddrvsy_aa.f
    derrgt.f derrlq.f derrls.f
    derrps.f derrql.f derrqp.f derrqr.f
    derrrq.f derrsy.f derrtr.f derrtz.f derrvx.f
@@ -110,32 +111,32 @@ set(DLINTST  dchkaa.f
    dqrt01.f dqrt01p.f dqrt02.f dqrt03.f dqrt11.f dqrt12.f
    dqrt13.f dqrt14.f dqrt15.f dqrt16.f dqrt17.f
    drqt01.f drqt02.f drqt03.f drzt01.f drzt02.f
-   dspt01.f dsyt01.f dsyt01_rook.f dsyt01_aa.f
+   dspt01.f dsyt01.f dsyt01_rook.f dsyt01_3.f dsyt01_aa.f
    dtbt02.f dtbt03.f dtbt05.f dtbt06.f dtpt01.f
    dtpt02.f dtpt03.f dtpt05.f dtpt06.f dtrt01.f
    dtrt02.f dtrt03.f dtrt05.f dtrt06.f
    dgennd.f
    dqrt04.f dqrt05.f dchkqrt.f derrqrt.f dchkqrtp.f derrqrtp.f
    dchklq.f dchklqt.f dchklqtp.f dchktsqr.f
-   derrlqt.f derrlqtp.f derrtsqr.f dtsqr01.f dlqt04.f dlqt05.f )
+   derrlqt.f derrlqtp.f derrtsqr.f dtsqr01.f dlqt04.f dlqt05.f)
 
 if(USEXBLAS)
   list(APPEND
-    DLINTST  ddrvgex.f ddrvgbx.f derrgex.f ddrvpox.f derrpox.f debchvxx.f)
+    DLINTST ddrvgex.f ddrvgbx.f derrgex.f ddrvpox.f derrpox.f debchvxx.f)
 else()
   list(APPEND
-    DLINTST  ddrvge.f ddrvgb.f derrge.f ddrvpo.f derrpo.f)
+    DLINTST ddrvge.f ddrvgb.f derrge.f ddrvpo.f derrpo.f)
 endif()
 
-set(ZLINTST  zchkaa.f
+set(ZLINTST zchkaa.f
    zchkeq.f zchkgb.f zchkge.f zchkgt.f
-   zchkhe.f zchkhe_rook.f zchkhe_aa.f zchkhp.f zchklq.f zchkpb.f
+   zchkhe.f zchkhe_rook.f zchkhe_rk.f zchkhe_aa.f zchkhp.f zchklq.f zchkpb.f
    zchkpo.f zchkps.f zchkpp.f zchkpt.f zchkq3.f zchkql.f
-   zchkqr.f zchkrq.f zchksp.f zchksy.f zchksy_rook.f zchktb.f
+   zchkqr.f zchkrq.f zchksp.f zchksy.f zchksy_rook.f zchksy_rk.f zchksy_aa.f zchktb.f
    zchktp.f zchktr.f zchktz.f
-   zdrvgt.f zdrvhe.f zdrvhe_rook.f zdrvhe_aa.f zdrvhp.f
+   zdrvgt.f zdrvhe.f zdrvhe_rook.f zdrvhe_rk.f zdrvhe_aa.f zdrvhp.f
    zdrvls.f zdrvpb.f zdrvpp.f zdrvpt.f
-   zdrvsp.f zdrvsy.f zdrvsy_rook.f
+   zdrvsp.f zdrvsy.f zdrvsy_rook.f zdrvsy_rk.f zdrvsy_aa.f
    zerrgt.f zerrhe.f zerrlq.f
    zerrls.f zerrps.f zerrql.f zerrqp.f
    zerrqr.f zerrrq.f zerrsy.f zerrtr.f zerrtz.f
@@ -143,7 +144,8 @@ set(ZLINTST  zchkaa.f
    zgbt01.f zgbt02.f zgbt05.f zgelqs.f zgeqls.f zgeqrs.f
    zgerqs.f zget01.f zget02.f
    zget03.f zget04.f zget07.f zgtt01.f zgtt02.f
-   zgtt05.f zhet01.f zhet01_rook.f zhet01_aa.f zhpt01.f zlaipd.f zlaptm.f zlarhs.f zlatb4.f zlatb5.f
+   zgtt05.f zhet01.f zhet01_rook.f zhet01_3.f zhet01_aa.f
+   zhpt01.f zlaipd.f zlaptm.f zlarhs.f zlatb4.f zlatb5.f
    zlatsp.f zlatsy.f zlattb.f zlattp.f zlattr.f
    zlavhe.f zlavhe_rook.f zlavhp.f zlavsp.f zlavsy.f zlavsy_rook.f zlqt01.f
    zlqt02.f zlqt03.f zpbt01.f zpbt02.f zpbt05.f
@@ -154,7 +156,7 @@ set(ZLINTST  zchkaa.f
    zqrt12.f zqrt13.f zqrt14.f zqrt15.f zqrt16.f
    zqrt17.f zrqt01.f zrqt02.f zrqt03.f zrzt01.f zrzt02.f
    zsbmv.f  zspt01.f
-   zspt02.f zspt03.f zsyt01.f  zsyt01_rook.f zsyt02.f zsyt03.f
+   zspt02.f zspt03.f zsyt01.f zsyt01_rook.f zsyt01_3.f zsyt01_aa.f zsyt02.f zsyt03.f
    ztbt02.f ztbt03.f ztbt05.f ztbt06.f ztpt01.f
    ztpt02.f ztpt03.f ztpt05.f ztpt06.f ztrt01.f
    ztrt02.f ztrt03.f ztrt05.f ztrt06.f
@@ -165,69 +167,69 @@ set(ZLINTST  zchkaa.f
 
 if(USEXBLAS)
   list(APPEND
-    ZLINTST  zdrvgex.f zdrvgbx.f zerrgex.f zdrvpox.f zerrpox.f zebchvxx.f)
+    ZLINTST zdrvgex.f zdrvgbx.f zerrgex.f zdrvpox.f zerrpox.f zebchvxx.f)
 else()
   list(APPEND
-    ZLINTST  zdrvge.f zdrvgb.f zerrge.f zdrvpo.f zerrpo.f)
+    ZLINTST zdrvge.f zdrvgb.f zerrge.f zdrvpo.f zerrpo.f)
 endif()
 
-set(DSLINTST  dchkab.f
+set(DSLINTST dchkab.f
 	ddrvab.f ddrvac.f derrab.f derrac.f dget08.f
 	alaerh.f alahd.f  aladhd.f alareq.f
 	chkxer.f dlarhs.f dlatb4.f xerbla.f
 	dget02.f dpot06.f)
 
-set(ZCLINTST  zchkab.f
+set(ZCLINTST zchkab.f
 	zdrvab.f zdrvac.f zerrab.f zerrac.f zget08.f
 	alaerh.f alahd.f  aladhd.f alareq.f
 	chkxer.f zget02.f zlarhs.f zlatb4.f
 	zsbmv.f  xerbla.f zpot06.f zlaipd.f)
 
-set(SLINTSTRFP  schkrfp.f sdrvrfp.f sdrvrf1.f sdrvrf2.f sdrvrf3.f sdrvrf4.f serrrfp.f
+set(SLINTSTRFP schkrfp.f sdrvrfp.f sdrvrf1.f sdrvrf2.f sdrvrf3.f sdrvrf4.f serrrfp.f
 	slatb4.f slarhs.f sget04.f spot01.f spot03.f spot02.f
-	chkxer.f xerbla.f alaerh.f aladhd.f alahd.f alasvm.f )
+	chkxer.f xerbla.f alaerh.f aladhd.f alahd.f alasvm.f)
 
-set(DLINTSTRFP  dchkrfp.f ddrvrfp.f ddrvrf1.f ddrvrf2.f ddrvrf3.f ddrvrf4.f derrrfp.f
+set(DLINTSTRFP dchkrfp.f ddrvrfp.f ddrvrf1.f ddrvrf2.f ddrvrf3.f ddrvrf4.f derrrfp.f
 	dlatb4.f dlarhs.f dget04.f dpot01.f dpot03.f dpot02.f
-	chkxer.f xerbla.f alaerh.f aladhd.f alahd.f alasvm.f )
+	chkxer.f xerbla.f alaerh.f aladhd.f alahd.f alasvm.f)
 
-set(CLINTSTRFP  cchkrfp.f cdrvrfp.f cdrvrf1.f cdrvrf2.f cdrvrf3.f cdrvrf4.f cerrrfp.f
+set(CLINTSTRFP cchkrfp.f cdrvrfp.f cdrvrf1.f cdrvrf2.f cdrvrf3.f cdrvrf4.f cerrrfp.f
   claipd.f clatb4.f clarhs.f csbmv.f cget04.f cpot01.f cpot03.f cpot02.f
-  chkxer.f xerbla.f alaerh.f aladhd.f alahd.f alasvm.f )
+  chkxer.f xerbla.f alaerh.f aladhd.f alahd.f alasvm.f)
 
-set(ZLINTSTRFP  zchkrfp.f zdrvrfp.f zdrvrf1.f zdrvrf2.f zdrvrf3.f zdrvrf4.f zerrrfp.f
+set(ZLINTSTRFP zchkrfp.f zdrvrfp.f zdrvrf1.f zdrvrf2.f zdrvrf3.f zdrvrf4.f zerrrfp.f
   zlatb4.f zlaipd.f zlarhs.f zsbmv.f zget04.f zpot01.f zpot03.f zpot02.f
-  chkxer.f xerbla.f alaerh.f aladhd.f alahd.f alasvm.f )
+  chkxer.f xerbla.f alaerh.f aladhd.f alahd.f alasvm.f)
 
-macro(add_lin_executable name )
+macro(add_lin_executable name)
   add_executable(${name} ${ARGN})
   target_link_libraries(${name} tmglib ${LAPACK_LIBRARIES})
 endmacro()
 
 if(BUILD_SINGLE)
-add_lin_executable(xlintsts ${ALINTST} ${SCLNTST} ${SLINTST} ${SECOND_SRC} )
-add_lin_executable(xlintstrfs ${SLINTSTRFP} ${SECOND_SRC})
+  add_lin_executable(xlintsts ${ALINTST} ${SCLNTST} ${SLINTST} ${SECOND_SRC})
+  add_lin_executable(xlintstrfs ${SLINTSTRFP} ${SECOND_SRC})
 endif()
 
 if(BUILD_DOUBLE)
-add_lin_executable(xlintstd  ${ALINTST} ${DLINTST} ${DZLNTST} ${DSECOND_SRC})
-add_lin_executable(xlintstrfd ${DLINTSTRFP} ${DSECOND_SRC})
+  add_lin_executable(xlintstd ${ALINTST} ${DLINTST} ${DZLNTST} ${DSECOND_SRC})
+  add_lin_executable(xlintstrfd ${DLINTSTRFP} ${DSECOND_SRC})
 endif()
 
 if(BUILD_SINGLE AND BUILD_DOUBLE)
-add_lin_executable(xlintstds ${DSLINTST} ${SECOND_SRC} ${DSECOND_SRC} )
+  add_lin_executable(xlintstds ${DSLINTST} ${SECOND_SRC} ${DSECOND_SRC})
 endif()
 
 if(BUILD_COMPLEX)
-add_lin_executable(xlintstc  ${ALINTST} ${CLINTST} ${SCLNTST} ${SECOND_SRC} )
-add_lin_executable(xlintstrfc  ${CLINTSTRFP} ${SECOND_SRC})
+  add_lin_executable(xlintstc ${ALINTST} ${CLINTST} ${SCLNTST} ${SECOND_SRC})
+  add_lin_executable(xlintstrfc ${CLINTSTRFP} ${SECOND_SRC})
 endif()
 
 if(BUILD_COMPLEX16)
-add_lin_executable(xlintstz  ${ALINTST} ${ZLINTST} ${DZLNTST} ${DSECOND_SRC})
-add_lin_executable(xlintstrfz ${ZLINTSTRFP} ${DSECOND_SRC})
+  add_lin_executable(xlintstz ${ALINTST} ${ZLINTST} ${DZLNTST} ${DSECOND_SRC})
+  add_lin_executable(xlintstrfz ${ZLINTSTRFP} ${DSECOND_SRC})
 endif()
 
 if(BUILD_COMPLEX AND BUILD_COMPLEX16)
-add_lin_executable(xlintstzc ${ZCLINTST} ${SECOND_SRC} ${DSECOND_SRC} )
+  add_lin_executable(xlintstzc ${ZCLINTST} ${SECOND_SRC} ${DSECOND_SRC})
 endif()
diff --git a/TESTING/LIN/Makefile b/TESTING/LIN/Makefile
index a9d1d177..bd188b20 100644
--- a/TESTING/LIN/Makefile
+++ b/TESTING/LIN/Makefile
@@ -35,7 +35,7 @@ include ../../make.inc
 #######################################################################
 
 ifneq ($(strip $(VARLIB)),)
-    LAPACKLIB :=  $(VARLIB) ../../$(LAPACKLIB)
+    LAPACKLIB := $(VARLIB) ../../$(LAPACKLIB)
 endif
 
 
@@ -43,18 +43,18 @@ ALINTST = \
    aladhd.o alaerh.o alaesm.o alahd.o alareq.o \
    alasum.o alasvm.o chkxer.o icopy.o ilaenv.o xlaenv.o xerbla.o
 
-SCLNTST= slaord.o
+SCLNTST = slaord.o
 
-DZLNTST= dlaord.o
+DZLNTST = dlaord.o
 
 SLINTST = schkaa.o \
    schkeq.o schkgb.o schkge.o schkgt.o \
    schklq.o schkpb.o schkpo.o schkps.o schkpp.o \
    schkpt.o schkq3.o schkql.o schkqr.o schkrq.o \
-   schksp.o schksy.o schksy_rook.o schksy_aa.o schktb.o schktp.o schktr.o \
+   schksp.o schksy.o schksy_rook.o schksy_rk.o schksy_aa.o schktb.o schktp.o schktr.o \
    schktz.o \
    sdrvgt.o sdrvls.o sdrvpb.o \
-   sdrvpp.o sdrvpt.o sdrvsp.o  sdrvsy_rook.o sdrvsy_aa.o\
+   sdrvpp.o sdrvpt.o sdrvsp.o sdrvsy_rook.o sdrvsy_rk.o  sdrvsy_aa.o \
    serrgt.o serrlq.o serrls.o \
    serrps.o serrql.o serrqp.o serrqr.o \
    serrrq.o serrtr.o serrtz.o \
@@ -70,13 +70,13 @@ SLINTST = schkaa.o \
    sqrt01.o sqrt01p.o sqrt02.o sqrt03.o sqrt11.o sqrt12.o \
    sqrt13.o sqrt14.o sqrt15.o sqrt16.o sqrt17.o \
    srqt01.o srqt02.o srqt03.o srzt01.o srzt02.o \
-   sspt01.o ssyt01.o ssyt01_rook.o ssyt01_aa.o\
+   sspt01.o ssyt01.o ssyt01_rook.o ssyt01_3.o ssyt01_aa.o \
    stbt02.o stbt03.o stbt05.o stbt06.o stpt01.o \
    stpt02.o stpt03.o stpt05.o stpt06.o strt01.o \
    strt02.o strt03.o strt05.o strt06.o \
    sgennd.o sqrt04.o sqrt05.o schkqrt.o serrqrt.o schkqrtp.o serrqrtp.o \
    schklqt.o schklqtp.o schktsqr.o \
-   serrlqt.o serrlqtp.o serrtsqr.o stsqr01.o slqt04.o slqt05.o 
+   serrlqt.o serrlqtp.o serrtsqr.o stsqr01.o slqt04.o slqt05.o
 
 ifdef USEXBLAS
 SLINTST += serrvxx.o sdrvgex.o sdrvsyx.o serrgex.o sdrvgbx.o sdrvpox.o \
@@ -88,20 +88,21 @@ endif
 
 CLINTST = cchkaa.o \
    cchkeq.o cchkgb.o cchkge.o cchkgt.o \
-   cchkhe.o cchkhe_rook.o cchkhe_aa.o cchkhp.o cchklq.o cchkpb.o \
+   cchkhe.o cchkhe_rook.o cchkhe_rk.o cchkhe_aa.o cchkhp.o cchklq.o cchkpb.o \
    cchkpo.o cchkps.o cchkpp.o cchkpt.o cchkq3.o cchkql.o \
-   cchkqr.o cchkrq.o cchksp.o cchksy.o cchksy_rook.o cchktb.o \
+   cchkqr.o cchkrq.o cchksp.o cchksy.o cchksy_rook.o cchksy_rk.o cchksy_aa.o cchktb.o \
    cchktp.o cchktr.o cchktz.o \
-   cdrvgt.o cdrvhe_rook.o cdrvhe_aa.o cdrvhp.o \
+   cdrvgt.o cdrvhe_rook.o cdrvhe_rk.o cdrvhe_aa.o cdrvhp.o \
    cdrvls.o cdrvpb.o cdrvpp.o cdrvpt.o \
-   cdrvsp.o cdrvsy_rook.o \
+   cdrvsp.o cdrvsy_rook.o cdrvsy_rk.o cdrvsy_aa.o \
    cerrgt.o cerrlq.o \
    cerrls.o cerrps.o cerrql.o cerrqp.o \
    cerrqr.o cerrrq.o cerrtr.o cerrtz.o \
    cgbt01.o cgbt02.o cgbt05.o cgelqs.o cgeqls.o cgeqrs.o \
    cgerqs.o cget01.o cget02.o \
    cget03.o cget04.o cget07.o cgtt01.o cgtt02.o \
-   cgtt05.o chet01.o chet01_rook.o chet01_aa.o chpt01.o claipd.o claptm.o clarhs.o clatb4.o clatb5.o \
+   cgtt05.o chet01.o chet01_rook.o chet01_3.o \
+   chet01_aa.o chpt01.o claipd.o claptm.o clarhs.o clatb4.o clatb5.o \
    clatsp.o clatsy.o clattb.o clattp.o clattr.o \
    clavhe.o clavhe_rook.o clavhp.o clavsp.o clavsy.o clavsy_rook.o clqt01.o \
    clqt02.o clqt03.o cpbt01.o cpbt02.o cpbt05.o \
@@ -112,14 +113,14 @@ CLINTST = cchkaa.o \
    cqrt12.o cqrt13.o cqrt14.o cqrt15.o cqrt16.o \
    cqrt17.o crqt01.o crqt02.o crqt03.o crzt01.o crzt02.o \
    csbmv.o  cspt01.o \
-   cspt02.o cspt03.o csyt01.o csyt01_rook.o csyt02.o csyt03.o \
+   cspt02.o cspt03.o csyt01.o csyt01_rook.o csyt01_3.o csyt01_aa.o csyt02.o csyt03.o \
    ctbt02.o ctbt03.o ctbt05.o ctbt06.o ctpt01.o \
    ctpt02.o ctpt03.o ctpt05.o ctpt06.o ctrt01.o \
    ctrt02.o ctrt03.o ctrt05.o ctrt06.o \
    sget06.o cgennd.o \
    cqrt04.o cqrt05.o cchkqrt.o cerrqrt.o cchkqrtp.o cerrqrtp.o \
    cchklqt.o cchklqtp.o cchktsqr.o \
-   cerrlqt.o cerrlqtp.o cerrtsqr.o ctsqr01.o clqt04.o clqt05.o 
+   cerrlqt.o cerrlqtp.o cerrtsqr.o ctsqr01.o clqt04.o clqt05.o
 
 ifdef USEXBLAS
 CLINTST += cerrvxx.o cdrvgex.o cdrvsyx.o cdrvgbx.o cerrgex.o cdrvpox.o \
@@ -133,10 +134,10 @@ DLINTST = dchkaa.o \
    dchkeq.o dchkgb.o dchkge.o dchkgt.o \
    dchklq.o dchkpb.o dchkpo.o dchkps.o dchkpp.o \
    dchkpt.o dchkq3.o dchkql.o dchkqr.o dchkrq.o \
-   dchksp.o dchksy.o dchksy_rook.o dchksy_aa.o dchktb.o dchktp.o dchktr.o \
+   dchksp.o dchksy.o dchksy_rook.o dchksy_rk.o dchksy_aa.o dchktb.o dchktp.o dchktr.o \
    dchktz.o \
    ddrvgt.o ddrvls.o ddrvpb.o \
-   ddrvpp.o ddrvpt.o ddrvsp.o ddrvsy_rook.o ddrvsy_aa.o\
+   ddrvpp.o ddrvpt.o ddrvsp.o ddrvsy_rook.o ddrvsy_rk.o ddrvsy_aa.o \
    derrgt.o derrlq.o derrls.o \
    derrps.o derrql.o derrqp.o derrqr.o \
    derrrq.o derrtr.o derrtz.o \
@@ -149,17 +150,17 @@ DLINTST = dchkaa.o \
    dpot02.o dpot03.o dpot05.o dpst01.o dppt01.o \
    dppt02.o dppt03.o dppt05.o dptt01.o dptt02.o \
    dptt05.o dqlt01.o dqlt02.o dqlt03.o dqpt01.o \
-   dqrt01.o dqrt01p.o  dqrt02.o dqrt03.o dqrt11.o dqrt12.o \
+   dqrt01.o dqrt01p.o dqrt02.o dqrt03.o dqrt11.o dqrt12.o \
    dqrt13.o dqrt14.o dqrt15.o dqrt16.o dqrt17.o \
    drqt01.o drqt02.o drqt03.o drzt01.o drzt02.o \
-   dspt01.o dsyt01.o dsyt01_rook.o dsyt01_aa.o\
+   dspt01.o dsyt01.o dsyt01_rook.o dsyt01_3.o dsyt01_aa.o \
    dtbt02.o dtbt03.o dtbt05.o dtbt06.o dtpt01.o \
    dtpt02.o dtpt03.o dtpt05.o dtpt06.o dtrt01.o \
    dtrt02.o dtrt03.o dtrt05.o dtrt06.o \
    dgennd.o \
    dqrt04.o dqrt05.o dchkqrt.o derrqrt.o dchkqrtp.o derrqrtp.o \
    dchklq.o dchklqt.o dchklqtp.o dchktsqr.o \
-   derrlqt.o derrlqtp.o derrtsqr.o dtsqr01.o dlqt04.o dlqt05.o 
+   derrlqt.o derrlqtp.o derrtsqr.o dtsqr01.o dlqt04.o dlqt05.o
 
 ifdef USEXBLAS
 DLINTST += derrvxx.o ddrvgex.o ddrvsyx.o ddrvgbx.o derrgex.o ddrvpox.o derrpox.o \
@@ -171,20 +172,21 @@ endif
 
 ZLINTST = zchkaa.o \
    zchkeq.o zchkgb.o zchkge.o zchkgt.o \
-   zchkhe.o zchkhe_rook.o zchkhe_aa.o zchkhp.o zchklq.o zchkpb.o \
+   zchkhe.o zchkhe_rook.o zchkhe_rk.o zchkhe_aa.o zchkhp.o zchklq.o zchkpb.o \
    zchkpo.o zchkps.o zchkpp.o zchkpt.o zchkq3.o zchkql.o \
-   zchkqr.o zchkrq.o zchksp.o zchksy.o zchksy_rook.o zchktb.o \
+   zchkqr.o zchkrq.o zchksp.o zchksy.o zchksy_rook.o zchksy_rk.o zchksy_aa.o zchktb.o \
    zchktp.o zchktr.o zchktz.o \
-   zdrvgt.o zdrvhe_rook.o zdrvhe_aa.o zdrvhp.o \
+   zdrvgt.o zdrvhe_rook.o zdrvhe_rk.o zdrvhe_aa.o zdrvhp.o \
    zdrvls.o zdrvpb.o zdrvpp.o zdrvpt.o \
-   zdrvsp.o zdrvsy_rook.o \
+   zdrvsp.o zdrvsy_rook.o zdrvsy_rk.o zdrvsy_aa.o \
    zerrgt.o zerrlq.o \
    zerrls.o zerrps.o zerrql.o zerrqp.o \
    zerrqr.o zerrrq.o zerrtr.o zerrtz.o \
    zgbt01.o zgbt02.o zgbt05.o zgelqs.o zgeqls.o zgeqrs.o \
    zgerqs.o zget01.o zget02.o \
    zget03.o zget04.o zget07.o zgtt01.o zgtt02.o \
-   zgtt05.o zhet01.o zhet01_rook.o zhet01_aa.o zhpt01.o zlaipd.o zlaptm.o zlarhs.o zlatb4.o zlatb5.o \
+   zgtt05.o zhet01.o zhet01_rook.o zhet01_3.o \
+   zhet01_aa.o zhpt01.o zlaipd.o zlaptm.o zlarhs.o zlatb4.o zlatb5.o \
    zlatsp.o zlatsy.o zlattb.o zlattp.o zlattr.o \
    zlavhe.o zlavhe_rook.o zlavhp.o zlavsp.o zlavsy.o zlavsy_rook.o zlqt01.o \
    zlqt02.o zlqt03.o zpbt01.o zpbt02.o zpbt05.o \
@@ -195,7 +197,7 @@ ZLINTST = zchkaa.o \
    zqrt12.o zqrt13.o zqrt14.o zqrt15.o zqrt16.o \
    zqrt17.o zrqt01.o zrqt02.o zrqt03.o zrzt01.o zrzt02.o \
    zsbmv.o  zspt01.o \
-   zspt02.o zspt03.o zsyt01.o zsyt01_rook.o zsyt02.o zsyt03.o \
+   zspt02.o zspt03.o zsyt01.o zsyt01_rook.o zsyt01_3.o zsyt01_aa.o zsyt02.o zsyt03.o \
    ztbt02.o ztbt03.o ztbt05.o ztbt06.o ztpt01.o \
    ztpt02.o ztpt03.o ztpt05.o ztpt06.o ztrt01.o \
    ztrt02.o ztrt03.o ztrt05.o ztrt06.o \
@@ -213,13 +215,13 @@ ZLINTST += zerrvx.o zdrvge.o zdrvsy.o zdrvgb.o zerrge.o zdrvpo.o \
 endif
 
 DSLINTST = dchkab.o \
-	ddrvab.o ddrvac.o derrab.o derrac.o dget08.o          \
+	ddrvab.o ddrvac.o derrab.o derrac.o dget08.o \
 	alaerh.o alahd.o  aladhd.o alareq.o \
 	chkxer.o dlarhs.o dlatb4.o xerbla.o \
 	dget02.o dpot06.o
 
 ZCLINTST = zchkab.o \
-	zdrvab.o zdrvac.o zerrab.o zerrac.o zget08.o          \
+	zdrvab.o zdrvac.o zerrab.o zerrac.o zget08.o \
 	alaerh.o alahd.o  aladhd.o alareq.o \
 	chkxer.o zget02.o zlarhs.o zlatb4.o \
 	zsbmv.o  xerbla.o zpot06.o zlaipd.o
@@ -240,7 +242,7 @@ ZLINTSTRFP = zchkrfp.o zdrvrfp.o zdrvrf1.o zdrvrf2.o zdrvrf3.o zdrvrf4.o zerrrfp
 	zlatb4.o zlaipd.o zlarhs.o zsbmv.o zget04.o zpot01.o zpot03.o zpot02.o \
 	chkxer.o xerbla.o alaerh.o aladhd.o alahd.o alasvm.o
 
-all:  single double complex complex16 proto-single proto-double proto-complex proto-complex16
+all: single double complex complex16 proto-single proto-double proto-complex proto-complex16
 
 single: ../xlintsts
 double: ../xlintstd
@@ -252,75 +254,45 @@ proto-double: ../xlintstds ../xlintstrfd
 proto-complex: ../xlintstrfc
 proto-complex16: ../xlintstzc ../xlintstrfz
 
-xlintsts : $(ALINTST) $(SLINTST) $(SCLNTST) ../../$(LAPACKLIB)
-	$(LOADER) $(LOADOPTS)  $(ALINTST) $(SCLNTST) $(SLINTST) \
-        ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB)  $(BLASLIB) -o $@
+../xlintsts: $(ALINTST) $(SLINTST) $(SCLNTST) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ $(ALINTST) $(SCLNTST) $(SLINTST) \
+	../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
 
-xlintstc : $(ALINTST) $(CLINTST) $(SCLNTST) ../../$(LAPACKLIB)
-	$(LOADER) $(LOADOPTS)  $(ALINTST) $(SCLNTST) $(CLINTST) \
-        ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB)  $(BLASLIB) -o $@
+../xlintstc: $(ALINTST) $(CLINTST) $(SCLNTST) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ $(ALINTST) $(SCLNTST) $(CLINTST) \
+	../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
 
-xlintstd : $(ALINTST) $(DLINTST) $(DZLNTST) ../../$(LAPACKLIB)
-	$(LOADER) $(LOADOPTS) $^ \
-        ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB) -o $@
+../xlintstd: $(ALINTST) $(DLINTST) $(DZLNTST) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ $^ \
+	../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
 
-xlintstz : $(ALINTST) $(ZLINTST) $(DZLNTST) ../../$(LAPACKLIB)
-	$(LOADER) $(LOADOPTS)  $(ALINTST) $(DZLNTST) $(ZLINTST) \
-        ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB)  $(BLASLIB) -o $@
+../xlintstz: $(ALINTST) $(ZLINTST) $(DZLNTST) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ $(ALINTST) $(DZLNTST) $(ZLINTST) \
+	../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
 
-xlintstds : $(DSLINTST) ../../$(LAPACKLIB)
-	$(LOADER) $(LOADOPTS)  $(DSLINTST) \
-        ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) -o $@
+../xlintstds: $(DSLINTST) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ $(DSLINTST) \
+	../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
 
-xlintstzc : $(ZCLINTST) ../../$(LAPACKLIB)
-	$(LOADER) $(LOADOPTS)  $(ZCLINTST) \
-        ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) -o $@
+../xlintstzc: $(ZCLINTST) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ $(ZCLINTST) \
+	../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
 
-xlintstrfs : $(SLINTSTRFP) ../../$(LAPACKLIB)
-	$(LOADER) $(LOADOPTS)  $(SLINTSTRFP) \
-        ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) -o $@
+../xlintstrfs: $(SLINTSTRFP) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ $(SLINTSTRFP) \
+	../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
 
-xlintstrfd : $(DLINTSTRFP) ../../$(LAPACKLIB)
-	$(LOADER) $(LOADOPTS)  $(DLINTSTRFP) \
-        ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) -o $@
+../xlintstrfd: $(DLINTSTRFP) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ $(DLINTSTRFP) \
+	../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
 
-xlintstrfc : $(CLINTSTRFP) ../../$(LAPACKLIB)
-	$(LOADER) $(LOADOPTS)  $(CLINTSTRFP) \
-        ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) -o $@
+../xlintstrfc: $(CLINTSTRFP) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ $(CLINTSTRFP) \
+	../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
 
-xlintstrfz : $(ZLINTSTRFP) ../../$(LAPACKLIB)
-	$(LOADER) $(LOADOPTS)  $(ZLINTSTRFP) \
-        ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) -o $@
-
-../xlintsts: xlintsts
-	mv xlintsts $@
-
-../xlintstc: xlintstc
-	mv xlintstc $@
-
-../xlintstz: xlintstz
-	mv xlintstz $@
-
-../xlintstd: xlintstd
-	mv xlintstd $@
-
-../xlintstds: xlintstds
-	mv xlintstds $@
-
-../xlintstzc: xlintstzc
-	mv xlintstzc $@
-
-../xlintstrfs: xlintstrfs
-	mv xlintstrfs $@
-
-../xlintstrfc: xlintstrfc
-	mv xlintstrfc $@
-
-../xlintstrfd: xlintstrfd
-	mv xlintstrfd $@
-
-../xlintstrfz: xlintstrfz
-	mv xlintstrfz $@
+../xlintstrfz: $(ZLINTSTRFP) ../../$(LAPACKLIB)
+	$(LOADER) $(LOADOPTS) -o $@ $(ZLINTSTRFP) \
+	../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
 
 $(ALINTST): $(FRC)
 $(SCLNTST): $(FRC)
@@ -337,15 +309,15 @@ clean:
 	rm -f *.o
 
 schkaa.o: schkaa.f
-	$(FORTRAN) $(DRVOPTS) -c $< -o $@
+	$(FORTRAN) $(DRVOPTS) -c -o $@ $<
 dchkaa.o: dchkaa.f
-	$(FORTRAN) $(DRVOPTS) -c $< -o $@
+	$(FORTRAN) $(DRVOPTS) -c -o $@ $<
 cchkaa.o: cchkaa.f
-	$(FORTRAN) $(DRVOPTS) -c $< -o $@
+	$(FORTRAN) $(DRVOPTS) -c -o $@ $<
 zchkaa.o: zchkaa.f
-	$(FORTRAN) $(DRVOPTS) -c $< -o $@
+	$(FORTRAN) $(DRVOPTS) -c -o $@ $<
 
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
 
 .NOTPARALLEL:
diff --git a/TESTING/LIN/aladhd.f b/TESTING/LIN/aladhd.f
index a45a56f3..130c57a8 100644
--- a/TESTING/LIN/aladhd.f
+++ b/TESTING/LIN/aladhd.f
@@ -50,7 +50,12 @@
 *>             _SY:  Symmetric indefinite,
 *>                     with partial (Bunch-Kaufman) pivoting
 *>             _SR:  Symmetric indefinite,
-*>                     with "rook" (bounded Bunch-Kaufman) pivoting
+*>                     with rook (bounded Bunch-Kaufman) pivoting
+*>             _SK:  Symmetric indefinite,
+*>                     with rook (bounded Bunch-Kaufman) pivoting
+*>                     ( new storage format for factors:
+*>                       L and diagonal of D is stored in A,
+*>                       subdiagonal of D is stored in E )
 *>             _SP:  Symmetric indefinite packed,
 *>                     with partial (Bunch-Kaufman) pivoting
 *>             _HA:  (complex) Hermitian ,
@@ -58,7 +63,12 @@
 *>             _HE:  (complex) Hermitian indefinite,
 *>                     with partial (Bunch-Kaufman) pivoting
 *>             _HR:  (complex) Hermitian indefinite,
-*>                     with "rook" (bounded Bunch-Kaufman) pivoting
+*>                     with rook (bounded Bunch-Kaufman) pivoting
+*>             _HK:  (complex) Hermitian indefinite,
+*>                     with rook (bounded Bunch-Kaufman) pivoting
+*>                     ( new storage format for factors:
+*>                       L and diagonal of D is stored in A,
+*>                       subdiagonal of D is stored in E )
 *>             _HP:  (complex) Hermitian indefinite packed,
 *>                     with partial (Bunch-Kaufman) pivoting
 *>          The first character must be one of S, D, C, or Z (C or Z only
@@ -73,17 +83,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2013
+*> \date November 2016
 *
 *> \ingroup aux_lin
 *
 *  =====================================================================
       SUBROUTINE ALADHD( IOUNIT, PATH )
 *
-*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2013
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -257,10 +267,16 @@
          WRITE( IOUNIT, FMT = 9976 )6
          WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
 *
-      ELSE IF( LSAMEN( 2, P2, 'SR' )  ) THEN
+      ELSE IF( LSAMEN( 2, P2, 'SR' ) .OR. LSAMEN( 2, P2, 'SK') ) THEN
 *
 *        SR: Symmetric indefinite full,
-*            with "rook" (bounded Bunch-Kaufman) pivoting algorithm
+*            with rook (bounded Bunch-Kaufman) pivoting algorithm
+*
+*        SK: Symmetric indefinite full,
+*            with rook (bounded Bunch-Kaufman) pivoting algorithm,
+*            ( new storage format for factors:
+*              L and diagonal of D is stored in A,
+*              subdiagonal of D is stored in E )
 *
          WRITE( IOUNIT, FMT = 9992 )PATH, 'Symmetric'
 *
@@ -322,10 +338,16 @@
          WRITE( IOUNIT, FMT = 9976 )6
          WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
 *
-      ELSE IF( LSAMEN( 2, P2, 'HR' )  ) THEN
+      ELSE IF( LSAMEN( 2, P2, 'HR' ) .OR. LSAMEN( 2, P2, 'HK' ) ) THEN
 *
 *        HR: Hermitian indefinite full,
-*            with "rook" (bounded Bunch-Kaufman) pivoting algorithm
+*            with rook (bounded Bunch-Kaufman) pivoting algorithm
+*
+*        HK: Hermitian indefinite full,
+*            with rook (bounded Bunch-Kaufman) pivoting algorithm,
+*            ( new storage format for factors:
+*              L and diagonal of D is stored in A,
+*              subdiagonal of D is stored in E )
 *
          WRITE( IOUNIT, FMT = 9992 )PATH, 'Hermitian'
 *
diff --git a/TESTING/LIN/alaerh.f b/TESTING/LIN/alaerh.f
index 4fec4522..0346e10e 100644
--- a/TESTING/LIN/alaerh.f
+++ b/TESTING/LIN/alaerh.f
@@ -139,7 +139,7 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2013
+*> \date November 2016
 *
 *> \ingroup aux_lin
 *
@@ -147,10 +147,10 @@
       SUBROUTINE ALAERH( PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU,
      $                   N5, IMAT, NFAIL, NERRS, NOUT )
 *
-*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2013
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -489,20 +489,28 @@
 *
       ELSE IF( LSAMEN( 2, P2, 'SY' )
      $         .OR. LSAMEN( 2, P2, 'SR' )
+     $         .OR. LSAMEN( 2, P2, 'SK' )
      $         .OR. LSAMEN( 2, P2, 'HE' )
-     $         .OR. LSAMEN( 2, P2, 'HA' )
-     $         .OR. LSAMEN( 2, P2, 'HR' ) ) THEN
+     $         .OR. LSAMEN( 2, P2, 'HR' )
+     $         .OR. LSAMEN( 2, P2, 'HK' )
+     $         .OR. LSAMEN( 2, P2, 'HA' ) ) THEN
 *
 *        xSY: symmetric indefinite matrices
 *             with partial (Bunch-Kaufman) pivoting;
 *        xSR: symmetric indefinite matrices
 *             with rook (bounded Bunch-Kaufman) pivoting;
+*        xSK: symmetric indefinite matrices
+*             with rook (bounded Bunch-Kaufman) pivoting,
+*             new storage format;
 *        xHE: Hermitian indefinite matrices
 *             with partial (Bunch-Kaufman) pivoting.
-*        xHA: Hermitian matrices
-*             Aasen Algorithm
 *        xHR: Hermitian indefinite matrices
 *             with rook (bounded Bunch-Kaufman) pivoting;
+*        xHK: Hermitian indefinite matrices
+*             with rook (bounded Bunch-Kaufman) pivoting,
+*             new storage format;
+*        xHA: Hermitian matrices
+*             Aasen Algorithm
 *
          UPLO = OPTS( 1: 1 )
          IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
diff --git a/TESTING/LIN/alahd.f b/TESTING/LIN/alahd.f
index 7919957f..d124d770 100644
--- a/TESTING/LIN/alahd.f
+++ b/TESTING/LIN/alahd.f
@@ -50,15 +50,25 @@
 *>             _SY:  Symmetric indefinite,
 *>                     with partial (Bunch-Kaufman) pivoting
 *>             _SR:  Symmetric indefinite,
-*>                     with "rook" (bounded Bunch-Kaufman) pivoting
+*>                     with rook (bounded Bunch-Kaufman) pivoting
+*>             _SK:  Symmetric indefinite,
+*>                     with rook (bounded Bunch-Kaufman) pivoting
+*>                     ( new storage format for factors:
+*>                       L and diagonal of D is stored in A,
+*>                       subdiagonal of D is stored in E )
 *>             _SP:  Symmetric indefinite packed,
 *>                     with partial (Bunch-Kaufman) pivoting
 *>             _HA:  (complex) Hermitian ,
 *>                     with Aasen Algorithm
 *>             _HE:  (complex) Hermitian indefinite,
 *>                     with partial (Bunch-Kaufman) pivoting
-*>             _HR:  Symmetric indefinite,
-*>                     with "rook" (bounded Bunch-Kaufman) pivoting
+*>             _HR:  (complex) Hermitian indefinite,
+*>                     with rook (bounded Bunch-Kaufman) pivoting
+*>             _HK:  (complex) Hermitian indefinite,
+*>                     with rook (bounded Bunch-Kaufman) pivoting
+*>                     ( new storage format for factors:
+*>                       L and diagonal of D is stored in A,
+*>                       subdiagonal of D is stored in E )
 *>             _HP:  (complex) Hermitian indefinite packed,
 *>                     with partial (Bunch-Kaufman) pivoting
 *>             _TR:  Triangular
@@ -88,17 +98,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup aux_lin
 *
 *  =====================================================================
       SUBROUTINE ALAHD( IOUNIT, PATH )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -304,10 +314,16 @@
          WRITE( IOUNIT, FMT = 9955 )9
          WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
 *
-      ELSE IF( LSAMEN( 2, P2, 'SR' )  ) THEN
+      ELSE IF( LSAMEN( 2, P2, 'SR' ) .OR. LSAMEN( 2, P2, 'SK') ) THEN
 *
 *        SR: Symmetric indefinite full,
-*            with "rook" (bounded Bunch-Kaufman) pivoting algorithm
+*            with rook (bounded Bunch-Kaufman) pivoting algorithm
+*
+*        SK: Symmetric indefinite full,
+*            with rook (bounded Bunch-Kaufman) pivoting algorithm,
+*            ( new storage format for factors:
+*              L and diagonal of D is stored in A,
+*              subdiagonal of D is stored in E )
 *
          WRITE( IOUNIT, FMT = 9892 )PATH, 'Symmetric'
 *
@@ -401,10 +417,16 @@
          WRITE( IOUNIT, FMT = 9955 )9
          WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
 *
-      ELSE IF( LSAMEN( 2, P2, 'HR' )  ) THEN
+      ELSE IF( LSAMEN( 2, P2, 'HR' ) .OR. LSAMEN( 2, P2, 'HR' ) ) THEN
+*
+*        HR: Hermitian indefinite full,
+*            with rook (bounded Bunch-Kaufman) pivoting algorithm
 *
-*        HR: Symmetric indefinite full,
-*            with "rook" (bounded Bunch-Kaufman) pivoting algorithm
+*        HK: Hermitian indefinite full,
+*            with rook (bounded Bunch-Kaufman) pivoting algorithm,
+*            ( new storage format for factors:
+*              L and diagonal of D is stored in A,
+*              subdiagonal of D is stored in E )
 *
          WRITE( IOUNIT, FMT = 9892 )PATH, 'Hermitian'
 *
diff --git a/TESTING/LIN/cchkaa.f b/TESTING/LIN/cchkaa.f
index cffaa1d6..f2ef59f1 100644
--- a/TESTING/LIN/cchkaa.f
+++ b/TESTING/LIN/cchkaa.f
@@ -51,9 +51,11 @@
 *> CPT   12               List types on next line if 0 < NTYPES < 12
 *> CHE   10               List types on next line if 0 < NTYPES < 10
 *> CHR   10               List types on next line if 0 < NTYPES < 10
+*> CHK   10               List types on next line if 0 < NTYPES < 10
 *> CHA   10               List types on next line if 0 < NTYPES < 10
 *> CHP   10               List types on next line if 0 < NTYPES < 10
 *> CSY   11               List types on next line if 0 < NTYPES < 11
+*> CSK   11               List types on next line if 0 < NTYPES < 11
 *> CSR   11               List types on next line if 0 < NTYPES < 11
 *> CSP   11               List types on next line if 0 < NTYPES < 11
 *> CTR   18               List types on next line if 0 < NTYPES < 18
@@ -151,7 +153,7 @@
      $                   RANKVAL( MAXIN ), PIV( NMAX )
       REAL               RWORK( 150*NMAX+2*MAXRHS ), S( 2*NMAX )
       COMPLEX            A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
-     $                   WORK( NMAX, NMAX+MAXRHS+10 )
+     $                   E( NMAX ), WORK( NMAX, NMAX+MAXRHS+10 )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME, LSAMEN
@@ -160,14 +162,15 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAREQ, CCHKEQ, CCHKGB, CCHKGE, CCHKGT, CCHKHE,
-     $                   CCHKHE_ROOK, CCHKHE_AA, CCHKHP, CCHKLQ, CCHKPB,
-     $                   CCHKPO, CCHKPS, CCHKPP, CCHKPT, CCHKQ3, CCHKQL,
-     $                   CCHKQR, CCHKRQ, CCHKSP, CCHKSY, CCHKSY_ROOK,
-     $                   CCHKTB, CCHKTP, CCHKTR, CCHKTZ, CDRVGB, CDRVGE,
-     $                   CDRVGT, CDRVHE, CDRVHE_ROOK, CDRVHE_AA, CDRVHP,
-     $                   CDRVLS, CDRVPB, CDRVPO, CDRVPP, CDRVPT, CDRVSP,
-     $                   CDRVSY, CDRVSY_ROOK, ILAVER, CCHKQRT, CCHKQRTP
-
+     $                   CCHKHE_ROOK, CCHKHE_RK, CCHKHE_AA, CCHKLQ,
+     $                   CCHKPB,CCHKPO, CCHKPS, CCHKPP, CCHKPT, CCHKQ3,
+     $                   CCHKQL, CCHKQR, CCHKRQ, CCHKSP, CCHKSY,
+     $                   CCHKSY_ROOK, CCHKSY_RK, CCHKSY_AA, CCHKTB, 
+     $                   CCHKTP, CCHKTR, CCHKTZ, CDRVGB, CDRVGE, CDRVGT,
+     $                   CDRVHE, CDRVHE_ROOK, CDRVHE_RK, CDRVHE_AA, 
+     $                   CDRVHP, CDRVLS, CDRVPB, CDRVPO, CDRVPP, CDRVPT,
+     $                   CDRVSP, CDRVSY, CDRVSY_ROOK, CDRVSY_RK,
+     $                   CDRVSY_AA, ILAVER, CCHKQRT, CCHKQRTP
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -642,55 +645,82 @@
             WRITE( NOUT, FMT = 9988 )PATH
          END IF
 *
-      ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
+      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
 *
-*        HA:  Hermitian matrices,
-*             Aasen Algorithm
+*        HR:  Hermitian indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm
 *
          NTYPES = 10
          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
 *
          IF( TSTCHK ) THEN
-            CALL CCHKHE_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
-     $                         NSVAL, THRESH, TSTERR, LDA, 
-     $                         A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
-     $                         B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
-     $                         WORK, RWORK, IWORK, NOUT )
+            CALL CCHKHE_ROOK(DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+     $                       THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+     $                       A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+     $                       WORK, RWORK, IWORK, NOUT )
          ELSE
             WRITE( NOUT, FMT = 9989 )PATH
          END IF
 *
          IF( TSTDRV ) THEN
-            CALL CDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, 
-     $                         LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), 
-     $                              B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), 
-     $                         WORK, RWORK, IWORK, NOUT )
+            CALL CDRVHE_ROOK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                        LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+     $                        B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+     $                        RWORK, IWORK, NOUT )
          ELSE
             WRITE( NOUT, FMT = 9988 )PATH
          END IF
 *
-      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+      ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
 *
-*        HR:  Hermitian indefinite matrices,
-*             with "rook" (bounded Bunch-Kaufman) pivoting algorithm
+*        HK:  Hermitian indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm,
+*             differnet matrix storage format than HR path version.
 *
          NTYPES = 10
          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
 *
          IF( TSTCHK ) THEN
-            CALL CCHKHE_ROOK(DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
-     $                       THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
-     $                       A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
-     $                       WORK, RWORK, IWORK, NOUT )
+            CALL CCHKHE_RK( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+     $                      THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+     $                      E, A( 1, 3 ), B( 1, 1 ), B( 1, 2 ),
+     $                      B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
          ELSE
             WRITE( NOUT, FMT = 9989 )PATH
          END IF
 *
          IF( TSTDRV ) THEN
-            CALL CDRVHE_ROOK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
-     $                        LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
-     $                        B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
-     $                        RWORK, IWORK, NOUT )
+            CALL CDRVHE_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      LDA, A( 1, 1 ), A( 1, 2 ), E, A( 1, 3 ),
+     $                      B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+     $                      RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9988 )PATH
+         END IF
+*
+      ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
+*
+*        HA:  Hermitian matrices,
+*             Aasen Algorithm
+*
+         NTYPES = 10
+         CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+         IF( TSTCHK ) THEN
+            CALL CCHKHE_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
+     $                         NSVAL, THRESH, TSTERR, LDA,
+     $                         A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+     $                         B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+     $                         WORK, RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9989 )PATH
+         END IF
+*
+         IF( TSTDRV ) THEN
+            CALL CDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                         LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+     $                              B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+     $                         WORK, RWORK, IWORK, NOUT )
          ELSE
             WRITE( NOUT, FMT = 9988 )PATH
          END IF
@@ -750,7 +780,7 @@
       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 *
 *        SR:  symmetric indefinite matrices,
-*             with "rook" (bounded Bunch-Kaufman) pivoting algorithm
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm
 *
          NTYPES = 11
          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
@@ -773,6 +803,58 @@
             WRITE( NOUT, FMT = 9988 )PATH
          END IF
 *
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        SK:  symmetric indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm,
+*             differnet matrix storage format than SR path version.
+*
+         NTYPES = 11
+         CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+         IF( TSTCHK ) THEN
+            CALL CCHKSY_RK( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+     $                      THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+     $                      E, A( 1, 3 ), B( 1, 1 ), B( 1, 2 ),
+     $                      B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9989 )PATH
+         END IF
+*
+         IF( TSTDRV ) THEN
+            CALL CDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      LDA, A( 1, 1 ), A( 1, 2 ), E, A( 1, 3 ),
+     $                      B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+     $                      RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9988 )PATH
+         END IF
+*
+      ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
+*
+*        SA:  symmetric indefinite matrices with Aasen's algorithm,
+*
+         NTYPES = 11
+         CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+         IF( TSTCHK ) THEN
+            CALL CCHKSY_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+     $                      THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+     $                      A( 1, 3 ), B( 1, 1 ), B( 1, 2 ),
+     $                      B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9989 )PATH
+         END IF
+*
+         IF( TSTDRV ) THEN
+            CALL CDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+     $                      B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+     $                      RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9988 )PATH
+         END IF
+*
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
 *        SP:  symmetric indefinite packed matrices,
diff --git a/TESTING/LIN/cchkhe_aa.f b/TESTING/LIN/cchkhe_aa.f
index 702677bd..ca23c0f2 100644
--- a/TESTING/LIN/cchkhe_aa.f
+++ b/TESTING/LIN/cchkhe_aa.f
@@ -205,13 +205,13 @@
       PARAMETER    ( NTESTS = 9 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL      TRFCON, ZEROT
+      LOGICAL      ZEROT
       CHARACTER    DIST, TYPE, UPLO, XTYPE
       CHARACTER*3  PATH, MATPATH
       INTEGER      I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
      $             IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
      $             N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
-      REAL         ANORM, CNDNUM, RCOND, RCONDC
+      REAL         ANORM, CNDNUM
 *     ..
 *     .. Local Arrays ..
       CHARACTER    UPLOS( 2 )
@@ -224,7 +224,7 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL     ALAERH, ALAHD, ALASUM, XLAENV, CERRHE, CGET04,
-     $             ZHECON, CHERFS, CHET01, CHETRF_AA, ZHETRI2,
+     $             ZHECON, CHERFS, CHET01_AA, CHETRF_AA, ZHETRI2,
      $             CHETRS_AA, CLACPY, CLAIPD, CLARHS, CLATB4, 
      $             CLATMS, CPOT02, ZPOT03, ZPOT05
 *     ..
@@ -431,10 +431,10 @@
 *                 the block structure of D. AINV is a work array for
 *                 block factorization, LWORK is the length of AINV.
 *
-                  LWORK = ( NB+1 )*LDA
+                  LWORK = MAX( 1, ( NB+1 )*LDA )
                   SRNAMT = 'CHETRF_AA'
                   CALL CHETRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV, 
-     $                               LWORK, INFO )
+     $                            LWORK, INFO )
 *
 *                 Adjust the expected value of INFO to account for
 *                 pivoting.
@@ -464,19 +464,11 @@
      $                            NOUT )
                   END IF
 *
-*                 Set the condition estimate flag if the INFO is not 0.
-*
-                  IF( INFO.NE.0 ) THEN
-                     TRFCON = .TRUE.
-                  ELSE
-                     TRFCON = .FALSE.
-                  END IF
-*
 *+    TEST 1
 *                 Reconstruct matrix from factors and compute residual.
 *
                   CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
-     $                               AINV, LDA, RWORK, RESULT( 1 ) )
+     $                            AINV, LDA, RWORK, RESULT( 1 ) )
                   NT = 1
 *
 *
@@ -494,10 +486,9 @@
   110             CONTINUE
                   NRUN = NRUN + NT
 *
-*                 Do only the condition estimate if INFO is not 0.
+*                 Skip solver test if INFO is not 0.
 *
-                  IF( TRFCON ) THEN
-                     RCONDC = ZERO
+                  IF( INFO.NE.0 ) THEN
                      GO TO 140
                   END IF
 *
@@ -506,7 +497,7 @@
                   DO 130 IRHS = 1, NNS
                      NRHS = NSVAL( IRHS )
 *
-*+    TEST 3 (Using TRS)
+*+    TEST 2 (Using TRS)
 *                 Solve and compute residual for  A * X = B.
 *
 *                    Choose a set of NRHS random solution vectors
@@ -519,9 +510,9 @@
                      CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
 *
                      SRNAMT = 'CHETRS_AA'
-                     LWORK = 3*N-2
+                     LWORK = MAX( 1, 3*N-2 )
                      CALL CHETRS_AA( UPLO, N, NRHS, AFAC, LDA, IWORK,
-     $                                  X, LDA, WORK, LWORK, INFO )
+     $                               X, LDA, WORK, LWORK, INFO )
 *
 *                    Check error code from CHETRS and handle error.
 *
diff --git a/TESTING/LIN/cchkhe_rk.f b/TESTING/LIN/cchkhe_rk.f
new file mode 100644
index 00000000..a4d5ee62
--- /dev/null
+++ b/TESTING/LIN/cchkhe_rk.f
@@ -0,0 +1,859 @@
+*> \brief \b CCHKHE_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CCHKHE_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+*                             THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+*                             X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NNB, NNS, NOUT
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+*       REAL               RWORK( * )
+*       COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+*      $                   WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CCHKHE_RK tests CHETRF_RK, -TRI_3, -TRS_3,
+*> and -CON_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*>          NNB is INTEGER
+*>          The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*>          NBVAL is INTEGER array, dimension (NBVAL)
+*>          The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*>          NNS is INTEGER
+*>          The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*>          NSVAL is INTEGER array, dimension (NNS)
+*>          The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (NMAX*NSMAX)
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is COMPLEX array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is COMPLEX array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (max(NMAX,2*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup complex_lin
+*
+*  =====================================================================
+      SUBROUTINE CCHKHE_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+     $                      THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+     $                      X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NNB, NNS, NOUT
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+      REAL               RWORK( * )
+      COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      REAL               ONEHALF
+      PARAMETER          ( ONEHALF = 0.5E+0 )
+      REAL               EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
+      COMPLEX            CZERO
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+      INTEGER            NTYPES
+      PARAMETER          ( NTYPES = 10 )
+      INTEGER            NTESTS
+      PARAMETER          ( NTESTS = 7 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            TRFCON, ZEROT
+      CHARACTER          DIST, TYPE, UPLO, XTYPE
+      CHARACTER*3        PATH, MATPATH
+      INTEGER            I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+     $                   ITEMP, ITEMP2, IUPLO, IZERO, J, K, KL, KU, LDA,
+     $                   LWORK, MODE, N, NB, NERRS, NFAIL, NIMAT, NRHS,
+     $                   NRUN, NT
+      REAL               ALPHA, ANORM, CNDNUM, CONST, SING_MAX,
+     $                   SING_MIN, RCOND, RCONDC, STEMP
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 ), IDUMMY( 1 )
+      REAL               RESULT( NTESTS )
+      COMPLEX            BLOCK( 2, 2 ), CDUMMY( 1 )
+*     ..
+*     .. External Functions ..
+      REAL               CLANGE, CLANHE, SGET06
+      EXTERNAL           CLANGE, CLANHE, SGET06
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALAERH, ALAHD, ALASUM, CERRHE, CGESVD, CGET04,
+     $                   CLACPY, CLARHS, CLATB4, CLATMS, CPOT02, CPOT03,
+     $                   CHECON_3, CHET01_3, CHETRF_RK, CHETRI_3,
+     $                   CHETRS_3, XLAENV
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          CONJG, MAX, MIN, SQRT
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Complex precision'
+      PATH( 2: 3 ) = 'HK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Complex precision'
+      MATPATH( 2: 3 ) = 'HE'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL CERRHE( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the minimum block size for which the block routine should
+*     be used, which will be later returned by ILAENV
+*
+      CALL XLAENV( 2, 2 )
+*
+*     Do for each value of N in NVAL
+*
+      DO 270 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         IZERO = 0
+*
+*        Do for each value of matrix type IMAT
+*
+         DO 260 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 260
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 260
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 250 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*                 Begin generate the test matrix A.
+*
+*                 Set up parameters with CLATB4 for the matrix generator
+*                 based on the type of matrix to be generated.
+*
+                  CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                         MODE, CNDNUM, DIST )
+*
+*                 Generate a matrix with CLATMS.
+*
+                  SRNAMT = 'CLATMS'
+                  CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                         CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+     $                         WORK, INFO )
+*
+*                 Check error code from CLATMS and handle error.
+*
+                  IF( INFO.NE.0 ) THEN
+                     CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
+     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+*                    Skip all tests for this generated matrix
+*
+                     GO TO 250
+                  END IF
+*
+*                 For matrix types 3-6, zero one or more rows and
+*                 columns of the matrix to test that INFO is returned
+*                 correctly.
+*
+                  IF( ZEROT ) THEN
+                     IF( IMAT.EQ.3 ) THEN
+                        IZERO = 1
+                     ELSE IF( IMAT.EQ.4 ) THEN
+                        IZERO = N
+                     ELSE
+                        IZERO = N / 2 + 1
+                     END IF
+*
+                     IF( IMAT.LT.6 ) THEN
+*
+*                       Set row and column IZERO to zero.
+*
+                        IF( IUPLO.EQ.1 ) THEN
+                           IOFF = ( IZERO-1 )*LDA
+                           DO 20 I = 1, IZERO - 1
+                              A( IOFF+I ) = CZERO
+   20                      CONTINUE
+                           IOFF = IOFF + IZERO
+                           DO 30 I = IZERO, N
+                              A( IOFF ) = CZERO
+                              IOFF = IOFF + LDA
+   30                      CONTINUE
+                        ELSE
+                           IOFF = IZERO
+                           DO 40 I = 1, IZERO - 1
+                              A( IOFF ) = CZERO
+                              IOFF = IOFF + LDA
+   40                      CONTINUE
+                           IOFF = IOFF - IZERO
+                           DO 50 I = IZERO, N
+                              A( IOFF+I ) = CZERO
+   50                      CONTINUE
+                        END IF
+                     ELSE
+                        IF( IUPLO.EQ.1 ) THEN
+*
+*                          Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 70 J = 1, N
+                              I2 = MIN( J, IZERO )
+                              DO 60 I = 1, I2
+                                 A( IOFF+I ) = CZERO
+   60                         CONTINUE
+                              IOFF = IOFF + LDA
+   70                      CONTINUE
+                        ELSE
+*
+*                          Set the last IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 90 J = 1, N
+                              I1 = MAX( J, IZERO )
+                              DO 80 I = I1, N
+                                 A( IOFF+I ) = CZERO
+   80                         CONTINUE
+                              IOFF = IOFF + LDA
+   90                      CONTINUE
+                        END IF
+                     END IF
+                  ELSE
+                     IZERO = 0
+                  END IF
+*
+*                 End generate the test matrix A.
+*
+*
+*              Do for each value of NB in NBVAL
+*
+               DO 240 INB = 1, NNB
+*
+*                 Set the optimal blocksize, which will be later
+*                 returned by ILAENV.
+*
+                  NB = NBVAL( INB )
+                  CALL XLAENV( 1, NB )
+*
+*                 Copy the test matrix A into matrix AFAC which
+*                 will be factorized in place. This is needed to
+*                 preserve the test matrix A for subsequent tests.
+*
+                  CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+*                 Compute the L*D*L**T or U*D*U**T factorization of the
+*                 matrix. IWORK stores details of the interchanges and
+*                 the block structure of D. AINV is a work array for
+*                 block factorization, LWORK is the length of AINV.
+*
+                  LWORK = MAX( 2, NB )*LDA
+                  SRNAMT = 'CHETRF_RK'
+                  CALL CHETRF_RK( UPLO, N, AFAC, LDA, E, IWORK, AINV,
+     $                            LWORK, INFO )
+*
+*                 Adjust the expected value of INFO to account for
+*                 pivoting.
+*
+                  K = IZERO
+                  IF( K.GT.0 ) THEN
+  100                CONTINUE
+                     IF( IWORK( K ).LT.0 ) THEN
+                        IF( IWORK( K ).NE.-K ) THEN
+                           K = -IWORK( K )
+                           GO TO 100
+                        END IF
+                     ELSE IF( IWORK( K ).NE.K ) THEN
+                        K = IWORK( K )
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Check error code from CHETRF_RK and handle error.
+*
+                  IF( INFO.NE.K)
+     $               CALL ALAERH( PATH, 'CHETRF_RK', INFO, K,
+     $                            UPLO, N, N, -1, -1, NB, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Set the condition estimate flag if the INFO is not 0.
+*
+                  IF( INFO.NE.0 ) THEN
+                     TRFCON = .TRUE.
+                  ELSE
+                     TRFCON = .FALSE.
+                  END IF
+*
+*+    TEST 1
+*                 Reconstruct matrix from factors and compute residual.
+*
+                  CALL CHET01_3( UPLO, N, A, LDA, AFAC, LDA, E, IWORK,
+     $                           AINV, LDA, RWORK, RESULT( 1 ) )
+                  NT = 1
+*
+*+    TEST 2
+*                 Form the inverse and compute the residual,
+*                 if the factorization was competed without INFO > 0
+*                 (i.e. there is no zero rows and columns).
+*                 Do it only for the first block size.
+*
+                  IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN
+                     CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     SRNAMT = 'CHETRI_3'
+*
+*                    Another reason that we need to compute the invesrse
+*                    is that CPOT03 produces RCONDC which is used later
+*                    in TEST6 and TEST7.
+*
+                     LWORK = (N+NB+1)*(NB+3)
+                     CALL CHETRI_3( UPLO, N, AINV, LDA, E, IWORK, WORK,
+     $                              LWORK, INFO )
+*
+*                    Check error code from ZHETRI_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'CHETRI_3', INFO, -1,
+     $                               UPLO, N, N, -1, -1, -1, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+*                    Compute the residual for a Hermitian matrix times
+*                    its inverse.
+*
+                     CALL CPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
+     $                            RWORK, RCONDC, RESULT( 2 ) )
+                     NT = 2
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 110 K = 1, NT
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  110             CONTINUE
+                  NRUN = NRUN + NT
+*
+*+    TEST 3
+*                 Compute largest element in U or L
+*
+                  RESULT( 3 ) = ZERO
+                  STEMP = ZERO
+*
+                  CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) ) /
+     $                    ( ONE-ALPHA )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                 Compute largest element in U
+*
+                     K = N
+  120                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 130
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in U
+*
+                        STEMP = CLANGE( 'M', K-1, 1,
+     $                          AFAC( ( K-1 )*LDA+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k-1 in U
+*
+                        STEMP = CLANGE( 'M', K-2, 2,
+     $                          AFAC( ( K-2 )*LDA+1 ), LDA, RWORK )
+                        K = K - 1
+*
+                     END IF
+*
+*                    STEMP should be bounded by CONST
+*
+                     STEMP = STEMP - CONST + THRESH
+                     IF( STEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = STEMP
+*
+                     K = K - 1
+*
+                     GO TO 120
+  130                CONTINUE
+*
+                  ELSE
+*
+*                 Compute largest element in L
+*
+                     K = 1
+  140                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 150
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in L
+*
+                        STEMP = CLANGE( 'M', N-K, 1,
+     $                          AFAC( ( K-1 )*LDA+K+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k+1 in L
+*
+                        STEMP = CLANGE( 'M', N-K-1, 2,
+     $                          AFAC( ( K-1 )*LDA+K+2 ), LDA, RWORK )
+                        K = K + 1
+*
+                     END IF
+*
+*                    STEMP should be bounded by CONST
+*
+                     STEMP = STEMP - CONST + THRESH
+                     IF( STEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = STEMP
+*
+                     K = K + 1
+*
+                     GO TO 140
+  150                CONTINUE
+                  END IF
+*
+*
+*+    TEST 4
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
+*
+                  RESULT( 4 ) = ZERO
+                  STEMP = ZERO
+*
+                  CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) )*
+     $                    ( ( ONE + ALPHA ) / ( ONE - ALPHA ) )
+                  CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                    Loop backward for UPLO = 'U'
+*
+                     K = N
+  160                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 170
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
+                        BLOCK( 1, 2 ) = E( K )
+                        BLOCK( 2, 1 ) = CONJG( BLOCK( 1, 2 ) )
+                        BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
+*
+                        CALL CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               CDUMMY, 1, CDUMMY, 1,
+     $                               WORK, 6, RWORK( 3 ), INFO )
+*
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        STEMP = SING_MAX / SING_MIN
+*
+*                       STEMP should be bounded by CONST
+*
+                        STEMP = STEMP - CONST + THRESH
+                        IF( STEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = STEMP
+                        K = K - 1
+*
+                     END IF
+*
+                     K = K - 1
+*
+                     GO TO 160
+  170                CONTINUE
+*
+                  ELSE
+*
+*                    Loop forward for UPLO = 'L'
+*
+                     K = 1
+  180                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 190
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K )
+                        BLOCK( 2, 1 ) = E( K )
+                        BLOCK( 1, 2 ) = CONJG( BLOCK( 2, 1 ) )
+                        BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 )
+*
+                        CALL CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               CDUMMY, 1, CDUMMY, 1,
+     $                               WORK, 6, RWORK(3), INFO )
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        STEMP = SING_MAX / SING_MIN
+*
+*                       STEMP should be bounded by CONST
+*
+                        STEMP = STEMP - CONST + THRESH
+                        IF( STEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = STEMP
+                        K = K + 1
+*
+                     END IF
+*
+                     K = K + 1
+*
+                     GO TO 180
+  190                CONTINUE
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 200 K = 3, 4
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  200             CONTINUE
+                  NRUN = NRUN + 2
+*
+*                 Skip the other tests if this is not the first block
+*                 size.
+*
+                  IF( INB.GT.1 )
+     $               GO TO 240
+*
+*                 Do only the condition estimate if INFO is not 0.
+*
+                  IF( TRFCON ) THEN
+                     RCONDC = ZERO
+                     GO TO 230
+                  END IF
+*
+*                 Do for each value of NRHS in NSVAL.
+*
+                  DO 220 IRHS = 1, NNS
+                     NRHS = NSVAL( IRHS )
+*
+*                    Begin loop over NRHS values
+*
+*
+*+    TEST 5 ( Using TRS_3)
+*                 Solve and compute residual for  A * X = B.
+*
+*                    Choose a set of NRHS random solution vectors
+*                    stored in XACT and set up the right hand side B
+*
+                     SRNAMT = 'CLARHS'
+                     CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+     $                            KL, KU, NRHS, A, LDA, XACT, LDA,
+     $                            B, LDA, ISEED, INFO )
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+                     SRNAMT = 'CHETRS_3'
+                     CALL CHETRS_3( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, INFO )
+*
+*                    Check error code from CHETRS_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'CHETRS_3', INFO, 0,
+     $                               UPLO, N, N, -1, -1, NRHS, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+*
+*                    Compute the residual for the solution
+*
+                     CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 5 ) )
+*
+*+    TEST 6
+*                 Check solution from generated exact solution.
+*
+                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 6 ) )
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 210 K = 5, 6
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALAHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+     $                        IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  210                CONTINUE
+                     NRUN = NRUN + 2
+*
+*                 End do for each value of NRHS in NSVAL.
+*
+  220             CONTINUE
+*
+*+    TEST 7
+*                 Get an estimate of RCOND = 1/CNDNUM.
+*
+  230             CONTINUE
+                  ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )
+                  SRNAMT = 'CHECON_3'
+                  CALL CHECON_3( UPLO, N, AFAC, LDA, E, IWORK, ANORM,
+     $                           RCOND, WORK, INFO )
+*
+*                 Check error code from CHECON_3 and handle error.
+*
+                  IF( INFO.NE.0 )
+     $               CALL ALAERH( PATH, 'CHECON_3', INFO, 0,
+     $                            UPLO, N, N, -1, -1, -1, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Compute the test ratio to compare values of RCOND
+*
+                  RESULT( 7 ) = SGET06( RCOND, RCONDC )
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  IF( RESULT( 7 ).GE.THRESH ) THEN
+                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                  CALL ALAHD( NOUT, PATH )
+                     WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 7,
+     $                  RESULT( 7 )
+                     NFAIL = NFAIL + 1
+                  END IF
+                  NRUN = NRUN + 1
+  240          CONTINUE
+*
+  250       CONTINUE
+  260    CONTINUE
+  270 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+     $      I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+     $      I2, ', test ', I2, ', ratio =', G12.5 )
+ 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
+     $      ', test ', I2, ', ratio =', G12.5 )
+      RETURN
+*
+*     End of CCHKHE_RK
+*
+      END
diff --git a/TESTING/LIN/cchksy_aa.f b/TESTING/LIN/cchksy_aa.f
new file mode 100644
index 00000000..534be92f
--- /dev/null
+++ b/TESTING/LIN/cchksy_aa.f
@@ -0,0 +1,572 @@
+*> \brief \b CCHKSY_AA
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+*                             THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
+*                             XACT, WORK, RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NNB, NNS, NOUT
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+*       COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
+*      $                   RWORK( * ), WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CCHKSY_AA tests CSYTRF_AA, -TRS_AA.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*>          NNB is INTEGER
+*>          The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*>          NBVAL is INTEGER array, dimension (NBVAL)
+*>          The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*>          NNS is INTEGER
+*>          The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*>          NSVAL is INTEGER array, dimension (NNS)
+*>          The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is REAL array, dimension (NMAX*NSMAX)
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is REAL array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is REAL array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*  @generated from LIN/dchksy_aa.f, fortran d -> c, Wed Nov 16 21:34:18 2016
+*
+*> \ingroup complex_lin
+*
+*  =====================================================================
+      SUBROUTINE CCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+     $                      THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
+     $                      X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+      IMPLICIT NONE
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NN, NNB, NNS, NMAX, NOUT
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+      REAL               RWORK( * )
+      COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0D+0 )
+      COMPLEX            CZERO
+      PARAMETER          ( CZERO = 0.0E+0 )
+      INTEGER            NTYPES
+      PARAMETER          ( NTYPES = 10 )
+      INTEGER            NTESTS
+      PARAMETER          ( NTESTS = 9 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ZEROT
+      CHARACTER          DIST, TYPE, UPLO, XTYPE
+      CHARACTER*3        PATH, MATPATH
+      INTEGER            I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+     $                   IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
+     $                   N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
+      REAL               ANORM, CNDNUM
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      REAL               RESULT( NTESTS )
+*     ..
+*     .. External Functions ..
+      REAL               DGET06, CLANSY
+      EXTERNAL           DGET06, CLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALAERH, ALAHD, ALASUM, CERRSY, CGET04, CLACPY,
+     $                   CLARHS, CLATB4, CLATMS, CSYT02, DSYT03, DSYT05,
+     $                   DSYCON, CSYRFS, CSYT01_AA, CSYTRF_AA,
+     $                   DSYTRI2, CSYTRS_AA, XLAENV
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Complex precision'
+      PATH( 2: 3 ) = 'SA'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Complex precision'
+      MATPATH( 2: 3 ) = 'SY'
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL CERRSY( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the minimum block size for which the block routine should
+*     be used, which will be later returned by ILAENV
+*
+      CALL XLAENV( 2, 2 )
+*
+*     Do for each value of N in NVAL
+*
+      DO 180 IN = 1, NN
+         N = NVAL( IN )
+         IF( N .GT. NMAX ) THEN
+            NFAIL = NFAIL + 1
+            WRITE(NOUT, 9995) 'M ', N, NMAX
+            GO TO 180
+         END IF
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         IZERO = 0
+*
+*        Do for each value of matrix type IMAT
+*
+         DO 170 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 170
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 170
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 160 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*              Begin generate the test matrix A.
+*
+*
+*              Set up parameters with CLATB4 for the matrix generator
+*              based on the type of matrix to be generated.
+*
+               CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
+     $                      ANORM, MODE, CNDNUM, DIST )
+*
+*              Generate a matrix with CLATMS.
+*
+               SRNAMT = 'CLATMS'
+               CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+     $                      INFO )
+*
+*              Check error code from CLATMS and handle error.
+*
+               IF( INFO.NE.0 ) THEN
+                  CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
+     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+*                    Skip all tests for this generated matrix
+*
+                  GO TO 160
+               END IF
+*
+*              For matrix types 3-6, zero one or more rows and
+*              columns of the matrix to test that INFO is returned
+*              correctly.
+*
+               IF( ZEROT ) THEN
+                  IF( IMAT.EQ.3 ) THEN
+                     IZERO = 1
+                  ELSE IF( IMAT.EQ.4 ) THEN
+                     IZERO = N
+                  ELSE
+                     IZERO = N / 2 + 1
+                  END IF
+*
+                  IF( IMAT.LT.6 ) THEN
+*
+*                    Set row and column IZERO to zero.
+*
+                     IF( IUPLO.EQ.1 ) THEN
+                        IOFF = ( IZERO-1 )*LDA
+                        DO 20 I = 1, IZERO - 1
+                           A( IOFF+I ) = CZERO
+   20                   CONTINUE
+                        IOFF = IOFF + IZERO
+                        DO 30 I = IZERO, N
+                           A( IOFF ) = CZERO
+                           IOFF = IOFF + LDA
+   30                   CONTINUE
+                     ELSE
+                        IOFF = IZERO
+                        DO 40 I = 1, IZERO - 1
+                           A( IOFF ) = CZERO
+                           IOFF = IOFF + LDA
+   40                   CONTINUE
+                        IOFF = IOFF - IZERO
+                        DO 50 I = IZERO, N
+                           A( IOFF+I ) = CZERO
+   50                   CONTINUE
+                     END IF
+                  ELSE
+                     IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                        IOFF = 0
+                        DO 70 J = 1, N
+                           I2 = MIN( J, IZERO )
+                           DO 60 I = 1, I2
+                              A( IOFF+I ) = CZERO
+   60                      CONTINUE
+                           IOFF = IOFF + LDA
+   70                   CONTINUE
+                        IZERO = 1
+                     ELSE
+*
+*                       Set the last IZERO rows and columns to zero.
+*
+                        IOFF = 0
+                        DO 90 J = 1, N
+                           I1 = MAX( J, IZERO )
+                           DO 80 I = I1, N
+                              A( IOFF+I ) = CZERO
+   80                      CONTINUE
+                           IOFF = IOFF + LDA
+   90                   CONTINUE
+                     END IF
+                  END IF
+               ELSE
+                  IZERO = 0
+               END IF
+*
+*              End generate the test matrix A.
+*
+*              Do for each value of NB in NBVAL
+*
+               DO 150 INB = 1, NNB
+*
+*                 Set the optimal blocksize, which will be later
+*                 returned by ILAENV.
+*
+                  NB = NBVAL( INB )
+                  CALL XLAENV( 1, NB )
+*
+*                 Copy the test matrix A into matrix AFAC which
+*                 will be factorized in place. This is needed to
+*                 preserve the test matrix A for subsequent tests.
+*
+                  CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+*                 Compute the L*D*L**T or U*D*U**T factorization of the
+*                 matrix. IWORK stores details of the interchanges and
+*                 the block structure of D. AINV is a work array for
+*                 block factorization, LWORK is the length of AINV.
+*
+                  SRNAMT = 'CSYTRF_AA'
+                  LWORK = MAX( 1, N*NB + N )
+                  CALL CSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
+     $                            LWORK, INFO )
+*
+*                 Adjust the expected value of INFO to account for
+*                 pivoting.
+*
+                  IF( IZERO.GT.0 ) THEN
+                     J = 1
+                     K = IZERO
+  100                CONTINUE
+                     IF( J.EQ.K ) THEN
+                        K = IWORK( J )
+                     ELSE IF( IWORK( J ).EQ.K ) THEN
+                        K = J
+                     END IF
+                     IF( J.LT.K ) THEN
+                        J = J + 1
+                        GO TO 100
+                     END IF
+                  ELSE
+                     K = 0
+                  END IF
+*
+*                 Check error code from CSYTRF and handle error.
+*
+                  IF( INFO.NE.K ) THEN
+                     CALL ALAERH( PATH, 'CSYTRF_AA', INFO, K, UPLO,
+     $                            N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
+     $                            NOUT )
+                  END IF
+*
+*+    TEST 1
+*                 Reconstruct matrix from factors and compute residual.
+*
+                  CALL CSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
+     $                            AINV, LDA, RWORK, RESULT( 1 ) )
+                  NT = 1
+*
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 110 K = 1, NT
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  110             CONTINUE
+                  NRUN = NRUN + NT
+*
+*                 Skip solver test if INFO is not 0.
+*
+                  IF( INFO.NE.0 ) THEN
+                     GO TO 140
+                  END IF
+*
+*                 Do for each value of NRHS in NSVAL.
+*
+                  DO 130 IRHS = 1, NNS
+                     NRHS = NSVAL( IRHS )
+*
+*+    TEST 2 (Using TRS)
+*                 Solve and compute residual for  A * X = B.
+*
+*                    Choose a set of NRHS random solution vectors
+*                    stored in XACT and set up the right hand side B
+*
+                     SRNAMT = 'CLARHS'
+                     CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+     $                            KL, KU, NRHS, A, LDA, XACT, LDA,
+     $                            B, LDA, ISEED, INFO )
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+                     SRNAMT = 'CSYTRS_AA'
+                     LWORK = MAX( 1, 3*N-2 )
+                     CALL CSYTRS_AA( UPLO, N, NRHS, AFAC, LDA,
+     $                               IWORK, X, LDA, WORK, LWORK,
+     $                               INFO )
+*
+*                    Check error code from CSYTRS and handle error.
+*
+                     IF( INFO.NE.0 ) THEN
+                        CALL ALAERH( PATH, 'CSYTRS_AA', INFO, 0,
+     $                               UPLO, N, N, -1, -1, NRHS, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+                     END IF
+*
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+*
+*                    Compute the residual for the solution
+*
+                     CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 2 ) )
+*
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 120 K = 2, 2
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALAHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+     $                        IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  120                CONTINUE
+                     NRUN = NRUN + 1
+*
+*                 End do for each value of NRHS in NSVAL.
+*
+  130             CONTINUE
+  140             CONTINUE
+  150          CONTINUE
+  160       CONTINUE
+  170    CONTINUE
+  180 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+     $      I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+     $      I2, ', test(', I2, ') =', G12.5 )
+ 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
+     $      I6 )
+      RETURN
+*
+*     End of CCHKSY_AA
+*
+      END
diff --git a/TESTING/LIN/cchksy_rk.f b/TESTING/LIN/cchksy_rk.f
new file mode 100644
index 00000000..ba9687c5
--- /dev/null
+++ b/TESTING/LIN/cchksy_rk.f
@@ -0,0 +1,867 @@
+*> \brief \b CCHKSY_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CCHKSY_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+*                             THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+*                             X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NNB, NNS, NOUT
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+*       REAL               RWORK( * )
+*       COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+*      $                   WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CCHKSY_RK tests CSYTRF_RK, -TRI_3, -TRS_3,
+*> and -CON_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*>          NNB is INTEGER
+*>          The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*>          NBVAL is INTEGER array, dimension (NBVAL)
+*>          The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*>          NNS is INTEGER
+*>          The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*>          NSVAL is INTEGER array, dimension (NNS)
+*>          The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (NMAX*NSMAX)
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is COMPLEX array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is COMPLEX array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup complex_lin
+*
+*  =====================================================================
+      SUBROUTINE CCHKSY_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+     $                      THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+     $                      X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NNB, NNS, NOUT
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+      REAL               RWORK( * )
+      COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      REAL               ONEHALF
+      PARAMETER          ( ONEHALF = 0.5E+0 )
+      REAL               EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
+      COMPLEX            CZERO
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+      INTEGER            NTYPES
+      PARAMETER          ( NTYPES = 11 )
+      INTEGER            NTESTS
+      PARAMETER          ( NTESTS = 7 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            TRFCON, ZEROT
+      CHARACTER          DIST, TYPE, UPLO, XTYPE
+      CHARACTER*3        PATH, MATPATH
+      INTEGER            I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+     $                   ITEMP, ITEMP2, IUPLO, IZERO, J, K, KL, KU, LDA,
+     $                   LWORK, MODE, N, NB, NERRS, NFAIL, NIMAT, NRHS,
+     $                   NRUN, NT
+      REAL               ALPHA, ANORM, CNDNUM, CONST, SING_MAX,
+     $                   SING_MIN, RCOND, RCONDC, STEMP
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      REAL               RESULT( NTESTS )
+      COMPLEX            BLOCK( 2, 2 ), CDUMMY( 1 )
+*     ..
+*     .. External Functions ..
+      REAL               CLANGE, CLANSY, SGET06
+      EXTERNAL           CLANGE, CLANSY, SGET06
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALAERH, ALAHD, ALASUM, CERRSY, CGESVD, CGET04,
+     $                   CLACPY, CLARHS, CLATB4, CLATMS, CLATSY, CSYT02,
+     $                   CSYT03, CSYCON_3, CSYT01_3, CSYTRF_RK,
+     $                   CSYTRI_3, CSYTRS_3, XLAENV
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Complex precision'
+      PATH( 2: 3 ) = 'SK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Complex precision'
+      MATPATH( 2: 3 ) = 'SY'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL CERRSY( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the minimum block size for which the block routine should
+*     be used, which will be later returned by ILAENV
+*
+      CALL XLAENV( 2, 2 )
+*
+*     Do for each value of N in NVAL
+*
+      DO 270 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         IZERO = 0
+*
+*        Do for each value of matrix type IMAT
+*
+         DO 260 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 260
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 260
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 250 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*              Begin generate test matrix A.
+*
+               IF( IMAT.NE.NTYPES ) THEN
+*
+*                 Set up parameters with CLATB4 for the matrix generator
+*                 based on the type of matrix to be generated.
+*
+                  CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                         MODE, CNDNUM, DIST )
+*
+*                 Generate a matrix with CLATMS.
+*
+                  SRNAMT = 'CLATMS'
+                  CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                         CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+     $                         WORK, INFO )
+*
+*                 Check error code from CLATMS and handle error.
+*
+                  IF( INFO.NE.0 ) THEN
+                     CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
+     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+*                    Skip all tests for this generated matrix
+*
+                     GO TO 250
+                  END IF
+*
+*                 For matrix types 3-6, zero one or more rows and
+*                 columns of the matrix to test that INFO is returned
+*                 correctly.
+*
+                  IF( ZEROT ) THEN
+                     IF( IMAT.EQ.3 ) THEN
+                        IZERO = 1
+                     ELSE IF( IMAT.EQ.4 ) THEN
+                        IZERO = N
+                     ELSE
+                        IZERO = N / 2 + 1
+                     END IF
+*
+                     IF( IMAT.LT.6 ) THEN
+*
+*                       Set row and column IZERO to zero.
+*
+                        IF( IUPLO.EQ.1 ) THEN
+                           IOFF = ( IZERO-1 )*LDA
+                           DO 20 I = 1, IZERO - 1
+                              A( IOFF+I ) = CZERO
+   20                      CONTINUE
+                           IOFF = IOFF + IZERO
+                           DO 30 I = IZERO, N
+                              A( IOFF ) = CZERO
+                              IOFF = IOFF + LDA
+   30                      CONTINUE
+                        ELSE
+                           IOFF = IZERO
+                           DO 40 I = 1, IZERO - 1
+                              A( IOFF ) = CZERO
+                              IOFF = IOFF + LDA
+   40                      CONTINUE
+                           IOFF = IOFF - IZERO
+                           DO 50 I = IZERO, N
+                              A( IOFF+I ) = CZERO
+   50                      CONTINUE
+                        END IF
+                     ELSE
+                        IF( IUPLO.EQ.1 ) THEN
+*
+*                          Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 70 J = 1, N
+                              I2 = MIN( J, IZERO )
+                              DO 60 I = 1, I2
+                                 A( IOFF+I ) = CZERO
+   60                         CONTINUE
+                              IOFF = IOFF + LDA
+   70                      CONTINUE
+                        ELSE
+*
+*                          Set the last IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 90 J = 1, N
+                              I1 = MAX( J, IZERO )
+                              DO 80 I = I1, N
+                                 A( IOFF+I ) = CZERO
+   80                         CONTINUE
+                              IOFF = IOFF + LDA
+   90                      CONTINUE
+                        END IF
+                     END IF
+                  ELSE
+                     IZERO = 0
+                  END IF
+*
+               ELSE
+*
+*                 For matrix kind IMAT = 11, generate special block
+*                 diagonal matrix to test alternate code
+*                 for the 2 x 2 blocks.
+*
+                  CALL CLATSY( UPLO, N, A, LDA, ISEED )
+*
+               END IF
+*
+*              End generate test matrix A.
+*
+*
+*              Do for each value of NB in NBVAL
+*
+               DO 240 INB = 1, NNB
+*
+*                 Set the optimal blocksize, which will be later
+*                 returned by ILAENV.
+*
+                  NB = NBVAL( INB )
+                  CALL XLAENV( 1, NB )
+*
+*                 Copy the test matrix A into matrix AFAC which
+*                 will be factorized in place. This is needed to
+*                 preserve the test matrix A for subsequent tests.
+*
+                  CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+*                 Compute the L*D*L**T or U*D*U**T factorization of the
+*                 matrix. IWORK stores details of the interchanges and
+*                 the block structure of D. AINV is a work array for
+*                 block factorization, LWORK is the length of AINV.
+*
+                  LWORK = MAX( 2, NB )*LDA
+                  SRNAMT = 'CSYTRF_RK'
+                  CALL CSYTRF_RK( UPLO, N, AFAC, LDA, E, IWORK, AINV,
+     $                            LWORK, INFO )
+*
+*                 Adjust the expected value of INFO to account for
+*                 pivoting.
+*
+                  K = IZERO
+                  IF( K.GT.0 ) THEN
+  100                CONTINUE
+                     IF( IWORK( K ).LT.0 ) THEN
+                        IF( IWORK( K ).NE.-K ) THEN
+                           K = -IWORK( K )
+                           GO TO 100
+                        END IF
+                     ELSE IF( IWORK( K ).NE.K ) THEN
+                        K = IWORK( K )
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Check error code from CSYTRF_RK and handle error.
+*
+                  IF( INFO.NE.K)
+     $               CALL ALAERH( PATH, 'CSYTRF_RK', INFO, K,
+     $                            UPLO, N, N, -1, -1, NB, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Set the condition estimate flag if the INFO is not 0.
+*
+                  IF( INFO.NE.0 ) THEN
+                     TRFCON = .TRUE.
+                  ELSE
+                     TRFCON = .FALSE.
+                  END IF
+*
+*+    TEST 1
+*                 Reconstruct matrix from factors and compute residual.
+*
+                  CALL CSYT01_3( UPLO, N, A, LDA, AFAC, LDA, E, IWORK,
+     $                           AINV, LDA, RWORK, RESULT( 1 ) )
+                  NT = 1
+*
+*+    TEST 2
+*                 Form the inverse and compute the residual,
+*                 if the factorization was competed without INFO > 0
+*                 (i.e. there is no zero rows and columns).
+*                 Do it only for the first block size.
+*
+                  IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN
+                     CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     SRNAMT = 'CSYTRI_3'
+*
+*                    Another reason that we need to compute the invesrse
+*                    is that CSYT03 produces RCONDC which is used later
+*                    in TEST6 and TEST7.
+*
+                     LWORK = (N+NB+1)*(NB+3)
+                     CALL CSYTRI_3( UPLO, N, AINV, LDA, E, IWORK, WORK,
+     $                              LWORK, INFO )
+*
+*                    Check error code from CSYTRI_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'CSYTRI_3', INFO, -1,
+     $                               UPLO, N, N, -1, -1, -1, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+*                    Compute the residual for a symmetric matrix times
+*                    its inverse.
+*
+                     CALL CSYT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
+     $                            RWORK, RCONDC, RESULT( 2 ) )
+                     NT = 2
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 110 K = 1, NT
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  110             CONTINUE
+                  NRUN = NRUN + NT
+*
+*+    TEST 3
+*                 Compute largest element in U or L
+*
+                  RESULT( 3 ) = ZERO
+                  STEMP = ZERO
+*
+                  CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) ) /
+     $                    ( ONE-ALPHA )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                 Compute largest element in U
+*
+                     K = N
+  120                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 130
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in in U
+*
+                        STEMP = CLANGE( 'M', K-1, 1,
+     $                          AFAC( ( K-1 )*LDA+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k-1 in U
+*
+                        STEMP = CLANGE( 'M', K-2, 2,
+     $                          AFAC( ( K-2 )*LDA+1 ), LDA, RWORK )
+                        K = K - 1
+*
+                     END IF
+*
+*                    STEMP should be bounded by CONST
+*
+                     STEMP = STEMP - CONST + THRESH
+                     IF( STEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = STEMP
+*
+                     K = K - 1
+*
+                     GO TO 120
+  130                CONTINUE
+*
+                  ELSE
+*
+*                 Compute largest element in L
+*
+                     K = 1
+  140                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 150
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in in L
+*
+                        STEMP = CLANGE( 'M', N-K, 1,
+     $                          AFAC( ( K-1 )*LDA+K+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k+1 in L
+*
+                        STEMP = CLANGE( 'M', N-K-1, 2,
+     $                          AFAC( ( K-1 )*LDA+K+2 ), LDA, RWORK )
+                        K = K + 1
+*
+                     END IF
+*
+*                    STEMP should be bounded by CONST
+*
+                     STEMP = STEMP - CONST + THRESH
+                     IF( STEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = STEMP
+*
+                     K = K + 1
+*
+                     GO TO 140
+  150                CONTINUE
+                  END IF
+*
+*
+*+    TEST 4
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
+*
+                  RESULT( 4 ) = ZERO
+                  STEMP = ZERO
+*
+                  CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) )*
+     $                    ( ( ONE + ALPHA ) / ( ONE - ALPHA ) )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                    Loop backward for UPLO = 'U'
+*
+                     K = N
+  160                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 170
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
+                        BLOCK( 1, 2 ) = E( K )
+                        BLOCK( 2, 1 ) = BLOCK( 1, 2 )
+                        BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
+*
+                        CALL CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               CDUMMY, 1, CDUMMY, 1,
+     $                               WORK, 6, RWORK( 3 ), INFO )
+*
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        STEMP = SING_MAX / SING_MIN
+*
+*                       STEMP should be bounded by CONST
+*
+                        STEMP = STEMP - CONST + THRESH
+                        IF( STEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = STEMP
+                        K = K - 1
+*
+                     END IF
+*
+                     K = K - 1
+*
+                     GO TO 160
+  170                CONTINUE
+*
+                  ELSE
+*
+*                    Loop forward for UPLO = 'L'
+*
+                     K = 1
+  180                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 190
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K )
+                        BLOCK( 2, 1 ) = E( K )
+                        BLOCK( 1, 2 ) = BLOCK( 2, 1 )
+                        BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 )
+*
+                        CALL CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               CDUMMY, 1, CDUMMY, 1,
+     $                               WORK, 6, RWORK(3), INFO )
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        STEMP = SING_MAX / SING_MIN
+*
+*                       STEMP should be bounded by CONST
+*
+                        STEMP = STEMP - CONST + THRESH
+                        IF( STEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = STEMP
+                        K = K + 1
+*
+                     END IF
+*
+                     K = K + 1
+*
+                     GO TO 180
+  190                CONTINUE
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 200 K = 3, 4
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  200             CONTINUE
+                  NRUN = NRUN + 2
+*
+*                 Skip the other tests if this is not the first block
+*                 size.
+*
+                  IF( INB.GT.1 )
+     $               GO TO 240
+*
+*                 Do only the condition estimate if INFO is not 0.
+*
+                  IF( TRFCON ) THEN
+                     RCONDC = ZERO
+                     GO TO 230
+                  END IF
+*
+*                 Do for each value of NRHS in NSVAL.
+*
+                  DO 220 IRHS = 1, NNS
+                     NRHS = NSVAL( IRHS )
+*
+*+    TEST 5 ( Using TRS_3)
+*                 Solve and compute residual for  A * X = B.
+*
+*                    Choose a set of NRHS random solution vectors
+*                    stored in XACT and set up the right hand side B
+*
+                     SRNAMT = 'CLARHS'
+                     CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+     $                            KL, KU, NRHS, A, LDA, XACT, LDA,
+     $                            B, LDA, ISEED, INFO )
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+                     SRNAMT = 'CSYTRS_3'
+                     CALL CSYTRS_3( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, INFO )
+*
+*                    Check error code from CSYTRS_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'CSYTRS_3', INFO, 0,
+     $                               UPLO, N, N, -1, -1, NRHS, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+*
+*                    Compute the residual for the solution
+*
+                     CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 5 ) )
+*
+*+    TEST 6
+*                 Check solution from generated exact solution.
+*
+                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 6 ) )
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 210 K = 5, 6
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALAHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+     $                        IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  210                CONTINUE
+                     NRUN = NRUN + 2
+*
+*                 End do for each value of NRHS in NSVAL.
+*
+  220             CONTINUE
+*
+*+    TEST 7
+*                 Get an estimate of RCOND = 1/CNDNUM.
+*
+  230             CONTINUE
+                  ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK )
+                  SRNAMT = 'CSYCON_3'
+                  CALL CSYCON_3( UPLO, N, AFAC, LDA, E, IWORK, ANORM,
+     $                           RCOND, WORK, INFO )
+*
+*                 Check error code from CSYCON_3 and handle error.
+*
+                  IF( INFO.NE.0 )
+     $               CALL ALAERH( PATH, 'CSYCON_3', INFO, 0,
+     $                            UPLO, N, N, -1, -1, -1, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Compute the test ratio to compare values of RCOND
+*
+                  RESULT( 7 ) = SGET06( RCOND, RCONDC )
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  IF( RESULT( 7 ).GE.THRESH ) THEN
+                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                  CALL ALAHD( NOUT, PATH )
+                     WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 7,
+     $                  RESULT( 7 )
+                     NFAIL = NFAIL + 1
+                  END IF
+                  NRUN = NRUN + 1
+  240          CONTINUE
+*
+  250       CONTINUE
+  260    CONTINUE
+  270 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+     $      I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+     $      I2, ', test(', I2, ') =', G12.5 )
+ 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
+     $      ', test(', I2, ') =', G12.5 )
+      RETURN
+*
+*     End of CCHKSY_RK
+*
+      END
diff --git a/TESTING/LIN/cdrvhe_aa.f b/TESTING/LIN/cdrvhe_aa.f
index 38ebca59..4e4f73bb 100644
--- a/TESTING/LIN/cdrvhe_aa.f
+++ b/TESTING/LIN/cdrvhe_aa.f
@@ -9,8 +9,8 @@
 *  ===========
 *
 *       SUBROUTINE CDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
-*                                A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
-*                                NOUT )
+*                             A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+*                             NOUT )
 *
 *       .. Scalar Arguments ..
 *       LOGICAL            TSTERR
@@ -186,9 +186,9 @@
       CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
       CHARACTER*3        MATPATH, PATH
       INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
-     $                   IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
      $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
-      REAL               AINVNM, ANORM, CNDNUM, RCOND, RCONDC
+      REAL               ANORM, CNDNUM
 *     ..
 *     .. Local Arrays ..
       CHARACTER          FACTS( NFACT ), UPLOS( 2 )
@@ -385,45 +385,6 @@
 *
                   FACT = FACTS( IFACT )
 *
-*                 Compute the condition number for comparison with
-*                 the value returned by CHESVX.
-*
-                  IF( ZEROT ) THEN
-                     IF( IFACT.EQ.1 )
-     $                  GO TO 150
-                     RCONDC = ZERO
-*
-                  ELSE IF( IFACT.EQ.1 ) THEN
-*
-*                    Compute the 1-norm of A.
-*
-                     ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )
-*
-*                    Factor the matrix A.
-*
-c                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
-c                     SRNAMT = 'CHETRF_AA'
-c                     CALL CHETRF_AA( UPLO, N, AFAC, LDA, IWORK,
-c     $                            WORK, LWORK, INFO )
-*
-*                    Compute inv(A) and take its norm.
-*
-c                     CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
-c                     LWORK = (N+NB+1)*(NB+3)
-c                     SRNAMT = 'CHETRI2'
-c                     CALL CHETRI2( UPLO, N, AINV, LDA, IWORK, WORK,
-c     $                            LWORK, INFO )
-c                     AINVNM = CLANHE( '1', UPLO, N, AINV, LDA, RWORK )
-*
-*                    Compute the 1-norm condition number of A.
-*
-c                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
-c                        RCONDC = ONE
-c                     ELSE
-c                        RCONDC = ( ONE / ANORM ) / AINVNM
-c                     END IF
-                  END IF
-*
 *                 Form an exact solution and set the right hand side.
 *
                   SRNAMT = 'CLARHS'
@@ -487,12 +448,7 @@ c                     END IF
                      CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
                      CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
      $                            LDA, RWORK, RESULT( 2 ) )
-*
-*                    Check solution from generated exact solution.
-*
-                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
-     $                            RESULT( 3 ) )
-                     NT = 3
+                     NT = 2
 *
 *                    Print information about the tests that did not pass
 *                    the threshold.
diff --git a/TESTING/LIN/cdrvhe_rk.f b/TESTING/LIN/cdrvhe_rk.f
new file mode 100644
index 00000000..36a9a930
--- /dev/null
+++ b/TESTING/LIN/cdrvhe_rk.f
@@ -0,0 +1,534 @@
+*> \brief \b CDRVHE_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CDRVHE_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+*                             NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+*                             RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NOUT, NRHS
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NVAL( * )
+*       REAL               RWORK( * )
+*       COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+*      $                   WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CDRVHE_RK tests the driver routines CHESV_RK.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand side vectors to be generated for
+*>          each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup complex_lin
+*
+*  =====================================================================
+      SUBROUTINE CDRVHE_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+     $                      RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NOUT, NRHS
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NVAL( * )
+      REAL               RWORK( * )
+      COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+      INTEGER            NTYPES, NTESTS
+      PARAMETER          ( NTYPES = 10, NTESTS = 3 )
+      INTEGER            NFACT
+      PARAMETER          ( NFACT = 2 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ZEROT
+      CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
+      CHARACTER*3        MATPATH, PATH
+      INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+     $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+      REAL               AINVNM, ANORM, CNDNUM, RCONDC
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          FACTS( NFACT ), UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      REAL               RESULT( NTESTS )
+
+*     ..
+*     .. External Functions ..
+      REAL               CLANHE
+      EXTERNAL           CLANHE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, CERRVX, CGET04,
+     $                   CLACPY, CLARHS, CLATB4, CLATMS, CHESV_RK,
+     $                   CHET01_3, CPOT02, CHETRF_RK, CHETRI_3
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Complex precision'
+      PATH( 2: 3 ) = 'HK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Complex precision'
+      MATPATH( 2: 3 ) = 'HE'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+      LWORK = MAX( 2*NMAX, NMAX*NRHS )
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL CERRVX( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the block size and minimum block size for which the block
+*     routine should be used, which will be later returned by ILAENV.
+*
+      NB = 1
+      NBMIN = 2
+      CALL XLAENV( 1, NB )
+      CALL XLAENV( 2, NBMIN )
+*
+*     Do for each value of N in NVAL
+*
+      DO 180 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         DO 170 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 170
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 170
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 160 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*                 Begin generate the test matrix A.
+*
+*                 Set up parameters with CLATB4 for the matrix generator
+*                 based on the type of matrix to be generated.
+*
+                  CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                         MODE, CNDNUM, DIST )
+*
+*                 Generate a matrix with CLATMS.
+*
+                  SRNAMT = 'CLATMS'
+                  CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                         CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+     $                         WORK, INFO )
+*
+*                 Check error code from CLATMS and handle error.
+*
+                  IF( INFO.NE.0 ) THEN
+                     CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
+     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+                     GO TO 160
+                  END IF
+*
+*                 For types 3-6, zero one or more rows and columns of
+*                 the matrix to test that INFO is returned correctly.
+*
+                  IF( ZEROT ) THEN
+                     IF( IMAT.EQ.3 ) THEN
+                        IZERO = 1
+                     ELSE IF( IMAT.EQ.4 ) THEN
+                        IZERO = N
+                     ELSE
+                        IZERO = N / 2 + 1
+                     END IF
+*
+                     IF( IMAT.LT.6 ) THEN
+*
+*                       Set row and column IZERO to zero.
+*
+                        IF( IUPLO.EQ.1 ) THEN
+                           IOFF = ( IZERO-1 )*LDA
+                           DO 20 I = 1, IZERO - 1
+                              A( IOFF+I ) = ZERO
+   20                      CONTINUE
+                           IOFF = IOFF + IZERO
+                           DO 30 I = IZERO, N
+                              A( IOFF ) = ZERO
+                              IOFF = IOFF + LDA
+   30                      CONTINUE
+                        ELSE
+                           IOFF = IZERO
+                           DO 40 I = 1, IZERO - 1
+                              A( IOFF ) = ZERO
+                              IOFF = IOFF + LDA
+   40                      CONTINUE
+                           IOFF = IOFF - IZERO
+                           DO 50 I = IZERO, N
+                              A( IOFF+I ) = ZERO
+   50                      CONTINUE
+                        END IF
+                     ELSE
+                        IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 70 J = 1, N
+                              I2 = MIN( J, IZERO )
+                              DO 60 I = 1, I2
+                                 A( IOFF+I ) = ZERO
+   60                         CONTINUE
+                              IOFF = IOFF + LDA
+   70                      CONTINUE
+                        ELSE
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 90 J = 1, N
+                              I1 = MAX( J, IZERO )
+                              DO 80 I = I1, N
+                                 A( IOFF+I ) = ZERO
+   80                         CONTINUE
+                              IOFF = IOFF + LDA
+   90                      CONTINUE
+                        END IF
+                     END IF
+                  ELSE
+                     IZERO = 0
+                  END IF
+*
+*                 End generate the test matrix A.
+*
+*
+               DO 150 IFACT = 1, NFACT
+*
+*                 Do first for FACT = 'F', then for other values.
+*
+                  FACT = FACTS( IFACT )
+*
+*                 Compute the condition number
+*
+                  IF( ZEROT ) THEN
+                     IF( IFACT.EQ.1 )
+     $                  GO TO 150
+                     RCONDC = ZERO
+*
+                  ELSE IF( IFACT.EQ.1 ) THEN
+*
+*                    Compute the 1-norm of A.
+*
+                     ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )
+*
+*                    Factor the matrix A.
+*
+                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL CHETRF_RK( UPLO, N, AFAC, LDA, E, IWORK, WORK,
+     $                               LWORK, INFO )
+*
+*                    Compute inv(A) and take its norm.
+*
+                     CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     LWORK = (N+NB+1)*(NB+3)
+*
+*                    We need to copute the invesrse to compute
+*                    RCONDC that is used later in TEST3.
+*
+                     CALL CSYTRI_3( UPLO, N, AINV, LDA, E, IWORK,
+     $                              WORK, LWORK, INFO )
+                     AINVNM = CLANHE( '1', UPLO, N, AINV, LDA, RWORK )
+*
+*                    Compute the 1-norm condition number of A.
+*
+                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
+                        RCONDC = ONE
+                     ELSE
+                        RCONDC = ( ONE / ANORM ) / AINVNM
+                     END IF
+                  END IF
+*
+*                 Form an exact solution and set the right hand side.
+*
+                  SRNAMT = 'CLARHS'
+                  CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+     $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+     $                         INFO )
+                  XTYPE = 'C'
+*
+*                 --- Test CHESV_RK  ---
+*
+                  IF( IFACT.EQ.2 ) THEN
+                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+*                    Factor the matrix and solve the system using
+*                    CHESV_RK.
+*
+                     SRNAMT = 'CHESV_RK'
+                     CALL CHESV_RK( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, WORK, LWORK, INFO )
+*
+*                    Adjust the expected value of INFO to account for
+*                    pivoting.
+*
+                     K = IZERO
+                     IF( K.GT.0 ) THEN
+  100                   CONTINUE
+                        IF( IWORK( K ).LT.0 ) THEN
+                           IF( IWORK( K ).NE.-K ) THEN
+                              K = -IWORK( K )
+                              GO TO 100
+                           END IF
+                        ELSE IF( IWORK( K ).NE.K ) THEN
+                           K = IWORK( K )
+                           GO TO 100
+                        END IF
+                     END IF
+*
+*                    Check error code from CHESV_RK and handle error.
+*
+                     IF( INFO.NE.K ) THEN
+                        CALL ALAERH( PATH, 'CHESV_RK', INFO, K, UPLO,
+     $                               N, N, -1, -1, NRHS, IMAT, NFAIL,
+     $                               NERRS, NOUT )
+                        GO TO 120
+                     ELSE IF( INFO.NE.0 ) THEN
+                        GO TO 120
+                     END IF
+*
+*+    TEST 1      Reconstruct matrix from factors and compute
+*                 residual.
+*
+                     CALL CHET01_3( UPLO, N, A, LDA, AFAC, LDA, E,
+     $                              IWORK, AINV, LDA, RWORK,
+     $                              RESULT( 1 ) )
+*
+*+    TEST 2      Compute residual of the computed solution.
+*
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+                     CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 2 ) )
+*
+*+    TEST 3
+*                 Check solution from generated exact solution.
+*
+                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 3 ) )
+                     NT = 3
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 110 K = 1, NT
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALADHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9999 )'CHESV_RK', UPLO,
+     $                            N, IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  110                CONTINUE
+                     NRUN = NRUN + NT
+  120                CONTINUE
+                  END IF
+*
+  150          CONTINUE
+*
+  160       CONTINUE
+  170    CONTINUE
+  180 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+     $      ', test ', I2, ', ratio =', G12.5 )
+      RETURN
+*
+*     End of CDRVHE_RK
+*
+      END
diff --git a/TESTING/LIN/cdrvls.f b/TESTING/LIN/cdrvls.f
index de9890f4..ededde5a 100644
--- a/TESTING/LIN/cdrvls.f
+++ b/TESTING/LIN/cdrvls.f
@@ -489,7 +489,7 @@
                                  CALL CLACPY( 'Full', NROWS, NRHS,
      $                                        COPYB, LDB, B, LDB )
                               END IF
-                              SRNAMT = 'DGETSLS '
+                              SRNAMT = 'CGETSLS '
                               CALL CGETSLS( TRANS, M, N, NRHS, A,
      $                                 LDA, B, LDB, WORK, LWORK, INFO )
                               IF( INFO.NE.0 )
diff --git a/TESTING/LIN/cdrvsy_aa.f b/TESTING/LIN/cdrvsy_aa.f
new file mode 100644
index 00000000..69a4e556
--- /dev/null
+++ b/TESTING/LIN/cdrvsy_aa.f
@@ -0,0 +1,480 @@
+*> \brief \b CDRVSY_AA
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
+*                             A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+*                             NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NOUT, NRHS
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NVAL( * )
+*       REAL               RWORK( * )
+*       COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
+*      $                   WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CDRVSY_AA tests the driver routine CSYSV_AA.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand side vectors to be generated for
+*>          each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*  @generated from LIN/ddrvsy_aa.f, fortran d -> c, Thu Nov 17 12:14:51 2016
+*
+*> \ingroup complex_lin
+*
+*  =====================================================================
+      SUBROUTINE CDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+     $                      RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NOUT, NRHS
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NVAL( * )
+      REAL               RWORK( * )
+      COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0D+0 )
+      COMPLEX            CZERO
+      PARAMETER          ( CZERO = 0.0E+0 )
+      INTEGER            NTYPES, NTESTS
+      PARAMETER          ( NTYPES = 10, NTESTS = 3 )
+      INTEGER            NFACT
+      PARAMETER          ( NFACT = 2 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ZEROT
+      CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
+      CHARACTER*3        MATPATH, PATH
+      INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+     $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+      REAL               ANORM, CNDNUM
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          FACTS( NFACT ), UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      REAL   RESULT( NTESTS )
+*     ..
+*     .. External Functions ..
+      REAL               DGET06, CLANSY
+      EXTERNAL           DGET06, CLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALADHD, ALAERH, ALASVM, DERRVX, CGET04, CLACPY,
+     $                   CLARHS, CLASET, CLATB4, CLATMS, CSYT02, DSYT05,
+     $                   CSYSV_AA, CSYT01_AA, CSYTRF_AA, XLAENV
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Complex precision'
+      PATH( 2: 3 ) = 'SA'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Complex precision'
+      MATPATH( 2: 3 ) = 'SY'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+      LWORK = MAX( 2*NMAX, NMAX*NRHS )
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL CERRVX( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the block size and minimum block size for testing.
+*
+      NB = 1
+      NBMIN = 2
+      CALL XLAENV( 1, NB )
+      CALL XLAENV( 2, NBMIN )
+*
+*     Do for each value of N in NVAL
+*
+      DO 180 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         DO 170 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 170
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 170
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 160 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*              Set up parameters with CLATB4 and generate a test matrix
+*              with CLATMS.
+*
+               CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                      MODE, CNDNUM, DIST )
+*
+               SRNAMT = 'CLATMS'
+               CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+     $                      INFO )
+*
+*              Check error code from CLATMS.
+*
+               IF( INFO.NE.0 ) THEN
+                  CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
+     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
+                  GO TO 160
+               END IF
+*
+*              For types 3-6, zero one or more rows and columns of the
+*              matrix to test that INFO is returned correctly.
+*
+               IF( ZEROT ) THEN
+                  IF( IMAT.EQ.3 ) THEN
+                     IZERO = 1
+                  ELSE IF( IMAT.EQ.4 ) THEN
+                     IZERO = N
+                  ELSE
+                     IZERO = N / 2 + 1
+                  END IF
+*
+                  IF( IMAT.LT.6 ) THEN
+*
+*                    Set row and column IZERO to zero.
+*
+                     IF( IUPLO.EQ.1 ) THEN
+                        IOFF = ( IZERO-1 )*LDA
+                        DO 20 I = 1, IZERO - 1
+                           A( IOFF+I ) = CZERO
+   20                   CONTINUE
+                        IOFF = IOFF + IZERO
+                        DO 30 I = IZERO, N
+                           A( IOFF ) = CZERO
+                           IOFF = IOFF + LDA
+   30                   CONTINUE
+                     ELSE
+                        IOFF = IZERO
+                        DO 40 I = 1, IZERO - 1
+                           A( IOFF ) = CZERO
+                           IOFF = IOFF + LDA
+   40                   CONTINUE
+                        IOFF = IOFF - IZERO
+                        DO 50 I = IZERO, N
+                           A( IOFF+I ) = CZERO
+   50                   CONTINUE
+                     END IF
+                  ELSE
+                     IOFF = 0
+                     IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                        DO 70 J = 1, N
+                           I2 = MIN( J, IZERO )
+                           DO 60 I = 1, I2
+                              A( IOFF+I ) = CZERO
+   60                      CONTINUE
+                           IOFF = IOFF + LDA
+   70                   CONTINUE
+                        IZERO = 1
+                     ELSE
+*
+*                       Set the last IZERO rows and columns to zero.
+*
+                        DO 90 J = 1, N
+                           I1 = MAX( J, IZERO )
+                           DO 80 I = I1, N
+                              A( IOFF+I ) = CZERO
+   80                      CONTINUE
+                           IOFF = IOFF + LDA
+   90                   CONTINUE
+                     END IF
+                  END IF
+               ELSE
+                  IZERO = 0
+               END IF
+*
+               DO 150 IFACT = 1, NFACT
+*
+*                 Do first for FACT = 'F', then for other values.
+*
+                  FACT = FACTS( IFACT )
+*
+*                 Form an exact solution and set the right hand side.
+*
+                  SRNAMT = 'CLARHS'
+                  CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+     $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+     $                         INFO )
+                  XTYPE = 'C'
+*
+*                 --- Test CSYSV_AA  ---
+*
+                  IF( IFACT.EQ.2 ) THEN
+                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+*                    Factor the matrix and solve the system using CSYSV_AA.
+*
+                     SRNAMT = 'CSYSV_AA'
+                     CALL CSYSV_AA( UPLO, N, NRHS, AFAC, LDA, IWORK,
+     $                                 X, LDA, WORK, LWORK, INFO )
+*
+*                    Adjust the expected value of INFO to account for
+*                    pivoting.
+*
+                     IF( IZERO.GT.0 ) THEN
+                        J = 1
+                        K = IZERO
+  100                   CONTINUE
+                        IF( J.EQ.K ) THEN
+                           K = IWORK( J )
+                        ELSE IF( IWORK( J ).EQ.K ) THEN
+                           K = J
+                        END IF
+                        IF( J.LT.K ) THEN
+                           J = J + 1
+                           GO TO 100
+                        END IF
+                     ELSE
+                        K = 0
+                     END IF
+*
+*                    Check error code from CSYSV_AA .
+*
+                     IF( INFO.NE.K ) THEN
+                        CALL ALAERH( PATH, 'CSYSV_AA ', INFO, K,
+     $                               UPLO, N, N, -1, -1, NRHS,
+     $                               IMAT, NFAIL, NERRS, NOUT )
+                        GO TO 120
+                     ELSE IF( INFO.NE.0 ) THEN
+                        GO TO 120
+                     END IF
+*
+*                    Reconstruct matrix from factors and compute
+*                    residual.
+*
+                     CALL CSYT01_AA( UPLO, N, A, LDA, AFAC, LDA,
+     $                               IWORK, AINV, LDA, RWORK,
+     $                               RESULT( 1 ) )
+*
+*                    Compute residual of the computed solution.
+*
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+                     CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 2 ) )
+                     NT = 2
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 110 K = 1, NT
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALADHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9999 )'CSYSV_AA ',
+     $                        UPLO, N, IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  110                CONTINUE
+                     NRUN = NRUN + NT
+  120                CONTINUE
+                  END IF
+*
+  150          CONTINUE
+*
+  160       CONTINUE
+  170    CONTINUE
+  180 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+     $      ', test ', I2, ', ratio =', G12.5 )
+      RETURN
+*
+*     End of CDRVSY_AA
+*
+      END
diff --git a/TESTING/LIN/cdrvsy_rk.f b/TESTING/LIN/cdrvsy_rk.f
new file mode 100644
index 00000000..900ce441
--- /dev/null
+++ b/TESTING/LIN/cdrvsy_rk.f
@@ -0,0 +1,542 @@
+*> \brief \b CDRVSY_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+*                             NMAX, A, AFAC, E,  AINV, B, X, XACT, WORK,
+*                             RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NOUT, NRHS
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NVAL( * )
+*       REAL               RWORK( * )
+*       COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+*      $                   WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CDRVSY_RK tests the driver routines CSYSV_RK.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand side vectors to be generated for
+*>          each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (NMAX)
+*> \param[out] AINV
+*>
+*> \verbatim
+*>          AINV is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup complex_lin
+*
+*  =====================================================================
+      SUBROUTINE CDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+     $                      RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NOUT, NRHS
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NVAL( * )
+      REAL               RWORK( * )
+      COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+      INTEGER            NTYPES, NTESTS
+      PARAMETER          ( NTYPES = 11, NTESTS = 3 )
+      INTEGER            NFACT
+      PARAMETER          ( NFACT = 2 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ZEROT
+      CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
+      CHARACTER*3        MATPATH, PATH
+      INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+     $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+      REAL               AINVNM, ANORM, CNDNUM, RCONDC
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          FACTS( NFACT ), UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      REAL               RESULT( NTESTS )
+
+*     ..
+*     .. External Functions ..
+      REAL               CLANSY
+      EXTERNAL           CLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, CERRVX, CGET04,
+     $                   CLACPY, CLARHS, CLATB4, CLATMS, CLATSY,
+     $                   CSYSV_RK, CSYT01_3, CSYT02, CSYTRF_RK, CSYTRI_3
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Complex precision'
+      PATH( 2: 3 ) = 'SK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Complex precision'
+      MATPATH( 2: 3 ) = 'SY'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+      LWORK = MAX( 2*NMAX, NMAX*NRHS )
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL CERRVX( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the block size and minimum block size for which the block
+*     routine should be used, which will be later returned by ILAENV.
+*
+      NB = 1
+      NBMIN = 2
+      CALL XLAENV( 1, NB )
+      CALL XLAENV( 2, NBMIN )
+*
+*     Do for each value of N in NVAL
+*
+      DO 180 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         DO 170 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 170
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 170
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 160 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+               IF( IMAT.NE.NTYPES ) THEN
+*
+*                 Begin generate the test matrix A.
+*
+*                 Set up parameters with CLATB4 for the matrix generator
+*                 based on the type of matrix to be generated.
+*
+                  CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                         MODE, CNDNUM, DIST )
+*
+*                 Generate a matrix with CLATMS.
+*
+                  SRNAMT = 'CLATMS'
+                  CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                         CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+     $                         WORK, INFO )
+*
+*                 Check error code from CLATMS and handle error.
+*
+                  IF( INFO.NE.0 ) THEN
+                     CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
+     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+                     GO TO 160
+                  END IF
+*
+*                 For types 3-6, zero one or more rows and columns of
+*                 the matrix to test that INFO is returned correctly.
+*
+                  IF( ZEROT ) THEN
+                     IF( IMAT.EQ.3 ) THEN
+                        IZERO = 1
+                     ELSE IF( IMAT.EQ.4 ) THEN
+                        IZERO = N
+                     ELSE
+                        IZERO = N / 2 + 1
+                     END IF
+*
+                     IF( IMAT.LT.6 ) THEN
+*
+*                       Set row and column IZERO to zero.
+*
+                        IF( IUPLO.EQ.1 ) THEN
+                           IOFF = ( IZERO-1 )*LDA
+                           DO 20 I = 1, IZERO - 1
+                              A( IOFF+I ) = ZERO
+   20                      CONTINUE
+                           IOFF = IOFF + IZERO
+                           DO 30 I = IZERO, N
+                              A( IOFF ) = ZERO
+                              IOFF = IOFF + LDA
+   30                      CONTINUE
+                        ELSE
+                           IOFF = IZERO
+                           DO 40 I = 1, IZERO - 1
+                              A( IOFF ) = ZERO
+                              IOFF = IOFF + LDA
+   40                      CONTINUE
+                           IOFF = IOFF - IZERO
+                           DO 50 I = IZERO, N
+                              A( IOFF+I ) = ZERO
+   50                      CONTINUE
+                        END IF
+                     ELSE
+                        IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 70 J = 1, N
+                              I2 = MIN( J, IZERO )
+                              DO 60 I = 1, I2
+                                 A( IOFF+I ) = ZERO
+   60                         CONTINUE
+                              IOFF = IOFF + LDA
+   70                      CONTINUE
+                        ELSE
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 90 J = 1, N
+                              I1 = MAX( J, IZERO )
+                              DO 80 I = I1, N
+                                 A( IOFF+I ) = ZERO
+   80                         CONTINUE
+                              IOFF = IOFF + LDA
+   90                      CONTINUE
+                        END IF
+                     END IF
+                  ELSE
+                     IZERO = 0
+                  END IF
+*
+*                 End generate the test matrix A.
+*
+               ELSE
+*
+*                 IMAT = NTYPES:  Use a special block diagonal matrix to
+*                 test alternate code for the 2-by-2 blocks.
+*
+                  CALL CLATSY( UPLO, N, A, LDA, ISEED )
+               END IF
+*
+               DO 150 IFACT = 1, NFACT
+*
+*                 Do first for FACT = 'F', then for other values.
+*
+                  FACT = FACTS( IFACT )
+*
+*                 Compute the condition number
+*
+                  IF( ZEROT ) THEN
+                     IF( IFACT.EQ.1 )
+     $                  GO TO 150
+                     RCONDC = ZERO
+*
+                  ELSE IF( IFACT.EQ.1 ) THEN
+*
+*                    Compute the 1-norm of A.
+*
+                     ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+*                    Factor the matrix A.
+*
+
+                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL CSYTRF_RK( UPLO, N, AFAC, LDA, E, IWORK, WORK,
+     $                               LWORK, INFO )
+*
+*                    Compute inv(A) and take its norm.
+*
+                     CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     LWORK = (N+NB+1)*(NB+3)
+*
+*                    We need to copute the invesrse to compute
+*                    RCONDC that is used later in TEST3.
+*
+                     CALL CSYTRI_3( UPLO, N, AINV, LDA, E, IWORK,
+     $                              WORK, LWORK, INFO )
+                     AINVNM = CLANSY( '1', UPLO, N, AINV, LDA, RWORK )
+*
+*                    Compute the 1-norm condition number of A.
+*
+                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
+                        RCONDC = ONE
+                     ELSE
+                        RCONDC = ( ONE / ANORM ) / AINVNM
+                     END IF
+                  END IF
+*
+*                 Form an exact solution and set the right hand side.
+*
+                  SRNAMT = 'CLARHS'
+                  CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+     $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+     $                         INFO )
+                  XTYPE = 'C'
+*
+*                 --- Test CSYSV_RK  ---
+*
+                  IF( IFACT.EQ.2 ) THEN
+                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+*                    Factor the matrix and solve the system using
+*                    CSYSV_RK.
+*
+                     SRNAMT = 'CSYSV_RK'
+                     CALL CSYSV_RK( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, WORK, LWORK, INFO )
+*
+*                    Adjust the expected value of INFO to account for
+*                    pivoting.
+*
+                     K = IZERO
+                     IF( K.GT.0 ) THEN
+  100                   CONTINUE
+                        IF( IWORK( K ).LT.0 ) THEN
+                           IF( IWORK( K ).NE.-K ) THEN
+                              K = -IWORK( K )
+                              GO TO 100
+                           END IF
+                        ELSE IF( IWORK( K ).NE.K ) THEN
+                           K = IWORK( K )
+                           GO TO 100
+                        END IF
+                     END IF
+*
+*                    Check error code from CSYSV_RK and handle error.
+*
+                     IF( INFO.NE.K ) THEN
+                        CALL ALAERH( PATH, 'CSYSV_RK', INFO, K, UPLO,
+     $                               N, N, -1, -1, NRHS, IMAT, NFAIL,
+     $                               NERRS, NOUT )
+                        GO TO 120
+                     ELSE IF( INFO.NE.0 ) THEN
+                        GO TO 120
+                     END IF
+*
+*+    TEST 1      Reconstruct matrix from factors and compute
+*                 residual.
+*
+                     CALL CSYT01_3( UPLO, N, A, LDA, AFAC, LDA, E,
+     $                              IWORK, AINV, LDA, RWORK,
+     $                              RESULT( 1 ) )
+*
+*+    TEST 2      Compute residual of the computed solution.
+*
+                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+                     CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 2 ) )
+*
+*+    TEST 3
+*                 Check solution from generated exact solution.
+*
+                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 3 ) )
+                     NT = 3
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 110 K = 1, NT
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALADHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9999 )'CSYSV_RK', UPLO,
+     $                            N, IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  110                CONTINUE
+                     NRUN = NRUN + NT
+  120                CONTINUE
+                  END IF
+*
+  150          CONTINUE
+*
+  160       CONTINUE
+  170    CONTINUE
+  180 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+     $      ', test ', I2, ', ratio =', G12.5 )
+      RETURN
+*
+*     End of CDRVSY_RK
+*
+      END
diff --git a/TESTING/LIN/cerrhe.f b/TESTING/LIN/cerrhe.f
index 22defe6e..2bc50c0d 100644
--- a/TESTING/LIN/cerrhe.f
+++ b/TESTING/LIN/cerrhe.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2013
+*> \date November 2016
 *
 *> \ingroup complex_lin
 *
 *  =====================================================================
       SUBROUTINE CERRHE( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2013
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -81,18 +81,20 @@
       INTEGER            IP( NMAX )
       REAL               R( NMAX ), R1( NMAX ), R2( NMAX )
       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
       EXTERNAL           LSAMEN
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ALAESM, CHECON, CHECON_ROOK, CHERFS, CHETF2,
-     $                   CHETF2_ROOK, CHETRF, CHETRF_ROOK, CHETRF_AA, 
-     $                   CHETRI, CHETRI_ROOK, CHETRI2, CHETRS, 
-     $                   CHETRS_ROOK, CHETRS_AA, CHKXER, CHPCON, CHPRFS,
-     $                   CHPTRF, CHPTRI, CHPTRS
+      EXTERNAL           ALAESM, CHECON, CSYCON_3, CHECON_ROOK, CHERFS,
+     $                   CHETF2, CHETF2_RK, CHETF2_ROOK, CHETRF_AA, 
+     $                   CHETRF, CHETRF_RK, CHETRF_ROOK, CHETRI,
+     $                   CHETRI_3, CHETRI_3X, CHETRI_ROOK, CHETRI2,
+     $                   CHETRI2X, CHETRS, CHETRS_3, CHETRS_ROOK,
+     $                   CHETRS_AA, CHKXER, CHPCON, CHPRFS, CHPTRF,
+     $                   CHPTRI, CHPTRS
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -119,22 +121,23 @@
             A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
             AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
    10    CONTINUE
-         B( J ) = 0.
-         R1( J ) = 0.
-         R2( J ) = 0.
-         W( J ) = 0.
-         X( J ) = 0.
+         B( J ) = 0.E+0
+         E( J ) = 0.E+0
+         R1( J ) = 0.E+0
+         R2( J ) = 0.E+0
+         W( J ) = 0.E+0
+         X( J ) = 0.E+0
          IP( J ) = J
    20 CONTINUE
       ANRM = 1.0
       OK = .TRUE.
 *
-*     Test error exits of the routines that use factorization
-*     of a Hermitian indefinite matrix with patrial
-*     (Bunch-Kaufman) diagonal pivoting method.
-*
       IF( LSAMEN( 2, C2, 'HE' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a Hermitian indefinite matrix with patrial
+*        (Bunch-Kaufman) diagonal pivoting method.
+*
 *        CHETRF
 *
          SRNAMT = 'CHETRF'
@@ -147,6 +150,12 @@
          INFOT = 4
          CALL CHETRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
 *
 *        CHETF2
 *
@@ -187,6 +196,19 @@
          CALL CHETRI2( 'U', 2, A, 1, IP, W, 1, INFO )
          CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
 *
+*        CHETRI2X
+*
+         SRNAMT = 'CHETRI2X'
+         INFOT = 1
+         CALL CHETRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK )
+*
 *        CHETRS
 *
          SRNAMT = 'CHETRS'
@@ -254,12 +276,12 @@
          CALL CHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+*
 *        Test error exits of the routines that use factorization
-*        of a Hermitian indefinite matrix with "rook"
+*        of a Hermitian indefinite matrix with rook
 *        (bounded Bunch-Kaufman) diagonal pivoting method.
 *
-      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
-*
 *        CHETRF_ROOK
 *
          SRNAMT = 'CHETRF_ROOK'
@@ -272,6 +294,12 @@
          INFOT = 4
          CALL CHETRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        CHETF2_ROOK
 *
@@ -334,10 +362,119 @@
          CALL CHECON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
+*
 *        Test error exits of the routines that use factorization
-*        of a Hermitian indefinite matrix with Aasen's algorithm.
+*        of a Hermitian indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        CHETRF_RK
+*
+         SRNAMT = 'CHETRF_RK'
+         INFOT = 1
+         CALL CHETRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
+         CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHETRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHETRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        CHETF2_RK
+*
+         SRNAMT = 'CHETF2_RK'
+         INFOT = 1
+         CALL CHETF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK )
 *
-      ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
+*        CHETRI_3
+*
+         SRNAMT = 'CHETRI_3'
+         INFOT = 1
+         CALL CHETRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHETRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHETRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK )
+*
+*        CHETRI_3X
+*
+         SRNAMT = 'CHETRI_3X'
+         INFOT = 1
+         CALL CHETRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        CHETRS_3
+*
+         SRNAMT = 'CHETRS_3'
+         INFOT = 1
+         CALL CHETRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHETRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHETRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CHETRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK )
+*
+*        CHECON_3
+*
+         SRNAMT = 'CHECON_3'
+         INFOT = 1
+         CALL CHECON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHECON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHECON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHECON_3( 'U', 1, A, 1, E, IP, -1.0E0, RCOND, W, INFO)
+         CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
+*
+*        Test error exits of the routines that use factorization
+*        of a Hermitian indefinite matrix with Aasen's algorithm.
 *
 *        CHETRF_AA
 *
@@ -351,6 +488,12 @@
          INFOT = 4
          CALL CHETRF_AA( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'CHETRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRF_AA( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'CHETRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRF_AA( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'CHETRF_AA', INFOT, NOUT, LERR, OK )
 *
 *        CHETRS_AA
 *
@@ -370,6 +513,12 @@
          INFOT = 8
          CALL CHETRS_AA( 'U', 2, 1, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'CHETRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHETRS_AA( 'U', 0, 1, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CHETRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHETRS_AA( 'U', 0, 1, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CHETRS_AA', INFOT, NOUT, LERR, OK )
 *
 *        Test error exits of the routines that use factorization
 *        of a Hermitian indefinite packed matrix with patrial
diff --git a/TESTING/LIN/cerrhex.f b/TESTING/LIN/cerrhex.f
index a6ee9fa9..662892e3 100644
--- a/TESTING/LIN/cerrhex.f
+++ b/TESTING/LIN/cerrhex.f
@@ -51,17 +51,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup complex_lin
 *
 *  =====================================================================
       SUBROUTINE CERRHE( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -87,18 +87,19 @@
      $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
       EXTERNAL           LSAMEN
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ALAESM, CHECON,  CHECON_ROOK, CHERFS, CHETF2,
-     $                   CHETF2_ROOK, CHETRF, CHETRF_ROOK, CHETRI,
-     $                   CHETRI_ROOK, CHETRI2, CHETRS,  CHETRS_ROOK,
-     $                   CHKXER, CHPCON, CHPRFS, CHPTRF, CHPTRI, CHPTRS,
-     $                   CHERFSX
+      EXTERNAL           ALAESM, CHECON, CHECON_3, CHECON_ROOK, CHERFS,
+     $                   CHETF2, CHETF2_RK, CHETF2_ROOK, CHETRF,
+     $                   CHETRF_RK, CHETRF_ROOK, CHETRI, CHETRI_3,
+     $                   CHETRI_3X, CHETRI_ROOK, CHETRI2, CHETRI2X,
+     $                   CHETRS, CHETRS_3, CHETRS_ROOK, CHKXER, CHPCON,
+     $                   CHPRFS, CHPTRF, CHPTRI, CHPTRS, CHERFSX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -125,23 +126,23 @@
             A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
             AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
    10    CONTINUE
-         B( J ) = 0.
-         R1( J ) = 0.
-         R2( J ) = 0.
-         W( J ) = 0.
-         X( J ) = 0.
-         S( J ) = 0.
+         B( J ) = 0.E+0
+         E( J ) = 0.E+0
+         R1( J ) = 0.E+0
+         R2( J ) = 0.E+0
+         W( J ) = 0.E+0
+         X( J ) = 0.E+0
          IP( J ) = J
    20 CONTINUE
       ANRM = 1.0
       OK = .TRUE.
 *
-*     Test error exits of the routines that use factorization
-*     of a Hermitian indefinite matrix with patrial
-*     (Bunch-Kaufman) diagonal pivoting method.
-*
       IF( LSAMEN( 2, C2, 'HE' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a Hermitian indefinite matrix with patrial
+*        (Bunch-Kaufman) diagonal pivoting method.
+*
 *        CHETRF
 *
          SRNAMT = 'CHETRF'
@@ -154,6 +155,12 @@
          INFOT = 4
          CALL CHETRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
 *
 *        CHETF2
 *
@@ -194,6 +201,19 @@
          CALL CHETRI2( 'U', 2, A, 1, IP, W, 1, INFO )
          CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
 *
+*        CHETRI2X
+*
+         SRNAMT = 'CHETRI2X'
+         INFOT = 1
+         CALL CHETRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI2X', INFOT, NOUT, LERR, OK )
+*
 *        CHETRS
 *
          SRNAMT = 'CHETRS'
@@ -308,12 +328,12 @@
      $        PARAMS, W, R, INFO )
          CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+*
 *        Test error exits of the routines that use factorization
-*        of a Hermitian indefinite matrix with "rook"
+*        of a Hermitian indefinite matrix with rook
 *        (bounded Bunch-Kaufman) diagonal pivoting method.
 *
-      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
-*
 *        CHETRF_ROOK
 *
          SRNAMT = 'CHETRF_ROOK'
@@ -326,6 +346,12 @@
          INFOT = 4
          CALL CHETRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHETRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'CHETRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        CHETF2_ROOK
 *
@@ -388,12 +414,121 @@
          CALL CHECON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'CHECON_ROOK', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
+*
+*        Test error exits of the routines that use factorization
+*        of a Hermitian indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        CHETRF_RK
+*
+         SRNAMT = 'CHETRF_RK'
+         INFOT = 1
+         CALL CHETRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
+         CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHETRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHETRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'CHETRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        CHETF2_RK
+*
+         SRNAMT = 'CHETF2_RK'
+         INFOT = 1
+         CALL CHETF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CHETF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        CHETRI_3
+*
+         SRNAMT = 'CHETRI_3'
+         INFOT = 1
+         CALL CHETRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHETRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHETRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'CHETRI_3', INFOT, NOUT, LERR, OK )
+*
+*        CHETRI_3X
+*
+         SRNAMT = 'CHETRI_3X'
+         INFOT = 1
+         CALL CHETRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHETRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CHETRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        CHETRS_3
+*
+         SRNAMT = 'CHETRS_3'
+         INFOT = 1
+         CALL CHETRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHETRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHETRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHETRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CHETRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CHETRS_3', INFOT, NOUT, LERR, OK )
+*
+*        CHECON_3
+*
+         SRNAMT = 'CHECON_3'
+         INFOT = 1
+         CALL CHECON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHECON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CHECON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CHECON_3( 'U', 1, A, 1, E, IP, -1.0E0, RCOND, W, INFO)
+         CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
+*
 *     Test error exits of the routines that use factorization
 *     of a Hermitian indefinite packed matrix with patrial
 *     (Bunch-Kaufman) diagonal pivoting method.
 *
-      ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
-*
 *        CHPTRF
 *
          SRNAMT = 'CHPTRF'
diff --git a/TESTING/LIN/cerrsy.f b/TESTING/LIN/cerrsy.f
index b9e43855..e4bdc1dd 100644
--- a/TESTING/LIN/cerrsy.f
+++ b/TESTING/LIN/cerrsy.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2013
+*> \date November 2016
 *
 *> \ingroup complex_lin
 *
 *  =====================================================================
       SUBROUTINE CERRSY( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2013
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -80,7 +80,7 @@
       INTEGER            IP( NMAX )
       REAL               R( NMAX ), R1( NMAX ), R2( NMAX )
       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -88,9 +88,11 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAESM, CHKXER, CSPCON, CSPRFS, CSPTRF, CSPTRI,
-     $                   CSPTRS, CSYCON, CSYCON_ROOK, CSYRFS, CSYTF2,
-     $                   CSYTF2_ROOK, CSYTRF, CSYTRF_ROOK, CSYTRI,
-     $                   CSYTRI_ROOK, CSYTRI2, CSYTRS, CSYTRS_ROOK
+     $                   CSPTRS, CSYCON, CSYCON_3, CSYCON_ROOK, CSYRFS,
+     $                   CSYTF2, CSYTF2_RK, CSYTF2_ROOK, CSYTRF,
+     $                   CSYTRF_RK, CSYTRF_ROOK, CSYTRI, CSYTRI_3,
+     $                   CSYTRI_3X, CSYTRI_ROOK, CSYTRI2, CSYTRI2X,
+     $                   CSYTRS, CSYTRS_3, CSYTRS_ROOK
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -117,22 +119,23 @@
             A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
             AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
    10    CONTINUE
-         B( J ) = 0.
-         R1( J ) = 0.
-         R2( J ) = 0.
-         W( J ) = 0.
-         X( J ) = 0.
+         B( J ) = 0.E0
+         E( J ) = 0.E0
+         R1( J ) = 0.E0
+         R2( J ) = 0.E0
+         W( J ) = 0.E0
+         X( J ) = 0.E0
          IP( J ) = J
    20 CONTINUE
       ANRM = 1.0
       OK = .TRUE.
 *
-*     Test error exits of the routines that use factorization
-*     of a symmetric indefinite matrix with patrial
-*     (Bunch-Kaufman) diagonal pivoting method.
-*
       IF( LSAMEN( 2, C2, 'SY' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with patrial
+*        (Bunch-Kaufman) diagonal pivoting method.
+*
 *        CSYTRF
 *
          SRNAMT = 'CSYTRF'
@@ -145,6 +148,12 @@
          INFOT = 4
          CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYTRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYTRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
 *
 *        CSYTF2
 *
@@ -185,6 +194,19 @@
          CALL CSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO )
          CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
 *
+*        CSYTRI2X
+*
+         SRNAMT = 'CSYTRI2X'
+         INFOT = 1
+         CALL CSYTRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI2X', INFOT, NOUT, LERR, OK )
+*
 *        CSYTRS
 *
          SRNAMT = 'CSYTRS'
@@ -252,12 +274,12 @@
          CALL CSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
 *
-*     Test error exits of the routines that use factorization
-*     of a symmetric indefinite matrix with "rook"
-*     (bounded Bunch-Kaufman) diagonal pivoting method.
-*
       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) diagonal pivoting method.
+*
 *        CSYTRF_ROOK
 *
          SRNAMT = 'CSYTRF_ROOK'
@@ -270,6 +292,12 @@
          INFOT = 4
          CALL CSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'CSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYTRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'CSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYTRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'CSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        CSYTF2_ROOK
 *
@@ -332,12 +360,121 @@
          CALL CSYCON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'CSYCON_ROOK', INFOT, NOUT, LERR, OK )
 *
-*     Test error exits of the routines that use factorization
-*     of a symmetric indefinite packed matrix with patrial
-*     (Bunch-Kaufman) diagonal pivoting method.
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        CSYTRF_RK
+*
+         SRNAMT = 'CSYTRF_RK'
+         INFOT = 1
+         CALL CSYTRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
+         CALL CHKXER( 'CSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CSYTRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'CSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CSYTRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'CSYTRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        CSYTF2_RK
+*
+         SRNAMT = 'CSYTF2_RK'
+         INFOT = 1
+         CALL CSYTF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CSYTF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        CSYTRI_3
+*
+         SRNAMT = 'CSYTRI_3'
+         INFOT = 1
+         CALL CSYTRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CSYTRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'CSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CSYTRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'CSYTRI_3', INFOT, NOUT, LERR, OK )
+*
+*        CSYTRI_3X
+*
+         SRNAMT = 'CSYTRI_3X'
+         INFOT = 1
+         CALL CSYTRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        CSYTRS_3
+*
+         SRNAMT = 'CSYTRS_3'
+         INFOT = 1
+         CALL CSYTRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CSYTRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CSYTRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'CSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CSYTRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CSYTRS_3', INFOT, NOUT, LERR, OK )
+*
+*        CSYCON_3
+*
+         SRNAMT = 'CSYCON_3'
+         INFOT = 1
+         CALL CSYCON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYCON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYCON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYCON_3( 'U', 1, A, 1, E, IP, -1.0E0, RCOND, W, INFO)
+         CALL CHKXER( 'CSYCON_3', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite packed matrix with patrial
+*        (Bunch-Kaufman) diagonal pivoting method.
+*
 *        CSPTRF
 *
          SRNAMT = 'CSPTRF'
@@ -410,6 +547,56 @@
          INFOT = 5
          CALL CSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
+*
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with Aasen's algorithm
+*
+*        CSYTRF_AA
+*
+         SRNAMT = 'CSYTRF_AA'
+         INFOT = 1
+         CALL CSYTRF_AA( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRF_AA( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTRF_AA( 'U', 2, A, 1, IP, W, 4, INFO )
+         CALL CHKXER( 'CSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYTRF_AA( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'CSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYTRF_AA( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'CSYTRF_AA', INFOT, NOUT, LERR, OK )
+*
+*        CSYTRS_AA
+*
+         SRNAMT = 'CSYTRS_AA'
+         INFOT = 1
+         CALL CSYTRS_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRS_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CSYTRS_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CSYTRS_AA( 'U', 2, 1, A, 1, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'CSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CSYTRS_AA( 'U', 2, 1, A, 2, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CSYTRS_AA( 'U', 0, 1, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CSYTRS_AA( 'U', 0, 1, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CSYTRS_AA', INFOT, NOUT, LERR, OK )
+*
       END IF
 *
 *     Print a summary line.
diff --git a/TESTING/LIN/cerrsyx.f b/TESTING/LIN/cerrsyx.f
index b0cc0d34..0356be30 100644
--- a/TESTING/LIN/cerrsyx.f
+++ b/TESTING/LIN/cerrsyx.f
@@ -51,17 +51,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup complex_lin
 *
 *  =====================================================================
       SUBROUTINE CERRSY( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -86,7 +86,7 @@
      $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -124,23 +124,23 @@
             A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
             AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
    10    CONTINUE
-         B( J ) = 0.
-         R1( J ) = 0.
-         R2( J ) = 0.
-         W( J ) = 0.
-         X( J ) = 0.
-         S( J ) = 0.
+         B( J ) = 0.E0
+         E( J ) = 0.E0
+         R1( J ) = 0.E0
+         R2( J ) = 0.E0
+         W( J ) = 0.E0
+         X( J ) = 0.E0
          IP( J ) = J
    20 CONTINUE
       ANRM = 1.0
       OK = .TRUE.
-*
-*     Test error exits of the routines that use factorization
-*     of a symmetric indefinite matrix with patrial
-*     (Bunch-Kaufman) diagonal pivoting method.
-*
+
       IF( LSAMEN( 2, C2, 'SY' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with patrial
+*        (Bunch-Kaufman) diagonal pivoting method.
+*
 *        CSYTRF
 *
          SRNAMT = 'CSYTRF'
@@ -153,6 +153,12 @@
          INFOT = 4
          CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYTRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYTRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
 *
 *        CSYTF2
 *
@@ -193,6 +199,19 @@
          CALL CSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO )
          CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
 *
+*        CSYTRI2X
+*
+         SRNAMT = 'CSYTRI2X'
+         INFOT = 1
+         CALL CSYTRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI2X', INFOT, NOUT, LERR, OK )
+*
 *        CSYTRS
 *
          SRNAMT = 'CSYTRS'
@@ -307,12 +326,12 @@
          CALL CSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
 *
-*     Test error exits of the routines that use factorization
-*     of a symmetric indefinite matrix with "rook"
-*     (bounded Bunch-Kaufman) diagonal pivoting method.
-*
       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) diagonal pivoting method.
+*
 *        CSYTRF_ROOK
 *
          SRNAMT = 'CSYTRF_ROOK'
@@ -325,6 +344,12 @@
          INFOT = 4
          CALL CSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'CSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYTRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'CSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYTRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'CSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        CSYTF2_ROOK
 *
@@ -387,12 +412,121 @@
          CALL CSYCON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'CSYCON_ROOK', INFOT, NOUT, LERR, OK )
 *
-*     Test error exits of the routines that use factorization
-*     of a symmetric indefinite packed matrix with patrial
-*     (Bunch-Kaufman) diagonal pivoting method.
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        CSYTRF_RK
+*
+         SRNAMT = 'CSYTRF_RK'
+         INFOT = 1
+         CALL CSYTRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
+         CALL CHKXER( 'CSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CSYTRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'CSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CSYTRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'CSYTRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        CSYTF2_RK
+*
+         SRNAMT = 'CSYTF2_RK'
+         INFOT = 1
+         CALL CSYTF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'CSYTF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        CSYTRI_3
+*
+         SRNAMT = 'CSYTRI_3'
+         INFOT = 1
+         CALL CSYTRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CSYTRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'CSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CSYTRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'CSYTRI_3', INFOT, NOUT, LERR, OK )
+*
+*        CSYTRI_3X
+*
+         SRNAMT = 'CSYTRI_3X'
+         INFOT = 1
+         CALL CSYTRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYTRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'CSYTRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        CSYTRS_3
+*
+         SRNAMT = 'CSYTRS_3'
+         INFOT = 1
+         CALL CSYTRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYTRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CSYTRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CSYTRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'CSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CSYTRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'CSYTRS_3', INFOT, NOUT, LERR, OK )
+*
+*        CSYCON_3
+*
+         SRNAMT = 'CSYCON_3'
+         INFOT = 1
+         CALL CSYCON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYCON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL CSYCON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'CSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL CSYCON_3( 'U', 1, A, 1, E, IP, -1.0E0, RCOND, W, INFO)
+         CALL CHKXER( 'CSYCON_3', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite packed matrix with patrial
+*        (Bunch-Kaufman) diagonal pivoting method.
+*
 *        CSPTRF
 *
          SRNAMT = 'CSPTRF'
diff --git a/TESTING/LIN/cerrvx.f b/TESTING/LIN/cerrvx.f
index 13496241..655155a7 100644
--- a/TESTING/LIN/cerrvx.f
+++ b/TESTING/LIN/cerrvx.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2013
+*> \date November 2016
 *
 *> \ingroup complex_lin
 *
 *  =====================================================================
       SUBROUTINE CERRVX( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2013
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -82,7 +82,7 @@
       REAL               C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
      $                   RF( NMAX ), RW( NMAX )
       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -90,10 +90,11 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           CGBSV, CGBSVX, CGESV, CGESVX, CGTSV, CGTSVX,
-     $                   CHESV, CHESV_ROOK, CHESVX, CHKXER, CHPSV,
-     $                   CHPSVX, CPBSV, CPBSVX, CPOSV, CPOSVX, CPPSV,
-     $                   CPPSVX, CPTSV, CPTSVX, CSPSV, CSPSVX, CSYSV,
-     $                   CSYSV_AA, CSYSV_ROOK, CSYSVX
+     $                   CHESV, CHESV_RK ,CHESV_ROOK, CHESVX, CHKXER,
+     $                   CHPSV, CHPSVX, CPBSV, CPBSVX, CPOSV, CPOSVX,
+     $                   CPPSV, CPPSVX, CPTSV, CPTSVX, CSPSV, CSPSVX,
+     $                   CSYSV, CSYSV_AA, CSYSV_RK, CSYSV_ROOK,
+     $                   CSYSVX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -120,13 +121,14 @@
             A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
             AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
    10    CONTINUE
-         B( J ) = 0.
-         R1( J ) = 0.
-         R2( J ) = 0.
-         W( J ) = 0.
-         X( J ) = 0.
-         C( J ) = 0.
-         R( J ) = 0.
+         B( J ) = 0.E+0
+         E( J ) = 0.E+0
+         R1( J ) = 0.E+0
+         R2( J ) = 0.E+0
+         W( J ) = 0.E+0
+         X( J ) = 0.E+0
+         C( J ) = 0.E+0
+         R( J ) = 0.E+0
          IP( J ) = J
    20 CONTINUE
       EQ = ' '
@@ -591,6 +593,12 @@
          INFOT = 8
          CALL CHESV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHESV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHESV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
 *
 *        CHESVX
 *
@@ -632,42 +640,82 @@
      $                RCOND, R1, R2, W, 3, RW, INFO )
          CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
 *
-      ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
-*
-*        CHESV_AA
-*
-        SRNAMT = 'CHESV_AA'
-        INFOT = 1
-        CALL CHESV_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 2
-        CALL CHESV_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 3
-        CALL CHESV_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 8
-        CALL CHESV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_AA', INFOT, NOUT, LERR, OK )
-*
-
       ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
 *
 *        CHESV_ROOK
 *
-        SRNAMT = 'CHESV_ROOK'
-        INFOT = 1
-        CALL CHESV_ROOK( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
-        INFOT = 2
-        CALL CHESV_ROOK( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
-        INFOT = 3
-        CALL CHESV_ROOK( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
-        INFOT = 8
-        CALL CHESV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         SRNAMT = 'CHESV_ROOK'
+         INFOT = 1
+         CALL CHESV_ROOK( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHESV_ROOK( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHESV_ROOK( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHESV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHESV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHESV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
+*
+*        CHESV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'CHESV_RK'
+         INFOT = 1
+         CALL CHESV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHESV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHESV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHESV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CHESV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CHESV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CHESV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
+*
+*        CHESV_AASEN
+*
+         SRNAMT = 'CHESV_AA'
+         INFOT = 1
+         CALL CHESV_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHESV_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHESV_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHESV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_AA', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
 *
@@ -732,6 +780,12 @@
          INFOT = 8
          CALL CSYSV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'CSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CSYSV ', INFOT, NOUT, LERR, OK )
 *
 *        CSYSVX
 *
@@ -790,6 +844,47 @@
          INFOT = 8
          CALL CSYSV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'CSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CSYSV_ROOK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        CSYSV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'CSYSV_RK'
+         INFOT = 1
+         CALL CSYSV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYSV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CSYSV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CSYSV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CSYSV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
diff --git a/TESTING/LIN/cerrvxx.f b/TESTING/LIN/cerrvxx.f
index 82a93a5e..09c2749e 100644
--- a/TESTING/LIN/cerrvxx.f
+++ b/TESTING/LIN/cerrvxx.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup complex_lin
 *
 *  =====================================================================
       SUBROUTINE CERRVX( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -85,7 +85,7 @@
      $                   RF( NMAX ), RW( NMAX ), ERR_BNDS_N( NMAX, 3 ),
      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -93,11 +93,11 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           CGBSV, CGBSVX, CGESV, CGESVX, CGTSV, CGTSVX,
-     $                   CHESV, CHESV_ROOK, CHESVX, CHKXER, CHPSV,
-     $                   CHPSVX, CPBSV, CPBSVX, CPOSV, CPOSVX, CPPSV,
-     $                   CPPSVX, CPTSV, CPTSVX, CSPSV, CSPSVX, CSYSV,
-     $                   CSYSV_ROOK, CSYSVX, CGESVXX, CPOSVXX, CSYSVXX,
-     $                   CHESVXX, CGBSVXX
+     $                   CHESV, CHESV_RK, CHESV_ROOK, CHESVX, CHKXER,
+     $                   CHPSV, CHPSVX, CPBSV, CPBSVX, CPOSV, CPOSVX,
+     $                   CPPSV, CPPSVX, CPTSV, CPTSVX, CSPSV, CSPSVX,
+     $                   CSYSV, CSYSV_RK, CSYSV_ROOK, CSYSVX, CGESVXX,
+     $                   CPOSVXX, CSYSVXX, CHESVXX, CGBSVXX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -124,13 +124,14 @@
             A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
             AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
    10    CONTINUE
-         B( J ) = 0.
-         R1( J ) = 0.
-         R2( J ) = 0.
-         W( J ) = 0.
-         X( J ) = 0.
-         C( J ) = 0.
-         R( J ) = 0.
+         B( J ) = 0.E+0
+         E( J ) = 0E+0
+         R1( J ) = 0.E+0
+         R2( J ) = 0.E+0
+         W( J ) = 0.E+0
+         X( J ) = 0.E+0
+         C( J ) = 0.E+0
+         R( J ) = 0.E+0
          IP( J ) = J
    20 CONTINUE
       EQ = ' '
@@ -804,6 +805,12 @@
          INFOT = 8
          CALL CHESV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHESV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHESV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
 *
 *        CHESVX
 *
@@ -907,19 +914,60 @@
 *
 *        CHESV_ROOK
 *
-        SRNAMT = 'CHESV_ROOK'
-        INFOT = 1
-        CALL CHESV_ROOK( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
-        INFOT = 2
-        CALL CHESV_ROOK( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
-        INFOT = 3
-        CALL CHESV_ROOK( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
-        INFOT = 8
-        CALL CHESV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         SRNAMT = 'CHESV_ROOK'
+         INFOT = 1
+         CALL CHESV_ROOK( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHESV_ROOK( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHESV_ROOK( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL CHESV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHESV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CHESV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CHESV_ROOK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
+*
+*        CHESV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'CHESV_RK'
+         INFOT = 1
+         CALL CHESV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CHESV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CHESV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CHESV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CHESV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CHESV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CHESV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CHESV_RK', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
 *
@@ -984,6 +1032,12 @@
          INFOT = 8
          CALL CSYSV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'CSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CSYSV ', INFOT, NOUT, LERR, OK )
 *
 *        CSYSVX
 *
@@ -1110,6 +1164,47 @@
          INFOT = 8
          CALL CSYSV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'CSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL CSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CSYSV_ROOK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        CSYSV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'CSYSV_RK'
+         INFOT = 1
+         CALL CSYSV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL CSYSV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL CSYSV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL CSYSV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL CSYSV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL CSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'CSYSV_RK', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
diff --git a/TESTING/LIN/chet01_3.f b/TESTING/LIN/chet01_3.f
new file mode 100644
index 00000000..7b26c398
--- /dev/null
+++ b/TESTING/LIN/chet01_3.f
@@ -0,0 +1,264 @@
+*> \brief \b CHET01_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHET01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+*                            LDC, RWORK, RESID )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            LDA, LDAFAC, LDC, N
+*       REAL               RESID
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               RWORK( * )
+*       COMPLEX            A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+*                          E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHET01_3 reconstructs a Hermitian indefinite matrix A from its
+*> block L*D*L' or U*D*U' factorization computed by CHETRF_RK
+*> (or CHETRF_BK) and computes the residual
+*>    norm( C - A ) / ( N * norm(A) * EPS ),
+*> where C is the reconstructed matrix and EPS is the machine epsilon.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          The original Hermitian matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N)
+*> \endverbatim
+*>
+*> \param[in] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX array, dimension (LDAFAC,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by CHETRF_RK and CHETRF_BK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDAFAC
+*> \verbatim
+*>          LDAFAC is INTEGER
+*>          The leading dimension of the array AFAC.
+*>          LDAFAC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          The pivot indices from CHETRF_RK (or CHETRF_BK).
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*>          C is COMPLEX array, dimension (LDC,N)
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] RESID
+*> \verbatim
+*>          RESID is REAL
+*>          If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS )
+*>          If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex_lin
+*
+*  =====================================================================
+      SUBROUTINE CHET01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+     $                     LDC, RWORK, RESID )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            LDA, LDAFAC, LDC, N
+      REAL               RESID
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               RWORK( * )
+      COMPLEX            A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+     $                   E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      COMPLEX            CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   CONE = ( 1.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, INFO, J
+      REAL               ANORM, EPS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      REAL               CLANHE, SLAMCH
+      EXTERNAL           LSAME, CLANHE, SLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CLASET, CLAVHE_ROOK, CSYCONVF_ROOK
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          AIMAG, REAL
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick exit if N = 0.
+*
+      IF( N.LE.0 ) THEN
+         RESID = ZERO
+         RETURN
+      END IF
+*
+*     a) Revert to multiplyers of L
+*
+      CALL CSYCONVF_ROOK( UPLO, 'R', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+*     1) Determine EPS and the norm of A.
+*
+      EPS = SLAMCH( 'Epsilon' )
+      ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )
+*
+*     Check the imaginary parts of the diagonal elements and return with
+*     an error code if any are nonzero.
+*
+      DO J = 1, N
+         IF( AIMAG( AFAC( J, J ) ).NE.ZERO ) THEN
+            RESID = ONE / EPS
+            RETURN
+         END IF
+      END DO
+*
+*     2) Initialize C to the identity matrix.
+*
+      CALL CLASET( 'Full', N, N, CZERO, CONE, C, LDC )
+*
+*     3) Call CLAVHE_ROOK to form the product D * U' (or D * L' ).
+*
+      CALL CLAVHE_ROOK( UPLO, 'Conjugate', 'Non-unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     4) Call ZLAVHE_RK again to multiply by U (or L ).
+*
+      CALL CLAVHE_ROOK( UPLO, 'No transpose', 'Unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     5) Compute the difference  C - A .
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+         DO J = 1, N
+            DO I = 1, J - 1
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+            C( J, J ) = C( J, J ) - REAL( A( J, J ) )
+         END DO
+      ELSE
+         DO J = 1, N
+            C( J, J ) = C( J, J ) - REAL( A( J, J ) )
+            DO I = J + 1, N
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      END IF
+*
+*     6) Compute norm( C - A ) / ( N * norm(A) * EPS )
+*
+      RESID = CLANHE( '1', UPLO, N, C, LDC, RWORK )
+*
+      IF( ANORM.LE.ZERO ) THEN
+         IF( RESID.NE.ZERO )
+     $      RESID = ONE / EPS
+      ELSE
+         RESID = ( ( RESID/REAL( N ) )/ANORM ) / EPS
+      END IF
+*
+*     b) Convert to factor of L (or U)
+*
+      CALL CSYCONVF_ROOK( UPLO, 'C', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+      RETURN
+*
+*     End of CHET01_3
+*
+      END
diff --git a/TESTING/LIN/chet01_aa.f b/TESTING/LIN/chet01_aa.f
index 8f797f11..31b504d2 100644
--- a/TESTING/LIN/chet01_aa.f
+++ b/TESTING/LIN/chet01_aa.f
@@ -9,17 +9,17 @@
 *  ===========
 *
 *       SUBROUTINE CHET01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV,
-*                          C, LDC, RWORK, RESID )
+*                             C, LDC, RWORK, RESID )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
 *       INTEGER            LDA, LDAFAC, LDC, N
-*       COMPLEX            RESID
+*       REAL               RESID
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * )
-*       COMPLEX            A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
-*      $                   RWORK( * )
+*       REAL               RWORK( * )
+*       COMPLEX            A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
 *       ..
 *
 *
@@ -123,7 +123,7 @@
 *
 *  =====================================================================
       SUBROUTINE CHET01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
-     $                         LDC, RWORK, RESID )
+     $                      LDC, RWORK, RESID )
 *
 *  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -137,8 +137,8 @@
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * )
-      COMPLEX            A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
-     $                   RWORK( * )
+      REAL               RWORK( * )
+      COMPLEX            A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
 *     ..
 *
 *  =====================================================================
@@ -197,27 +197,29 @@
      $                   LDC+1 )
             CALL CLACGV( N-1, C( 1, 2 ), LDC+1 )
          ENDIF
-      ENDIF
 *
-*     Call CTRMM to form the product U' * D (or L * D ).
+*        Call CTRMM to form the product U' * D (or L * D ).
 *
-      IF( LSAME( UPLO, 'U' ) ) THEN
-         CALL CTRMM( 'Left', UPLO, 'Conjugate transpose', 'Unit', N-1,
-     $               N, CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC )
-      ELSE
-         CALL CTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
-     $               CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
-      END IF
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL CTRMM( 'Left', UPLO, 'Conjugate transpose', 'Unit',
+     $                  N-1, N, CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ),
+     $                  LDC )
+         ELSE
+            CALL CTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
+     $                  CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
+         END IF
 *
-*     Call CTRMM again to multiply by U (or L ).
+*        Call CTRMM again to multiply by U (or L ).
 *
-      IF( LSAME( UPLO, 'U' ) ) THEN
-         CALL CTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
-     $               CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
-      ELSE
-         CALL CTRMM( 'Right', UPLO, 'Conjugate transpose', 'Unit', N,
-     $               N-1, CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC )
-      END IF
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL CTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
+     $                  CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
+         ELSE
+            CALL CTRMM( 'Right', UPLO, 'Conjugate transpose', 'Unit', N,
+     $                  N-1, CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ),
+     $                  LDC )
+         END IF
+      ENDIF
 *
 *     Apply hermitian pivots
 *
diff --git a/TESTING/LIN/csyt01_3.f b/TESTING/LIN/csyt01_3.f
new file mode 100644
index 00000000..730d681a
--- /dev/null
+++ b/TESTING/LIN/csyt01_3.f
@@ -0,0 +1,253 @@
+*> \brief \b CSYT01_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+*                            LDC, RWORK, RESID )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            LDA, LDAFAC, LDC, N
+*       REAL               RESID
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               RWORK( * )
+*       COMPLEX            A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+*                          E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CSYT01_3 reconstructs a symmetric indefinite matrix A from its
+*> block L*D*L' or U*D*U' factorization computed by CSYTRF_RK
+*> (or CSYTRF_BK) and computes the residual
+*>    norm( C - A ) / ( N * norm(A) * EPS ),
+*> where C is the reconstructed matrix and EPS is the machine epsilon.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          The original symmetric matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N)
+*> \endverbatim
+*>
+*> \param[in] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX array, dimension (LDAFAC,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by CSYTRF_RK and CSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDAFAC
+*> \verbatim
+*>          LDAFAC is INTEGER
+*>          The leading dimension of the array AFAC.
+*>          LDAFAC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          The pivot indices from CSYTRF_RK (or CSYTRF_BK).
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*>          C is COMPLEX array, dimension (LDC,N)
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] RESID
+*> \verbatim
+*>          RESID is REAL
+*>          If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS )
+*>          If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex_lin
+*
+*  =====================================================================
+      SUBROUTINE CSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+     $                     LDC, RWORK, RESID )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            LDA, LDAFAC, LDC, N
+      REAL               RESID
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               RWORK( * )
+      COMPLEX            A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+     $                   E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      COMPLEX            CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   CONE = ( 1.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, INFO, J
+      REAL               ANORM, EPS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      REAL               SLAMCH, CLANSY
+      EXTERNAL           LSAME, SLAMCH, CLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CLASET, CLAVSY_ROOK, CSYCONVF_ROOK
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick exit if N = 0.
+*
+      IF( N.LE.0 ) THEN
+         RESID = ZERO
+         RETURN
+      END IF
+*
+*     a) Revert to multiplyers of L
+*
+      CALL CSYCONVF_ROOK( UPLO, 'R', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+*     1) Determine EPS and the norm of A.
+*
+      EPS = SLAMCH( 'Epsilon' )
+      ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+*     2) Initialize C to the identity matrix.
+*
+      CALL CLASET( 'Full', N, N, CZERO, CONE, C, LDC )
+*
+*     3) Call ZLAVSY_ROOK to form the product D * U' (or D * L' ).
+*
+      CALL CLAVSY_ROOK( UPLO, 'Transpose', 'Non-unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     4) Call ZLAVSY_ROOK again to multiply by U (or L ).
+*
+      CALL CLAVSY_ROOK( UPLO, 'No transpose', 'Unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     5) Compute the difference  C - A .
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+         DO J = 1, N
+            DO I = 1, J
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      ELSE
+         DO J = 1, N
+            DO I = J, N
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      END IF
+*
+*     6) Compute norm( C - A ) / ( N * norm(A) * EPS )
+*
+      RESID = CLANSY( '1', UPLO, N, C, LDC, RWORK )
+*
+      IF( ANORM.LE.ZERO ) THEN
+         IF( RESID.NE.ZERO )
+     $      RESID = ONE / EPS
+      ELSE
+         RESID = ( ( RESID / REAL( N ) ) / ANORM ) / EPS
+      END IF
+
+*
+*     b) Convert to factor of L (or U)
+*
+      CALL CSYCONVF_ROOK( UPLO, 'C', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+      RETURN
+*
+*     End of CSYT01_3
+*
+      END
diff --git a/TESTING/LIN/csyt01_aa.f b/TESTING/LIN/csyt01_aa.f
new file mode 100644
index 00000000..7c7382a3
--- /dev/null
+++ b/TESTING/LIN/csyt01_aa.f
@@ -0,0 +1,265 @@
+*> \brief \b CSYT01
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC,
+*                             RWORK, RESID )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            LDA, LDAFAC, LDC, N
+*       REAL               RESID
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               RWORK( * )
+*       COMPLEX            A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CSYT01 reconstructs a hermitian indefinite matrix A from its
+*> block L*D*L' or U*D*U' factorization and computes the residual
+*>    norm( C - A ) / ( N * norm(A) * EPS ),
+*> where C is the reconstructed matrix and EPS is the machine epsilon.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          hermitian matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          The original hermitian matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N)
+*> \endverbatim
+*>
+*> \param[in] AFAC
+*> \verbatim
+*>          AFAC is REAL array, dimension (LDAFAC,N)
+*>          The factored form of the matrix A.  AFAC contains the block
+*>          diagonal matrix D and the multipliers used to obtain the
+*>          factor L or U from the block L*D*L' or U*D*U' factorization
+*>          as computed by CSYTRF.
+*> \endverbatim
+*>
+*> \param[in] LDAFAC
+*> \verbatim
+*>          LDAFAC is INTEGER
+*>          The leading dimension of the array AFAC.  LDAFAC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          The pivot indices from CSYTRF.
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*>          C is REAL array, dimension (LDC,N)
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] RESID
+*> \verbatim
+*>          RESID is REAL
+*>          If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS )
+*>          If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*  @generated from LIN/dsyt01_aa.f, fortran d -> c, Thu Nov 17 13:01:50 2016
+*
+*> \ingroup complex_lin
+*
+*  =====================================================================
+      SUBROUTINE CSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
+     $                      LDC, RWORK, RESID )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            LDA, LDAFAC, LDC, N
+      REAL               RESID
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX            A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
+      REAL               RWORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      COMPLEX            CZERO, CONE
+      PARAMETER          ( CZERO = 0.0E+0, CONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, J
+      REAL               ANORM, EPS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      REAL               SLAMCH, CLANSY
+      EXTERNAL           LSAME, SLAMCH, CLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CLASET, CLAVSY
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick exit if N = 0.
+*
+      IF( N.LE.0 ) THEN
+         RESID = ZERO
+         RETURN
+      END IF
+*
+*     Determine EPS and the norm of A.
+*
+      EPS = SLAMCH( 'Epsilon' )
+      ANORM = CLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+*     Initialize C to the tridiagonal matrix T.
+*
+      CALL CLASET( 'Full', N, N, CZERO, CZERO, C, LDC )
+      CALL CLACPY( 'F', 1, N, AFAC( 1, 1 ), LDAFAC+1, C( 1, 1 ), LDC+1 )
+      IF( N.GT.1 ) THEN
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL CLACPY( 'F', 1, N-1, AFAC( 1, 2 ), LDAFAC+1, C( 1, 2 ),
+     $                   LDC+1 )
+            CALL CLACPY( 'F', 1, N-1, AFAC( 1, 2 ), LDAFAC+1, C( 2, 1 ),
+     $                   LDC+1 )
+         ELSE
+            CALL CLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 1, 2 ),
+     $                   LDC+1 )
+            CALL CLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 2, 1 ),
+     $                   LDC+1 )
+         ENDIF
+*
+*        Call CTRMM to form the product U' * D (or L * D ).
+*
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL CTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N,
+     $                  CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC )
+         ELSE
+            CALL CTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
+     $                  CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
+         END IF
+*
+*        Call CTRMM again to multiply by U (or L ).
+*
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL CTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
+     $                  CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
+         ELSE
+            CALL CTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1,
+     $                  CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC )
+         END IF
+      ENDIF
+*
+*     Apply symmetric pivots
+*
+      DO J = N, 1, -1
+         I = IPIV( J )
+         IF( I.NE.J )
+     $      CALL CSWAP( N, C( J, 1 ), LDC, C( I, 1 ), LDC )
+      END DO
+      DO J = N, 1, -1
+         I = IPIV( J )
+         IF( I.NE.J )
+     $      CALL CSWAP( N, C( 1, J ), 1, C( 1, I ), 1 )
+      END DO
+*
+*
+*     Compute the difference  C - A .
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+         DO J = 1, N
+            DO I = 1, J
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      ELSE
+         DO J = 1, N
+            DO I = J, N
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      END IF
+*
+*     Compute norm( C - A ) / ( N * norm(A) * EPS )
+*
+      RESID = CLANSY( '1', UPLO, N, C, LDC, RWORK )
+*
+      IF( ANORM.LE.ZERO ) THEN
+         IF( RESID.NE.ZERO )
+     $      RESID = ONE / EPS
+      ELSE
+         RESID = ( ( RESID / DBLE( N ) ) / ANORM ) / EPS
+      END IF
+*
+      RETURN
+*
+*     End of CSYT01
+*
+      END
diff --git a/TESTING/LIN/dchkaa.f b/TESTING/LIN/dchkaa.f
index 8bcb8217..5d122d38 100644
--- a/TESTING/LIN/dchkaa.f
+++ b/TESTING/LIN/dchkaa.f
@@ -49,9 +49,10 @@
 *> DPP    9               List types on next line if 0 < NTYPES <  9
 *> DPB    8               List types on next line if 0 < NTYPES <  8
 *> DPT   12               List types on next line if 0 < NTYPES < 12
-*> DSA   10               List types on next line if 0 < NTYPES < 10
 *> DSY   10               List types on next line if 0 < NTYPES < 10
 *> DSR   10               List types on next line if 0 < NTYPES < 10
+*> DSK   10               List types on next line if 0 < NTYPES < 10
+*> DSA   10               List types on next line if 0 < NTYPES < 10
 *> DSP   10               List types on next line if 0 < NTYPES < 10
 *> DTR   18               List types on next line if 0 < NTYPES < 18
 *> DTP   18               List types on next line if 0 < NTYPES < 18
@@ -147,8 +148,8 @@
      $                   NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ),
      $                   RANKVAL( MAXIN ), PIV( NMAX )
       DOUBLE PRECISION   A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
-     $                   RWORK( 5*NMAX+2*MAXRHS ), S( 2*NMAX ),
-     $                   WORK( NMAX, NMAX+MAXRHS+30 )
+     $                   E( NMAX ), RWORK( 5*NMAX+2*MAXRHS ),
+     $                   S( 2*NMAX ), WORK( NMAX, NMAX+MAXRHS+30 )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME, LSAMEN
@@ -159,10 +160,11 @@
       EXTERNAL           ALAREQ, DCHKEQ, DCHKGB, DCHKGE, DCHKGT, DCHKLQ,
      $                   DCHKPB, DCHKPO, DCHKPS, DCHKPP, DCHKPT, DCHKQ3,
      $                   DCHKQL, DCHKQR, DCHKRQ, DCHKSP, DCHKSY,
-     $                   DCHKSY_ROOK, DCHKSY_AA, DCHKTB, DCHKTP, DCHKTR,
-     $                   DCHKTZ, DDRVGB, DDRVGE, DDRVGT, DDRVLS, DDRVPB,
-     $                   DDRVPO, DDRVPP, DDRVPT, DDRVSP, DDRVSY, 
-     $                   DDRVSY_ROOK, DDRVSY_AA, ILAVER, DCHKQRT, 
+     $                   DCHKSY_ROOK, DCHKSY_RK, DCHKSY_AA, DCHKTB,
+     $                   DCHKTP, DCHKTR, DCHKTZ, DDRVGB, DDRVGE,
+     $                   DDRVGT, DDRVLS, DDRVPB, DDRVPO, DDRVPP,
+     $                   DDRVPT, DDRVSP, DDRVSY, DDRVSY_ROOK, DDRVSY_RK,
+     $                   DDRVSY_AA, ILAVER, DCHKQRT,
      $                   DCHKQRTP, DCHKLQTP, DCHKTSQR, DCHKLQT
 
 *     ..
@@ -643,8 +645,8 @@
 *
       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 *
-*        SR:  symmetric indefinite matrices with Rook pivoting,
-*             with rook (bounded Bunch-Kaufman) pivoting algorithm
+*        SR:  symmetric indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm
 *
          NTYPES = 10
          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
@@ -667,9 +669,36 @@
             WRITE( NOUT, FMT = 9988 )PATH
          END IF
 *
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        SK:  symmetric indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm,
+*             differnet matrix storage format than SR path version.
+*
+         NTYPES = 10
+         CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+         IF( TSTCHK ) THEN
+            CALL DCHKSY_RK( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+     $                      THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+     $                      E, A( 1, 3 ), B( 1, 1 ), B( 1, 2 ),
+     $                      B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9989 )PATH
+         END IF
+*
+         IF( TSTDRV ) THEN
+            CALL DDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      LDA, A( 1, 1 ), A( 1, 2 ), E, A( 1, 3 ),
+     $                      B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+     $                      WORK, RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9988 )PATH
+         END IF
+*
       ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
 *
-*        SY:  symmetric indefinite matrices,
+*        SA:  symmetric indefinite matrices,
 *             with partial (Aasen's) pivoting algorithm
 *
          NTYPES = 10
diff --git a/TESTING/LIN/dchksy_aa.f b/TESTING/LIN/dchksy_aa.f
index a596bcb9..a01f4fa0 100644
--- a/TESTING/LIN/dchksy_aa.f
+++ b/TESTING/LIN/dchksy_aa.f
@@ -163,6 +163,7 @@
 *
 *> \date November 2016
 *
+*  @precisions fortran d -> z c
 *
 *> \ingroup double_lin
 *
@@ -201,13 +202,13 @@
       PARAMETER          ( NTESTS = 9 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            TRFCON, ZEROT
+      LOGICAL            ZEROT
       CHARACTER          DIST, TYPE, UPLO, XTYPE
       CHARACTER*3        PATH, MATPATH
       INTEGER            I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
      $                   IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
      $                   N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
-      DOUBLE PRECISION   ANORM, CNDNUM, RCONDC
+      DOUBLE PRECISION   ANORM, CNDNUM
 *     ..
 *     .. Local Arrays ..
       CHARACTER          UPLOS( 2 )
@@ -221,7 +222,7 @@
 *     .. External Subroutines ..
       EXTERNAL           ALAERH, ALAHD, ALASUM, DERRSY, DGET04, DLACPY,
      $                   DLARHS, DLATB4, DLATMS, DPOT02, DPOT03, DPOT05,
-     $                   DSYCON, DSYRFS, DSYT01, DSYTRF_AA,
+     $                   DSYCON, DSYRFS, DSYT01_AA, DSYTRF_AA,
      $                   DSYTRI2, DSYTRS_AA, XLAENV
 *     ..
 *     .. Intrinsic Functions ..
@@ -429,9 +430,9 @@
 *                 block factorization, LWORK is the length of AINV.
 *
                   SRNAMT = 'DSYTRF_AA'
-                  LWORK = N*NB + N
+                  LWORK = MAX( 1, N*NB + N )
                   CALL DSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
-     $                               LWORK, INFO )
+     $                            LWORK, INFO )
 *
 *                 Adjust the expected value of INFO to account for
 *                 pivoting.
@@ -461,19 +462,11 @@
      $                            NOUT )
                   END IF
 *
-*                 Set the condition estimate flag if the INFO is not 0.
-*
-                  IF( INFO.NE.0 ) THEN
-                     TRFCON = .TRUE.
-                  ELSE
-                     TRFCON = .FALSE.
-                  END IF
-*
 *+    TEST 1
 *                 Reconstruct matrix from factors and compute residual.
 *
                   CALL DSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
-     $                               AINV, LDA, RWORK, RESULT( 1 ) )
+     $                            AINV, LDA, RWORK, RESULT( 1 ) )
                   NT = 1
 *
 *
@@ -491,10 +484,9 @@
   110             CONTINUE
                   NRUN = NRUN + NT
 *
-*                 Do only the condition estimate if INFO is not 0.
+*                 Skip solver test if INFO is not 0.
 *
-                  IF( TRFCON ) THEN
-                     RCONDC = ZERO
+                  IF( INFO.NE.0 ) THEN
                      GO TO 140
                   END IF
 *
@@ -503,7 +495,7 @@
                   DO 130 IRHS = 1, NNS
                      NRHS = NSVAL( IRHS )
 *
-*+    TEST 3 ( Using TRS)
+*+    TEST 2 (Using TRS)
 *                 Solve and compute residual for  A * X = B.
 *
 *                    Choose a set of NRHS random solution vectors
@@ -516,10 +508,10 @@
                      CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
 *
                      SRNAMT = 'DSYTRS_AA'
-                     LWORK = 3*N-2
+                     LWORK = MAX( 1, 3*N-2 )
                      CALL DSYTRS_AA( UPLO, N, NRHS, AFAC, LDA,
-     $                                  IWORK, X, LDA, WORK, LWORK,
-     $                                  INFO )
+     $                               IWORK, X, LDA, WORK, LWORK,
+     $                               INFO )
 *
 *                    Check error code from DSYTRS and handle error.
 *
diff --git a/TESTING/LIN/dchksy_rk.f b/TESTING/LIN/dchksy_rk.f
new file mode 100644
index 00000000..9907d701
--- /dev/null
+++ b/TESTING/LIN/dchksy_rk.f
@@ -0,0 +1,846 @@
+*> \brief \b DCHKSY_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DCHKSY_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+*                             THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+*                             X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NNB, NNS, NOUT
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+*       DOUBLE PRECISION   A( * ), AFAC( * ), E( * ), AINV( * ), B( * ),
+*      $                   RWORK( * ), WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> DCHKSY_RK tests DSYTRF_RK, -TRI_3, -TRS_3, and -CON_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*>          NNB is INTEGER
+*>          The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*>          NBVAL is INTEGER array, dimension (NBVAL)
+*>          The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*>          NNS is INTEGER
+*>          The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*>          NSVAL is INTEGER array, dimension (NNS)
+*>          The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is DOUBLE PRECISION
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array, dimension (NMAX*NSMAX),
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array, dimension (NMAX*NSMAX),
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is DOUBLE PRECISION array, dimension (NMAX*NSMAX),
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup double_lin
+*
+*  =====================================================================
+      SUBROUTINE DCHKSY_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+     $                      THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+     $                      X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NNB, NNS, NOUT
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+      DOUBLE PRECISION   A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   RWORK( * ), WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      DOUBLE PRECISION   EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
+      INTEGER            NTYPES
+      PARAMETER          ( NTYPES = 10 )
+      INTEGER            NTESTS
+      PARAMETER          ( NTESTS = 7 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            TRFCON, ZEROT
+      CHARACTER          DIST, TYPE, UPLO, XTYPE
+      CHARACTER*3        PATH, MATPATH
+      INTEGER            I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+     $                   ITEMP, IUPLO, IZERO, J, K, KL, KU, LDA, LWORK,
+     $                   MODE, N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN,
+     $                   NT
+      DOUBLE PRECISION   ALPHA, ANORM, CNDNUM, CONST, DTEMP, SING_MAX,
+     $                   SING_MIN, RCOND, RCONDC
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          UPLOS( 2 )
+      INTEGER            IDUMMY( 1 ), ISEED( 4 ), ISEEDY( 4 )
+      DOUBLE PRECISION   BLOCK( 2, 2 ), DDUMMY( 1 ), RESULT( NTESTS )
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DGET06, DLANGE, DLANSY
+      EXTERNAL           DGET06, DLANGE, DLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALAERH, ALAHD, ALASUM, DERRSY, DGESVD, DGET04,
+     $                   DLACPY, DLARHS, DLATB4, DLATMS, DPOT02, DPOT03,
+     $                   DSYCON_3, DSYT01_3, DSYTRF_RK, DSYTRI_3,
+     $                   DSYTRS_3, XLAENV
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Double precision'
+      PATH( 2: 3 ) = 'SK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Double precision'
+      MATPATH( 2: 3 ) = 'SY'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL DERRSY( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the minimum block size for which the block routine should
+*     be used, which will be later returned by ILAENV
+*
+      CALL XLAENV( 2, 2 )
+*
+*     Do for each value of N in NVAL
+*
+      DO 270 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         IZERO = 0
+*
+*        Do for each value of matrix type IMAT
+*
+         DO 260 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 260
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 260
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 250 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*              Begin generate the test matrix A.
+*
+*              Set up parameters with DLATB4 for the matrix generator
+*              based on the type of matrix to be generated.
+*
+               CALL DLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                      MODE, CNDNUM, DIST )
+*
+*              Generate a matrix with DLATMS.
+*
+               SRNAMT = 'DLATMS'
+               CALL DLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+     $                      INFO )
+*
+*              Check error code from DLATMS and handle error.
+*
+               IF( INFO.NE.0 ) THEN
+                  CALL ALAERH( PATH, 'DLATMS', INFO, 0, UPLO, N, N, -1,
+     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+*                 Skip all tests for this generated matrix
+*
+                  GO TO 250
+               END IF
+*
+*              For matrix types 3-6, zero one or more rows and
+*              columns of the matrix to test that INFO is returned
+*              correctly.
+*
+               IF( ZEROT ) THEN
+                  IF( IMAT.EQ.3 ) THEN
+                     IZERO = 1
+                  ELSE IF( IMAT.EQ.4 ) THEN
+                     IZERO = N
+                  ELSE
+                     IZERO = N / 2 + 1
+                  END IF
+*
+                  IF( IMAT.LT.6 ) THEN
+*
+*                    Set row and column IZERO to zero.
+*
+                     IF( IUPLO.EQ.1 ) THEN
+                        IOFF = ( IZERO-1 )*LDA
+                        DO 20 I = 1, IZERO - 1
+                           A( IOFF+I ) = ZERO
+   20                   CONTINUE
+                        IOFF = IOFF + IZERO
+                        DO 30 I = IZERO, N
+                           A( IOFF ) = ZERO
+                           IOFF = IOFF + LDA
+   30                   CONTINUE
+                     ELSE
+                        IOFF = IZERO
+                        DO 40 I = 1, IZERO - 1
+                           A( IOFF ) = ZERO
+                           IOFF = IOFF + LDA
+   40                   CONTINUE
+                        IOFF = IOFF - IZERO
+                        DO 50 I = IZERO, N
+                           A( IOFF+I ) = ZERO
+   50                   CONTINUE
+                     END IF
+                  ELSE
+                     IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                        IOFF = 0
+                        DO 70 J = 1, N
+                           I2 = MIN( J, IZERO )
+                           DO 60 I = 1, I2
+                              A( IOFF+I ) = ZERO
+   60                      CONTINUE
+                           IOFF = IOFF + LDA
+   70                   CONTINUE
+                     ELSE
+*
+*                       Set the last IZERO rows and columns to zero.
+*
+                        IOFF = 0
+                        DO 90 J = 1, N
+                           I1 = MAX( J, IZERO )
+                           DO 80 I = I1, N
+                              A( IOFF+I ) = ZERO
+   80                      CONTINUE
+                           IOFF = IOFF + LDA
+   90                   CONTINUE
+                     END IF
+                  END IF
+               ELSE
+                  IZERO = 0
+               END IF
+*
+*              End generate the test matrix A.
+*
+*
+*              Do for each value of NB in NBVAL
+*
+               DO 240 INB = 1, NNB
+*
+*                 Set the optimal blocksize, which will be later
+*                 returned by ILAENV.
+*
+                  NB = NBVAL( INB )
+                  CALL XLAENV( 1, NB )
+*
+*                 Copy the test matrix A into matrix AFAC which
+*                 will be factorized in place. This is needed to
+*                 preserve the test matrix A for subsequent tests.
+*
+                  CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+*                 Compute the L*D*L**T or U*D*U**T factorization of the
+*                 matrix. IWORK stores details of the interchanges and
+*                 the block structure of D. AINV is a work array for
+*                 block factorization, LWORK is the length of AINV.
+*
+                  LWORK = MAX( 2, NB )*LDA
+                  SRNAMT = 'DSYTRF_RK'
+                  CALL DSYTRF_RK( UPLO, N, AFAC, LDA, E, IWORK, AINV,
+     $                            LWORK, INFO )
+*
+*                 Adjust the expected value of INFO to account for
+*                 pivoting.
+*
+                  K = IZERO
+                  IF( K.GT.0 ) THEN
+  100                CONTINUE
+                     IF( IWORK( K ).LT.0 ) THEN
+                        IF( IWORK( K ).NE.-K ) THEN
+                           K = -IWORK( K )
+                           GO TO 100
+                        END IF
+                     ELSE IF( IWORK( K ).NE.K ) THEN
+                        K = IWORK( K )
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Check error code from DSYTRF_RK and handle error.
+*
+                  IF( INFO.NE.K)
+     $               CALL ALAERH( PATH, 'DSYTRF_RK', INFO, K,
+     $                            UPLO, N, N, -1, -1, NB, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Set the condition estimate flag if the INFO is not 0.
+*
+                  IF( INFO.NE.0 ) THEN
+                     TRFCON = .TRUE.
+                  ELSE
+                     TRFCON = .FALSE.
+                  END IF
+*
+*+    TEST 1
+*                 Reconstruct matrix from factors and compute residual.
+*
+                  CALL DSYT01_3( UPLO, N, A, LDA, AFAC, LDA, E, IWORK,
+     $                           AINV, LDA, RWORK, RESULT( 1 ) )
+                  NT = 1
+*
+*+    TEST 2
+*                 Form the inverse and compute the residual,
+*                 if the factorization was competed without INFO > 0
+*                 (i.e. there is no zero rows and columns).
+*                 Do it only for the first block size.
+*
+                  IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN
+                     CALL DLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     SRNAMT = 'DSYTRI_3'
+*
+*                    Another reason that we need to compute the invesrse
+*                    is that DPOT03 produces RCONDC which is used later
+*                    in TEST6 and TEST7.
+*
+                     LWORK = (N+NB+1)*(NB+3)
+                     CALL DSYTRI_3( UPLO, N, AINV, LDA, E, IWORK, WORK,
+     $                              LWORK, INFO )
+*
+*                    Check error code from DSYTRI_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'DSYTRI_3', INFO, -1,
+     $                               UPLO, N, N, -1, -1, -1, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+*                    Compute the residual for a symmetric matrix times
+*                    its inverse.
+*
+                     CALL DPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
+     $                            RWORK, RCONDC, RESULT( 2 ) )
+                     NT = 2
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 110 K = 1, NT
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  110             CONTINUE
+                  NRUN = NRUN + NT
+*
+*+    TEST 3
+*                 Compute largest element in U or L
+*
+                  RESULT( 3 ) = ZERO
+                  DTEMP = ZERO
+*
+                  CONST = ONE / ( ONE-ALPHA )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                 Compute largest element in U
+*
+                     K = N
+  120                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 130
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in in U
+*
+                        DTEMP = DLANGE( 'M', K-1, 1,
+     $                          AFAC( ( K-1 )*LDA+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k-1 in U
+*
+                        DTEMP = DLANGE( 'M', K-2, 2,
+     $                          AFAC( ( K-2 )*LDA+1 ), LDA, RWORK )
+                        K = K - 1
+*
+                     END IF
+*
+*                    DTEMP should be bounded by CONST
+*
+                     DTEMP = DTEMP - CONST + THRESH
+                     IF( DTEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = DTEMP
+*
+                     K = K - 1
+*
+                     GO TO 120
+  130                CONTINUE
+*
+                  ELSE
+*
+*                 Compute largest element in L
+*
+                     K = 1
+  140                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 150
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in in L
+*
+                        DTEMP = DLANGE( 'M', N-K, 1,
+     $                          AFAC( ( K-1 )*LDA+K+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k+1 in L
+*
+                        DTEMP = DLANGE( 'M', N-K-1, 2,
+     $                          AFAC( ( K-1 )*LDA+K+2 ), LDA, RWORK )
+                        K = K + 1
+*
+                     END IF
+*
+*                    DTEMP should be bounded by CONST
+*
+                     DTEMP = DTEMP - CONST + THRESH
+                     IF( DTEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = DTEMP
+*
+                     K = K + 1
+*
+                     GO TO 140
+  150                CONTINUE
+                  END IF
+*
+*+    TEST 4
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
+*
+                  RESULT( 4 ) = ZERO
+                  DTEMP = ZERO
+*
+                  CONST = ( ONE+ALPHA ) / ( ONE-ALPHA )
+                  CALL DLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                    Loop backward for UPLO = 'U'
+*
+                     K = N
+  160                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 170
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
+                        BLOCK( 1, 2 ) = E( K )
+                        BLOCK( 2, 1 ) = BLOCK( 1, 2 )
+                        BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
+*
+                        CALL DGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               DDUMMY, 1, DDUMMY, 1,
+     $                               WORK, 10, INFO )
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        DTEMP = SING_MAX / SING_MIN
+*
+*                       DTEMP should be bounded by CONST
+*
+                        DTEMP = DTEMP - CONST + THRESH
+                        IF( DTEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = DTEMP
+                        K = K - 1
+*
+                     END IF
+*
+                     K = K - 1
+*
+                     GO TO 160
+  170                CONTINUE
+*
+                  ELSE
+*
+*                    Loop forward for UPLO = 'L'
+*
+                     K = 1
+  180                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 190
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K )
+                        BLOCK( 2, 1 ) = E( K )
+                        BLOCK( 1, 2 ) = BLOCK( 2, 1 )
+                        BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 )
+*
+                        CALL DGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               DDUMMY, 1, DDUMMY, 1,
+     $                               WORK, 10, INFO )
+*
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        DTEMP = SING_MAX / SING_MIN
+*
+*                       DTEMP should be bounded by CONST
+*
+                        DTEMP = DTEMP - CONST + THRESH
+                        IF( DTEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = DTEMP
+                        K = K + 1
+*
+                     END IF
+*
+                     K = K + 1
+*
+                     GO TO 180
+  190                CONTINUE
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 200 K = 3, 4
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  200             CONTINUE
+                  NRUN = NRUN + 2
+*
+*                 Skip the other tests if this is not the first block
+*                 size.
+*
+                  IF( INB.GT.1 )
+     $               GO TO 240
+*
+*                 Do only the condition estimate if INFO is not 0.
+*
+                  IF( TRFCON ) THEN
+                     RCONDC = ZERO
+                     GO TO 230
+                  END IF
+*
+*                 Do for each value of NRHS in NSVAL.
+*
+                  DO 220 IRHS = 1, NNS
+                     NRHS = NSVAL( IRHS )
+*
+*+    TEST 5 ( Using TRS_3)
+*                 Solve and compute residual for  A * X = B.
+*
+*                    Choose a set of NRHS random solution vectors
+*                    stored in XACT and set up the right hand side B
+*
+                     SRNAMT = 'DLARHS'
+                     CALL DLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+     $                            KL, KU, NRHS, A, LDA, XACT, LDA,
+     $                            B, LDA, ISEED, INFO )
+                     CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+                     SRNAMT = 'DSYTRS_3'
+                     CALL DSYTRS_3( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, INFO )
+*
+*                    Check error code from DSYTRS_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'DSYTRS_3', INFO, 0,
+     $                               UPLO, N, N, -1, -1, NRHS, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+                     CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+*
+*                    Compute the residual for the solution
+*
+                     CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 5 ) )
+*
+*+    TEST 6
+*                    Check solution from generated exact solution.
+*
+                     CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 6 ) )
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 210 K = 5, 6
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALAHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+     $                        IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  210                CONTINUE
+                     NRUN = NRUN + 2
+*
+*                 End do for each value of NRHS in NSVAL.
+*
+  220             CONTINUE
+*
+*+    TEST 7
+*                 Get an estimate of RCOND = 1/CNDNUM.
+*
+  230             CONTINUE
+                  ANORM = DLANSY( '1', UPLO, N, A, LDA, RWORK )
+                  SRNAMT = 'DSYCON_3'
+                  CALL DSYCON_3( UPLO, N, AFAC, LDA, E, IWORK, ANORM,
+     $                           RCOND, WORK, IWORK( N+1 ), INFO )
+*
+*                 Check error code from DSYCON_3 and handle error.
+*
+                  IF( INFO.NE.0 )
+     $               CALL ALAERH( PATH, 'DSYCON_3', INFO, 0,
+     $                            UPLO, N, N, -1, -1, -1, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Compute the test ratio to compare to values of RCOND
+*
+                  RESULT( 7 ) = DGET06( RCOND, RCONDC )
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  IF( RESULT( 7 ).GE.THRESH ) THEN
+                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                  CALL ALAHD( NOUT, PATH )
+                     WRITE( NOUT, FMT = 9997 ) UPLO, N, IMAT, 7,
+     $                  RESULT( 7 )
+                     NFAIL = NFAIL + 1
+                  END IF
+                  NRUN = NRUN + 1
+  240          CONTINUE
+*
+  250       CONTINUE
+  260    CONTINUE
+  270 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+     $      I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+     $      I2, ', test(', I2, ') =', G12.5 )
+ 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
+     $      ', test(', I2, ') =', G12.5 )
+      RETURN
+*
+*     End of DCHKSY_RK
+*
+      END
diff --git a/TESTING/LIN/ddrvsy_aa.f b/TESTING/LIN/ddrvsy_aa.f
index be5d6eb3..25a58292 100644
--- a/TESTING/LIN/ddrvsy_aa.f
+++ b/TESTING/LIN/ddrvsy_aa.f
@@ -9,8 +9,8 @@
 *  ===========
 *
 *       SUBROUTINE DDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
-*                          A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
-*                          NOUT )
+*                             A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+*                             NOUT )
 *
 *       .. Scalar Arguments ..
 *       LOGICAL            TSTERR
@@ -145,12 +145,14 @@
 *
 *> \date November 2016
 *
+*  @precisions fortran d -> z c
+*
 *> \ingroup double_lin
 *
 *  =====================================================================
       SUBROUTINE DDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
-     $                         NMAX, A, AFAC, AINV, B, X, XACT, WORK,
-     $                         RWORK, IWORK, NOUT )
+     $                      NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+     $                      RWORK, IWORK, NOUT )
 *
 *  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -184,9 +186,9 @@
       CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
       CHARACTER*3        MATPATH, PATH
       INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
-     $                   IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
      $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
-      DOUBLE PRECISION   AINVNM, ANORM, CNDNUM, RCOND, RCONDC
+      DOUBLE PRECISION   ANORM, CNDNUM
 *     ..
 *     .. Local Arrays ..
       CHARACTER          FACTS( NFACT ), UPLOS( 2 )
@@ -374,44 +376,6 @@
 *
                   FACT = FACTS( IFACT )
 *
-*                 Compute the condition number for comparison with
-*                 the value returned by DSYSVX.
-*
-                  IF( ZEROT ) THEN
-                     IF( IFACT.EQ.1 )
-     $                  GO TO 150
-                     RCONDC = ZERO
-*
-                  ELSE IF( IFACT.EQ.1 ) THEN
-*
-*                    Compute the 1-norm of A.
-*
-                     ANORM = DLANSY( '1', UPLO, N, A, LDA, RWORK )
-*
-*                    Factor the matrix A.
-*
-c                     CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
-c                     CALL DSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK,
-c     $                            LWORK, INFO )
-*
-*                    Compute inv(A) and take its norm.
-*
-c                     CALL DLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
-c                     LWORK = (N+NB+1)*(NB+3)
-c                     SRNAMT = 'DSYTRI2'
-c                     CALL DSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
-c     $                            LWORK, INFO )
-c                     AINVNM = DLANSY( '1', UPLO, N, AINV, LDA, RWORK )
-*
-*                    Compute the 1-norm condition number of A.
-*
-c                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
-c                        RCONDC = ONE
-c                     ELSE
-c                        RCONDC = ( ONE / ANORM ) / AINVNM
-c                     END IF
-                  END IF
-*
 *                 Form an exact solution and set the right hand side.
 *
                   SRNAMT = 'DLARHS'
@@ -475,12 +439,7 @@ c                     END IF
                      CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
                      CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
      $                            LDA, RWORK, RESULT( 2 ) )
-*
-*                    Check solution from generated exact solution.
-*
-                     CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
-     $                            RESULT( 3 ) )
-                     NT = 3
+                     NT = 2
 *
 *                    Print information about the tests that did not pass
 *                    the threshold.
diff --git a/TESTING/LIN/ddrvsy_rk.f b/TESTING/LIN/ddrvsy_rk.f
new file mode 100644
index 00000000..be8a233e
--- /dev/null
+++ b/TESTING/LIN/ddrvsy_rk.f
@@ -0,0 +1,531 @@
+*> \brief \b DDRVSY_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*     SUBROUTINE DDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+*    $                      NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+*    $                      RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NOUT, NRHS
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NVAL( * )
+*       DOUBLE PRECISION   A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+*      $                   RWORK( * ), WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> DDRVSY_RK tests the driver routines DSYSV_RK.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand side vectors to be generated for
+*>          each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is DOUBLE PRECISION
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup double_lin
+*
+*  =====================================================================
+      SUBROUTINE DDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+     $                      RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NOUT, NRHS
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NVAL( * )
+      DOUBLE PRECISION   A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   RWORK( * ), WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE, ZERO
+      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+      INTEGER            NTYPES, NTESTS
+      PARAMETER          ( NTYPES = 10, NTESTS = 3 )
+      INTEGER            NFACT
+      PARAMETER          ( NFACT = 2 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ZEROT
+      CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
+      CHARACTER*3        PATH, MATPATH
+      INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+     $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+      DOUBLE PRECISION   AINVNM, ANORM, CNDNUM, RCONDC
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          FACTS( NFACT ), UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      DOUBLE PRECISION   RESULT( NTESTS )
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DLANSY
+      EXTERNAL           DLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALADHD, ALAERH, ALASVM, DERRVX, DGET04, DLACPY,
+     $                   DLARHS, DLATB4, DLATMS, DPOT02, DSYSV_RK,
+     $                   DSYT01_3, DSYTRF_RK, DSYTRI_3, XLAENV
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Double precision'
+      PATH( 2: 3 ) = 'SK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Double precision'
+      MATPATH( 2: 3 ) = 'SY'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+      LWORK = MAX( 2*NMAX, NMAX*NRHS )
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL DERRVX( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the block size and minimum block size for which the block
+*     routine should be used, which will be later returned by ILAENV.
+*
+      NB = 1
+      NBMIN = 2
+      CALL XLAENV( 1, NB )
+      CALL XLAENV( 2, NBMIN )
+*
+*     Do for each value of N in NVAL
+*
+      DO 180 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         DO 170 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 170
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 170
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 160 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*              Begin generate the test matrix A.
+*
+*              Set up parameters with DLATB4 for the matrix generator
+*              based on the type of matrix to be generated.
+*
+               CALL DLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                      MODE, CNDNUM, DIST )
+*
+*              Generate a matrix with DLATMS.
+*
+               SRNAMT = 'DLATMS'
+               CALL DLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+     $                      INFO )
+*
+*              Check error code from DLATMS and handle error.
+*
+               IF( INFO.NE.0 ) THEN
+                  CALL ALAERH( PATH, 'DLATMS', INFO, 0, UPLO, N, N, -1,
+     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+*                 Skip all tests for this generated matrix
+*
+                  GO TO 160
+               END IF
+*
+*              For types 3-6, zero one or more rows and columns of the
+*              matrix to test that INFO is returned correctly.
+*
+               IF( ZEROT ) THEN
+                  IF( IMAT.EQ.3 ) THEN
+                     IZERO = 1
+                  ELSE IF( IMAT.EQ.4 ) THEN
+                     IZERO = N
+                  ELSE
+                     IZERO = N / 2 + 1
+                  END IF
+*
+                  IF( IMAT.LT.6 ) THEN
+*
+*                    Set row and column IZERO to zero.
+*
+                     IF( IUPLO.EQ.1 ) THEN
+                        IOFF = ( IZERO-1 )*LDA
+                        DO 20 I = 1, IZERO - 1
+                           A( IOFF+I ) = ZERO
+   20                   CONTINUE
+                        IOFF = IOFF + IZERO
+                        DO 30 I = IZERO, N
+                           A( IOFF ) = ZERO
+                           IOFF = IOFF + LDA
+   30                   CONTINUE
+                     ELSE
+                        IOFF = IZERO
+                        DO 40 I = 1, IZERO - 1
+                           A( IOFF ) = ZERO
+                           IOFF = IOFF + LDA
+   40                   CONTINUE
+                        IOFF = IOFF - IZERO
+                        DO 50 I = IZERO, N
+                           A( IOFF+I ) = ZERO
+   50                   CONTINUE
+                     END IF
+                  ELSE
+                     IOFF = 0
+                     IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                        DO 70 J = 1, N
+                           I2 = MIN( J, IZERO )
+                           DO 60 I = 1, I2
+                              A( IOFF+I ) = ZERO
+   60                      CONTINUE
+                           IOFF = IOFF + LDA
+   70                   CONTINUE
+                     ELSE
+*
+*                       Set the last IZERO rows and columns to zero.
+*
+                        DO 90 J = 1, N
+                           I1 = MAX( J, IZERO )
+                           DO 80 I = I1, N
+                              A( IOFF+I ) = ZERO
+   80                      CONTINUE
+                           IOFF = IOFF + LDA
+   90                   CONTINUE
+                     END IF
+                  END IF
+               ELSE
+                  IZERO = 0
+               END IF
+*
+*              End generate the test matrix A.
+*
+               DO 150 IFACT = 1, NFACT
+*
+*                 Do first for FACT = 'F', then for other values.
+*
+                  FACT = FACTS( IFACT )
+*
+*                 Compute the condition number
+*
+                  IF( ZEROT ) THEN
+                     IF( IFACT.EQ.1 )
+     $                  GO TO 150
+                     RCONDC = ZERO
+*
+                  ELSE IF( IFACT.EQ.1 ) THEN
+*
+*                    Compute the 1-norm of A.
+*
+                     ANORM = DLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+*                    Factor the matrix A.
+*
+                     CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL DSYTRF_RK( UPLO, N, AFAC, LDA, E, IWORK, WORK,
+     $                               LWORK, INFO )
+*
+*                    Compute inv(A) and take its norm.
+*
+                     CALL DLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     LWORK = (N+NB+1)*(NB+3)
+*
+*                    We need to copute the invesrse to compute
+*                    RCONDC that is used later in TEST3.
+*
+                     CALL DSYTRI_3( UPLO, N, AINV, LDA, E, IWORK,
+     $                              WORK, LWORK, INFO )
+                     AINVNM = DLANSY( '1', UPLO, N, AINV, LDA, RWORK )
+*
+*                    Compute the 1-norm condition number of A.
+*
+                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
+                        RCONDC = ONE
+                     ELSE
+                        RCONDC = ( ONE / ANORM ) / AINVNM
+                     END IF
+                  END IF
+*
+*                 Form an exact solution and set the right hand side.
+*
+                  SRNAMT = 'DLARHS'
+                  CALL DLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+     $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+     $                         INFO )
+                  XTYPE = 'C'
+*
+*                 --- Test DSYSV_RK  ---
+*
+                  IF( IFACT.EQ.2 ) THEN
+                     CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+*                    Factor the matrix and solve the system using
+*                    DSYSV_RK.
+*
+                     SRNAMT = 'DSYSV_RK'
+                     CALL DSYSV_RK( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, WORK, LWORK, INFO )
+*
+*                    Adjust the expected value of INFO to account for
+*                    pivoting.
+*
+                     K = IZERO
+                     IF( K.GT.0 ) THEN
+  100                   CONTINUE
+                        IF( IWORK( K ).LT.0 ) THEN
+                           IF( IWORK( K ).NE.-K ) THEN
+                              K = -IWORK( K )
+                              GO TO 100
+                           END IF
+                        ELSE IF( IWORK( K ).NE.K ) THEN
+                           K = IWORK( K )
+                           GO TO 100
+                        END IF
+                     END IF
+*
+*                    Check error code from DSYSV_RK and handle error.
+*
+                     IF( INFO.NE.K ) THEN
+                        CALL ALAERH( PATH, 'DSYSV_RK', INFO, K, UPLO,
+     $                               N, N, -1, -1, NRHS, IMAT, NFAIL,
+     $                               NERRS, NOUT )
+                        GO TO 120
+                     ELSE IF( INFO.NE.0 ) THEN
+                        GO TO 120
+                     END IF
+*
+*+    TEST 1      Reconstruct matrix from factors and compute
+*                 residual.
+*
+                     CALL DSYT01_3( UPLO, N, A, LDA, AFAC, LDA, E,
+     $                              IWORK, AINV, LDA, RWORK,
+     $                              RESULT( 1 ) )
+*
+*+    TEST 2      Compute residual of the computed solution.
+*
+                     CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+                     CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 2 ) )
+*
+*+    TEST 3
+*                 Check solution from generated exact solution.
+*
+                     CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 3 ) )
+                     NT = 3
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 110 K = 1, NT
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALADHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9999 )'DSYSV_RK', UPLO,
+     $                           N, IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  110                CONTINUE
+                     NRUN = NRUN + NT
+  120                CONTINUE
+                  END IF
+*
+  150          CONTINUE
+*
+  160       CONTINUE
+  170    CONTINUE
+  180 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+     $      ', test ', I2, ', ratio =', G12.5 )
+      RETURN
+*
+*     End of DDRVSY_RK
+*
+      END
diff --git a/TESTING/LIN/derrsy.f b/TESTING/LIN/derrsy.f
index a453ab19..7fe74de3 100644
--- a/TESTING/LIN/derrsy.f
+++ b/TESTING/LIN/derrsy.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup double_lin
 *
 *  =====================================================================
       SUBROUTINE DERRSY( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -79,7 +79,8 @@
 *     .. Local Arrays ..
       INTEGER            IP( NMAX ), IW( NMAX )
       DOUBLE PRECISION   A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX )
+     $                   E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
+     $                   X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -87,10 +88,12 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAESM, CHKXER, DSPCON, DSPRFS, DSPTRF, DSPTRI,
-     $                   DSPTRS, DSYCON, DSYCON_ROOK, DSYRFS, DSYTF2,
-     $                   DSYTF2_ROOK, DSYTRF, DSYTRF_ROOK, DSYTRF_AA,
-     $                   DSYTRI, DSYTRI_ROOK, DSYTRI2, DSYTRS, 
-     $                   DSYTRS_ROOK, DSYTRS_AA
+     $                   DSPTRS, DSYCON, DSYCON_3, DSYCON_ROOK, DSYRFS,
+     $                   DSYTF2, DSYTF2_RK, DSYTF2_ROOK, DSYTRF,
+     $                   DSYTRF_RK, DSYTRF_ROOK, DSYTRF_AA, DSYTRI,
+     $                   DSYTRI_3, DSYTRI_3X, DSYTRI_ROOK, DSYTRI2,
+     $                   DSYTRI2X, DSYTRS, DSYTRS_3, DSYTRS_ROOK,
+     $                   DSYTRS_AA
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -118,6 +121,7 @@
             AF( I, J ) = 1.D0 / DBLE( I+J )
    10    CONTINUE
          B( J ) = 0.D0
+         E( J ) = 0.D0
          R1( J ) = 0.D0
          R2( J ) = 0.D0
          W( J ) = 0.D0
@@ -147,6 +151,12 @@
          INFOT = 4
          CALL DSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
 *
 *        DSYTF2
 *
@@ -187,6 +197,19 @@
          CALL DSYTRI2( 'U', 2, A, 1, IP, W, IW(1), INFO )
          CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
 *
+*        DSYTRI2X
+*
+         SRNAMT = 'DSYTRI2X'
+         INFOT = 1
+         CALL DSYTRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI2X', INFOT, NOUT, LERR, OK )
+*
 *        DSYTRS
 *
          SRNAMT = 'DSYTRS'
@@ -272,6 +295,12 @@
          INFOT = 4
          CALL DSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'DSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'DSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'DSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        DSYTF2_ROOK
 *
@@ -334,6 +363,119 @@
          CALL DSYCON_ROOK( 'U', 1, A, 1, IP, -1.0D0, RCOND, W, IW, INFO)
          CALL CHKXER( 'DSYCON_ROOK', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        DSYTRF_RK
+*
+         SRNAMT = 'DSYTRF_RK'
+         INFOT = 1
+         CALL DSYTRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTRF_RK( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYTRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'DSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYTRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'DSYTRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        DSYTF2_RK
+*
+         SRNAMT = 'DSYTF2_RK'
+         INFOT = 1
+         CALL DSYTF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'DSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'DSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'DSYTF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        DSYTRI_3
+*
+         SRNAMT = 'DSYTRI_3'
+         INFOT = 1
+         CALL DSYTRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYTRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'DSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYTRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'DSYTRI_3', INFOT, NOUT, LERR, OK )
+*
+*        DSYTRI_3X
+*
+         SRNAMT = 'DSYTRI_3X'
+         INFOT = 1
+         CALL DSYTRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        DSYTRS_3
+*
+         SRNAMT = 'DSYTRS_3'
+         INFOT = 1
+         CALL DSYTRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'DSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'DSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYTRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'DSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYTRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'DSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL DSYTRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'DSYTRS_3', INFOT, NOUT, LERR, OK )
+*
+*        DSYCON_3
+*
+         SRNAMT = 'DSYCON_3'
+         INFOT = 1
+         CALL DSYCON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'DSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYCON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'DSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYCON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'DSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYCON_3( 'U', 1, A, 1, E, IP, -1.0D0, RCOND, W, IW,
+     $                   INFO)
+         CALL CHKXER( 'DSYCON_3', INFOT, NOUT, LERR, OK )
+*
       ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
 *
 *        Test error exits of the routines that use factorization
@@ -351,6 +493,12 @@
          INFOT = 4
          CALL DSYTRF_AA( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'DSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRF_AA( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'DSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRF_AA( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'DSYTRF_AA', INFOT, NOUT, LERR, OK )
 *
 *        DSYTRS_AA
 *
@@ -370,6 +518,13 @@
          INFOT = 8
          CALL DSYTRS_AA( 'U', 2, 1, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'DSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYTRS_AA( 'U', 0, 1, A, 2, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'DSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYTRS_AA( 'U', 0, 1, A, 2, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'DSYTRS_AA', INFOT, NOUT, LERR, OK )
+*
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
 *        Test error exits of the routines that use factorization
diff --git a/TESTING/LIN/derrsyx.f b/TESTING/LIN/derrsyx.f
index 635868df..7c7df446 100644
--- a/TESTING/LIN/derrsyx.f
+++ b/TESTING/LIN/derrsyx.f
@@ -51,17 +51,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup double_lin
 *
 *  =====================================================================
       SUBROUTINE DERRSY( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -83,8 +83,8 @@
 *     .. Local Arrays ..
       INTEGER            IP( NMAX ), IW( NMAX )
       DOUBLE PRECISION   A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX ),
-     $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
+     $                   E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
+     $                   X( NMAX ), S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
 *     ..
 *     .. External Functions ..
@@ -92,11 +92,12 @@
       EXTERNAL           LSAMEN
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ALAESM, CHKXER, DSPCON, DSYCON_ROOK, DSPRFS,
-     $                   DSPTRF, DSPTRI, DSPTRS, DSYCON, DSYRFS, DSYTF2,
-     $                   DSYTF2_ROOK, DSYTRF, DSYTRF_ROOK, DSYTRI,
-     $                   DSYTRI_ROOK, DSYTRI2, DSYTRS, DSYTRS_ROOK,
-     $                   DSYRFSX
+      EXTERNAL           ALAESM, CHKXER, DSPCON, DSPRFS, DSPTRF, DSPTRI,
+     $                   DSPTRS, DSYCON, DSYCON_3, DSYCON_ROOK, DSYRFS,
+     $                   DSYTF2, DSYTF2_RK, DSYTF2_ROOK, DSYTRF,
+     $                   DSYTRF_RK, DSYTRF_ROOK, DSYTRI, DSYTRI_3,
+     $                   DSYTRI_3X, DSYTRI_ROOK, DSYTRI2, DSYTRI2X,
+     $                   DSYTRS, DSYTRS_3, DSYTRS_ROOK, DSYRFSX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -124,6 +125,7 @@
             AF( I, J ) = 1.D0 / DBLE( I+J )
    10    CONTINUE
          B( J ) = 0.D0
+         E( J ) = 0.D0
          R1( J ) = 0.D0
          R2( J ) = 0.D0
          W( J ) = 0.D0
@@ -154,6 +156,12 @@
          INFOT = 4
          CALL DSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
 *
 *        DSYTF2
 *
@@ -194,6 +202,19 @@
          CALL DSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO )
          CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
 *
+*        DSYTRI2X
+*
+         SRNAMT = 'DSYTRI2X'
+         INFOT = 1
+         CALL DSYTRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI2X', INFOT, NOUT, LERR, OK )
+*
 *        DSYTRS
 *
          SRNAMT = 'DSYTRS'
@@ -326,6 +347,12 @@
          INFOT = 4
          CALL DSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'DSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'DSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYTRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'DSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        DSYTF2_ROOK
 *
@@ -388,6 +415,119 @@
          CALL DSYCON_ROOK( 'U', 1, A, 1, IP, -1.0D0, RCOND, W, IW, INFO)
          CALL CHKXER( 'DSYCON_ROOK', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        DSYTRF_RK
+*
+         SRNAMT = 'DSYTRF_RK'
+         INFOT = 1
+         CALL DSYTRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTRF_RK( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYTRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'DSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYTRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'DSYTRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        DSYTF2_RK
+*
+         SRNAMT = 'DSYTF2_RK'
+         INFOT = 1
+         CALL DSYTF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'DSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'DSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'DSYTF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        DSYTRI_3
+*
+         SRNAMT = 'DSYTRI_3'
+         INFOT = 1
+         CALL DSYTRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYTRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'DSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYTRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'DSYTRI_3', INFOT, NOUT, LERR, OK )
+*
+*        DSYTRI_3X
+*
+         SRNAMT = 'DSYTRI_3X'
+         INFOT = 1
+         CALL DSYTRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYTRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'DSYTRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        DSYTRS_3
+*
+         SRNAMT = 'DSYTRS_3'
+         INFOT = 1
+         CALL DSYTRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'DSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYTRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'DSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYTRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'DSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYTRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'DSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL DSYTRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'DSYTRS_3', INFOT, NOUT, LERR, OK )
+*
+*        DSYCON_3
+*
+         SRNAMT = 'DSYCON_3'
+         INFOT = 1
+         CALL DSYCON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'DSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYCON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'DSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL DSYCON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'DSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL DSYCON_3( 'U', 1, A, 1, E, IP, -1.0D0, RCOND, W, IW,
+     $                   INFO)
+         CALL CHKXER( 'DSYCON_3', INFOT, NOUT, LERR, OK )
+*
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
 *        Test error exits of the routines that use factorization
diff --git a/TESTING/LIN/derrvx.f b/TESTING/LIN/derrvx.f
index ff57aa7e..c18f9ab0 100644
--- a/TESTING/LIN/derrvx.f
+++ b/TESTING/LIN/derrvx.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date April 2012
+*> \date November 2016
 *
 *> \ingroup double_lin
 *
 *  =====================================================================
       SUBROUTINE DERRVX( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.4.1) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     April 2012
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -80,8 +80,8 @@
 *     .. Local Arrays ..
       INTEGER            IP( NMAX ), IW( NMAX )
       DOUBLE PRECISION   A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   C( NMAX ), E( NMAX ),  R( NMAX ), R1( NMAX ),
+     $                   R2( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -91,7 +91,7 @@
       EXTERNAL           CHKXER, DGBSV, DGBSVX, DGESV, DGESVX, DGTSV,
      $                   DGTSVX, DPBSV, DPBSVX, DPOSV, DPOSVX, DPPSV,
      $                   DPPSVX, DPTSV, DPTSVX, DSPSV, DSPSVX, DSYSV,
-     $                   DSYSV_AA, DSYSV_ROOK, DSYSVX
+     $                   DSYSV_AA, DSYSV_RK, DSYSV_ROOK, DSYSVX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -118,13 +118,14 @@
             A( I, J ) = 1.D0 / DBLE( I+J )
             AF( I, J ) = 1.D0 / DBLE( I+J )
    10    CONTINUE
-         B( J ) = 0.D0
-         R1( J ) = 0.D0
-         R2( J ) = 0.D0
-         W( J ) = 0.D0
-         X( J ) = 0.D0
-         C( J ) = 0.D0
-         R( J ) = 0.D0
+         B( J ) = 0.D+0
+         E( J ) = 0.D+0
+         R1( J ) = 0.D+0
+         R2( J ) = 0.D+0
+         W( J ) = 0.D+0
+         X( J ) = 0.D+0
+         C( J ) = 0.D+0
+         R( J ) = 0.D+0
          IP( J ) = J
    20 CONTINUE
       EQ = ' '
@@ -583,9 +584,18 @@
          INFOT = 3
          CALL DSYSV( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'DSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYSV( 'U', 2, 0, A, 1, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
          INFOT = 8
          CALL DSYSV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'DSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'DSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'DSYSV ', INFOT, NOUT, LERR, OK )
 *
 *        DSYSVX
 *
@@ -627,25 +637,6 @@
      $                RCOND, R1, R2, W, 3, IW, INFO )
          CALL CHKXER( 'DSYSVX', INFOT, NOUT, LERR, OK )
 *
-      ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
-*
-*        DSYSV_AA
-*
-        SRNAMT = 'DSYSV_AA'
-        INFOT = 1
-        CALL DSYSV_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'DSYSV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 2
-        CALL DSYSV_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'DSYSV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 3
-        CALL DSYSV_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'DSYSV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 8
-        CALL DSYSV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'DSYSV_AA', INFOT, NOUT, LERR, OK )
-*
-
       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 *
 *        DSYSV_ROOK
@@ -660,9 +651,71 @@
          INFOT = 3
          CALL DSYSV_ROOK( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYSV_ROOK( 'U', 2, 0, A, 1, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
          INFOT = 8
          CALL DSYSV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        DSYSV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'DSYSV_RK'
+         INFOT = 1
+         CALL DSYSV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYSV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYSV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYSV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL DSYSV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL DSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL DSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
+*
+*        DSYSV_AA
+*
+        SRNAMT = 'DSYSV_AA'
+        INFOT = 1
+        CALL DSYSV_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+        CALL CHKXER( 'DSYSV_AA', INFOT, NOUT, LERR, OK )
+        INFOT = 2
+        CALL DSYSV_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+        CALL CHKXER( 'DSYSV_AA', INFOT, NOUT, LERR, OK )
+        INFOT = 3
+        CALL DSYSV_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+        CALL CHKXER( 'DSYSV_AA', INFOT, NOUT, LERR, OK )
+        INFOT = 8
+        CALL DSYSV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
+        CALL CHKXER( 'DSYSV_AA', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
diff --git a/TESTING/LIN/derrvxx.f b/TESTING/LIN/derrvxx.f
index b28e01cb..d29797b4 100644
--- a/TESTING/LIN/derrvxx.f
+++ b/TESTING/LIN/derrvxx.f
@@ -82,9 +82,10 @@
 *     .. Local Arrays ..
       INTEGER            IP( NMAX ), IW( NMAX )
       DOUBLE PRECISION   A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX ), ERR_BNDS_N( NMAX, 3 ),
-     $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
+     $                   C( NMAX ), E( NMAX ), R( NMAX ), R1( NMAX ),
+     $                   R2( NMAX ), W( 2*NMAX ), X( NMAX ),
+     $                   ERR_BNDS_N( NMAX, 3 ), ERR_BNDS_C( NMAX, 3 ),
+     $                   PARAMS( 1 )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -94,7 +95,8 @@
       EXTERNAL           CHKXER, DGBSV, DGBSVX, DGESV, DGESVX, DGTSV,
      $                   DGTSVX, DPBSV, DPBSVX, DPOSV, DPOSVX, DPPSV,
      $                   DPPSVX, DPTSV, DPTSVX, DSPSV, DSPSVX, DSYSV,
-     $                   DSYSVX, DGESVXX, DSYSVXX, DPOSVXX, DGBSVXX
+     $                   DSYSV_RK, DSYSV_ROOK, DSYSVX, DGESVXX, DSYSVXX,
+     $                   DPOSVXX, DGBSVXX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -121,13 +123,14 @@
             A( I, J ) = 1.D0 / DBLE( I+J )
             AF( I, J ) = 1.D0 / DBLE( I+J )
    10    CONTINUE
-         B( J ) = 0.D0
-         R1( J ) = 0.D0
-         R2( J ) = 0.D0
-         W( J ) = 0.D0
-         X( J ) = 0.D0
-         C( J ) = 0.D0
-         R( J ) = 0.D0
+         B( J ) = 0.D+0
+         E( J ) = 0.D+0
+         R1( J ) = 0.D+0
+         R2( J ) = 0.D+0
+         W( J ) = 0.D+0
+         X( J ) = 0.D+0
+         C( J ) = 0.D+0
+         R( J ) = 0.D+0
          IP( J ) = J
    20 CONTINUE
       EQ = ' '
@@ -795,9 +798,18 @@
          INFOT = 3
          CALL DSYSV( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'DSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYSV( 'U', 2, 0, A, 1, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
          INFOT = 8
          CALL DSYSV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'DSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'DSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'DSYSV ', INFOT, NOUT, LERR, OK )
 *
 *        DSYSVX
 *
@@ -907,6 +919,68 @@
      $        ERR_BNDS_C, NPARAMS, PARAMS, W, IW, INFO )
          CALL CHKXER( 'DSYSVXX', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
+*
+*        DSYSV_ROOK
+*
+         SRNAMT = 'DSYSV_ROOK'
+         INFOT = 1
+         CALL DSYSV_ROOK( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYSV_ROOK( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYSV_ROOK( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYSV_ROOK( 'U', 2, 0, A, 1, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL DSYSV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL DSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'DSYSV_ROOK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        DSYSV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'DSYSV_RK'
+         INFOT = 1
+         CALL DSYSV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL DSYSV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL DSYSV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL DSYSV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL DSYSV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL DSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL DSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'DSYSV_RK', INFOT, NOUT, LERR, OK )
+*
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
 *        DSPSV
diff --git a/TESTING/LIN/dsyt01_3.f b/TESTING/LIN/dsyt01_3.f
new file mode 100644
index 00000000..92e4aefe
--- /dev/null
+++ b/TESTING/LIN/dsyt01_3.f
@@ -0,0 +1,248 @@
+*> \brief \b DSYT01_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+*                            LDC, RWORK, RESID )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            LDA, LDAFAC, LDC, N
+*       DOUBLE PRECISION   RESID
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+*      $                   E( * ), RWORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYT01_3 reconstructs a symmetric indefinite matrix A from its
+*> block L*D*L' or U*D*U' factorization computed by DSYTRF_RK
+*> (or DSYTRF_BK) and computes the residual
+*>    norm( C - A ) / ( N * norm(A) * EPS ),
+*> where C is the reconstructed matrix and EPS is the machine epsilon.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          The original symmetric matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N)
+*> \endverbatim
+*>
+*> \param[in] AFAC
+*> \verbatim
+*>          AFAC is DOUBLE PRECISION array, dimension (LDAFAC,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by DSYTRF_RK and DSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDAFAC
+*> \verbatim
+*>          LDAFAC is INTEGER
+*>          The leading dimension of the array AFAC.
+*>          LDAFAC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          The pivot indices from DSYTRF_RK (or DSYTRF_BK).
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*>          C is DOUBLE PRECISION array, dimension (LDC,N)
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] RESID
+*> \verbatim
+*>          RESID is DOUBLE PRECISION
+*>          If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS )
+*>          If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup double_lin
+*
+*  =====================================================================
+      SUBROUTINE DSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+     $                     LDC, RWORK, RESID )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            LDA, LDAFAC, LDC, N
+      DOUBLE PRECISION   RESID
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+     $                   E( * ), RWORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, INFO, J
+      DOUBLE PRECISION   ANORM, EPS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      DOUBLE PRECISION   DLAMCH, DLANSY
+      EXTERNAL           LSAME, DLAMCH, DLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DLASET, DLAVSY_ROOK, DSYCONVF_ROOK
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick exit if N = 0.
+*
+      IF( N.LE.0 ) THEN
+         RESID = ZERO
+         RETURN
+      END IF
+*
+*     a) Revert to multiplyers of L
+*
+      CALL DSYCONVF_ROOK( UPLO, 'R', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+*     1) Determine EPS and the norm of A.
+*
+      EPS = DLAMCH( 'Epsilon' )
+      ANORM = DLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+*     2) Initialize C to the identity matrix.
+*
+      CALL DLASET( 'Full', N, N, ZERO, ONE, C, LDC )
+*
+*     3) Call DLAVSY_ROOK to form the product D * U' (or D * L' ).
+*
+      CALL DLAVSY_ROOK( UPLO, 'Transpose', 'Non-unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     4) Call DLAVSY_ROOK again to multiply by U (or L ).
+*
+      CALL DLAVSY_ROOK( UPLO, 'No transpose', 'Unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     5) Compute the difference  C - A.
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+         DO J = 1, N
+            DO I = 1, J
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      ELSE
+         DO J = 1, N
+            DO I = J, N
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      END IF
+*
+*     6) Compute norm( C - A ) / ( N * norm(A) * EPS )
+*
+      RESID = DLANSY( '1', UPLO, N, C, LDC, RWORK )
+*
+      IF( ANORM.LE.ZERO ) THEN
+         IF( RESID.NE.ZERO )
+     $      RESID = ONE / EPS
+      ELSE
+         RESID = ( ( RESID / DBLE( N ) ) / ANORM ) / EPS
+      END IF
+
+*
+*     b) Convert to factor of L (or U)
+*
+      CALL DSYCONVF_ROOK( UPLO, 'C', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+      RETURN
+*
+*     End of DSYT01_3
+*
+      END
diff --git a/TESTING/LIN/dsyt01_aa.f b/TESTING/LIN/dsyt01_aa.f
index bc30df38..3a704de3 100644
--- a/TESTING/LIN/dsyt01_aa.f
+++ b/TESTING/LIN/dsyt01_aa.f
@@ -8,8 +8,8 @@
 *  Definition:
 *  ===========
 *
-*       SUBROUTINE DSYT01( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC,
-*                          RWORK, RESID )
+*       SUBROUTINE DSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC,
+*                             RWORK, RESID )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
@@ -118,7 +118,7 @@
 *
 *> \date November 2016
 *
-*  @precisions fortran d -> s
+*  @precisions fortran d -> z c
 *
 *> \ingroup double_lin
 *
@@ -193,27 +193,27 @@
             CALL DLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 2, 1 ),
      $                   LDC+1 )
          ENDIF
-      ENDIF
 *
-*     Call DTRMM to form the product U' * D (or L * D ).
+*        Call DTRMM to form the product U' * D (or L * D ).
 *
-      IF( LSAME( UPLO, 'U' ) ) THEN
-         CALL DTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N,
-     $               ONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC )
-      ELSE
-         CALL DTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
-     $               ONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
-      END IF
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL DTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N,
+     $                  ONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC )
+         ELSE
+            CALL DTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
+     $                  ONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
+         END IF
 *
-*     Call DTRMM again to multiply by U (or L ).
+*        Call DTRMM again to multiply by U (or L ).
 *
-      IF( LSAME( UPLO, 'U' ) ) THEN
-         CALL DTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
-     $               ONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
-      ELSE
-         CALL DTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1,
-     $               ONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC )
-      END IF
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL DTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
+     $                  ONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
+         ELSE
+            CALL DTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1,
+     $                  ONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC )
+         END IF
+      ENDIF
 *
 *     Apply symmetric pivots
 *
diff --git a/TESTING/LIN/schkaa.f b/TESTING/LIN/schkaa.f
index 37984e14..675e32f1 100644
--- a/TESTING/LIN/schkaa.f
+++ b/TESTING/LIN/schkaa.f
@@ -51,6 +51,8 @@
 *> SPT   12               List types on next line if 0 < NTYPES < 12
 *> SSY   10               List types on next line if 0 < NTYPES < 10
 *> SSR   10               List types on next line if 0 < NTYPES < 10
+*> SSK   10               List types on next line if 0 < NTYPES < 10
+*> SSA   10               List types on next line if 0 < NTYPES < 10
 *> SSP   10               List types on next line if 0 < NTYPES < 10
 *> STR   18               List types on next line if 0 < NTYPES < 18
 *> STP   18               List types on next line if 0 < NTYPES < 18
@@ -146,8 +148,8 @@
      $                   NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ),
      $                   RANKVAL( MAXIN ), PIV( NMAX )
       REAL               A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
-     $                   RWORK( 5*NMAX+2*MAXRHS ), S( 2*NMAX ),
-     $                   WORK( NMAX, NMAX+MAXRHS+30 )
+     $                   E( NMAX ), RWORK( 5*NMAX+2*MAXRHS ),
+     $                   S( 2*NMAX ), WORK( NMAX, NMAX+MAXRHS+30 )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME, LSAMEN
@@ -158,11 +160,11 @@
       EXTERNAL           ALAREQ, SCHKEQ, SCHKGB, SCHKGE, SCHKGT, SCHKLQ,
      $                   SCHKPB, SCHKPO, SCHKPS, SCHKPP, SCHKPT, SCHKQ3,
      $                   SCHKQL, SCHKQR, SCHKRQ, SCHKSP, SCHKSY,
-     $                   SCHKSY_ROOK, SCHKSY_AA, SCHKTB, SCHKTP, SCHKTR,
-     $                   SCHKTZ, SDRVGB, SDRVGE, SDRVGT, SDRVLS, SDRVPB,
-     $                   SDRVPO, SDRVPP, SDRVPT, SDRVSP, SDRVSY,
-     $                   SDRVSY_ROOK, SDRVSY_AA, ILAVER, SCHKLQTP,
-     $                   SCHKQRT, SCHKQRTP
+     $                   SCHKSY_ROOK, SCHKSY_RK, SCHKSY_AA, SCHKTB,
+     $                   SCHKTP, SCHKTR, SCHKTZ, SDRVGB, SDRVGE, SDRVGT,
+     $                   SDRVLS, SDRVPB, SDRVPO, SDRVPP, SDRVPT, SDRVSP,
+     $                   SDRVSY, SDRVSY_ROOK, SDRVSY_RK, SDRVSY_AA,
+     $                   ILAVER, SCHKLQTP, SCHKQRT, SCHKQRTP
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -641,8 +643,8 @@
 *
       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 *
-*        SR:  symmetric indefinite matrices with Rook pivoting,
-*             with rook (bounded Bunch-Kaufman) pivoting algorithm
+*        SR:  symmetric indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm
 *
          NTYPES = 10
          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
@@ -665,9 +667,36 @@
             WRITE( NOUT, FMT = 9988 )PATH
          END IF
 *
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        SK:  symmetric indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm,
+*             differnet matrix storage format than SR path version.
+*
+         NTYPES = 10
+         CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+         IF( TSTCHK ) THEN
+            CALL SCHKSY_RK( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+     $                      THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+     $                      E, A( 1, 3 ), B( 1, 1 ), B( 1, 2 ),
+     $                      B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9989 )PATH
+         END IF
+*
+         IF( TSTDRV ) THEN
+            CALL SDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      LDA, A( 1, 1 ), A( 1, 2 ), E, A( 1, 3 ),
+     $                      B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+     $                      WORK, RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9988 )PATH
+         END IF
+*
       ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
 *
-*        SY:  symmetric indefinite matrices,
+*        SA:  symmetric indefinite matrices,
 *             with partial (Aasen's) pivoting algorithm
 *
          NTYPES = 10
diff --git a/TESTING/LIN/schksy_aa.f b/TESTING/LIN/schksy_aa.f
index 0f668723..ee00fdb0 100644
--- a/TESTING/LIN/schksy_aa.f
+++ b/TESTING/LIN/schksy_aa.f
@@ -163,6 +163,7 @@
 *
 *> \date November 2016
 *
+*  @precisions fortran d -> z c
 *
 *> \ingroup real_lin
 *
@@ -201,13 +202,13 @@
       PARAMETER    ( NTESTS = 9 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL      TRFCON, ZEROT
+      LOGICAL      ZEROT
       CHARACTER    DIST, TYPE, UPLO, XTYPE
       CHARACTER*3  PATH, MATPATH
       INTEGER      I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
      $             IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
      $             N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
-      REAL         ANORM, CNDNUM, RCONDC
+      REAL         ANORM, CNDNUM
 *     ..
 *     .. Local Arrays ..
       CHARACTER    UPLOS( 2 )
@@ -430,9 +431,9 @@
 *                 block factorization, LWORK is the length of AINV.
 *
                   SRNAMT = 'SSYTRF_AA'
-                  LWORK = N*NB + N
+                  LWORK = MAX( 1, N*NB + N )
                   CALL SSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
-     $                               LWORK, INFO )
+     $                            LWORK, INFO )
 *
 *                 Adjust the expected value of INFO to account for
 *                 pivoting.
@@ -462,19 +463,11 @@
      $                            NOUT )
                   END IF
 *
-*                 Set the condition estimate flag if the INFO is not 0.
-*
-                  IF( INFO.NE.0 ) THEN
-                     TRFCON = .TRUE.
-                  ELSE
-                     TRFCON = .FALSE.
-                  END IF
-*
 *+    TEST 1
 *                 Reconstruct matrix from factors and compute residual.
 *
                   CALL SSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
-     $                               AINV, LDA, RWORK, RESULT( 1 ) )
+     $                            AINV, LDA, RWORK, RESULT( 1 ) )
                   NT = 1
 *
 *
@@ -492,10 +485,9 @@
   110             CONTINUE
                   NRUN = NRUN + NT
 *
-*                 Do only the condition estimate if INFO is not 0.
+*                 Skip solver test if INFO is not 0.
 *
-                  IF( TRFCON ) THEN
-                     RCONDC = ZERO
+                  IF( INFO.NE.0 ) THEN
                      GO TO 140
                   END IF
 *
@@ -504,7 +496,7 @@
                   DO 130 IRHS = 1, NNS
                      NRHS = NSVAL( IRHS )
 *
-*+    TEST 3 ( Using TRS)
+*+    TEST 2 (Using TRS)
 *                 Solve and compute residual for  A * X = B.
 *
 *                    Choose a set of NRHS random solution vectors
@@ -517,10 +509,10 @@
                      CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
 *
                      SRNAMT = 'SSYTRS_AA'
-                     LWORK = 3*N-2
+                     LWORK = MAX( 1, 3*N-2 )
                      CALL SSYTRS_AA( UPLO, N, NRHS, AFAC, LDA,
-     $                                  IWORK, X, LDA, WORK, LWORK,
-     $                                  INFO )
+     $                               IWORK, X, LDA, WORK, LWORK,
+     $                               INFO )
 *
 *                    Check error code from SSYTRS and handle error.
 *
diff --git a/TESTING/LIN/schksy_rk.f b/TESTING/LIN/schksy_rk.f
new file mode 100644
index 00000000..6205f6c1
--- /dev/null
+++ b/TESTING/LIN/schksy_rk.f
@@ -0,0 +1,846 @@
+*> \brief \b SCHKSY_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SCHKSY_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+*                             THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+*                             X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NNB, NNS, NOUT
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+*       REAL               A( * ), AFAC( * ), E( * ), AINV( * ), B( * ),
+*      $                   RWORK( * ), WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> SCHKSY_RK tests SSYTRF_RK, -TRI_3, -TRS_3, and -CON_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*>          NNB is INTEGER
+*>          The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*>          NBVAL is INTEGER array, dimension (NBVAL)
+*>          The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*>          NNS is INTEGER
+*>          The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*>          NSVAL is INTEGER array, dimension (NNS)
+*>          The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is REAL array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is REAL array, dimension (NMAX*NSMAX),
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is REAL array, dimension (NMAX*NSMAX),
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is REAL array, dimension (NMAX*NSMAX),
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup double_lin
+*
+*  =====================================================================
+      SUBROUTINE SCHKSY_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+     $                      THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+     $                      X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NNB, NNS, NOUT
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+      REAL               A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   RWORK( * ), WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+      REAL               EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 )
+      INTEGER            NTYPES
+      PARAMETER          ( NTYPES = 10 )
+      INTEGER            NTESTS
+      PARAMETER          ( NTESTS = 7 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            TRFCON, ZEROT
+      CHARACTER          DIST, TYPE, UPLO, XTYPE
+      CHARACTER*3        PATH, MATPATH
+      INTEGER            I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+     $                   ITEMP, IUPLO, IZERO, J, K, KL, KU, LDA, LWORK,
+     $                   MODE, N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN,
+     $                   NT
+      REAL               ALPHA, ANORM, CNDNUM, CONST, STEMP, SING_MAX,
+     $                   SING_MIN, RCOND, RCONDC
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          UPLOS( 2 )
+      INTEGER            IDUMMY( 1 ), ISEED( 4 ), ISEEDY( 4 )
+      REAL               BLOCK( 2, 2 ), SDUMMY( 1 ), RESULT( NTESTS )
+*     ..
+*     .. External Functions ..
+      REAL               SGET06, SLANGE, SLANSY
+      EXTERNAL           SGET06, SLANGE, SLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALAERH, ALAHD, ALASUM, SERRSY, SGESVD, SGET04,
+     $                   SLACPY, SLARHS, SLATB4, SLATMS, SPOT02, SPOT03,
+     $                   SSYCON_3, SSYT01_3, SSYTRF_RK, SSYTRI_3,
+     $                   SSYTRS_3, XLAENV
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Single precision'
+      PATH( 2: 3 ) = 'SK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Single precision'
+      MATPATH( 2: 3 ) = 'SY'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL SERRSY( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the minimum block size for which the block routine should
+*     be used, which will be later returned by ILAENV
+*
+      CALL XLAENV( 2, 2 )
+*
+*     Do for each value of N in NVAL
+*
+      DO 270 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         IZERO = 0
+*
+*        Do for each value of matrix type IMAT
+*
+         DO 260 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 260
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 260
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 250 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*              Begin generate the test matrix A.
+*
+*              Set up parameters with SLATB4 for the matrix generator
+*              based on the type of matrix to be generated.
+*
+               CALL SLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                      MODE, CNDNUM, DIST )
+*
+*              Generate a matrix with SLATMS.
+*
+               SRNAMT = 'SLATMS'
+               CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+     $                      INFO )
+*
+*              Check error code from SLATMS and handle error.
+*
+               IF( INFO.NE.0 ) THEN
+                  CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, -1,
+     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+*                 Skip all tests for this generated matrix
+*
+                  GO TO 250
+               END IF
+*
+*              For matrix types 3-6, zero one or more rows and
+*              columns of the matrix to test that INFO is returned
+*              correctly.
+*
+               IF( ZEROT ) THEN
+                  IF( IMAT.EQ.3 ) THEN
+                     IZERO = 1
+                  ELSE IF( IMAT.EQ.4 ) THEN
+                     IZERO = N
+                  ELSE
+                     IZERO = N / 2 + 1
+                  END IF
+*
+                  IF( IMAT.LT.6 ) THEN
+*
+*                    Set row and column IZERO to zero.
+*
+                     IF( IUPLO.EQ.1 ) THEN
+                        IOFF = ( IZERO-1 )*LDA
+                        DO 20 I = 1, IZERO - 1
+                           A( IOFF+I ) = ZERO
+   20                   CONTINUE
+                        IOFF = IOFF + IZERO
+                        DO 30 I = IZERO, N
+                           A( IOFF ) = ZERO
+                           IOFF = IOFF + LDA
+   30                   CONTINUE
+                     ELSE
+                        IOFF = IZERO
+                        DO 40 I = 1, IZERO - 1
+                           A( IOFF ) = ZERO
+                           IOFF = IOFF + LDA
+   40                   CONTINUE
+                        IOFF = IOFF - IZERO
+                        DO 50 I = IZERO, N
+                           A( IOFF+I ) = ZERO
+   50                   CONTINUE
+                     END IF
+                  ELSE
+                     IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                        IOFF = 0
+                        DO 70 J = 1, N
+                           I2 = MIN( J, IZERO )
+                           DO 60 I = 1, I2
+                              A( IOFF+I ) = ZERO
+   60                      CONTINUE
+                           IOFF = IOFF + LDA
+   70                   CONTINUE
+                     ELSE
+*
+*                       Set the last IZERO rows and columns to zero.
+*
+                        IOFF = 0
+                        DO 90 J = 1, N
+                           I1 = MAX( J, IZERO )
+                           DO 80 I = I1, N
+                              A( IOFF+I ) = ZERO
+   80                      CONTINUE
+                           IOFF = IOFF + LDA
+   90                   CONTINUE
+                     END IF
+                  END IF
+               ELSE
+                  IZERO = 0
+               END IF
+*
+*              End generate the test matrix A.
+*
+*
+*              Do for each value of NB in NBVAL
+*
+               DO 240 INB = 1, NNB
+*
+*                 Set the optimal blocksize, which will be later
+*                 returned by ILAENV.
+*
+                  NB = NBVAL( INB )
+                  CALL XLAENV( 1, NB )
+*
+*                 Copy the test matrix A into matrix AFAC which
+*                 will be factorized in place. This is needed to
+*                 preserve the test matrix A for subsequent tests.
+*
+                  CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+*                 Compute the L*D*L**T or U*D*U**T factorization of the
+*                 matrix. IWORK stores details of the interchanges and
+*                 the block structure of D. AINV is a work array for
+*                 block factorization, LWORK is the length of AINV.
+*
+                  LWORK = MAX( 2, NB )*LDA
+                  SRNAMT = 'SSYTRF_RK'
+                  CALL SSYTRF_RK( UPLO, N, AFAC, LDA, E, IWORK, AINV,
+     $                            LWORK, INFO )
+*
+*                 Adjust the expected value of INFO to account for
+*                 pivoting.
+*
+                  K = IZERO
+                  IF( K.GT.0 ) THEN
+  100                CONTINUE
+                     IF( IWORK( K ).LT.0 ) THEN
+                        IF( IWORK( K ).NE.-K ) THEN
+                           K = -IWORK( K )
+                           GO TO 100
+                        END IF
+                     ELSE IF( IWORK( K ).NE.K ) THEN
+                        K = IWORK( K )
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Check error code from DSYTRF_RK and handle error.
+*
+                  IF( INFO.NE.K)
+     $               CALL ALAERH( PATH, 'SSYTRF_RK', INFO, K,
+     $                            UPLO, N, N, -1, -1, NB, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Set the condition estimate flag if the INFO is not 0.
+*
+                  IF( INFO.NE.0 ) THEN
+                     TRFCON = .TRUE.
+                  ELSE
+                     TRFCON = .FALSE.
+                  END IF
+*
+*+    TEST 1
+*                 Reconstruct matrix from factors and compute residual.
+*
+                  CALL SSYT01_3( UPLO, N, A, LDA, AFAC, LDA, E, IWORK,
+     $                           AINV, LDA, RWORK, RESULT( 1 ) )
+                  NT = 1
+*
+*+    TEST 2
+*                 Form the inverse and compute the residual,
+*                 if the factorization was competed without INFO > 0
+*                 (i.e. there is no zero rows and columns).
+*                 Do it only for the first block size.
+*
+                  IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN
+                     CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     SRNAMT = 'SSYTRI_3'
+*
+*                    Another reason that we need to compute the invesrse
+*                    is that SPOT03 produces RCONDC which is used later
+*                    in TEST6 and TEST7.
+*
+                     LWORK = (N+NB+1)*(NB+3)
+                     CALL SSYTRI_3( UPLO, N, AINV, LDA, E, IWORK, WORK,
+     $                              LWORK, INFO )
+*
+*                    Check error code from SSYTRI_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'SSYTRI_3', INFO, -1,
+     $                               UPLO, N, N, -1, -1, -1, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+*                    Compute the residual for a symmetric matrix times
+*                    its inverse.
+*
+                     CALL SPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
+     $                            RWORK, RCONDC, RESULT( 2 ) )
+                     NT = 2
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 110 K = 1, NT
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  110             CONTINUE
+                  NRUN = NRUN + NT
+*
+*+    TEST 3
+*                 Compute largest element in U or L
+*
+                  RESULT( 3 ) = ZERO
+                  STEMP = ZERO
+*
+                  CONST = ONE / ( ONE-ALPHA )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                 Compute largest element in U
+*
+                     K = N
+  120                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 130
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in in U
+*
+                        STEMP = SLANGE( 'M', K-1, 1,
+     $                          AFAC( ( K-1 )*LDA+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k-1 in U
+*
+                        STEMP = SLANGE( 'M', K-2, 2,
+     $                          AFAC( ( K-2 )*LDA+1 ), LDA, RWORK )
+                        K = K - 1
+*
+                     END IF
+*
+*                    STEMP should be bounded by CONST
+*
+                     STEMP = STEMP - CONST + THRESH
+                     IF( STEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = STEMP
+*
+                     K = K - 1
+*
+                     GO TO 120
+  130                CONTINUE
+*
+                  ELSE
+*
+*                 Compute largest element in L
+*
+                     K = 1
+  140                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 150
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in in L
+*
+                        STEMP = SLANGE( 'M', N-K, 1,
+     $                          AFAC( ( K-1 )*LDA+K+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k+1 in L
+*
+                        STEMP = SLANGE( 'M', N-K-1, 2,
+     $                          AFAC( ( K-1 )*LDA+K+2 ), LDA, RWORK )
+                        K = K + 1
+*
+                     END IF
+*
+*                    STEMP should be bounded by CONST
+*
+                     STEMP = STEMP - CONST + THRESH
+                     IF( STEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = STEMP
+*
+                     K = K + 1
+*
+                     GO TO 140
+  150                CONTINUE
+                  END IF
+*
+*+    TEST 4
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
+*
+                  RESULT( 4 ) = ZERO
+                  STEMP = ZERO
+*
+                  CONST = ( ONE+ALPHA ) / ( ONE-ALPHA )
+                  CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                    Loop backward for UPLO = 'U'
+*
+                     K = N
+  160                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 170
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
+                        BLOCK( 1, 2 ) = E( K )
+                        BLOCK( 2, 1 ) = BLOCK( 1, 2 )
+                        BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
+*
+                        CALL SGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               SDUMMY, 1, SDUMMY, 1,
+     $                               WORK, 10, INFO )
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        STEMP = SING_MAX / SING_MIN
+*
+*                       STEMP should be bounded by CONST
+*
+                        STEMP = STEMP - CONST + THRESH
+                        IF( STEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = STEMP
+                        K = K - 1
+*
+                     END IF
+*
+                     K = K - 1
+*
+                     GO TO 160
+  170                CONTINUE
+*
+                  ELSE
+*
+*                    Loop forward for UPLO = 'L'
+*
+                     K = 1
+  180                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 190
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K )
+                        BLOCK( 2, 1 ) = E( K )
+                        BLOCK( 1, 2 ) = BLOCK( 2, 1 )
+                        BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 )
+*
+                        CALL SGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               SDUMMY, 1, SDUMMY, 1,
+     $                               WORK, 10, INFO )
+*
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        STEMP = SING_MAX / SING_MIN
+*
+*                       STEMP should be bounded by CONST
+*
+                        STEMP = STEMP - CONST + THRESH
+                        IF( STEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = STEMP
+                        K = K + 1
+*
+                     END IF
+*
+                     K = K + 1
+*
+                     GO TO 180
+  190                CONTINUE
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 200 K = 3, 4
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  200             CONTINUE
+                  NRUN = NRUN + 2
+*
+*                 Skip the other tests if this is not the first block
+*                 size.
+*
+                  IF( INB.GT.1 )
+     $               GO TO 240
+*
+*                 Do only the condition estimate if INFO is not 0.
+*
+                  IF( TRFCON ) THEN
+                     RCONDC = ZERO
+                     GO TO 230
+                  END IF
+*
+*                 Do for each value of NRHS in NSVAL.
+*
+                  DO 220 IRHS = 1, NNS
+                     NRHS = NSVAL( IRHS )
+*
+*+    TEST 5 ( Using TRS_3)
+*                 Solve and compute residual for  A * X = B.
+*
+*                    Choose a set of NRHS random solution vectors
+*                    stored in XACT and set up the right hand side B
+*
+                     SRNAMT = 'SLARHS'
+                     CALL SLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+     $                            KL, KU, NRHS, A, LDA, XACT, LDA,
+     $                            B, LDA, ISEED, INFO )
+                     CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+                     SRNAMT = 'SSYTRS_3'
+                     CALL SSYTRS_3( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, INFO )
+*
+*                    Check error code from SSYTRS_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'SSYTRS_3', INFO, 0,
+     $                               UPLO, N, N, -1, -1, NRHS, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+                     CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+*
+*                    Compute the residual for the solution
+*
+                     CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 5 ) )
+*
+*+    TEST 6
+*                    Check solution from generated exact solution.
+*
+                     CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 6 ) )
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 210 K = 5, 6
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALAHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+     $                        IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  210                CONTINUE
+                     NRUN = NRUN + 2
+*
+*                 End do for each value of NRHS in NSVAL.
+*
+  220             CONTINUE
+*
+*+    TEST 7
+*                 Get an estimate of RCOND = 1/CNDNUM.
+*
+  230             CONTINUE
+                  ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK )
+                  SRNAMT = 'SSYCON_3'
+                  CALL SSYCON_3( UPLO, N, AFAC, LDA, E, IWORK, ANORM,
+     $                           RCOND, WORK, IWORK( N+1 ), INFO )
+*
+*                 Check error code from DSYCON_3 and handle error.
+*
+                  IF( INFO.NE.0 )
+     $               CALL ALAERH( PATH, 'SSYCON_3', INFO, 0,
+     $                            UPLO, N, N, -1, -1, -1, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Compute the test ratio to compare to values of RCOND
+*
+                  RESULT( 7 ) = SGET06( RCOND, RCONDC )
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  IF( RESULT( 7 ).GE.THRESH ) THEN
+                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                  CALL ALAHD( NOUT, PATH )
+                     WRITE( NOUT, FMT = 9997 ) UPLO, N, IMAT, 7,
+     $                  RESULT( 7 )
+                     NFAIL = NFAIL + 1
+                  END IF
+                  NRUN = NRUN + 1
+  240          CONTINUE
+*
+  250       CONTINUE
+  260    CONTINUE
+  270 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+     $      I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+     $      I2, ', test(', I2, ') =', G12.5 )
+ 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
+     $      ', test(', I2, ') =', G12.5 )
+      RETURN
+*
+*     End of SCHKSY_RK
+*
+      END
diff --git a/TESTING/LIN/sdrvsy_aa.f b/TESTING/LIN/sdrvsy_aa.f
index 3fef3c70..da5cf8a2 100644
--- a/TESTING/LIN/sdrvsy_aa.f
+++ b/TESTING/LIN/sdrvsy_aa.f
@@ -9,8 +9,8 @@
 *  ===========
 *
 *       SUBROUTINE SDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
-*                          A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
-*                          NOUT )
+*                             A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+*                             NOUT )
 *
 *       .. Scalar Arguments ..
 *       LOGICAL            TSTERR
@@ -149,8 +149,8 @@
 *
 *  =====================================================================
       SUBROUTINE SDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
-     $                         NMAX, A, AFAC, AINV, B, X, XACT, WORK,
-     $                         RWORK, IWORK, NOUT )
+     $                      NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+     $                      RWORK, IWORK, NOUT )
 *
 *  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -184,9 +184,9 @@
       CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
       CHARACTER*3        MATPATH, PATH
       INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
-     $                   IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
      $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
-      REAL               AINVNM, ANORM, CNDNUM, RCOND, RCONDC
+      REAL               ANORM, CNDNUM
 *     ..
 *     .. Local Arrays ..
       CHARACTER          FACTS( NFACT ), UPLOS( 2 )
@@ -374,44 +374,6 @@
 *
                   FACT = FACTS( IFACT )
 *
-*                 Compute the condition number for comparison with
-*                 the value returned by SSYSVX.
-*
-                  IF( ZEROT ) THEN
-                     IF( IFACT.EQ.1 )
-     $                  GO TO 150
-                     RCONDC = ZERO
-*
-                  ELSE IF( IFACT.EQ.1 ) THEN
-*
-*                    Compute the 1-norm of A.
-*
-                     ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK )
-*
-*                    Factor the matrix A.
-*
-c                     CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
-c                     CALL SSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK,
-c     $                            LWORK, INFO )
-*
-*                    Compute inv(A) and take its norm.
-*
-c                     CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
-c                     LWORK = (N+NB+1)*(NB+3)
-c                     SRNAMT = 'DSYTRI2'
-c                     CALL DSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
-c     $                            LWORK, INFO )
-c                     AINVNM = SLANSY( '1', UPLO, N, AINV, LDA, RWORK )
-*
-*                    Compute the 1-norm condition number of A.
-*
-c                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
-c                        RCONDC = ONE
-c                     ELSE
-c                        RCONDC = ( ONE / ANORM ) / AINVNM
-c                     END IF
-                  END IF
-*
 *                 Form an exact solution and set the right hand side.
 *
                   SRNAMT = 'SLARHS'
@@ -475,12 +437,7 @@ c                     END IF
                      CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
                      CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
      $                            LDA, RWORK, RESULT( 2 ) )
-*
-*                    Check solution from generated exact solution.
-*
-                     CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
-     $                            RESULT( 3 ) )
-                     NT = 3
+                     NT = 2
 *
 *                    Print information about the tests that did not pass
 *                    the threshold.
diff --git a/TESTING/LIN/sdrvsy_rk.f b/TESTING/LIN/sdrvsy_rk.f
new file mode 100644
index 00000000..f91d2e0e
--- /dev/null
+++ b/TESTING/LIN/sdrvsy_rk.f
@@ -0,0 +1,531 @@
+*> \brief \b SDRVSY_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*     SUBROUTINE SDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+*    $                      NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+*    $                      RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NOUT, NRHS
+*       REAL               THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NVAL( * )
+*       REAL               A( * ), AFAC( * ), E( * ), AINV( * ), B( * ),
+*      $                   RWORK( * ), WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> SDRVSY_RK tests the driver routines SSYSV_RK.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand side vectors to be generated for
+*>          each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is REAL
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is REAL array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is REAL array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup single_lin
+*
+*  =====================================================================
+      SUBROUTINE SDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+     $                      RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NOUT, NRHS
+      REAL               THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NVAL( * )
+      REAL               A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   RWORK( * ), WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+      INTEGER            NTYPES, NTESTS
+      PARAMETER          ( NTYPES = 10, NTESTS = 3 )
+      INTEGER            NFACT
+      PARAMETER          ( NFACT = 2 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ZEROT
+      CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
+      CHARACTER*3        PATH, MATPATH
+      INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+     $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+      REAL               AINVNM, ANORM, CNDNUM, RCONDC
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          FACTS( NFACT ), UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      REAL               RESULT( NTESTS )
+*     ..
+*     .. External Functions ..
+      REAL               SLANSY
+      EXTERNAL           SLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALADHD, ALAERH, ALASVM, SERRVX, SGET04, SLACPY,
+     $                   SLARHS, SLATB4, SLATMS, SPOT02, SSYSV_RK,
+     $                   SSYT01_3, SSYTRF_RK, SSYTRI_3, XLAENV
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Single precision'
+      PATH( 2: 3 ) = 'SK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Single precision'
+      MATPATH( 2: 3 ) = 'SY'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+      LWORK = MAX( 2*NMAX, NMAX*NRHS )
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL SERRVX( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the block size and minimum block size for which the block
+*     routine should be used, which will be later returned by ILAENV.
+*
+      NB = 1
+      NBMIN = 2
+      CALL XLAENV( 1, NB )
+      CALL XLAENV( 2, NBMIN )
+*
+*     Do for each value of N in NVAL
+*
+      DO 180 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         DO 170 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 170
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 170
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 160 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*              Begin generate the test matrix A.
+*
+*              Set up parameters with SLATB4 for the matrix generator
+*              based on the type of matrix to be generated.
+*
+               CALL SLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                      MODE, CNDNUM, DIST )
+*
+*              Generate a matrix with SLATMS.
+*
+               SRNAMT = 'SLATMS'
+               CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+     $                      INFO )
+*
+*              Check error code from SLATMS and handle error.
+*
+               IF( INFO.NE.0 ) THEN
+                  CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, -1,
+     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+*                 Skip all tests for this generated matrix
+*
+                  GO TO 160
+               END IF
+*
+*              For types 3-6, zero one or more rows and columns of the
+*              matrix to test that INFO is returned correctly.
+*
+               IF( ZEROT ) THEN
+                  IF( IMAT.EQ.3 ) THEN
+                     IZERO = 1
+                  ELSE IF( IMAT.EQ.4 ) THEN
+                     IZERO = N
+                  ELSE
+                     IZERO = N / 2 + 1
+                  END IF
+*
+                  IF( IMAT.LT.6 ) THEN
+*
+*                    Set row and column IZERO to zero.
+*
+                     IF( IUPLO.EQ.1 ) THEN
+                        IOFF = ( IZERO-1 )*LDA
+                        DO 20 I = 1, IZERO - 1
+                           A( IOFF+I ) = ZERO
+   20                   CONTINUE
+                        IOFF = IOFF + IZERO
+                        DO 30 I = IZERO, N
+                           A( IOFF ) = ZERO
+                           IOFF = IOFF + LDA
+   30                   CONTINUE
+                     ELSE
+                        IOFF = IZERO
+                        DO 40 I = 1, IZERO - 1
+                           A( IOFF ) = ZERO
+                           IOFF = IOFF + LDA
+   40                   CONTINUE
+                        IOFF = IOFF - IZERO
+                        DO 50 I = IZERO, N
+                           A( IOFF+I ) = ZERO
+   50                   CONTINUE
+                     END IF
+                  ELSE
+                     IOFF = 0
+                     IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                        DO 70 J = 1, N
+                           I2 = MIN( J, IZERO )
+                           DO 60 I = 1, I2
+                              A( IOFF+I ) = ZERO
+   60                      CONTINUE
+                           IOFF = IOFF + LDA
+   70                   CONTINUE
+                     ELSE
+*
+*                       Set the last IZERO rows and columns to zero.
+*
+                        DO 90 J = 1, N
+                           I1 = MAX( J, IZERO )
+                           DO 80 I = I1, N
+                              A( IOFF+I ) = ZERO
+   80                      CONTINUE
+                           IOFF = IOFF + LDA
+   90                   CONTINUE
+                     END IF
+                  END IF
+               ELSE
+                  IZERO = 0
+               END IF
+*
+*              End generate the test matrix A.
+*
+               DO 150 IFACT = 1, NFACT
+*
+*                 Do first for FACT = 'F', then for other values.
+*
+                  FACT = FACTS( IFACT )
+*
+*                 Compute the condition number
+*
+                  IF( ZEROT ) THEN
+                     IF( IFACT.EQ.1 )
+     $                  GO TO 150
+                     RCONDC = ZERO
+*
+                  ELSE IF( IFACT.EQ.1 ) THEN
+*
+*                    Compute the 1-norm of A.
+*
+                     ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+*                    Factor the matrix A.
+*
+                     CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL SSYTRF_RK( UPLO, N, AFAC, LDA, E, IWORK, WORK,
+     $                               LWORK, INFO )
+*
+*                    Compute inv(A) and take its norm.
+*
+                     CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     LWORK = (N+NB+1)*(NB+3)
+*
+*                    We need to copute the invesrse to compute
+*                    RCONDC that is used later in TEST3.
+*
+                     CALL SSYTRI_3( UPLO, N, AINV, LDA, E, IWORK,
+     $                              WORK, LWORK, INFO )
+                     AINVNM = SLANSY( '1', UPLO, N, AINV, LDA, RWORK )
+*
+*                    Compute the 1-norm condition number of A.
+*
+                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
+                        RCONDC = ONE
+                     ELSE
+                        RCONDC = ( ONE / ANORM ) / AINVNM
+                     END IF
+                  END IF
+*
+*                 Form an exact solution and set the right hand side.
+*
+                  SRNAMT = 'SLARHS'
+                  CALL SLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+     $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+     $                         INFO )
+                  XTYPE = 'C'
+*
+*                 --- Test SSYSV_RK  ---
+*
+                  IF( IFACT.EQ.2 ) THEN
+                     CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+*                    Factor the matrix and solve the system using
+*                    SSYSV_RK.
+*
+                     SRNAMT = 'SSYSV_RK'
+                     CALL SSYSV_RK( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, WORK, LWORK, INFO )
+*
+*                    Adjust the expected value of INFO to account for
+*                    pivoting.
+*
+                     K = IZERO
+                     IF( K.GT.0 ) THEN
+  100                   CONTINUE
+                        IF( IWORK( K ).LT.0 ) THEN
+                           IF( IWORK( K ).NE.-K ) THEN
+                              K = -IWORK( K )
+                              GO TO 100
+                           END IF
+                        ELSE IF( IWORK( K ).NE.K ) THEN
+                           K = IWORK( K )
+                           GO TO 100
+                        END IF
+                     END IF
+*
+*                    Check error code from SSYSV_RK and handle error.
+*
+                     IF( INFO.NE.K ) THEN
+                        CALL ALAERH( PATH, 'SSYSV_RK', INFO, K, UPLO,
+     $                               N, N, -1, -1, NRHS, IMAT, NFAIL,
+     $                               NERRS, NOUT )
+                        GO TO 120
+                     ELSE IF( INFO.NE.0 ) THEN
+                        GO TO 120
+                     END IF
+*
+*+    TEST 1      Reconstruct matrix from factors and compute
+*                 residual.
+*
+                     CALL SSYT01_3( UPLO, N, A, LDA, AFAC, LDA, E,
+     $                              IWORK, AINV, LDA, RWORK,
+     $                              RESULT( 1 ) )
+*
+*+    TEST 2      Compute residual of the computed solution.
+*
+                     CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+                     CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 2 ) )
+*
+*+    TEST 3
+*                 Check solution from generated exact solution.
+*
+                     CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 3 ) )
+                     NT = 3
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 110 K = 1, NT
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALADHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9999 )'SSYSV_RK', UPLO,
+     $                           N, IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  110                CONTINUE
+                     NRUN = NRUN + NT
+  120                CONTINUE
+                  END IF
+*
+  150          CONTINUE
+*
+  160       CONTINUE
+  170    CONTINUE
+  180 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+     $      ', test ', I2, ', ratio =', G12.5 )
+      RETURN
+*
+*     End of SDRVSY_RK
+*
+      END
diff --git a/TESTING/LIN/serrsy.f b/TESTING/LIN/serrsy.f
index 8fd38687..25309611 100644
--- a/TESTING/LIN/serrsy.f
+++ b/TESTING/LIN/serrsy.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup single_lin
 *
 *  =====================================================================
       SUBROUTINE SERRSY( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -79,18 +79,21 @@
 *     .. Local Arrays ..
       INTEGER            IP( NMAX ), IW( NMAX )
       REAL               A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX )
+     $                   E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
+     $                   X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
       EXTERNAL           LSAMEN
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ALAESM, CHKXER, SSPCON, SSYCON_ROOK, SSPRFS,
-     $                   SSPTRF, SSPTRI, SSPTRS, SSYCON, SSYRFS, SSYTF2,
-     $                   SSYTF2_ROOK, SSYTRF, SSYTRF_ROOK, SSYTRF_AA,
-     $                   SSYTRI, SSYTRI_ROOK, SSYTRI2, SSYTRS, 
-     $                   SSYTRS_ROOK, SSYTRS_AA
+      EXTERNAL           ALAESM, CHKXER, SSPCON, SSPRFS, SSPTRF, SSPTRI,
+     $                   SSPTRS, SSYCON, SSYCON_3, SSYCON_ROOK, SSYRFS,
+     $                   SSYTF2_RK, SSYTF2_ROOK, SSYTRF, SSYTRF_RK,
+     $                   SSYTRF_ROOK, SSYTRI, SSYTF2, SSYTRI_3,
+     $                   SSYTRI_3X, SSYTRI_ROOK, SSYTRF_AA, SSYTRI2, 
+     $                   SYTRI2X, SSYTRS, SSYTRS_3, SSYTRS_ROOK,
+     $                   SSYTRS_AA
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -117,11 +120,12 @@
             A( I, J ) = 1. / REAL( I+J )
             AF( I, J ) = 1. / REAL( I+J )
    10    CONTINUE
-         B( J ) = 0.
-         R1( J ) = 0.
-         R2( J ) = 0.
-         W( J ) = 0.
-         X( J ) = 0.
+         B( J ) = 0.E+0
+         E( J ) = 0.E+0
+         R1( J ) = 0.E+0
+         R2( J ) = 0.E+0
+         W( J ) = 0.E+0
+         X( J ) = 0.E+0
          IP( J ) = J
          IW( J ) = J
    20 CONTINUE
@@ -147,6 +151,12 @@
          INFOT = 4
          CALL SSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
 *
 *        SSYTF2
 *
@@ -187,6 +197,19 @@
          CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW(1), INFO )
          CALL CHKXER( 'SSYTRI2', INFOT, NOUT, LERR, OK )
 *
+*        SSYTRI2X
+*
+         SRNAMT = 'SSYTRI2X'
+         INFOT = 1
+         CALL SSYTRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI2X', INFOT, NOUT, LERR, OK )
+*
 *        SSYTRS
 *
          SRNAMT = 'SSYTRS'
@@ -272,6 +295,12 @@
          INFOT = 4
          CALL SSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        SSYTF2_ROOK
 *
@@ -334,9 +363,118 @@
          CALL SSYCON_ROOK( 'U', 1, A, 1, IP, -1.0, RCOND, W, IW, INFO )
          CALL CHKXER( 'SSYCON_ROOK', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
 *        Test error exits of the routines that use factorization
-*        of a symmetric indefinite packed matrix with patrial
-*        (Bunch-Kaufman) pivoting.
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        SSYTRF_RK
+*
+         SRNAMT = 'SSYTRF_RK'
+         INFOT = 1
+         CALL SSYTRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
+         CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYTRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYTRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        SSYTF2_RK
+*
+         SRNAMT = 'SSYTF2_RK'
+         INFOT = 1
+         CALL SSYTF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'SSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'SSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'SSYTF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        SSYTRI_3
+*
+         SRNAMT = 'SSYTRI_3'
+         INFOT = 1
+         CALL SSYTRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYTRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYTRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
+*
+*        SSYTRI_3X
+*
+         SRNAMT = 'SSYTRI_3X'
+         INFOT = 1
+         CALL SSYTRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        SSYTRS_3
+*
+         SRNAMT = 'SSYTRS_3'
+         INFOT = 1
+         CALL SSYTRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYTRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSYTRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL SSYTRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
+*
+*        SSYCON_3
+*
+         SRNAMT = 'SSYCON_3'
+         INFOT = 1
+         CALL SSYCON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYCON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYCON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYCON_3( 'U', 1, A, 1, E, IP, -1.0E0, RCOND, W, IW,
+     $                   INFO)
+         CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
 *
@@ -355,6 +493,12 @@
          INFOT = 4
          CALL SSYTRF_AA( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'SSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRF_AA( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'SSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRF_AA( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'SSYTRF_AA', INFOT, NOUT, LERR, OK )
 *
 *        SSYTRS_AA
 *
@@ -374,8 +518,19 @@
          INFOT = 8
          CALL SSYTRS_AA( 'U', 2, 1, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYTRS_AA( 'U', 0, 1, A, 2, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYTRS_AA( 'U', 0, 1, A, 2, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
+*
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite packed matrix with patrial
+*        (Bunch-Kaufman) pivoting.
+*
 *        SSPTRF
 *
          SRNAMT = 'SSPTRF'
diff --git a/TESTING/LIN/serrsyx.f b/TESTING/LIN/serrsyx.f
index 9d5baaed..91ce5fc9 100644
--- a/TESTING/LIN/serrsyx.f
+++ b/TESTING/LIN/serrsyx.f
@@ -51,17 +51,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup single_lin
 *
 *  =====================================================================
       SUBROUTINE SERRSY( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -83,8 +83,8 @@
 *     .. Local Arrays ..
       INTEGER            IP( NMAX ), IW( NMAX )
       REAL               A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX ),
-     $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
+     $                   E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
+     $                   X( NMAX ), S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
 *     ..
 *     .. External Functions ..
@@ -93,10 +93,11 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAESM, CHKXER, SSPCON, SSPRFS, SSPTRF, SSPTRI,
-     $                   SSPTRS, SSYCON, SSYCON_ROOK,SSYRFS, SSYTF2,
-     $                   SSYTF2_ROOK, SSYTRF, SSYTRF_ROOK, SSYTRI,
-     $                   SSYTRI_ROOK, SSYTRI2, SSYTRS, SSYTRS_ROOK,
-     $                   SSYRFSX
+     $                   SSPTRS, SSYCON, SSYCON_3, SSYCON_ROOK, SSYRFS,
+     $                   SSYTF2, SSYTF2_RK, SSYTF2_ROOK, SSYTRF,
+     $                   SSYTRF_RK, SSYTRF_ROOK, SSYTRI, SSYTRI_3,
+     $                   SSYTRI_3X, SSYTRI_ROOK, SSYTRI2, SSYTRI2X,
+     $                   SSYTRS, SSYTRS_3, SSYTRS_ROOK, SSYRFSX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -123,12 +124,12 @@
             A( I, J ) = 1. / REAL( I+J )
             AF( I, J ) = 1. / REAL( I+J )
    10    CONTINUE
-         B( J ) = 0.
-         R1( J ) = 0.
-         R2( J ) = 0.
-         W( J ) = 0.
-         X( J ) = 0.
-         S( J ) = 0.
+         B( J ) = 0.E+0
+         E( J ) = 0.E+0
+         R1( J ) = 0.E+0
+         R2( J ) = 0.E+0
+         W( J ) = 0.E+0
+         X( J ) = 0.E+0
          IP( J ) = J
          IW( J ) = J
    20 CONTINUE
@@ -154,6 +155,12 @@
          INFOT = 4
          CALL SSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
 *
 *        SSYTF2
 *
@@ -194,6 +201,19 @@
          CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO )
          CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
 *
+*        SSYTRI2X
+*
+         SRNAMT = 'SSYTRI2X'
+         INFOT = 1
+         CALL SSYTRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI2X', INFOT, NOUT, LERR, OK )
+*
 *        SSYTRS
 *
          SRNAMT = 'SSYTRS'
@@ -326,6 +346,12 @@
          INFOT = 4
          CALL SSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYTRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'SSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        SSYTF2_ROOK
 *
@@ -388,12 +414,125 @@
          CALL SSYCON_ROOK( 'U', 1, A, 1, IP, -1.0, RCOND, W, IW, INFO )
          CALL CHKXER( 'SSYCON_ROOK', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
 *        Test error exits of the routines that use factorization
-*        of a symmetric indefinite packed matrix with patrial
-*        (Bunch-Kaufman) pivoting.
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        SSYTRF_RK
+*
+         SRNAMT = 'SSYTRF_RK'
+         INFOT = 1
+         CALL SSYTRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
+         CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYTRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYTRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'SSYTRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        SSYTF2_RK
+*
+         SRNAMT = 'SSYTF2_RK'
+         INFOT = 1
+         CALL SSYTF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'SSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'SSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'SSYTF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        SSYTRI_3
+*
+         SRNAMT = 'SSYTRI_3'
+         INFOT = 1
+         CALL SSYTRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYTRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYTRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'SSYTRI_3', INFOT, NOUT, LERR, OK )
+*
+*        SSYTRI_3X
+*
+         SRNAMT = 'SSYTRI_3X'
+         INFOT = 1
+         CALL SSYTRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYTRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'SSYTRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        SSYTRS_3
+*
+         SRNAMT = 'SSYTRS_3'
+         INFOT = 1
+         CALL SSYTRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYTRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYTRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSYTRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL SSYTRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'SSYTRS_3', INFOT, NOUT, LERR, OK )
+*
+*        SSYCON_3
+*
+         SRNAMT = 'SSYCON_3'
+         INFOT = 1
+         CALL SSYCON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYCON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL SSYCON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, IW,
+     $                   INFO )
+         CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL SSYCON_3( 'U', 1, A, 1, E, IP, -1.0E0, RCOND, W, IW,
+     $                   INFO)
+         CALL CHKXER( 'SSYCON_3', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite packed matrix with patrial
+*        (Bunch-Kaufman) pivoting.
+*
 *        SSPTRF
 *
          SRNAMT = 'SSPTRF'
diff --git a/TESTING/LIN/serrvx.f b/TESTING/LIN/serrvx.f
index 6bb49238..09e83397 100644
--- a/TESTING/LIN/serrvx.f
+++ b/TESTING/LIN/serrvx.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date April 2012
+*> \date November 2016
 *
 *> \ingroup single_lin
 *
 *  =====================================================================
       SUBROUTINE SERRVX( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.4.1) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     April 2012
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -80,8 +80,8 @@
 *     .. Local Arrays ..
       INTEGER            IP( NMAX ), IW( NMAX )
       REAL               A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   C( NMAX ), E( NMAX ), R( NMAX ), R1( NMAX ),
+     $                   R2( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -91,7 +91,7 @@
       EXTERNAL           CHKXER, SGBSV, SGBSVX, SGESV, SGESVX, SGTSV,
      $                   SGTSVX, SPBSV, SPBSVX, SPOSV, SPOSVX, SPPSV,
      $                   SPPSVX, SPTSV, SPTSVX, SSPSV, SSPSVX, SSYSV,
-     $                   SSYSV_AA, SSYSV_ROOK, SSYSVX
+     $                   SSYSV_AA, SSYSV_RK, SSYSV_ROOK, SSYSVX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -118,13 +118,14 @@
             A( I, J ) = 1. / REAL( I+J )
             AF( I, J ) = 1. / REAL( I+J )
    10    CONTINUE
-         B( J ) = 0.
-         R1( J ) = 0.
-         R2( J ) = 0.
-         W( J ) = 0.
-         X( J ) = 0.
-         C( J ) = 0.
-         R( J ) = 0.
+         B( J ) = 0.E+0
+         E( J ) = 0.E+0
+         R1( J ) = 0.E+0
+         R2( J ) = 0.E+0
+         W( J ) = 0.E+0
+         X( J ) = 0.E+0
+         C( J ) = 0.E+0
+         R( J ) = 0.E+0
          IP( J ) = J
    20 CONTINUE
       EQ = ' '
@@ -586,6 +587,12 @@
          INFOT = 8
          CALL SSYSV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'SSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'SSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'SSYSV ', INFOT, NOUT, LERR, OK )
 *
 *        SSYSVX
 *
@@ -627,23 +634,6 @@
      $                RCOND, R1, R2, W, 3, IW, INFO )
          CALL CHKXER( 'SSYSVX', INFOT, NOUT, LERR, OK )
 *
-      ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
-*
-*        SSYSV_AA
-*
-        SRNAMT = 'SSYSV_AA'
-        INFOT = 1
-        CALL SSYSV_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'SSYSV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 2
-        CALL SSYSV_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'SSYSV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 3
-        CALL SSYSV_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'SSYSV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 8
-        CALL SSYSV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'SSYSV_AA', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 *
@@ -662,6 +652,65 @@
          INFOT = 8
          CALL SSYSV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'SSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'SSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'SSYSV_ROOK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        SSYSV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'SSYSV_RK'
+         INFOT = 1
+         CALL SSYSV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYSV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYSV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSYSV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL SSYSV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL SSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL SSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
+*
+*        SSYSV_AA
+*
+         SRNAMT = 'SSYSV_AA'
+         INFOT = 1
+         CALL SSYSV_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYSV_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYSV_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL SSYSV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_AA', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
diff --git a/TESTING/LIN/serrvxx.f b/TESTING/LIN/serrvxx.f
index 146e8b37..02459133 100644
--- a/TESTING/LIN/serrvxx.f
+++ b/TESTING/LIN/serrvxx.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup single_lin
 *
 *  =====================================================================
       SUBROUTINE SERRVX( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -82,9 +82,10 @@
 *     .. Local Arrays ..
       INTEGER            IP( NMAX ), IW( NMAX )
       REAL               A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX ), ERR_BNDS_N( NMAX, 3 ),
-     $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
+     $                   C( NMAX ), E( NMAX ), R( NMAX ), R1( NMAX ),
+     $                   R2( NMAX ), W( 2*NMAX ), X( NMAX ),
+     $                   ERR_BNDS_N( NMAX, 3 ), ERR_BNDS_C( NMAX, 3 ),
+     $                   PARAMS( 1 )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -94,8 +95,8 @@
       EXTERNAL           CHKXER, SGBSV, SGBSVX, SGESV, SGESVX, SGTSV,
      $                   SGTSVX, SPBSV, SPBSVX, SPOSV, SPOSVX, SPPSV,
      $                   SPPSVX, SPTSV, SPTSVX, SSPSV, SSPSVX, SSYSV,
-     $                   SSYSV_ROOK, SSYSVX, SGESVXX, SSYSVXX, SPOSVXX,
-     $                   SGBSVXX
+     $                   SSYSV_RK, SSYSV_ROOK, SSYSVX, SGESVXX, SSYSVXX,
+     $                   SPOSVXX, SGBSVXX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -122,13 +123,14 @@
             A( I, J ) = 1. / REAL( I+J )
             AF( I, J ) = 1. / REAL( I+J )
    10    CONTINUE
-         B( J ) = 0.
-         R1( J ) = 0.
-         R2( J ) = 0.
-         W( J ) = 0.
-         X( J ) = 0.
-         C( J ) = 0.
-         R( J ) = 0.
+         B( J ) = 0.E+0
+         E( J ) = 0.E+0
+         R1( J ) = 0.E+0
+         R2( J ) = 0.E+0
+         W( J ) = 0.E+0
+         X( J ) = 0.E+0
+         C( J ) = 0.E+0
+         R( J ) = 0.E+0
          IP( J ) = J
    20 CONTINUE
       EQ = ' '
@@ -799,6 +801,12 @@
          INFOT = 8
          CALL SSYSV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'SSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'SSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'SSYSV ', INFOT, NOUT, LERR, OK )
 *
 *        SSYSVX
 *
@@ -908,6 +916,8 @@
      $        ERR_BNDS_C, NPARAMS, PARAMS, W, IW, INFO )
          CALL CHKXER( 'SSYSVXX', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
+*
 *        SSYSV_ROOK
 *
          SRNAMT = 'SSYSV_ROOK'
@@ -923,6 +933,47 @@
          INFOT = 8
          CALL SSYSV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'SSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'SSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL SSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'SSYSV_ROOK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        SSYSV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'SSYSV_RK'
+         INFOT = 1
+         CALL SSYSV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL SSYSV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL SSYSV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL SSYSV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL SSYSV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL SSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL SSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'SSYSV_RK', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
diff --git a/TESTING/LIN/ssyt01_3.f b/TESTING/LIN/ssyt01_3.f
new file mode 100644
index 00000000..8364d021
--- /dev/null
+++ b/TESTING/LIN/ssyt01_3.f
@@ -0,0 +1,248 @@
+*> \brief \b SSYT01_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+*                            LDC, RWORK, RESID )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            LDA, LDAFAC, LDC, N
+*       DOUBLE PRECISION   RESID
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+*      $                   E( * ), RWORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSYT01_3 reconstructs a symmetric indefinite matrix A from its
+*> block L*D*L' or U*D*U' factorization computed by SSYTRF_RK
+*> (or SSYTRF_BK) and computes the residual
+*>    norm( C - A ) / ( N * norm(A) * EPS ),
+*> where C is the reconstructed matrix and EPS is the machine epsilon.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          The original symmetric matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N)
+*> \endverbatim
+*>
+*> \param[in] AFAC
+*> \verbatim
+*>          AFAC is DOUBLE PRECISION array, dimension (LDAFAC,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by SSYTRF_RK and SSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDAFAC
+*> \verbatim
+*>          LDAFAC is INTEGER
+*>          The leading dimension of the array AFAC.
+*>          LDAFAC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is DOUBLE PRECISION array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          The pivot indices from SSYTRF_RK (or SSYTRF_BK).
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*>          C is DOUBLE PRECISION array, dimension (LDC,N)
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] RESID
+*> \verbatim
+*>          RESID is DOUBLE PRECISION
+*>          If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS )
+*>          If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup single_lin
+*
+*  =====================================================================
+      SUBROUTINE SSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+     $                     LDC, RWORK, RESID )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            LDA, LDAFAC, LDC, N
+      REAL               RESID
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+     $                   E( * ), RWORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, INFO, J
+      REAL               ANORM, EPS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      REAL               SLAMCH, SLANSY
+      EXTERNAL           LSAME, SLAMCH, SLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLASET, SLAVSY_ROOK, SSYCONVF_ROOK
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick exit if N = 0.
+*
+      IF( N.LE.0 ) THEN
+         RESID = ZERO
+         RETURN
+      END IF
+*
+*     a) Revert to multiplyers of L
+*
+      CALL SSYCONVF_ROOK( UPLO, 'R', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+*     1) Determine EPS and the norm of A.
+*
+      EPS = SLAMCH( 'Epsilon' )
+      ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+*     2) Initialize C to the identity matrix.
+*
+      CALL SLASET( 'Full', N, N, ZERO, ONE, C, LDC )
+*
+*     3) Call SLAVSY_ROOK to form the product D * U' (or D * L' ).
+*
+      CALL SLAVSY_ROOK( UPLO, 'Transpose', 'Non-unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     4) Call SLAVSY_ROOK again to multiply by U (or L ).
+*
+      CALL SLAVSY_ROOK( UPLO, 'No transpose', 'Unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     5) Compute the difference  C - A.
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+         DO J = 1, N
+            DO I = 1, J
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      ELSE
+         DO J = 1, N
+            DO I = J, N
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      END IF
+*
+*     6) Compute norm( C - A ) / ( N * norm(A) * EPS )
+*
+      RESID = SLANSY( '1', UPLO, N, C, LDC, RWORK )
+*
+      IF( ANORM.LE.ZERO ) THEN
+         IF( RESID.NE.ZERO )
+     $      RESID = ONE / EPS
+      ELSE
+         RESID = ( ( RESID / REAL( N ) ) / ANORM ) / EPS
+      END IF
+
+*
+*     b) Convert to factor of L (or U)
+*
+      CALL SSYCONVF_ROOK( UPLO, 'C', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+      RETURN
+*
+*     End of SSYT01_3
+*
+      END
diff --git a/TESTING/LIN/ssyt01_aa.f b/TESTING/LIN/ssyt01_aa.f
index 0e72fa71..5855ba22 100644
--- a/TESTING/LIN/ssyt01_aa.f
+++ b/TESTING/LIN/ssyt01_aa.f
@@ -9,7 +9,7 @@
 *  ===========
 *
 *       SUBROUTINE SSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV,
-*                          C, LDC, RWORK, RESID )
+*                             C, LDC, RWORK, RESID )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
@@ -123,7 +123,7 @@
 *
 *  =====================================================================
       SUBROUTINE SSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
-     $                         LDC, RWORK, RESID )
+     $                      LDC, RWORK, RESID )
 *
 *  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -144,7 +144,7 @@
 *  =====================================================================
 *
 *     .. Parameters ..
-      REAL   ZERO, ONE
+      REAL               ZERO, ONE
       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
 *     ..
 *     .. Local Scalars ..
@@ -192,27 +192,27 @@
             CALL SLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 2, 1 ),
      $                   LDC+1 )
          ENDIF
-      ENDIF
 *
-*     Call STRMM to form the product U' * D (or L * D ).
+*        Call STRMM to form the product U' * D (or L * D ).
 *
-      IF( LSAME( UPLO, 'U' ) ) THEN
-         CALL STRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N,
-     $               ONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC )
-      ELSE
-         CALL STRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
-     $               ONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
-      END IF
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL STRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N,
+     $                  ONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC )
+         ELSE
+            CALL STRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
+     $                  ONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
+         END IF
 *
-*     Call STRMM again to multiply by U (or L ).
+*        Call STRMM again to multiply by U (or L ).
 *
-      IF( LSAME( UPLO, 'U' ) ) THEN
-         CALL STRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
-     $               ONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
-      ELSE
-         CALL STRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1,
-     $               ONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC )
-      END IF
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL STRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
+     $                  ONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
+         ELSE
+            CALL STRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1,
+     $                  ONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC )
+         END IF
+      ENDIF
 *
 *     Apply symmetric pivots
 *
diff --git a/TESTING/LIN/xerbla.f b/TESTING/LIN/xerbla.f
index 821d5a5b..2038e049 100644
--- a/TESTING/LIN/xerbla.f
+++ b/TESTING/LIN/xerbla.f
@@ -123,7 +123,7 @@
  9999 FORMAT( ' *** XERBLA was called from ', A, ' with INFO = ', I6,
      $      ' instead of ', I2, ' ***' )
  9998 FORMAT( ' *** XERBLA was called with SRNAME = ', A,
-     $      ' instead of ', A6, ' ***' )
+     $      ' instead of ', A9, ' ***' )
  9997 FORMAT( ' *** On entry to ', A, ' parameter number ', I6,
      $      ' had an illegal value ***' )
 *
diff --git a/TESTING/LIN/zchkaa.f b/TESTING/LIN/zchkaa.f
index 766f873f..818f1e63 100644
--- a/TESTING/LIN/zchkaa.f
+++ b/TESTING/LIN/zchkaa.f
@@ -50,11 +50,13 @@
 *> ZPB    8               List types on next line if 0 < NTYPES <  8
 *> ZPT   12               List types on next line if 0 < NTYPES < 12
 *> ZHE   10               List types on next line if 0 < NTYPES < 10
-*> ZHA   10               List types on next line if 0 < NTYPES < 10
 *> ZHR   10               List types on next line if 0 < NTYPES < 10
+*> ZHK   10               List types on next line if 0 < NTYPES < 10
+*> ZHA   10               List types on next line if 0 < NTYPES < 10
 *> ZHP   10               List types on next line if 0 < NTYPES < 10
 *> ZSY   11               List types on next line if 0 < NTYPES < 11
 *> ZSR   11               List types on next line if 0 < NTYPES < 11
+*> ZSK   11               List types on next line if 0 < NTYPES < 11
 *> ZSP   11               List types on next line if 0 < NTYPES < 11
 *> ZTR   18               List types on next line if 0 < NTYPES < 18
 *> ZTP   18               List types on next line if 0 < NTYPES < 18
@@ -151,7 +153,7 @@
      $                   RANKVAL( MAXIN ), PIV( NMAX )
       DOUBLE PRECISION   RWORK( 150*NMAX+2*MAXRHS ), S( 2*NMAX )
       COMPLEX*16         A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
-     $                   WORK( NMAX, NMAX+MAXRHS+10 )
+     $                   E( NMAX ),  WORK( NMAX, NMAX+MAXRHS+10 )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME, LSAMEN
@@ -160,14 +162,16 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAREQ, ZCHKEQ, ZCHKGB, ZCHKGE, ZCHKGT, ZCHKHE,
-     $                   ZCHKHE_ROOK, ZCHKHE_AA, ZCHKHP, ZCHKLQ, ZCHKPB,
-     $                   ZCHKPO, ZCHKPS, ZCHKPP, ZCHKPT, ZCHKQ3, ZCHKQL,
-     $                   ZCHKQR, ZCHKRQ, ZCHKSP, ZCHKSY, ZCHKSY_ROOK,
-     $                   ZCHKTB, ZCHKTP, ZCHKTR, ZCHKTZ, ZDRVGB, ZDRVGE,
-     $                   ZDRVGT, ZDRVHE, ZDRVHE_ROOK, ZDRVHE_AA, ZDRVHP,
-     $                   ZDRVLS, ZDRVPB, ZDRVPO, ZDRVPP, ZDRVPT, ZDRVSP,
-     $                   ZDRVSY, ZDRVSY_ROOK, ILAVER, ZCHKQRT, ZCHKQRTP,
-     $                   ZCHKLQT, ZCHKLQTP, ZCHKTSQR
+     $                   ZCHKHE_ROOK, ZCHKHE_RK, ZCHKHE_AA, ZCHKHP,
+     $                   ZCHKLQ, ZCHKPB, ZCHKPO, ZCHKPS, ZCHKPP, ZCHKPT,
+     $                   ZCHKQ3, ZCHKQL, ZCHKQR, ZCHKRQ, ZCHKSP, ZCHKSY,
+     $                   ZCHKSY_ROOK, ZCHKSY_RK, ZCHKSY_AA, ZCHKTB,
+     $                   ZCHKTP, ZCHKTR, ZCHKTZ, ZDRVGB, ZDRVGE, ZDRVGT,
+     $                   ZDRVHE, ZDRVHE_ROOK, ZDRVHE_RK, ZDRVHE_AA,
+     $                   ZDRVHP, ZDRVLS, ZDRVPB, ZDRVPO, ZDRVPP, ZDRVPT,
+     $                   ZDRVSP, ZDRVSY, ZDRVSY_ROOK, ZDRVSY_RK,
+     $                   ZDRVSY_AA, ILAVER, ZCHKQRT, ZCHKQRTP, ZCHKLQT,
+     $                   ZCHKLQTP, ZCHKTSQR
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -640,56 +644,83 @@
          ELSE
             WRITE( NOUT, FMT = 9988 )PATH
          END IF
+
+      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
 *
-      ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
-*
-*        HA:  Hermitian indefinite matrices,
-*             with partial (Aasen's) pivoting algorithm
+*        HR:  Hermitian indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm,
 *
          NTYPES = 10
          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
 *
          IF( TSTCHK ) THEN
-            CALL ZCHKHE_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
-     $                         NSVAL, THRESH, TSTERR, LDA,
-     $                         A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
-     $                         B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
-     $                         WORK, RWORK, IWORK, NOUT )
+            CALL ZCHKHE_ROOK(DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+     $                       THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+     $                       A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+     $                       WORK, RWORK, IWORK, NOUT )
          ELSE
             WRITE( NOUT, FMT = 9989 )PATH
          END IF
 *
          IF( TSTDRV ) THEN
-            CALL ZDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
-     $                         LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
-     $                              B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
-     $                         WORK, RWORK, IWORK, NOUT )
+            CALL ZDRVHE_ROOK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                        LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+     $                        B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+     $                        RWORK, IWORK, NOUT )
          ELSE
             WRITE( NOUT, FMT = 9988 )PATH
          END IF
 *
-      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+      ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
 *
-*        HR:  Hermitian indefinite matrices,
-*             with "rook" (bounded Bunch-Kaufman) pivoting algorithm
+*        HK:  Hermitian indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm,
+*             differnet matrix storage format than HR path version.
 *
          NTYPES = 10
          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
 *
          IF( TSTCHK ) THEN
-            CALL ZCHKHE_ROOK(DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+            CALL ZCHKHE_RK ( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
      $                       THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
-     $                       A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
-     $                       WORK, RWORK, IWORK, NOUT )
+     $                       E, A( 1, 3 ), B( 1, 1 ), B( 1, 2 ),
+     $                       B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
          ELSE
             WRITE( NOUT, FMT = 9989 )PATH
          END IF
 *
          IF( TSTDRV ) THEN
-            CALL ZDRVHE_ROOK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
-     $                        LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
-     $                        B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
-     $                        RWORK, IWORK, NOUT )
+            CALL ZDRVHE_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      LDA, A( 1, 1 ), A( 1, 2 ), E, A( 1, 3 ),
+     $                      B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+     $                      RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9988 )PATH
+         END IF
+*
+      ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
+*
+*        HA:  Hermitian indefinite matrices,
+*             with partial (Aasen's) pivoting algorithm
+*
+         NTYPES = 10
+         CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+         IF( TSTCHK ) THEN
+            CALL ZCHKHE_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
+     $                         NSVAL, THRESH, TSTERR, LDA,
+     $                         A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+     $                         B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+     $                         WORK, RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9989 )PATH
+         END IF
+*
+         IF( TSTDRV ) THEN
+            CALL ZDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                         LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+     $                              B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+     $                         WORK, RWORK, IWORK, NOUT )
          ELSE
             WRITE( NOUT, FMT = 9988 )PATH
          END IF
@@ -748,7 +779,7 @@
       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 *
 *        SR:  symmetric indefinite matrices,
-*             with "rook" (bounded Bunch-Kaufman) pivoting algorithm
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm
 *
          NTYPES = 11
          CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
@@ -771,6 +802,60 @@
             WRITE( NOUT, FMT = 9988 )PATH
          END IF
 *
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        SK:  symmetric indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm,
+*             differnet matrix storage format than SR path version.
+*
+         NTYPES = 11
+         CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+         IF( TSTCHK ) THEN
+            CALL ZCHKSY_RK( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+     $                      THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+     $                      E, A( 1, 3 ), B( 1, 1 ), B( 1, 2 ),
+     $                      B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9989 )PATH
+         END IF
+*
+         IF( TSTDRV ) THEN
+            CALL ZDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      LDA, A( 1, 1 ), A( 1, 2 ), E, A( 1, 3 ),
+     $                      B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+     $                      RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9988 )PATH
+         END IF
+*
+      ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
+*
+*        SK:  symmetric indefinite matrices,
+*             with bounded Bunch-Kaufman (rook) pivoting algorithm,
+*             differnet matrix storage format than SR path version.
+*
+         NTYPES = 11
+         CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+         IF( TSTCHK ) THEN
+            CALL ZCHKSY_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
+     $                      THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
+     $                      A( 1, 3 ), B( 1, 1 ), B( 1, 2 ),
+     $                      B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9989 )PATH
+         END IF
+*
+         IF( TSTDRV ) THEN
+            CALL ZDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+     $                      B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+     $                      RWORK, IWORK, NOUT )
+         ELSE
+            WRITE( NOUT, FMT = 9988 )PATH
+         END IF
+*
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
 *        SP:  symmetric indefinite packed matrices,
diff --git a/TESTING/LIN/zchkhe_aa.f b/TESTING/LIN/zchkhe_aa.f
index 20d595be..5cc4b9ef 100644
--- a/TESTING/LIN/zchkhe_aa.f
+++ b/TESTING/LIN/zchkhe_aa.f
@@ -205,13 +205,13 @@
       PARAMETER          ( NTESTS = 9 )
 *     ..
 *     .. Local Scalars ..
-      LOGICAL            TRFCON, ZEROT
+      LOGICAL            ZEROT
       CHARACTER          DIST, TYPE, UPLO, XTYPE
       CHARACTER*3        PATH, MATPATH
       INTEGER            I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
      $                   IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
      $                   N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
-      DOUBLE PRECISION   ANORM, CNDNUM, RCOND, RCONDC
+      DOUBLE PRECISION   ANORM, CNDNUM
 *     ..
 *     .. Local Arrays ..
       CHARACTER          UPLOS( 2 )
@@ -224,7 +224,7 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAERH, ALAHD, ALASUM, XLAENV, ZERRHE, ZGET04,
-     $                   ZHECON, ZHERFS, ZHET01, ZHETRF_AA, ZHETRI2,
+     $                   ZHECON, ZHERFS, ZHET01_AA, ZHETRF_AA, ZHETRI2,
      $                   ZHETRS_AA, ZLACPY, ZLAIPD, ZLARHS, ZLATB4,
      $                   ZLATMS, ZPOT02, ZPOT03, ZPOT05
 *     ..
@@ -430,10 +430,10 @@
 *                 the block structure of D. AINV is a work array for
 *                 block factorization, LWORK is the length of AINV.
 *
-                  LWORK = ( NB+1 )*LDA
+                  LWORK = MAX( 1, ( NB+1 )*LDA )
                   SRNAMT = 'ZHETRF_AA'
                   CALL ZHETRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
-     $                               LWORK, INFO )
+     $                            LWORK, INFO )
 *
 *                 Adjust the expected value of INFO to account for
 *                 pivoting.
@@ -463,19 +463,11 @@
      $                            NOUT )
                   END IF
 *
-*                 Set the condition estimate flag if the INFO is not 0.
-*
-                  IF( INFO.NE.0 ) THEN
-                     TRFCON = .TRUE.
-                  ELSE
-                     TRFCON = .FALSE.
-                  END IF
-*
 *+    TEST 1
 *                 Reconstruct matrix from factors and compute residual.
 *
                   CALL ZHET01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
-     $                               AINV, LDA, RWORK, RESULT( 1 ) )
+     $                            AINV, LDA, RWORK, RESULT( 1 ) )
                   NT = 1
 *
 *
@@ -493,10 +485,9 @@
   110             CONTINUE
                   NRUN = NRUN + NT
 *
-*                 Do only the condition estimate if INFO is not 0.
+*                 Skip solver test if INFO is not 0.
 *
-                  IF( TRFCON ) THEN
-                     RCONDC = ZERO
+                  IF( INFO.NE.0 ) THEN
                      GO TO 140
                   END IF
 *
@@ -505,7 +496,7 @@
                   DO 130 IRHS = 1, NNS
                      NRHS = NSVAL( IRHS )
 *
-*+    TEST 3 (Using TRS)
+*+    TEST 2 (Using TRS)
 *                 Solve and compute residual for  A * X = B.
 *
 *                    Choose a set of NRHS random solution vectors
@@ -518,9 +509,9 @@
                      CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
 *
                      SRNAMT = 'ZHETRS_AA'
-                     LWORK = 3*N-2
+                     LWORK = MAX( 1, 3*N-2 )
                      CALL ZHETRS_AA( UPLO, N, NRHS, AFAC, LDA, IWORK,
-     $                                  X, LDA, WORK, LWORK, INFO )
+     $                               X, LDA, WORK, LWORK, INFO )
 *
 *                    Check error code from ZHETRS and handle error.
 *
diff --git a/TESTING/LIN/zchkhe_rk.f b/TESTING/LIN/zchkhe_rk.f
new file mode 100644
index 00000000..6c05245f
--- /dev/null
+++ b/TESTING/LIN/zchkhe_rk.f
@@ -0,0 +1,859 @@
+*> \brief \b ZCHKHE_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZCHKHE_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+*                             THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
+*                             XACT, WORK, RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NNB, NNS, NOUT
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+*       DOUBLE PRECISION   RWORK( * )
+*       COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+*      $                   WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZCHKHE_RK tests ZHETRF_RK, -TRI_3, -TRS_3,
+*> and -CON_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*>          NNB is INTEGER
+*>          The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*>          NBVAL is INTEGER array, dimension (NBVAL)
+*>          The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*>          NNS is INTEGER
+*>          The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*>          NSVAL is INTEGER array, dimension (NNS)
+*>          The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is DOUBLE PRECISION
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is CCOMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is CCOMPLEX*16 array, dimension (NMAX*NSMAX)
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (max(NMAX,2*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup complex16_lin
+*
+*  =====================================================================
+      SUBROUTINE ZCHKHE_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+     $                      THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+     $                      X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NNB, NNS, NOUT
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+      DOUBLE PRECISION   RWORK( * )
+      COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      DOUBLE PRECISION   ONEHALF
+      PARAMETER          ( ONEHALF = 0.5D+0 )
+      DOUBLE PRECISION   EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
+      COMPLEX*16         CZERO
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
+      INTEGER            NTYPES
+      PARAMETER          ( NTYPES = 10 )
+      INTEGER            NTESTS
+      PARAMETER          ( NTESTS = 7 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            TRFCON, ZEROT
+      CHARACTER          DIST, TYPE, UPLO, XTYPE
+      CHARACTER*3        PATH, MATPATH
+      INTEGER            I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+     $                   ITEMP, ITEMP2, IUPLO, IZERO, J, K, KL, KU, LDA,
+     $                   LWORK, MODE, N, NB, NERRS, NFAIL, NIMAT, NRHS,
+     $                   NRUN, NT
+      DOUBLE PRECISION   ALPHA, ANORM, CNDNUM, CONST, SING_MAX,
+     $                   SING_MIN, RCOND, RCONDC, DTEMP
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 ), IDUMMY( 1 )
+      DOUBLE PRECISION   RESULT( NTESTS )
+      COMPLEX*16         BLOCK( 2, 2 ), ZDUMMY( 1 )
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DGET06, ZLANGE, ZLANHE
+      EXTERNAL           DGET06, ZLANGE, ZLANHE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALAERH, ALAHD, ALASUM, ZERRHE, ZGESVD, ZGET04,
+     $                   ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZPOT02, ZPOT03,
+     $                   ZHECON_3, ZHET01_3, ZHETRF_RK, ZHETRI_3,
+     $                   ZHETRS_3, XLAENV
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG, MAX, MIN, SQRT
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Zomplex precision'
+      PATH( 2: 3 ) = 'HK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Zomplex precision'
+      MATPATH( 2: 3 ) = 'HE'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL ZERRHE( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the minimum block size for which the block routine should
+*     be used, which will be later returned by ILAENV
+*
+      CALL XLAENV( 2, 2 )
+*
+*     Do for each value of N in NVAL
+*
+      DO 270 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         IZERO = 0
+*
+*        Do for each value of matrix type IMAT
+*
+         DO 260 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 260
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 260
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 250 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*                 Begin generate the test matrix A.
+*
+*                 Set up parameters with ZLATB4 for the matrix generator
+*                 based on the type of matrix to be generated.
+*
+                  CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                         MODE, CNDNUM, DIST )
+*
+*                 Generate a matrix with ZLATMS.
+*
+                  SRNAMT = 'ZLATMS'
+                  CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                         CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+     $                         WORK, INFO )
+*
+*                 Check error code from ZLATMS and handle error.
+*
+                  IF( INFO.NE.0 ) THEN
+                     CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
+     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+*                    Skip all tests for this generated matrix
+*
+                     GO TO 250
+                  END IF
+*
+*                 For matrix types 3-6, zero one or more rows and
+*                 columns of the matrix to test that INFO is returned
+*                 correctly.
+*
+                  IF( ZEROT ) THEN
+                     IF( IMAT.EQ.3 ) THEN
+                        IZERO = 1
+                     ELSE IF( IMAT.EQ.4 ) THEN
+                        IZERO = N
+                     ELSE
+                        IZERO = N / 2 + 1
+                     END IF
+*
+                     IF( IMAT.LT.6 ) THEN
+*
+*                       Set row and column IZERO to zero.
+*
+                        IF( IUPLO.EQ.1 ) THEN
+                           IOFF = ( IZERO-1 )*LDA
+                           DO 20 I = 1, IZERO - 1
+                              A( IOFF+I ) = CZERO
+   20                      CONTINUE
+                           IOFF = IOFF + IZERO
+                           DO 30 I = IZERO, N
+                              A( IOFF ) = CZERO
+                              IOFF = IOFF + LDA
+   30                      CONTINUE
+                        ELSE
+                           IOFF = IZERO
+                           DO 40 I = 1, IZERO - 1
+                              A( IOFF ) = CZERO
+                              IOFF = IOFF + LDA
+   40                      CONTINUE
+                           IOFF = IOFF - IZERO
+                           DO 50 I = IZERO, N
+                              A( IOFF+I ) = CZERO
+   50                      CONTINUE
+                        END IF
+                     ELSE
+                        IF( IUPLO.EQ.1 ) THEN
+*
+*                          Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 70 J = 1, N
+                              I2 = MIN( J, IZERO )
+                              DO 60 I = 1, I2
+                                 A( IOFF+I ) = CZERO
+   60                         CONTINUE
+                              IOFF = IOFF + LDA
+   70                      CONTINUE
+                        ELSE
+*
+*                          Set the last IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 90 J = 1, N
+                              I1 = MAX( J, IZERO )
+                              DO 80 I = I1, N
+                                 A( IOFF+I ) = CZERO
+   80                         CONTINUE
+                              IOFF = IOFF + LDA
+   90                      CONTINUE
+                        END IF
+                     END IF
+                  ELSE
+                     IZERO = 0
+                  END IF
+*
+*                 End generate the test matrix A.
+*
+*
+*              Do for each value of NB in NBVAL
+*
+               DO 240 INB = 1, NNB
+*
+*                 Set the optimal blocksize, which will be later
+*                 returned by ILAENV.
+*
+                  NB = NBVAL( INB )
+                  CALL XLAENV( 1, NB )
+*
+*                 Copy the test matrix A into matrix AFAC which
+*                 will be factorized in place. This is needed to
+*                 preserve the test matrix A for subsequent tests.
+*
+                  CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+*                 Compute the L*D*L**T or U*D*U**T factorization of the
+*                 matrix. IWORK stores details of the interchanges and
+*                 the block structure of D. AINV is a work array for
+*                 block factorization, LWORK is the length of AINV.
+*
+                  LWORK = MAX( 2, NB )*LDA
+                  SRNAMT = 'ZHETRF_RK'
+                  CALL ZHETRF_RK( UPLO, N, AFAC, LDA, E, IWORK, AINV,
+     $                            LWORK, INFO )
+*
+*                 Adjust the expected value of INFO to account for
+*                 pivoting.
+*
+                  K = IZERO
+                  IF( K.GT.0 ) THEN
+  100                CONTINUE
+                     IF( IWORK( K ).LT.0 ) THEN
+                        IF( IWORK( K ).NE.-K ) THEN
+                           K = -IWORK( K )
+                           GO TO 100
+                        END IF
+                     ELSE IF( IWORK( K ).NE.K ) THEN
+                        K = IWORK( K )
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Check error code from ZHETRF_RK and handle error.
+*
+                  IF( INFO.NE.K)
+     $               CALL ALAERH( PATH, 'ZHETRF_RK', INFO, K,
+     $                            UPLO, N, N, -1, -1, NB, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Set the condition estimate flag if the INFO is not 0.
+*
+                  IF( INFO.NE.0 ) THEN
+                     TRFCON = .TRUE.
+                  ELSE
+                     TRFCON = .FALSE.
+                  END IF
+*
+*+    TEST 1
+*                 Reconstruct matrix from factors and compute residual.
+*
+                  CALL ZHET01_3( UPLO, N, A, LDA, AFAC, LDA, E, IWORK,
+     $                           AINV, LDA, RWORK, RESULT( 1 ) )
+                  NT = 1
+*
+*+    TEST 2
+*                 Form the inverse and compute the residual,
+*                 if the factorization was competed without INFO > 0
+*                 (i.e. there is no zero rows and columns).
+*                 Do it only for the first block size.
+*
+                  IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN
+                     CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     SRNAMT = 'ZHETRI_3'
+*
+*                    Another reason that we need to compute the invesrse
+*                    is that ZPOT03 produces RCONDC which is used later
+*                    in TEST6 and TEST7.
+*
+                     LWORK = (N+NB+1)*(NB+3)
+                     CALL ZHETRI_3( UPLO, N, AINV, LDA, E, IWORK, WORK,
+     $                              LWORK, INFO )
+*
+*                    Check error code from ZHETRI_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'ZHETRI_3', INFO, -1,
+     $                               UPLO, N, N, -1, -1, -1, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+*                    Compute the residual for a Hermitian matrix times
+*                    its inverse.
+*
+                     CALL ZPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
+     $                            RWORK, RCONDC, RESULT( 2 ) )
+                     NT = 2
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 110 K = 1, NT
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  110             CONTINUE
+                  NRUN = NRUN + NT
+*
+*+    TEST 3
+*                 Compute largest element in U or L
+*
+                  RESULT( 3 ) = ZERO
+                  DTEMP = ZERO
+*
+                  CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) ) /
+     $                    ( ONE-ALPHA )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                 Compute largest element in U
+*
+                     K = N
+  120                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 130
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in U
+*
+                        DTEMP = ZLANGE( 'M', K-1, 1,
+     $                          AFAC( ( K-1 )*LDA+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k-1 in U
+*
+                        DTEMP = ZLANGE( 'M', K-2, 2,
+     $                          AFAC( ( K-2 )*LDA+1 ), LDA, RWORK )
+                        K = K - 1
+*
+                     END IF
+*
+*                    DTEMP should be bounded by CONST
+*
+                     DTEMP = DTEMP - CONST + THRESH
+                     IF( DTEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = DTEMP
+*
+                     K = K - 1
+*
+                     GO TO 120
+  130                CONTINUE
+*
+                  ELSE
+*
+*                 Compute largest element in L
+*
+                     K = 1
+  140                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 150
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in L
+*
+                        DTEMP = ZLANGE( 'M', N-K, 1,
+     $                          AFAC( ( K-1 )*LDA+K+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k+1 in L
+*
+                        DTEMP = ZLANGE( 'M', N-K-1, 2,
+     $                          AFAC( ( K-1 )*LDA+K+2 ), LDA, RWORK )
+                        K = K + 1
+*
+                     END IF
+*
+*                    DTEMP should be bounded by CONST
+*
+                     DTEMP = DTEMP - CONST + THRESH
+                     IF( DTEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = DTEMP
+*
+                     K = K + 1
+*
+                     GO TO 140
+  150                CONTINUE
+                  END IF
+*
+*
+*+    TEST 4
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
+*
+                  RESULT( 4 ) = ZERO
+                  DTEMP = ZERO
+*
+                  CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) )*
+     $                    ( ( ONE + ALPHA ) / ( ONE - ALPHA ) )
+                  CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                    Loop backward for UPLO = 'U'
+*
+                     K = N
+  160                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 170
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
+                        BLOCK( 1, 2 ) = E( K )
+                        BLOCK( 2, 1 ) = DCONJG( BLOCK( 1, 2 ) )
+                        BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
+*
+                        CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               ZDUMMY, 1, ZDUMMY, 1,
+     $                               WORK, 6, RWORK( 3 ), INFO )
+*
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        DTEMP = SING_MAX / SING_MIN
+*
+*                       DTEMP should be bounded by CONST
+*
+                        DTEMP = DTEMP - CONST + THRESH
+                        IF( DTEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = DTEMP
+                        K = K - 1
+*
+                     END IF
+*
+                     K = K - 1
+*
+                     GO TO 160
+  170                CONTINUE
+*
+                  ELSE
+*
+*                    Loop forward for UPLO = 'L'
+*
+                     K = 1
+  180                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 190
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K )
+                        BLOCK( 2, 1 ) = E( K )
+                        BLOCK( 1, 2 ) = DCONJG( BLOCK( 2, 1 ) )
+                        BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 )
+*
+                        CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               ZDUMMY, 1, ZDUMMY, 1,
+     $                               WORK, 6, RWORK(3), INFO )
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        DTEMP = SING_MAX / SING_MIN
+*
+*                       DTEMP should be bounded by CONST
+*
+                        DTEMP = DTEMP - CONST + THRESH
+                        IF( DTEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = DTEMP
+                        K = K + 1
+*
+                     END IF
+*
+                     K = K + 1
+*
+                     GO TO 180
+  190                CONTINUE
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 200 K = 3, 4
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  200             CONTINUE
+                  NRUN = NRUN + 2
+*
+*                 Skip the other tests if this is not the first block
+*                 size.
+*
+                  IF( INB.GT.1 )
+     $               GO TO 240
+*
+*                 Do only the condition estimate if INFO is not 0.
+*
+                  IF( TRFCON ) THEN
+                     RCONDC = ZERO
+                     GO TO 230
+                  END IF
+*
+*                 Do for each value of NRHS in NSVAL.
+*
+                  DO 220 IRHS = 1, NNS
+                     NRHS = NSVAL( IRHS )
+*
+*                    Begin loop over NRHS values
+*
+*
+*+    TEST 5 ( Using TRS_3)
+*                 Solve and compute residual for  A * X = B.
+*
+*                    Choose a set of NRHS random solution vectors
+*                    stored in XACT and set up the right hand side B
+*
+                     SRNAMT = 'ZLARHS'
+                     CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+     $                            KL, KU, NRHS, A, LDA, XACT, LDA,
+     $                            B, LDA, ISEED, INFO )
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+                     SRNAMT = 'ZHETRS_3'
+                     CALL ZHETRS_3( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, INFO )
+*
+*                    Check error code from ZHETRS_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'ZHETRS_3', INFO, 0,
+     $                               UPLO, N, N, -1, -1, NRHS, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+*
+*                    Compute the residual for the solution
+*
+                     CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 5 ) )
+*
+*+    TEST 6
+*                 Check solution from generated exact solution.
+*
+                     CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 6 ) )
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 210 K = 5, 6
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALAHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+     $                        IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  210                CONTINUE
+                     NRUN = NRUN + 2
+*
+*                 End do for each value of NRHS in NSVAL.
+*
+  220             CONTINUE
+*
+*+    TEST 7
+*                 Get an estimate of RCOND = 1/CNDNUM.
+*
+  230             CONTINUE
+                  ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
+                  SRNAMT = 'ZHECON_3'
+                  CALL ZHECON_3( UPLO, N, AFAC, LDA, E, IWORK, ANORM,
+     $                           RCOND, WORK, INFO )
+*
+*                 Check error code from ZHECON_3 and handle error.
+*
+                  IF( INFO.NE.0 )
+     $               CALL ALAERH( PATH, 'ZHECON_3', INFO, 0,
+     $                            UPLO, N, N, -1, -1, -1, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Compute the test ratio to compare values of RCOND
+*
+                  RESULT( 7 ) = DGET06( RCOND, RCONDC )
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  IF( RESULT( 7 ).GE.THRESH ) THEN
+                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                  CALL ALAHD( NOUT, PATH )
+                     WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 7,
+     $                  RESULT( 7 )
+                     NFAIL = NFAIL + 1
+                  END IF
+                  NRUN = NRUN + 1
+  240          CONTINUE
+*
+  250       CONTINUE
+  260    CONTINUE
+  270 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+     $      I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+     $      I2, ', test ', I2, ', ratio =', G12.5 )
+ 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
+     $      ', test ', I2, ', ratio =', G12.5 )
+      RETURN
+*
+*     End of ZCHKHE_RK
+*
+      END
diff --git a/TESTING/LIN/zchksy_aa.f b/TESTING/LIN/zchksy_aa.f
new file mode 100644
index 00000000..4c2cd041
--- /dev/null
+++ b/TESTING/LIN/zchksy_aa.f
@@ -0,0 +1,572 @@
+*> \brief \b ZCHKSY_AA
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+*                             THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
+*                             XACT, WORK, RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NNB, NNS, NOUT
+*       COMPLEX*16         THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+*       COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ),
+*      $                   RWORK( * ), WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZCHKSY_AA tests ZSYTRF_AA, -TRS_AA.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*>          NNB is INTEGER
+*>          The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*>          NBVAL is INTEGER array, dimension (NBVAL)
+*>          The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*>          NNS is INTEGER
+*>          The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*>          NSVAL is INTEGER array, dimension (NNS)
+*>          The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is COMPLEX*16
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is COMPLEX*16 array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*  @generated from LIN/dchksy_aa.f, fortran d -> z, Wed Nov 16 21:34:18 2016
+*
+*> \ingroup complex16_lin
+*
+*  =====================================================================
+      SUBROUTINE ZCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+     $                      THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
+     $                      X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+      IMPLICIT NONE
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NN, NNB, NNS, NMAX, NOUT
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+      DOUBLE PRECISION   RWORK( * )
+      COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D+0 )
+      COMPLEX*16         CZERO
+      PARAMETER          ( CZERO = 0.0E+0 )
+      INTEGER            NTYPES
+      PARAMETER          ( NTYPES = 10 )
+      INTEGER            NTESTS
+      PARAMETER          ( NTESTS = 9 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ZEROT
+      CHARACTER          DIST, TYPE, UPLO, XTYPE
+      CHARACTER*3        PATH, MATPATH
+      INTEGER            I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+     $                   IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
+     $                   N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
+      DOUBLE PRECISION   ANORM, CNDNUM
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      DOUBLE PRECISION   RESULT( NTESTS )
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DGET06, ZLANSY
+      EXTERNAL           DGET06, ZLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALAERH, ALAHD, ALASUM, ZERRSY, ZGET04, ZLACPY,
+     $                   ZLARHS, ZLATB4, ZLATMS, ZSYT02, DSYT03, DSYT05,
+     $                   DSYCON, ZSYRFS, ZSYT01_AA, ZSYTRF_AA,
+     $                   DSYTRI2, ZSYTRS_AA, XLAENV
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Zomplex precision'
+      PATH( 2: 3 ) = 'SA'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Zomplex precision'
+      MATPATH( 2: 3 ) = 'SY'
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL ZERRSY( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the minimum block size for which the block routine should
+*     be used, which will be later returned by ILAENV
+*
+      CALL XLAENV( 2, 2 )
+*
+*     Do for each value of N in NVAL
+*
+      DO 180 IN = 1, NN
+         N = NVAL( IN )
+         IF( N .GT. NMAX ) THEN
+            NFAIL = NFAIL + 1
+            WRITE(NOUT, 9995) 'M ', N, NMAX
+            GO TO 180
+         END IF
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         IZERO = 0
+*
+*        Do for each value of matrix type IMAT
+*
+         DO 170 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 170
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 170
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 160 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*              Begin generate the test matrix A.
+*
+*
+*              Set up parameters with ZLATB4 for the matrix generator
+*              based on the type of matrix to be generated.
+*
+               CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
+     $                      ANORM, MODE, CNDNUM, DIST )
+*
+*              Generate a matrix with ZLATMS.
+*
+               SRNAMT = 'ZLATMS'
+               CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+     $                      INFO )
+*
+*              Check error code from ZLATMS and handle error.
+*
+               IF( INFO.NE.0 ) THEN
+                  CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
+     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+*                    Skip all tests for this generated matrix
+*
+                  GO TO 160
+               END IF
+*
+*              For matrix types 3-6, zero one or more rows and
+*              columns of the matrix to test that INFO is returned
+*              correctly.
+*
+               IF( ZEROT ) THEN
+                  IF( IMAT.EQ.3 ) THEN
+                     IZERO = 1
+                  ELSE IF( IMAT.EQ.4 ) THEN
+                     IZERO = N
+                  ELSE
+                     IZERO = N / 2 + 1
+                  END IF
+*
+                  IF( IMAT.LT.6 ) THEN
+*
+*                    Set row and column IZERO to zero.
+*
+                     IF( IUPLO.EQ.1 ) THEN
+                        IOFF = ( IZERO-1 )*LDA
+                        DO 20 I = 1, IZERO - 1
+                           A( IOFF+I ) = CZERO
+   20                   CONTINUE
+                        IOFF = IOFF + IZERO
+                        DO 30 I = IZERO, N
+                           A( IOFF ) = CZERO
+                           IOFF = IOFF + LDA
+   30                   CONTINUE
+                     ELSE
+                        IOFF = IZERO
+                        DO 40 I = 1, IZERO - 1
+                           A( IOFF ) = CZERO
+                           IOFF = IOFF + LDA
+   40                   CONTINUE
+                        IOFF = IOFF - IZERO
+                        DO 50 I = IZERO, N
+                           A( IOFF+I ) = CZERO
+   50                   CONTINUE
+                     END IF
+                  ELSE
+                     IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                        IOFF = 0
+                        DO 70 J = 1, N
+                           I2 = MIN( J, IZERO )
+                           DO 60 I = 1, I2
+                              A( IOFF+I ) = CZERO
+   60                      CONTINUE
+                           IOFF = IOFF + LDA
+   70                   CONTINUE
+                        IZERO = 1
+                     ELSE
+*
+*                       Set the last IZERO rows and columns to zero.
+*
+                        IOFF = 0
+                        DO 90 J = 1, N
+                           I1 = MAX( J, IZERO )
+                           DO 80 I = I1, N
+                              A( IOFF+I ) = CZERO
+   80                      CONTINUE
+                           IOFF = IOFF + LDA
+   90                   CONTINUE
+                     END IF
+                  END IF
+               ELSE
+                  IZERO = 0
+               END IF
+*
+*              End generate the test matrix A.
+*
+*              Do for each value of NB in NBVAL
+*
+               DO 150 INB = 1, NNB
+*
+*                 Set the optimal blocksize, which will be later
+*                 returned by ILAENV.
+*
+                  NB = NBVAL( INB )
+                  CALL XLAENV( 1, NB )
+*
+*                 Copy the test matrix A into matrix AFAC which
+*                 will be factorized in place. This is needed to
+*                 preserve the test matrix A for subsequent tests.
+*
+                  CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+*                 Compute the L*D*L**T or U*D*U**T factorization of the
+*                 matrix. IWORK stores details of the interchanges and
+*                 the block structure of D. AINV is a work array for
+*                 block factorization, LWORK is the length of AINV.
+*
+                  SRNAMT = 'ZSYTRF_AA'
+                  LWORK = MAX( 1, N*NB + N )
+                  CALL ZSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV,
+     $                            LWORK, INFO )
+*
+*                 Adjust the expected value of INFO to account for
+*                 pivoting.
+*
+                  IF( IZERO.GT.0 ) THEN
+                     J = 1
+                     K = IZERO
+  100                CONTINUE
+                     IF( J.EQ.K ) THEN
+                        K = IWORK( J )
+                     ELSE IF( IWORK( J ).EQ.K ) THEN
+                        K = J
+                     END IF
+                     IF( J.LT.K ) THEN
+                        J = J + 1
+                        GO TO 100
+                     END IF
+                  ELSE
+                     K = 0
+                  END IF
+*
+*                 Check error code from ZSYTRF and handle error.
+*
+                  IF( INFO.NE.K ) THEN
+                     CALL ALAERH( PATH, 'ZSYTRF_AA', INFO, K, UPLO,
+     $                            N, N, -1, -1, NB, IMAT, NFAIL, NERRS,
+     $                            NOUT )
+                  END IF
+*
+*+    TEST 1
+*                 Reconstruct matrix from factors and compute residual.
+*
+                  CALL ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
+     $                            AINV, LDA, RWORK, RESULT( 1 ) )
+                  NT = 1
+*
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 110 K = 1, NT
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  110             CONTINUE
+                  NRUN = NRUN + NT
+*
+*                 Skip solver test if INFO is not 0.
+*
+                  IF( INFO.NE.0 ) THEN
+                     GO TO 140
+                  END IF
+*
+*                 Do for each value of NRHS in NSVAL.
+*
+                  DO 130 IRHS = 1, NNS
+                     NRHS = NSVAL( IRHS )
+*
+*+    TEST 2 (Using TRS)
+*                 Solve and compute residual for  A * X = B.
+*
+*                    Choose a set of NRHS random solution vectors
+*                    stored in XACT and set up the right hand side B
+*
+                     SRNAMT = 'ZLARHS'
+                     CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+     $                            KL, KU, NRHS, A, LDA, XACT, LDA,
+     $                            B, LDA, ISEED, INFO )
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+                     SRNAMT = 'ZSYTRS_AA'
+                     LWORK = MAX( 1, 3*N-2 )
+                     CALL ZSYTRS_AA( UPLO, N, NRHS, AFAC, LDA,
+     $                                  IWORK, X, LDA, WORK, LWORK,
+     $                                  INFO )
+*
+*                    Check error code from ZSYTRS and handle error.
+*
+                     IF( INFO.NE.0 ) THEN
+                        CALL ALAERH( PATH, 'ZSYTRS_AA', INFO, 0,
+     $                               UPLO, N, N, -1, -1, NRHS, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+                     END IF
+*
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+*
+*                    Compute the residual for the solution
+*
+                     CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 2 ) )
+*
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 120 K = 2, 2
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALAHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+     $                        IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  120                CONTINUE
+                     NRUN = NRUN + 1
+*
+*                 End do for each value of NRHS in NSVAL.
+*
+  130             CONTINUE
+  140             CONTINUE
+  150          CONTINUE
+  160       CONTINUE
+  170    CONTINUE
+  180 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+     $      I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+     $      I2, ', test(', I2, ') =', G12.5 )
+ 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
+     $      I6 )
+      RETURN
+*
+*     End of ZCHKSY_AA
+*
+      END
diff --git a/TESTING/LIN/zchksy_rk.f b/TESTING/LIN/zchksy_rk.f
new file mode 100644
index 00000000..b8c62e57
--- /dev/null
+++ b/TESTING/LIN/zchksy_rk.f
@@ -0,0 +1,867 @@
+*> \brief \b ZCHKSY_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZCHKSY_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+*                             THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+*                             X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NNB, NNS, NOUT
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+*       DOUBLE PRECISION   RWORK( * )
+*       COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+*      $                   WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZCHKSY_RK tests ZSYTRF_RK, -TRI_3, -TRS_3,
+*> and -CON_3.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*>          NNB is INTEGER
+*>          The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*>          NBVAL is INTEGER array, dimension (NBVAL)
+*>          The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*>          NNS is INTEGER
+*>          The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*>          NSVAL is INTEGER array, dimension (NNS)
+*>          The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is DOUBLE PRECISION
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*>          where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup complex16_lin
+*
+*  =====================================================================
+      SUBROUTINE ZCHKSY_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
+     $                      THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
+     $                      X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NNB, NNS, NOUT
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+      DOUBLE PRECISION   RWORK( * )
+      COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      DOUBLE PRECISION   ONEHALF
+      PARAMETER          ( ONEHALF = 0.5D+0 )
+      DOUBLE PRECISION   EIGHT, SEVTEN
+      PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
+      COMPLEX*16         CZERO
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
+      INTEGER            NTYPES
+      PARAMETER          ( NTYPES = 11 )
+      INTEGER            NTESTS
+      PARAMETER          ( NTESTS = 7 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            TRFCON, ZEROT
+      CHARACTER          DIST, TYPE, UPLO, XTYPE
+      CHARACTER*3        PATH, MATPATH
+      INTEGER            I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+     $                   ITEMP, ITEMP2, IUPLO, IZERO, J, K, KL, KU, LDA,
+     $                   LWORK, MODE, N, NB, NERRS, NFAIL, NIMAT, NRHS,
+     $                   NRUN, NT
+      DOUBLE PRECISION   ALPHA, ANORM, CNDNUM, CONST, DTEMP, SING_MAX,
+     $                   SING_MIN, RCOND, RCONDC
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      DOUBLE PRECISION   RESULT( NTESTS )
+      COMPLEX*16         BLOCK( 2, 2 ), ZDUMMY( 1 )
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DGET06, ZLANGE, ZLANSY
+      EXTERNAL           DGET06, ZLANGE, ZLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALAERH, ALAHD, ALASUM, ZERRSY, ZGESVD, ZGET04,
+     $                   ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLATSY, ZSYT02,
+     $                   ZSYT03, ZSYCON_3, ZSYT01_3, ZSYTRF_RK,
+     $                   ZSYTRI_3, ZSYTRS_3, XLAENV
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN, SQRT
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Zomplex precision'
+      PATH( 2: 3 ) = 'SK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Zomplex precision'
+      MATPATH( 2: 3 ) = 'SY'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL ZERRSY( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the minimum block size for which the block routine should
+*     be used, which will be later returned by ILAENV
+*
+      CALL XLAENV( 2, 2 )
+*
+*     Do for each value of N in NVAL
+*
+      DO 270 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         IZERO = 0
+*
+*        Do for each value of matrix type IMAT
+*
+         DO 260 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 260
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 260
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 250 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*              Begin generate test matrix A.
+*
+               IF( IMAT.NE.NTYPES ) THEN
+*
+*                 Set up parameters with ZLATB4 for the matrix generator
+*                 based on the type of matrix to be generated.
+*
+                  CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                         MODE, CNDNUM, DIST )
+*
+*                 Generate a matrix with ZLATMS.
+*
+                  SRNAMT = 'ZLATMS'
+                  CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                         CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+     $                         WORK, INFO )
+*
+*                 Check error code from ZLATMS and handle error.
+*
+                  IF( INFO.NE.0 ) THEN
+                     CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
+     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+*                    Skip all tests for this generated matrix
+*
+                     GO TO 250
+                  END IF
+*
+*                 For matrix types 3-6, zero one or more rows and
+*                 columns of the matrix to test that INFO is returned
+*                 correctly.
+*
+                  IF( ZEROT ) THEN
+                     IF( IMAT.EQ.3 ) THEN
+                        IZERO = 1
+                     ELSE IF( IMAT.EQ.4 ) THEN
+                        IZERO = N
+                     ELSE
+                        IZERO = N / 2 + 1
+                     END IF
+*
+                     IF( IMAT.LT.6 ) THEN
+*
+*                    Set row and column IZERO to zero.
+*
+                        IF( IUPLO.EQ.1 ) THEN
+                           IOFF = ( IZERO-1 )*LDA
+                           DO 20 I = 1, IZERO - 1
+                              A( IOFF+I ) = CZERO
+   20                      CONTINUE
+                           IOFF = IOFF + IZERO
+                           DO 30 I = IZERO, N
+                              A( IOFF ) = CZERO
+                              IOFF = IOFF + LDA
+   30                      CONTINUE
+                        ELSE
+                           IOFF = IZERO
+                           DO 40 I = 1, IZERO - 1
+                              A( IOFF ) = CZERO
+                              IOFF = IOFF + LDA
+   40                      CONTINUE
+                           IOFF = IOFF - IZERO
+                           DO 50 I = IZERO, N
+                              A( IOFF+I ) = CZERO
+   50                      CONTINUE
+                        END IF
+                     ELSE
+                        IF( IUPLO.EQ.1 ) THEN
+*
+*                          Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 70 J = 1, N
+                              I2 = MIN( J, IZERO )
+                              DO 60 I = 1, I2
+                                 A( IOFF+I ) = CZERO
+   60                         CONTINUE
+                              IOFF = IOFF + LDA
+   70                      CONTINUE
+                        ELSE
+*
+*                          Set the last IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 90 J = 1, N
+                              I1 = MAX( J, IZERO )
+                              DO 80 I = I1, N
+                                 A( IOFF+I ) = CZERO
+   80                         CONTINUE
+                              IOFF = IOFF + LDA
+   90                      CONTINUE
+                        END IF
+                     END IF
+                  ELSE
+                     IZERO = 0
+                  END IF
+*
+               ELSE
+*
+*                 For matrix kind IMAT = 11, generate special block
+*                 diagonal matrix to test alternate code
+*                 for the 2 x 2 blocks.
+*
+                  CALL ZLATSY( UPLO, N, A, LDA, ISEED )
+*
+               END IF
+*
+*              End generate test matrix A.
+*
+*
+*              Do for each value of NB in NBVAL
+*
+               DO 240 INB = 1, NNB
+*
+*                 Set the optimal blocksize, which will be later
+*                 returned by ILAENV.
+*
+                  NB = NBVAL( INB )
+                  CALL XLAENV( 1, NB )
+*
+*                 Copy the test matrix A into matrix AFAC which
+*                 will be factorized in place. This is needed to
+*                 preserve the test matrix A for subsequent tests.
+*
+                  CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+*                 Compute the L*D*L**T or U*D*U**T factorization of the
+*                 matrix. IWORK stores details of the interchanges and
+*                 the block structure of D. AINV is a work array for
+*                 block factorization, LWORK is the length of AINV.
+*
+                  LWORK = MAX( 2, NB )*LDA
+                  SRNAMT = 'ZSYTRF_RK'
+                  CALL ZSYTRF_RK( UPLO, N, AFAC, LDA, E, IWORK, AINV,
+     $                            LWORK, INFO )
+*
+*                 Adjust the expected value of INFO to account for
+*                 pivoting.
+*
+                  K = IZERO
+                  IF( K.GT.0 ) THEN
+  100                CONTINUE
+                     IF( IWORK( K ).LT.0 ) THEN
+                        IF( IWORK( K ).NE.-K ) THEN
+                           K = -IWORK( K )
+                           GO TO 100
+                        END IF
+                     ELSE IF( IWORK( K ).NE.K ) THEN
+                        K = IWORK( K )
+                        GO TO 100
+                     END IF
+                  END IF
+*
+*                 Check error code from ZSYTRF_RK and handle error.
+*
+                  IF( INFO.NE.K)
+     $               CALL ALAERH( PATH, 'ZSYTRF_RK', INFO, K,
+     $                            UPLO, N, N, -1, -1, NB, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Set the condition estimate flag if the INFO is not 0.
+*
+                  IF( INFO.NE.0 ) THEN
+                     TRFCON = .TRUE.
+                  ELSE
+                     TRFCON = .FALSE.
+                  END IF
+*
+*+    TEST 1
+*                 Reconstruct matrix from factors and compute residual.
+*
+                  CALL ZSYT01_3( UPLO, N, A, LDA, AFAC, LDA, E, IWORK,
+     $                           AINV, LDA, RWORK, RESULT( 1 ) )
+                  NT = 1
+*
+*+    TEST 2
+*                 Form the inverse and compute the residual,
+*                 if the factorization was competed without INFO > 0
+*                 (i.e. there is no zero rows and columns).
+*                 Do it only for the first block size.
+*
+                  IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN
+                     CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     SRNAMT = 'ZSYTRI_3'
+*
+*                    Another reason that we need to compute the invesrse
+*                    is that ZSYT03 produces RCONDC which is used later
+*                    in TEST6 and TEST7.
+*
+                     LWORK = (N+NB+1)*(NB+3)
+                     CALL ZSYTRI_3( UPLO, N, AINV, LDA, E, IWORK, WORK,
+     $                              LWORK, INFO )
+*
+*                    Check error code from ZSYTRI_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'ZSYTRI_3', INFO, -1,
+     $                               UPLO, N, N, -1, -1, -1, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+*                    Compute the residual for a symmetric matrix times
+*                    its inverse.
+*
+                     CALL ZSYT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
+     $                            RWORK, RCONDC, RESULT( 2 ) )
+                     NT = 2
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 110 K = 1, NT
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  110             CONTINUE
+                  NRUN = NRUN + NT
+*
+*+    TEST 3
+*                 Compute largest element in U or L
+*
+                  RESULT( 3 ) = ZERO
+                  DTEMP = ZERO
+*
+                  CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) ) /
+     $                    ( ONE-ALPHA )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                 Compute largest element in U
+*
+                     K = N
+  120                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 130
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in in U
+*
+                        DTEMP = ZLANGE( 'M', K-1, 1,
+     $                          AFAC( ( K-1 )*LDA+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k-1 in U
+*
+                        DTEMP = ZLANGE( 'M', K-2, 2,
+     $                          AFAC( ( K-2 )*LDA+1 ), LDA, RWORK )
+                        K = K - 1
+*
+                     END IF
+*
+*                    DTEMP should be bounded by CONST
+*
+                     DTEMP = DTEMP - CONST + THRESH
+                     IF( DTEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = DTEMP
+*
+                     K = K - 1
+*
+                     GO TO 120
+  130                CONTINUE
+*
+                  ELSE
+*
+*                 Compute largest element in L
+*
+                     K = 1
+  140                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 150
+*
+                     IF( IWORK( K ).GT.ZERO ) THEN
+*
+*                       Get max absolute value from elements
+*                       in column k in in L
+*
+                        DTEMP = ZLANGE( 'M', N-K, 1,
+     $                          AFAC( ( K-1 )*LDA+K+1 ), LDA, RWORK )
+                     ELSE
+*
+*                       Get max absolute value from elements
+*                       in columns k and k+1 in L
+*
+                        DTEMP = ZLANGE( 'M', N-K-1, 2,
+     $                          AFAC( ( K-1 )*LDA+K+2 ), LDA, RWORK )
+                        K = K + 1
+*
+                     END IF
+*
+*                    DTEMP should be bounded by CONST
+*
+                     DTEMP = DTEMP - CONST + THRESH
+                     IF( DTEMP.GT.RESULT( 3 ) )
+     $                  RESULT( 3 ) = DTEMP
+*
+                     K = K + 1
+*
+                     GO TO 140
+  150                CONTINUE
+                  END IF
+*
+*
+*+    TEST 4
+*                 Compute largest 2-Norm (condition number)
+*                 of 2-by-2 diag blocks
+*
+                  RESULT( 4 ) = ZERO
+                  DTEMP = ZERO
+*
+                  CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) )*
+     $                    ( ( ONE + ALPHA ) / ( ONE - ALPHA ) )
+*
+                  IF( IUPLO.EQ.1 ) THEN
+*
+*                    Loop backward for UPLO = 'U'
+*
+                     K = N
+  160                CONTINUE
+                     IF( K.LE.1 )
+     $                  GO TO 170
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 )
+                        BLOCK( 1, 2 ) = E( K )
+                        BLOCK( 2, 1 ) = BLOCK( 1, 2 )
+                        BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K )
+*
+                        CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               ZDUMMY, 1, ZDUMMY, 1,
+     $                               WORK, 6, RWORK( 3 ), INFO )
+*
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        DTEMP = SING_MAX / SING_MIN
+*
+*                       DTEMP should be bounded by CONST
+*
+                        DTEMP = DTEMP - CONST + THRESH
+                        IF( DTEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = DTEMP
+                        K = K - 1
+*
+                     END IF
+*
+                     K = K - 1
+*
+                     GO TO 160
+  170                CONTINUE
+*
+                  ELSE
+*
+*                    Loop forward for UPLO = 'L'
+*
+                     K = 1
+  180                CONTINUE
+                     IF( K.GE.N )
+     $                  GO TO 190
+*
+                     IF( IWORK( K ).LT.ZERO ) THEN
+*
+*                       Get the two singular values
+*                       (real and non-negative) of a 2-by-2 block,
+*                       store them in RWORK array
+*
+                        BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K )
+                        BLOCK( 2, 1 ) = E( K )
+                        BLOCK( 1, 2 ) = BLOCK( 2, 1 )
+                        BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 )
+*
+                        CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK,
+     $                               ZDUMMY, 1, ZDUMMY, 1,
+     $                               WORK, 6, RWORK(3), INFO )
+*
+                        SING_MAX = RWORK( 1 )
+                        SING_MIN = RWORK( 2 )
+*
+                        DTEMP = SING_MAX / SING_MIN
+*
+*                       DTEMP should be bounded by CONST
+*
+                        DTEMP = DTEMP - CONST + THRESH
+                        IF( DTEMP.GT.RESULT( 4 ) )
+     $                     RESULT( 4 ) = DTEMP
+                        K = K + 1
+*
+                     END IF
+*
+                     K = K + 1
+*
+                     GO TO 180
+  190                CONTINUE
+                  END IF
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  DO 200 K = 3, 4
+                     IF( RESULT( K ).GE.THRESH ) THEN
+                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                     CALL ALAHD( NOUT, PATH )
+                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+     $                     RESULT( K )
+                        NFAIL = NFAIL + 1
+                     END IF
+  200             CONTINUE
+                  NRUN = NRUN + 2
+*
+*                 Skip the other tests if this is not the first block
+*                 size.
+*
+                  IF( INB.GT.1 )
+     $               GO TO 240
+*
+*                 Do only the condition estimate if INFO is not 0.
+*
+                  IF( TRFCON ) THEN
+                     RCONDC = ZERO
+                     GO TO 230
+                  END IF
+*
+*                 Do for each value of NRHS in NSVAL.
+*
+                  DO 220 IRHS = 1, NNS
+                     NRHS = NSVAL( IRHS )
+*
+*+    TEST 5 ( Using TRS_3)
+*                 Solve and compute residual for  A * X = B.
+*
+*                    Choose a set of NRHS random solution vectors
+*                    stored in XACT and set up the right hand side B
+*
+                     SRNAMT = 'ZLARHS'
+                     CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+     $                            KL, KU, NRHS, A, LDA, XACT, LDA,
+     $                            B, LDA, ISEED, INFO )
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+                     SRNAMT = 'ZSYTRS_3'
+                     CALL ZSYTRS_3( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, INFO )
+*
+*                    Check error code from ZSYTRS_3 and handle error.
+*
+                     IF( INFO.NE.0 )
+     $                  CALL ALAERH( PATH, 'ZSYTRS_3', INFO, 0,
+     $                               UPLO, N, N, -1, -1, NRHS, IMAT,
+     $                               NFAIL, NERRS, NOUT )
+*
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+*
+*                    Compute the residual for the solution
+*
+                     CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 5 ) )
+*
+*+    TEST 6
+*                 Check solution from generated exact solution.
+*
+                     CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 6 ) )
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 210 K = 5, 6
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALAHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+     $                        IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  210                CONTINUE
+                     NRUN = NRUN + 2
+*
+*                 End do for each value of NRHS in NSVAL.
+*
+  220             CONTINUE
+*
+*+    TEST 7
+*                 Get an estimate of RCOND = 1/CNDNUM.
+*
+  230             CONTINUE
+                  ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
+                  SRNAMT = 'ZSYCON_3'
+                  CALL ZSYCON_3( UPLO, N, AFAC, LDA, E, IWORK, ANORM,
+     $                           RCOND, WORK, INFO )
+*
+*                 Check error code from ZSYCON_3 and handle error.
+*
+                  IF( INFO.NE.0 )
+     $               CALL ALAERH( PATH, 'ZSYCON_3', INFO, 0,
+     $                            UPLO, N, N, -1, -1, -1, IMAT,
+     $                            NFAIL, NERRS, NOUT )
+*
+*                 Compute the test ratio to compare values of RCOND
+*
+                  RESULT( 7 ) = DGET06( RCOND, RCONDC )
+*
+*                 Print information about the tests that did not pass
+*                 the threshold.
+*
+                  IF( RESULT( 7 ).GE.THRESH ) THEN
+                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                  CALL ALAHD( NOUT, PATH )
+                     WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 7,
+     $                  RESULT( 7 )
+                     NFAIL = NFAIL + 1
+                  END IF
+                  NRUN = NRUN + 1
+  240          CONTINUE
+*
+  250       CONTINUE
+  260    CONTINUE
+  270 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+     $      I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+     $      I2, ', test(', I2, ') =', G12.5 )
+ 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
+     $      ', test(', I2, ') =', G12.5 )
+      RETURN
+*
+*     End of ZCHKSY_RK
+*
+      END
diff --git a/TESTING/LIN/zdrvhe_aa.f b/TESTING/LIN/zdrvhe_aa.f
index 3a43cf79..3b59395a 100644
--- a/TESTING/LIN/zdrvhe_aa.f
+++ b/TESTING/LIN/zdrvhe_aa.f
@@ -9,8 +9,8 @@
 *  ===========
 *
 *       SUBROUTINE ZDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
-*                                A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
-*                                NOUT )
+*                             A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+*                             NOUT )
 *
 *       .. Scalar Arguments ..
 *       LOGICAL            TSTERR
@@ -186,9 +186,9 @@
       CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
       CHARACTER*3        MATPATH, PATH
       INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
-     $                   IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
      $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
-      DOUBLE PRECISION   AINVNM, ANORM, CNDNUM, RCOND, RCONDC
+      DOUBLE PRECISION   ANORM, CNDNUM
 *     ..
 *     .. Local Arrays ..
       CHARACTER          FACTS( NFACT ), UPLOS( 2 )
@@ -202,8 +202,8 @@
 *     .. External Subroutines ..
       EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
      $                   ZHESV_AA, ZHET01_AA, ZHETRF_AA,
-     $                   ZHETRI2, ZLACPY, ZLAIPD, ZLARHS, ZLATB4, ZLATMS,
-     $                   ZPOT02
+     $                   ZHETRI2, ZLACPY, ZLAIPD, ZLARHS, ZLATB4, 
+     $                   ZLATMS, ZPOT02
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -383,43 +383,6 @@
 *
                   FACT = FACTS( IFACT )
 *
-*                 Compute the condition number for comparison with
-*                 the value returned by ZHESVX.
-*
-                  IF( ZEROT ) THEN
-                     IF( IFACT.EQ.1 )
-     $                  GO TO 150
-                     RCONDC = ZERO
-*
-                  ELSE IF( IFACT.EQ.1 ) THEN
-*
-*                    Compute the 1-norm of A.
-*
-                     ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
-*
-*                    Factor the matrix A.
-*
-c                     CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
-c                     CALL ZHETRF( UPLO, N, AFAC, LDA, IWORK, WORK,
-c     $                            LWORK, INFO )
-*
-*                    Compute inv(A) and take its norm.
-*
-c                     CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
-c                     LWORK = (N+NB+1)*(NB+3)
-c                     CALL ZHETRI2( UPLO, N, AINV, LDA, IWORK, WORK,
-c     $                            LWORK, INFO )
-c                     AINVNM = ZLANHE( '1', UPLO, N, AINV, LDA, RWORK )
-*
-*                    Compute the 1-norm condition number of A.
-*
-c                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
-c                        RCONDC = ONE
-c                     ELSE
-c                        RCONDC = ( ONE / ANORM ) / AINVNM
-c                     END IF
-                  END IF
-*
 *                 Form an exact solution and set the right hand side.
 *
                   SRNAMT = 'ZLARHS'
@@ -483,12 +446,7 @@ c                     END IF
                      CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
                      CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
      $                            LDA, RWORK, RESULT( 2 ) )
-*
-*                    Check solution from generated exact solution.
-*
-                     CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
-     $                            RESULT( 3 ) )
-                     NT = 3
+                     NT = 2
 *
 *                    Print information about the tests that did not pass
 *                    the threshold.
diff --git a/TESTING/LIN/zdrvhe_rk.f b/TESTING/LIN/zdrvhe_rk.f
new file mode 100644
index 00000000..e18a3706
--- /dev/null
+++ b/TESTING/LIN/zdrvhe_rk.f
@@ -0,0 +1,534 @@
+*> \brief \b ZDRVHE_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZDRVHE_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+*                             NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+*                             RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NOUT, NRHS
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NVAL( * )
+*       DOUBLE PRECISION   RWORK( * )
+*       COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+*      $                   WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZDRVHE_RK tests the driver routines ZHESV_RK.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand side vectors to be generated for
+*>          each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is DOUBLE PRECISION
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (NMAX)
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup complex16_lin
+*
+*  =====================================================================
+      SUBROUTINE ZDRVHE_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+     $                      RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NOUT, NRHS
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NVAL( * )
+      DOUBLE PRECISION   RWORK( * )
+      COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE, ZERO
+      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+      INTEGER            NTYPES, NTESTS
+      PARAMETER          ( NTYPES = 10, NTESTS = 3 )
+      INTEGER            NFACT
+      PARAMETER          ( NFACT = 2 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ZEROT
+      CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
+      CHARACTER*3        MATPATH, PATH
+      INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+     $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+      DOUBLE PRECISION   AINVNM, ANORM, CNDNUM, RCONDC
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          FACTS( NFACT ), UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      DOUBLE PRECISION   RESULT( NTESTS )
+
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   ZLANHE
+      EXTERNAL           ZLANHE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX,
+     $                   ZGET04, ZLACPY, ZLARHS, ZLATB4, ZLATMS,
+     $                   ZHESV_RK, ZHET01_3, ZPOT02, ZHETRF_RK, ZHETRI_3
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Zomplex precision'
+      PATH( 2: 3 ) = 'HK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Zomplex precision'
+      MATPATH( 2: 3 ) = 'HE'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+      LWORK = MAX( 2*NMAX, NMAX*NRHS )
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL ZERRVX( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the block size and minimum block size for which the block
+*     routine should be used, which will be later returned by ILAENV.
+*
+      NB = 1
+      NBMIN = 2
+      CALL XLAENV( 1, NB )
+      CALL XLAENV( 2, NBMIN )
+*
+*     Do for each value of N in NVAL
+*
+      DO 180 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         DO 170 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 170
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 170
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 160 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*                 Begin generate the test matrix A.
+*
+*                 Set up parameters with ZLATB4 for the matrix generator
+*                 based on the type of matrix to be generated.
+*
+                  CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                         MODE, CNDNUM, DIST )
+*
+*                 Generate a matrix with ZLATMS.
+*
+                  SRNAMT = 'ZLATMS'
+                  CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                         CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+     $                         WORK, INFO )
+*
+*                 Check error code from ZLATMS and handle error.
+*
+                  IF( INFO.NE.0 ) THEN
+                     CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
+     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+                     GO TO 160
+                  END IF
+*
+*                 For types 3-6, zero one or more rows and columns of
+*                 the matrix to test that INFO is returned correctly.
+*
+                  IF( ZEROT ) THEN
+                     IF( IMAT.EQ.3 ) THEN
+                        IZERO = 1
+                     ELSE IF( IMAT.EQ.4 ) THEN
+                        IZERO = N
+                     ELSE
+                        IZERO = N / 2 + 1
+                     END IF
+*
+                     IF( IMAT.LT.6 ) THEN
+*
+*                       Set row and column IZERO to zero.
+*
+                        IF( IUPLO.EQ.1 ) THEN
+                           IOFF = ( IZERO-1 )*LDA
+                           DO 20 I = 1, IZERO - 1
+                              A( IOFF+I ) = ZERO
+   20                      CONTINUE
+                           IOFF = IOFF + IZERO
+                           DO 30 I = IZERO, N
+                              A( IOFF ) = ZERO
+                              IOFF = IOFF + LDA
+   30                      CONTINUE
+                        ELSE
+                           IOFF = IZERO
+                           DO 40 I = 1, IZERO - 1
+                              A( IOFF ) = ZERO
+                              IOFF = IOFF + LDA
+   40                      CONTINUE
+                           IOFF = IOFF - IZERO
+                           DO 50 I = IZERO, N
+                              A( IOFF+I ) = ZERO
+   50                      CONTINUE
+                        END IF
+                     ELSE
+                        IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 70 J = 1, N
+                              I2 = MIN( J, IZERO )
+                              DO 60 I = 1, I2
+                                 A( IOFF+I ) = ZERO
+   60                         CONTINUE
+                              IOFF = IOFF + LDA
+   70                      CONTINUE
+                        ELSE
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 90 J = 1, N
+                              I1 = MAX( J, IZERO )
+                              DO 80 I = I1, N
+                                 A( IOFF+I ) = ZERO
+   80                         CONTINUE
+                              IOFF = IOFF + LDA
+   90                      CONTINUE
+                        END IF
+                     END IF
+                  ELSE
+                     IZERO = 0
+                  END IF
+*
+*                 End generate the test matrix A.
+*
+*
+               DO 150 IFACT = 1, NFACT
+*
+*                 Do first for FACT = 'F', then for other values.
+*
+                  FACT = FACTS( IFACT )
+*
+*                 Compute the condition number
+*
+                  IF( ZEROT ) THEN
+                     IF( IFACT.EQ.1 )
+     $                  GO TO 150
+                     RCONDC = ZERO
+*
+                  ELSE IF( IFACT.EQ.1 ) THEN
+*
+*                    Compute the 1-norm of A.
+*
+                     ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
+*
+*                    Factor the matrix A.
+*
+
+                     CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL ZHETRF_RK( UPLO, N, AFAC, LDA, E, IWORK, WORK,
+     $                               LWORK, INFO )
+*
+*                    Compute inv(A) and take its norm.
+*
+                     CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     LWORK = (N+NB+1)*(NB+3)
+*
+*                    We need to copute the invesrse to compute
+*                    RCONDC that is used later in TEST3.
+*
+                     CALL ZHETRI_3( UPLO, N, AINV, LDA, E, IWORK,
+     $                              WORK, LWORK, INFO )
+                     AINVNM = ZLANHE( '1', UPLO, N, AINV, LDA, RWORK )
+*
+*                    Compute the 1-norm condition number of A.
+*
+                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
+                        RCONDC = ONE
+                     ELSE
+                        RCONDC = ( ONE / ANORM ) / AINVNM
+                     END IF
+                  END IF
+*
+*                 Form an exact solution and set the right hand side.
+*
+                  SRNAMT = 'ZLARHS'
+                  CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+     $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+     $                         INFO )
+                  XTYPE = 'C'
+*
+*                 --- Test ZHESV_RK  ---
+*
+                  IF( IFACT.EQ.2 ) THEN
+                     CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+*                    Factor the matrix and solve the system using
+*                    ZHESV_RK.
+*
+                     SRNAMT = 'ZHESV_RK'
+                     CALL ZHESV_RK( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, WORK, LWORK, INFO )
+*
+*                    Adjust the expected value of INFO to account for
+*                    pivoting.
+*
+                     K = IZERO
+                     IF( K.GT.0 ) THEN
+  100                   CONTINUE
+                        IF( IWORK( K ).LT.0 ) THEN
+                           IF( IWORK( K ).NE.-K ) THEN
+                              K = -IWORK( K )
+                              GO TO 100
+                           END IF
+                        ELSE IF( IWORK( K ).NE.K ) THEN
+                           K = IWORK( K )
+                           GO TO 100
+                        END IF
+                     END IF
+*
+*                    Check error code from ZHESV_RK and handle error.
+*
+                     IF( INFO.NE.K ) THEN
+                        CALL ALAERH( PATH, 'ZHESV_RK', INFO, K, UPLO,
+     $                               N, N, -1, -1, NRHS, IMAT, NFAIL,
+     $                               NERRS, NOUT )
+                        GO TO 120
+                     ELSE IF( INFO.NE.0 ) THEN
+                        GO TO 120
+                     END IF
+*
+*+    TEST 1      Reconstruct matrix from factors and compute
+*                 residual.
+*
+                     CALL ZHET01_3( UPLO, N, A, LDA, AFAC, LDA, E,
+     $                              IWORK, AINV, LDA, RWORK,
+     $                              RESULT( 1 ) )
+*
+*+    TEST 2      Compute residual of the computed solution.
+*
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+                     CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 2 ) )
+*
+*+    TEST 3
+*                 Check solution from generated exact solution.
+*
+                     CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 3 ) )
+                     NT = 3
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 110 K = 1, NT
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALADHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9999 )'ZHESV_RK', UPLO,
+     $                            N, IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  110                CONTINUE
+                     NRUN = NRUN + NT
+  120                CONTINUE
+                  END IF
+*
+  150          CONTINUE
+*
+  160       CONTINUE
+  170    CONTINUE
+  180 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+     $      ', test ', I2, ', ratio =', G12.5 )
+      RETURN
+*
+*     End of ZDRVHE_RK
+*
+      END
diff --git a/TESTING/LIN/zdrvls.f b/TESTING/LIN/zdrvls.f
index 63fcc69e..fe63b540 100644
--- a/TESTING/LIN/zdrvls.f
+++ b/TESTING/LIN/zdrvls.f
@@ -487,7 +487,7 @@
                                  CALL ZLACPY( 'Full', NROWS, NRHS,
      $                                        COPYB, LDB, B, LDB )
                               END IF
-                              SRNAMT = 'DGETSLS '
+                              SRNAMT = 'ZGETSLS '
                               CALL ZGETSLS( TRANS, M, N, NRHS, A,
      $                                 LDA, B, LDB, WORK, LWORK, INFO )
                               IF( INFO.NE.0 )
diff --git a/TESTING/LIN/zdrvsy_aa.f b/TESTING/LIN/zdrvsy_aa.f
new file mode 100644
index 00000000..d0a9711b
--- /dev/null
+++ b/TESTING/LIN/zdrvsy_aa.f
@@ -0,0 +1,480 @@
+*> \brief \b ZDRVSY_AA
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
+*                             A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+*                             NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NOUT, NRHS
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NVAL( * )
+*       DOUBLE PRECISION   RWORK( * )
+*       COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ),
+*      $                   WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZDRVSY_AA tests the driver routine ZSYSV_AA.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand side vectors to be generated for
+*>          each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is COMPLEX*16
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is COMPLEX*16 array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*  @generated from LIN/ddrvsy_aa.f, fortran d -> z, Thu Nov 17 12:14:51 2016
+*
+*> \ingroup complex16_lin
+*
+*  =====================================================================
+      SUBROUTINE ZDRVSY_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+     $                      RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NOUT, NRHS
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NVAL( * )
+      DOUBLE PRECISION   RWORK( * )
+      COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO
+      PARAMETER          ( ZERO = 0.0D+0 )
+      COMPLEX*16         CZERO
+      PARAMETER          ( CZERO = 0.0E+0 )
+      INTEGER            NTYPES, NTESTS
+      PARAMETER          ( NTYPES = 10, NTESTS = 3 )
+      INTEGER            NFACT
+      PARAMETER          ( NFACT = 2 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ZEROT
+      CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
+      CHARACTER*3        MATPATH, PATH
+      INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+     $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+      DOUBLE PRECISION   ANORM, CNDNUM
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          FACTS( NFACT ), UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      DOUBLE PRECISION   RESULT( NTESTS )
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   DGET06, ZLANSY
+      EXTERNAL           DGET06, ZLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALADHD, ALAERH, ALASVM, DERRVX, ZGET04, ZLACPY,
+     $                   ZLARHS, ZLASET, ZLATB4, ZLATMS, ZSYT02, DSYT05,
+     $                   ZSYSV_AA, ZSYT01_AA, ZSYTRF_AA, XLAENV
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Zomplex precision'
+      PATH( 2: 3 ) = 'SA'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Zomplex precision'
+      MATPATH( 2: 3 ) = 'SY'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+      LWORK = MAX( 2*NMAX, NMAX*NRHS )
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL ZERRVX( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the block size and minimum block size for testing.
+*
+      NB = 1
+      NBMIN = 2
+      CALL XLAENV( 1, NB )
+      CALL XLAENV( 2, NBMIN )
+*
+*     Do for each value of N in NVAL
+*
+      DO 180 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         DO 170 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 170
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 170
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 160 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+*              Set up parameters with ZLATB4 and generate a test matrix
+*              with ZLATMS.
+*
+               CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                      MODE, CNDNUM, DIST )
+*
+               SRNAMT = 'ZLATMS'
+               CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+     $                      INFO )
+*
+*              Check error code from ZLATMS.
+*
+               IF( INFO.NE.0 ) THEN
+                  CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
+     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
+                  GO TO 160
+               END IF
+*
+*              For types 3-6, zero one or more rows and columns of the
+*              matrix to test that INFO is returned correctly.
+*
+               IF( ZEROT ) THEN
+                  IF( IMAT.EQ.3 ) THEN
+                     IZERO = 1
+                  ELSE IF( IMAT.EQ.4 ) THEN
+                     IZERO = N
+                  ELSE
+                     IZERO = N / 2 + 1
+                  END IF
+*
+                  IF( IMAT.LT.6 ) THEN
+*
+*                    Set row and column IZERO to zero.
+*
+                     IF( IUPLO.EQ.1 ) THEN
+                        IOFF = ( IZERO-1 )*LDA
+                        DO 20 I = 1, IZERO - 1
+                           A( IOFF+I ) = CZERO
+   20                   CONTINUE
+                        IOFF = IOFF + IZERO
+                        DO 30 I = IZERO, N
+                           A( IOFF ) = CZERO
+                           IOFF = IOFF + LDA
+   30                   CONTINUE
+                     ELSE
+                        IOFF = IZERO
+                        DO 40 I = 1, IZERO - 1
+                           A( IOFF ) = CZERO
+                           IOFF = IOFF + LDA
+   40                   CONTINUE
+                        IOFF = IOFF - IZERO
+                        DO 50 I = IZERO, N
+                           A( IOFF+I ) = CZERO
+   50                   CONTINUE
+                     END IF
+                  ELSE
+                     IOFF = 0
+                     IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                        DO 70 J = 1, N
+                           I2 = MIN( J, IZERO )
+                           DO 60 I = 1, I2
+                              A( IOFF+I ) = CZERO
+   60                      CONTINUE
+                           IOFF = IOFF + LDA
+   70                   CONTINUE
+                        IZERO = 1
+                     ELSE
+*
+*                       Set the last IZERO rows and columns to zero.
+*
+                        DO 90 J = 1, N
+                           I1 = MAX( J, IZERO )
+                           DO 80 I = I1, N
+                              A( IOFF+I ) = CZERO
+   80                      CONTINUE
+                           IOFF = IOFF + LDA
+   90                   CONTINUE
+                     END IF
+                  END IF
+               ELSE
+                  IZERO = 0
+               END IF
+*
+               DO 150 IFACT = 1, NFACT
+*
+*                 Do first for FACT = 'F', then for other values.
+*
+                  FACT = FACTS( IFACT )
+*
+*                 Form an exact solution and set the right hand side.
+*
+                  SRNAMT = 'ZLARHS'
+                  CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+     $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+     $                         INFO )
+                  XTYPE = 'C'
+*
+*                 --- Test ZSYSV_AA  ---
+*
+                  IF( IFACT.EQ.2 ) THEN
+                     CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+*                    Factor the matrix and solve the system using ZSYSV_AA.
+*
+                     SRNAMT = 'ZSYSV_AA'
+                     CALL ZSYSV_AA( UPLO, N, NRHS, AFAC, LDA, IWORK,
+     $                                 X, LDA, WORK, LWORK, INFO )
+*
+*                    Adjust the expected value of INFO to account for
+*                    pivoting.
+*
+                     IF( IZERO.GT.0 ) THEN
+                        J = 1
+                        K = IZERO
+  100                   CONTINUE
+                        IF( J.EQ.K ) THEN
+                           K = IWORK( J )
+                        ELSE IF( IWORK( J ).EQ.K ) THEN
+                           K = J
+                        END IF
+                        IF( J.LT.K ) THEN
+                           J = J + 1
+                           GO TO 100
+                        END IF
+                     ELSE
+                        K = 0
+                     END IF
+*
+*                    Check error code from ZSYSV_AA .
+*
+                     IF( INFO.NE.K ) THEN
+                        CALL ALAERH( PATH, 'ZSYSV_AA ', INFO, K,
+     $                               UPLO, N, N, -1, -1, NRHS,
+     $                               IMAT, NFAIL, NERRS, NOUT )
+                        GO TO 120
+                     ELSE IF( INFO.NE.0 ) THEN
+                        GO TO 120
+                     END IF
+*
+*                    Reconstruct matrix from factors and compute
+*                    residual.
+*
+                     CALL ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDA,
+     $                               IWORK, AINV, LDA, RWORK,
+     $                               RESULT( 1 ) )
+*
+*                    Compute residual of the computed solution.
+*
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+                     CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 2 ) )
+                     NT = 2
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 110 K = 1, NT
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALADHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9999 )'ZSYSV_AA ',
+     $                        UPLO, N, IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  110                CONTINUE
+                     NRUN = NRUN + NT
+  120                CONTINUE
+                  END IF
+*
+  150          CONTINUE
+*
+  160       CONTINUE
+  170    CONTINUE
+  180 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+     $      ', test ', I2, ', ratio =', G12.5 )
+      RETURN
+*
+*     End of ZDRVSY_AA
+*
+      END
diff --git a/TESTING/LIN/zdrvsy_rk.f b/TESTING/LIN/zdrvsy_rk.f
new file mode 100644
index 00000000..81bbc7ef
--- /dev/null
+++ b/TESTING/LIN/zdrvsy_rk.f
@@ -0,0 +1,542 @@
+*> \brief \b ZDRVSY_RK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+*                             NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+*                             RWORK, IWORK, NOUT )
+*
+*       .. Scalar Arguments ..
+*       LOGICAL            TSTERR
+*       INTEGER            NMAX, NN, NOUT, NRHS
+*       DOUBLE PRECISION   THRESH
+*       ..
+*       .. Array Arguments ..
+*       LOGICAL            DOTYPE( * )
+*       INTEGER            IWORK( * ), NVAL( * )
+*       DOUBLE PRECISION   RWORK( * )
+*       COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ), E( *),
+*      $                   WORK( * ), X( * ), XACT( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZDRVSY_RK tests the driver routines ZSYSV_RK.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*>          DOTYPE is LOGICAL array, dimension (NTYPES)
+*>          The matrix types to be used for testing.  Matrices of type j
+*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*>          NN is INTEGER
+*>          The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*>          NVAL is INTEGER array, dimension (NN)
+*>          The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand side vectors to be generated for
+*>          each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*>          THRESH is DOUBLE PRECISION
+*>          The threshold value for the test ratios.  A result is
+*>          included in the output file if RESULT >= THRESH.  To have
+*>          every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*>          TSTERR is LOGICAL
+*>          Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*>          NMAX is INTEGER
+*>          The maximum value permitted for N, used in dimensioning the
+*>          work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*>          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*>          X is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*>          XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*>          IWORK is INTEGER array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*>          NOUT is INTEGER
+*>          The unit number for output.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2013
+*
+*> \ingroup complex16_lin
+*
+*  =====================================================================
+      SUBROUTINE ZDRVSY_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+     $                      NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
+     $                      RWORK, IWORK, NOUT )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      LOGICAL            TSTERR
+      INTEGER            NMAX, NN, NOUT, NRHS
+      DOUBLE PRECISION   THRESH
+*     ..
+*     .. Array Arguments ..
+      LOGICAL            DOTYPE( * )
+      INTEGER            IWORK( * ), NVAL( * )
+      DOUBLE PRECISION   RWORK( * )
+      COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
+     $                   WORK( * ), X( * ), XACT( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE, ZERO
+      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+      INTEGER            NTYPES, NTESTS
+      PARAMETER          ( NTYPES = 11, NTESTS = 3 )
+      INTEGER            NFACT
+      PARAMETER          ( NFACT = 2 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            ZEROT
+      CHARACTER          DIST, FACT, TYPE, UPLO, XTYPE
+      CHARACTER*3        MATPATH, PATH
+      INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+     $                   IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+     $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+      DOUBLE PRECISION   AINVNM, ANORM, CNDNUM, RCONDC
+*     ..
+*     .. Local Arrays ..
+      CHARACTER          FACTS( NFACT ), UPLOS( 2 )
+      INTEGER            ISEED( 4 ), ISEEDY( 4 )
+      DOUBLE PRECISION   RESULT( NTESTS )
+
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION   ZLANSY
+      EXTERNAL           ZLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
+     $                   ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLATSY,
+     $                   ZSYSV_RK, ZSYT01_3, ZSYT02, ZSYTRF_RK, ZSYTRI_3
+*     ..
+*     .. Scalars in Common ..
+      LOGICAL            LERR, OK
+      CHARACTER*32       SRNAMT
+      INTEGER            INFOT, NUNIT
+*     ..
+*     .. Common blocks ..
+      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
+      COMMON             / SRNAMC / SRNAMT
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Data statements ..
+      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
+      DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+*     ..
+*     .. Executable Statements ..
+*
+*     Initialize constants and the random number seed.
+*
+*     Test path
+*
+      PATH( 1: 1 ) = 'Zomplex precision'
+      PATH( 2: 3 ) = 'SK'
+*
+*     Path to generate matrices
+*
+      MATPATH( 1: 1 ) = 'Zomplex precision'
+      MATPATH( 2: 3 ) = 'SY'
+*
+      NRUN = 0
+      NFAIL = 0
+      NERRS = 0
+      DO 10 I = 1, 4
+         ISEED( I ) = ISEEDY( I )
+   10 CONTINUE
+      LWORK = MAX( 2*NMAX, NMAX*NRHS )
+*
+*     Test the error exits
+*
+      IF( TSTERR )
+     $   CALL ZERRVX( PATH, NOUT )
+      INFOT = 0
+*
+*     Set the block size and minimum block size for which the block
+*     routine should be used, which will be later returned by ILAENV.
+*
+      NB = 1
+      NBMIN = 2
+      CALL XLAENV( 1, NB )
+      CALL XLAENV( 2, NBMIN )
+*
+*     Do for each value of N in NVAL
+*
+      DO 180 IN = 1, NN
+         N = NVAL( IN )
+         LDA = MAX( N, 1 )
+         XTYPE = 'N'
+         NIMAT = NTYPES
+         IF( N.LE.0 )
+     $      NIMAT = 1
+*
+         DO 170 IMAT = 1, NIMAT
+*
+*           Do the tests only if DOTYPE( IMAT ) is true.
+*
+            IF( .NOT.DOTYPE( IMAT ) )
+     $         GO TO 170
+*
+*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+            IF( ZEROT .AND. N.LT.IMAT-2 )
+     $         GO TO 170
+*
+*           Do first for UPLO = 'U', then for UPLO = 'L'
+*
+            DO 160 IUPLO = 1, 2
+               UPLO = UPLOS( IUPLO )
+*
+               IF( IMAT.NE.NTYPES ) THEN
+*
+*              Begin generate the test matrix A.
+*
+*              Set up parameters with ZLATB4 for the matrix generator
+*              based on the type of matrix to be generated.
+*
+                  CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+     $                         MODE, CNDNUM, DIST )
+*
+*              Generate a matrix with ZLATMS.
+*
+                  SRNAMT = 'ZLATMS'
+                  CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+     $                         CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+     $                         WORK, INFO )
+*
+*              Check error code from DLATMS and handle error.
+*
+                  IF( INFO.NE.0 ) THEN
+                     CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
+     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+                     GO TO 160
+                  END IF
+*
+*                 For types 3-6, zero one or more rows and columns of
+*                 the matrix to test that INFO is returned correctly.
+*
+                  IF( ZEROT ) THEN
+                     IF( IMAT.EQ.3 ) THEN
+                        IZERO = 1
+                     ELSE IF( IMAT.EQ.4 ) THEN
+                        IZERO = N
+                     ELSE
+                        IZERO = N / 2 + 1
+                     END IF
+*
+                     IF( IMAT.LT.6 ) THEN
+*
+*                       Set row and column IZERO to zero.
+*
+                        IF( IUPLO.EQ.1 ) THEN
+                           IOFF = ( IZERO-1 )*LDA
+                           DO 20 I = 1, IZERO - 1
+                              A( IOFF+I ) = ZERO
+   20                      CONTINUE
+                           IOFF = IOFF + IZERO
+                           DO 30 I = IZERO, N
+                              A( IOFF ) = ZERO
+                              IOFF = IOFF + LDA
+   30                      CONTINUE
+                        ELSE
+                           IOFF = IZERO
+                           DO 40 I = 1, IZERO - 1
+                              A( IOFF ) = ZERO
+                              IOFF = IOFF + LDA
+   40                      CONTINUE
+                           IOFF = IOFF - IZERO
+                           DO 50 I = IZERO, N
+                              A( IOFF+I ) = ZERO
+   50                      CONTINUE
+                        END IF
+                     ELSE
+                        IF( IUPLO.EQ.1 ) THEN
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 70 J = 1, N
+                              I2 = MIN( J, IZERO )
+                              DO 60 I = 1, I2
+                                 A( IOFF+I ) = ZERO
+   60                         CONTINUE
+                              IOFF = IOFF + LDA
+   70                      CONTINUE
+                        ELSE
+*
+*                       Set the first IZERO rows and columns to zero.
+*
+                           IOFF = 0
+                           DO 90 J = 1, N
+                              I1 = MAX( J, IZERO )
+                              DO 80 I = I1, N
+                                 A( IOFF+I ) = ZERO
+   80                         CONTINUE
+                              IOFF = IOFF + LDA
+   90                      CONTINUE
+                        END IF
+                     END IF
+                  ELSE
+                     IZERO = 0
+                  END IF
+               ELSE
+*
+*                 IMAT = NTYPES:  Use a special block diagonal matrix to
+*                 test alternate code for the 2-by-2 blocks.
+*
+                  CALL ZLATSY( UPLO, N, A, LDA, ISEED )
+               END IF
+*
+               DO 150 IFACT = 1, NFACT
+*
+*                 Do first for FACT = 'F', then for other values.
+*
+                  FACT = FACTS( IFACT )
+*
+*                 Compute the condition number for comparison with
+*                 the value returned by ZSYSVX_ROOK.
+*
+                  IF( ZEROT ) THEN
+                     IF( IFACT.EQ.1 )
+     $                  GO TO 150
+                     RCONDC = ZERO
+*
+                  ELSE IF( IFACT.EQ.1 ) THEN
+*
+*                    Compute the 1-norm of A.
+*
+                     ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+*                    Factor the matrix A.
+*
+
+                     CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL ZSYTRF_RK( UPLO, N, AFAC, LDA, E, IWORK, AINV,
+     $                               LWORK, INFO )
+*
+*                    Compute inv(A) and take its norm.
+*
+                     CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
+                     LWORK = (N+NB+1)*(NB+3)
+*
+*                    We need to copute the invesrse to compute
+*                    RCONDC that is used later in TEST3.
+*
+                     CALL ZSYTRI_3( UPLO, N, AINV, LDA, E, IWORK,
+     $                              WORK, LWORK, INFO )
+                     AINVNM = ZLANSY( '1', UPLO, N, AINV, LDA, RWORK )
+*
+*                    Compute the 1-norm condition number of A.
+*
+                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
+                        RCONDC = ONE
+                     ELSE
+                        RCONDC = ( ONE / ANORM ) / AINVNM
+                     END IF
+                  END IF
+*
+*                 Form an exact solution and set the right hand side.
+*
+                  SRNAMT = 'ZLARHS'
+                  CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+     $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+     $                         INFO )
+                  XTYPE = 'C'
+*
+*                 --- Test ZSYSV_RK  ---
+*
+                  IF( IFACT.EQ.2 ) THEN
+                     CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+*                    Factor the matrix and solve the system using
+*                    ZSYSV_RK.
+*
+                     SRNAMT = 'ZSYSV_RK'
+                     CALL ZSYSV_RK( UPLO, N, NRHS, AFAC, LDA, E, IWORK,
+     $                              X, LDA, WORK, LWORK, INFO )
+*
+*                    Adjust the expected value of INFO to account for
+*                    pivoting.
+*
+                     K = IZERO
+                     IF( K.GT.0 ) THEN
+  100                   CONTINUE
+                        IF( IWORK( K ).LT.0 ) THEN
+                           IF( IWORK( K ).NE.-K ) THEN
+                              K = -IWORK( K )
+                              GO TO 100
+                           END IF
+                        ELSE IF( IWORK( K ).NE.K ) THEN
+                           K = IWORK( K )
+                           GO TO 100
+                        END IF
+                     END IF
+*
+*                    Check error code from ZSYSV_RK and handle error.
+*
+                     IF( INFO.NE.K ) THEN
+                        CALL ALAERH( PATH, 'ZSYSV_RK', INFO, K, UPLO,
+     $                               N, N, -1, -1, NRHS, IMAT, NFAIL,
+     $                               NERRS, NOUT )
+                        GO TO 120
+                     ELSE IF( INFO.NE.0 ) THEN
+                        GO TO 120
+                     END IF
+*
+*+    TEST 1      Reconstruct matrix from factors and compute
+*                 residual.
+*
+                     CALL ZSYT01_3( UPLO, N, A, LDA, AFAC, LDA, E,
+     $                              IWORK, AINV, LDA, RWORK,
+     $                              RESULT( 1 ) )
+*
+*+    TEST 2      Compute residual of the computed solution.
+*
+                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+                     CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+     $                            LDA, RWORK, RESULT( 2 ) )
+*
+*+    TEST 3
+*                 Check solution from generated exact solution.
+*
+                     CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
+     $                            RESULT( 3 ) )
+                     NT = 3
+*
+*                    Print information about the tests that did not pass
+*                    the threshold.
+*
+                     DO 110 K = 1, NT
+                        IF( RESULT( K ).GE.THRESH ) THEN
+                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+     $                        CALL ALADHD( NOUT, PATH )
+                           WRITE( NOUT, FMT = 9999 )'ZSYSV_RK', UPLO,
+     $                            N, IMAT, K, RESULT( K )
+                           NFAIL = NFAIL + 1
+                        END IF
+  110                CONTINUE
+                     NRUN = NRUN + NT
+  120                CONTINUE
+                  END IF
+*
+  150          CONTINUE
+*
+  160       CONTINUE
+  170    CONTINUE
+  180 CONTINUE
+*
+*     Print a summary of the results.
+*
+      CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+     $      ', test ', I2, ', ratio =', G12.5 )
+      RETURN
+*
+*     End of ZDRVSY_RK
+*
+      END
diff --git a/TESTING/LIN/zerrhe.f b/TESTING/LIN/zerrhe.f
index 47b64ae0..d15b2cf4 100644
--- a/TESTING/LIN/zerrhe.f
+++ b/TESTING/LIN/zerrhe.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2013
+*> \date November 2016
 *
 *> \ingroup complex16_lin
 *
 *  =====================================================================
       SUBROUTINE ZERRHE( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2013
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -81,18 +81,20 @@
       INTEGER            IP( NMAX )
       DOUBLE PRECISION   R( NMAX ), R1( NMAX ), R2( NMAX )
       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
       EXTERNAL           LSAMEN
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ALAESM, CHKXER, ZHECON, ZHECON_ROOK, ZHERFS,
-     $                   ZHETF2, ZHETF2_ROOK, ZHETRF, ZHETRF_ROOK,
-     $                   ZHETRF_AA, ZHETRI, ZHETRI_ROOK, ZHETRI2, 
-     $                   ZHETRS, ZHETRS_ROOK, ZHETRS_AA, ZHPCON, ZHPRFS,
-     $                   ZHPTRF, ZHPTRI, ZHPTRS
+      EXTERNAL           ALAESM, CHKXER, ZHECON, ZHECON_3, ZHECON_ROOK,
+     $                   ZHERFS, ZHETF2, ZHETF2_RK, ZHETF2_ROOK, ZHETRF,
+     $                   ZHETRF_RK, ZHETRF_ROOK, ZHETRF_AA, ZHETRI,
+     $                   ZHETRI_3, ZHETRI_3X, ZHETRI_ROOK, ZHETRI2,
+     $                   ZHETRI2X, ZHETRS, ZHETRS_3, ZHETRS_ROOK,
+     $                   ZHETRS_AA, ZHPCON, ZHPRFS, ZHPTRF, ZHPTRI,
+     $                   ZHPTRS
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -122,6 +124,7 @@
      $                   -1.D0 / DBLE( I+J ) )
    10    CONTINUE
          B( J ) = 0.D0
+         E( J ) = 0.D0
          R1( J ) = 0.D0
          R2( J ) = 0.D0
          W( J ) = 0.D0
@@ -131,12 +134,12 @@
       ANRM = 1.0D0
       OK = .TRUE.
 *
-*     Test error exits of the routines that use factorization
-*     of a Hermitian indefinite matrix with patrial
-*     (Bunch-Kaufman) diagonal pivoting method.
-*
       IF( LSAMEN( 2, C2, 'HE' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a Hermitian indefinite matrix with patrial
+*        (Bunch-Kaufman) diagonal pivoting method.
+*
 *        ZHETRF
 *
          SRNAMT = 'ZHETRF'
@@ -149,6 +152,12 @@
          INFOT = 4
          CALL ZHETRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
 *
 *        ZHETF2
 *
@@ -189,6 +198,19 @@
          CALL ZHETRI2( 'U', 2, A, 1, IP, W, 1, INFO )
          CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
 *
+*        ZHETRI2X
+*
+         SRNAMT = 'ZHETRI2X'
+         INFOT = 1
+         CALL ZHETRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI2X', INFOT, NOUT, LERR, OK )
+*
 *        ZHETRS
 *
          SRNAMT = 'ZHETRS'
@@ -256,12 +278,12 @@
          CALL ZHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+*
 *        Test error exits of the routines that use factorization
-*        of a Hermitian indefinite matrix with "rook"
+*        of a Hermitian indefinite matrix with rook
 *        (bounded Bunch-Kaufman) diagonal pivoting method.
 *
-      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
-*
 *        ZHETRF_ROOK
 *
          SRNAMT = 'ZHETRF_ROOK'
@@ -274,6 +296,12 @@
          INFOT = 4
          CALL ZHETRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        ZHETF2_ROOK
 *
@@ -336,6 +364,115 @@
          CALL ZHECON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'ZHECON_ROOK', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
+*
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        ZHETRF_RK
+*
+         SRNAMT = 'ZHETRF_RK'
+         INFOT = 1
+         CALL ZHETRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
+         CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHETRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHETRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        ZHETF2_RK
+*
+         SRNAMT = 'ZHETF2_RK'
+         INFOT = 1
+         CALL ZHETF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZHETF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZHETF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZHETF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        ZHETRI_3
+*
+         SRNAMT = 'ZHETRI_3'
+         INFOT = 1
+         CALL ZHETRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHETRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHETRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
+*
+*        ZHETRI_3X
+*
+         SRNAMT = 'ZHETRI_3X'
+         INFOT = 1
+         CALL ZHETRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        ZHETRS_3
+*
+         SRNAMT = 'ZHETRS_3'
+         INFOT = 1
+         CALL ZHETRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHETRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHETRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZHETRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
+*
+*        ZHECON_3
+*
+         SRNAMT = 'ZHECON_3'
+         INFOT = 1
+         CALL ZHECON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHECON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHECON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHECON_3( 'U', 1, A, 1, E, IP, -1.0D0, RCOND, W, INFO)
+         CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
+*
 *        Test error exits of the routines that use factorization
 *        of a Hermitian indefinite matrix with Aasen's algorithm.
 *
@@ -353,6 +490,12 @@
          INFOT = 4
          CALL ZHETRF_AA( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'ZHETRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRF_AA( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'ZHETRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRF_AA( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'ZHETRF_AA', INFOT, NOUT, LERR, OK )
 *
 *        ZHETRS_AA
 *
@@ -372,13 +515,19 @@
          INFOT = 8
          CALL ZHETRS_AA( 'U', 2, 1, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'ZHETRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHETRS_AA( 'U', 0, 1, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZHETRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHETRS_AA( 'U', 0, 1, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZHETRS_AA', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
 *
 *        Test error exits of the routines that use factorization
 *        of a Hermitian indefinite packed matrix with patrial
 *        (Bunch-Kaufman) diagonal pivoting method.
 *
-      ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
-*
 *        ZHPTRF
 *
          SRNAMT = 'ZHPTRF'
diff --git a/TESTING/LIN/zerrhex.f b/TESTING/LIN/zerrhex.f
index 81d61a3c..ec0741a6 100644
--- a/TESTING/LIN/zerrhex.f
+++ b/TESTING/LIN/zerrhex.f
@@ -51,17 +51,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup complex16_lin
 *
 *  =====================================================================
       SUBROUTINE ZERRHE( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -87,18 +87,19 @@
      $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
       EXTERNAL           LSAMEN
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ALAESM, CHKXER, ZHECON, ZHECON_ROOK, ZHERFS,
-     $                   ZHETF2, ZHETF2_ROOK, ZHETRF, ZHETRF_ROOK,
-     $                   ZHETRI, ZHETRI_ROOK, ZHETRI2, ZHETRS,
-     $                   ZHETRS_ROOK, ZHPCON, ZHPRFS, ZHPTRF, ZHPTRI,
-     $                   ZHPTRS, ZHERFSX
+      EXTERNAL           ALAESM, CHKXER, ZHECON, ZHECON_3, ZHECON_ROOK,
+     $                   ZHERFS, ZHETF2, ZHETF2_RK, ZHETF2_ROOK, ZHETRF,
+     $                   ZHETRF_RK, ZHETRF_ROOK, ZHETRI, ZHETRI_3,
+     $                   ZHETRI_3X, ZHETRI_ROOK, ZHETRI2, ZHETRI2X,
+     $                   ZHETRS, ZHETRS_3, ZHETRS_ROOK, ZHPCON,
+     $                   ZHPRFS, ZHPTRF, ZHPTRI, ZHPTRS, ZHERFSX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -128,6 +129,7 @@
      $                   -1.D0 / DBLE( I+J ) )
    10    CONTINUE
          B( J ) = 0.D0
+         E( J ) = 0.D0
          R1( J ) = 0.D0
          R2( J ) = 0.D0
          W( J ) = 0.D0
@@ -156,6 +158,12 @@
          INFOT = 4
          CALL ZHETRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
 *
 *        ZHETF2
 *
@@ -196,6 +204,19 @@
          CALL ZHETRI2( 'U', 2, A, 1, IP, W, 1, INFO )
          CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
 *
+*        ZHETRI2X
+*
+         SRNAMT = 'ZHETRI2X'
+         INFOT = 1
+         CALL ZHETRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI2X', INFOT, NOUT, LERR, OK )
+*
 *        ZHETRS
 *
          SRNAMT = 'ZHETRS'
@@ -310,12 +331,12 @@
          CALL ZHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
+*
 *        Test error exits of the routines that use factorization
-*        of a Hermitian indefinite matrix with "rook"
+*        of a Hermitian indefinite matrix with rook
 *        (bounded Bunch-Kaufman) diagonal pivoting method.
 *
-      ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
-*
 *        ZHETRF_ROOK
 *
          SRNAMT = 'ZHETRF_ROOK'
@@ -328,6 +349,12 @@
          INFOT = 4
          CALL ZHETRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHETRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'ZHETRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        ZHETF2_ROOK
 *
@@ -390,12 +417,121 @@
          CALL ZHECON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'ZHECON_ROOK', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
+*
 *        Test error exits of the routines that use factorization
-*        of a Hermitian indefinite packed matrix with patrial
-*        (Bunch-Kaufman) diagonal pivoting method.
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        ZHETRF_RK
+*
+         SRNAMT = 'ZHETRF_RK'
+         INFOT = 1
+         CALL ZHETRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
+         CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHETRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHETRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'ZHETRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        ZHETF2_RK
+*
+         SRNAMT = 'ZHETF2_RK'
+         INFOT = 1
+         CALL ZHETF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZHETF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZHETF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZHETF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        ZHETRI_3
+*
+         SRNAMT = 'ZHETRI_3'
+         INFOT = 1
+         CALL ZHETRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHETRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZHETRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'ZHETRI_3', INFOT, NOUT, LERR, OK )
+*
+*        ZHETRI_3X
+*
+         SRNAMT = 'ZHETRI_3X'
+         INFOT = 1
+         CALL ZHETRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHETRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZHETRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        ZHETRS_3
+*
+         SRNAMT = 'ZHETRS_3'
+         INFOT = 1
+         CALL ZHETRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHETRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHETRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHETRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZHETRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZHETRS_3', INFOT, NOUT, LERR, OK )
+*
+*        ZHECON_3
+*
+         SRNAMT = 'ZHECON_3'
+         INFOT = 1
+         CALL ZHECON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHECON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZHECON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZHECON_3( 'U', 1, A, 1, E, IP, -1.0D0, RCOND, W, INFO)
+         CALL CHKXER( 'ZHECON_3', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a Hermitian indefinite packed matrix with patrial
+*        (Bunch-Kaufman) diagonal pivoting method.
+*
 *        ZHPTRF
 *
          SRNAMT = 'ZHPTRF'
diff --git a/TESTING/LIN/zerrsy.f b/TESTING/LIN/zerrsy.f
index 35361e60..eb8bb628 100644
--- a/TESTING/LIN/zerrsy.f
+++ b/TESTING/LIN/zerrsy.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2013
+*> \date November 2016
 *
 *> \ingroup complex16_lin
 *
 *  =====================================================================
       SUBROUTINE ZERRSY( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2013
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -80,7 +80,7 @@
       INTEGER            IP( NMAX )
       DOUBLE PRECISION   R( NMAX ), R1( NMAX ), R2( NMAX )
       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -88,9 +88,11 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAESM, CHKXER, ZSPCON, ZSPRFS, ZSPTRF, ZSPTRI,
-     $                   ZSPTRS, ZSYCON, ZSYCON_ROOK, ZSYRFS, ZSYTF2,
-     $                   ZSYTF2_ROOK, ZSYTRF, ZSYTRF_ROOK, ZSYTRI,
-     $                   ZSYTRI_ROOK, ZSYTRI2, ZSYTRS, ZSYTRS_ROOK
+     $                   ZSPTRS, ZSYCON, ZSYCON_3, ZSYCON_ROOK, ZSYRFS,
+     $                   ZSYTF2, ZSYTF2_RK, ZSYTF2_ROOK, ZSYTRF,
+     $                   ZSYTRF_RK, ZSYTRF_ROOK, ZSYTRI, ZSYTRI_3,
+     $                   ZSYTRI_3X, ZSYTRI_ROOK, ZSYTRI2, ZSYTRI2Z,
+     $                   ZSYTRS, ZSYTRS_3, ZSYTRS_ROOK
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -120,6 +122,7 @@
      $                   -1.D0 / DBLE( I+J ) )
    10    CONTINUE
          B( J ) = 0.D0
+         E( J ) = 0.D0
          R1( J ) = 0.D0
          R2( J ) = 0.D0
          W( J ) = 0.D0
@@ -129,12 +132,12 @@
       ANRM = 1.0D0
       OK = .TRUE.
 *
-*     Test error exits of the routines that use factorization
-*     of a symmetric indefinite matrix with patrial
-*     (Bunch-Kaufman) diagonal pivoting method.
-*
       IF( LSAMEN( 2, C2, 'SY' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with patrial
+*        (Bunch-Kaufman) diagonal pivoting method.
+*
 *        ZSYTRF
 *
          SRNAMT = 'ZSYTRF'
@@ -147,6 +150,12 @@
          INFOT = 4
          CALL ZSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYTRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYTRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
 *
 *        ZSYTF2
 *
@@ -187,6 +196,19 @@
          CALL ZSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO )
          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
 *
+*        ZSYTRI2X
+*
+         SRNAMT = 'ZSYTRI2X'
+         INFOT = 1
+         CALL ZSYTRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI2X', INFOT, NOUT, LERR, OK )
+*
 *        ZSYTRS
 *
          SRNAMT = 'ZSYTRS'
@@ -254,12 +276,12 @@
          CALL ZSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
 *
-*     Test error exits of the routines that use factorization
-*     of a symmetric indefinite matrix with "rook"
-*     (bounded Bunch-Kaufman) diagonal pivoting method.
-*
       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) diagonal pivoting method.
+*
 *        ZSYTRF_ROOK
 *
          SRNAMT = 'ZSYTRF_ROOK'
@@ -272,6 +294,12 @@
          INFOT = 4
          CALL ZSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'ZSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYTRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'ZSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYTRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'ZSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        ZSYTF2_ROOK
 *
@@ -334,12 +362,121 @@
          CALL ZSYCON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'ZSYCON_ROOK', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
 *        Test error exits of the routines that use factorization
-*        of a symmetric indefinite packed matrix with patrial
-*        (Bunch-Kaufman) pivoting.
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        ZSYTRF_RK
+*
+         SRNAMT = 'ZSYTRF_RK'
+         INFOT = 1
+         CALL ZSYTRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
+         CALL CHKXER( 'ZSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZSYTRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'ZSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZSYTRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'ZSYTRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        ZSYTF2_RK
+*
+         SRNAMT = 'ZSYTF2_RK'
+         INFOT = 1
+         CALL ZSYTF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZSYTF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        ZSYTRI_3
+*
+         SRNAMT = 'ZSYTRI_3'
+         INFOT = 1
+         CALL ZSYTRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZSYTRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'ZSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZSYTRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'ZSYTRI_3', INFOT, NOUT, LERR, OK )
+*
+*        ZSYTRI_3X
+*
+         SRNAMT = 'ZSYTRI_3X'
+         INFOT = 1
+         CALL ZSYTRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        ZSYTRS_3
+*
+         SRNAMT = 'ZSYTRS_3'
+         INFOT = 1
+         CALL ZSYTRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZSYTRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZSYTRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'ZSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZSYTRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_3', INFOT, NOUT, LERR, OK )
+*
+*        ZSYCON_3
+*
+         SRNAMT = 'ZSYCON_3'
+         INFOT = 1
+         CALL ZSYCON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYCON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYCON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYCON_3( 'U', 1, A, 1, E, IP, -1.0D0, RCOND, W, INFO)
+         CALL CHKXER( 'ZSYCON_3', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite packed matrix with patrial
+*        (Bunch-Kaufman) pivoting.
+*
 *        ZSPTRF
 *
          SRNAMT = 'ZSPTRF'
@@ -412,6 +549,50 @@
          INFOT = 5
          CALL ZSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
+*
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with Aasen's algorithm.
+*
+*        ZSYTRF_AA
+*
+         SRNAMT = 'ZSYTRF_AA'
+         INFOT = 1
+         CALL ZSYTRF_AA( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRF_AA( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTRF_AA( 'U', 2, A, 1, IP, W, 4, INFO )
+         CALL CHKXER( 'ZSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYTRF_AA( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'ZSYTRF_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYTRF_AA( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'ZSYTRF_AA', INFOT, NOUT, LERR, OK )
+*
+*        ZSYTRS_AA
+*
+         SRNAMT = 'ZSYTRS_AA'
+         INFOT = 1
+         CALL ZSYTRS_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRS_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZSYTRS_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZSYTRS_AA( 'U', 2, 1, A, 1, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_AA', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZSYTRS_AA( 'U', 2, 1, A, 2, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_AA', INFOT, NOUT, LERR, OK )
+*
       END IF
 *
 *     Print a summary line.
diff --git a/TESTING/LIN/zerrsyx.f b/TESTING/LIN/zerrsyx.f
index f78ce009..df4f9902 100644
--- a/TESTING/LIN/zerrsyx.f
+++ b/TESTING/LIN/zerrsyx.f
@@ -51,17 +51,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup complex16_lin
 *
 *  =====================================================================
       SUBROUTINE ZERRSY( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -86,7 +86,7 @@
      $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -94,10 +94,11 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           ALAESM, CHKXER, ZSPCON, ZSPRFS, ZSPTRF, ZSPTRI,
-     $                   ZSPTRS, ZSYCON, ZSYCON_ROOK, ZSYRFS, ZSYTF2,
-     $                   ZSYTF2_ROOK, ZSYTRF, ZSYTRF_ROOK, ZSYTRI,
-     $                   ZSYTRI_ROOK, ZSYTRI2, ZSYTRS, ZSYTRS_ROOK,
-     $                   ZSYRFSX
+     $                   ZSPTRS, ZSYCON, ZSYCON_3, ZSYCON_ROOK, ZSYRFS,
+     $                   ZSYTF2, ZSYTF2_RK, ZSYTF2_ROOK, ZSYTRF,
+     $                   ZSYTRF_RK, ZSYTRF_ROOK, ZSYTRI, ZSYTRI_3,
+     $                   ZSYTRI_3X, ZSYTRI_ROOK, ZSYTRI2, ZSYTRI2X,
+     $                   ZSYTRS, ZSYTRS_3, ZSYTRS_ROOK, ZSYRFSX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -127,6 +128,7 @@
      $                   -1.D0 / DBLE( I+J ) )
    10    CONTINUE
          B( J ) = 0.D0
+         E( J ) = 0.D0
          R1( J ) = 0.D0
          R2( J ) = 0.D0
          W( J ) = 0.D0
@@ -137,12 +139,12 @@
       ANRM = 1.0D0
       OK = .TRUE.
 *
-*     Test error exits of the routines that use factorization
-*     of a symmetric indefinite matrix with patrial
-*     (Bunch-Kaufman) diagonal pivoting method.
-*
       IF( LSAMEN( 2, C2, 'SY' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with patrial
+*        (Bunch-Kaufman) diagonal pivoting method.
+*
 *        ZSYTRF
 *
          SRNAMT = 'ZSYTRF'
@@ -155,6 +157,12 @@
          INFOT = 4
          CALL ZSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYTRF( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYTRF( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
 *
 *        ZSYTF2
 *
@@ -195,6 +203,19 @@
          CALL ZSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO )
          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
 *
+*        ZSYTRI2X
+*
+         SRNAMT = 'ZSYTRI2X'
+         INFOT = 1
+         CALL ZSYTRI2X( '/', 0, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRI2X( 'U', -1, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI2X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTRI2X( 'U', 2, A, 1, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI2X', INFOT, NOUT, LERR, OK )
+*
 *        ZSYTRS
 *
          SRNAMT = 'ZSYTRS'
@@ -309,12 +330,12 @@
          CALL ZSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
 *
-*     Test error exits of the routines that use factorization
-*     of a symmetric indefinite matrix with "rook"
-*     (bounded Bunch-Kaufman) diagonal pivoting method.
-*
       ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) diagonal pivoting method.
+*
 *        ZSYTRF_ROOK
 *
          SRNAMT = 'ZSYTRF_ROOK'
@@ -327,6 +348,12 @@
          INFOT = 4
          CALL ZSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
          CALL CHKXER( 'ZSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYTRF_ROOK( 'U', 0, A, 1, IP, W, 0, INFO )
+         CALL CHKXER( 'ZSYTRF_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYTRF_ROOK( 'U', 0, A, 1, IP, W, -2, INFO )
+         CALL CHKXER( 'ZSYTRF_ROOK', INFOT, NOUT, LERR, OK )
 *
 *        ZSYTF2_ROOK
 *
@@ -389,12 +416,121 @@
          CALL ZSYCON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
          CALL CHKXER( 'ZSYCON_ROOK', INFOT, NOUT, LERR, OK )
 *
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
 *        Test error exits of the routines that use factorization
-*        of a symmetric indefinite packed matrix with patrial
-*        (Bunch-Kaufman) pivoting.
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+*        ZSYTRF_RK
+*
+         SRNAMT = 'ZSYTRF_RK'
+         INFOT = 1
+         CALL ZSYTRF_RK( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRF_RK( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTRF_RK( 'U', 2, A, 1, E, IP, W, 4, INFO )
+         CALL CHKXER( 'ZSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZSYTRF_RK( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'ZSYTRF_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZSYTRF_RK( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'ZSYTRF_RK', INFOT, NOUT, LERR, OK )
+*
+*        ZSYTF2_RK
+*
+         SRNAMT = 'ZSYTF2_RK'
+         INFOT = 1
+         CALL ZSYTF2_RK( '/', 0, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTF2_RK( 'U', -1, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZSYTF2_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTF2_RK( 'U', 2, A, 1, E, IP, INFO )
+         CALL CHKXER( 'ZSYTF2_RK', INFOT, NOUT, LERR, OK )
+*
+*        ZSYTRI_3
+*
+         SRNAMT = 'ZSYTRI_3'
+         INFOT = 1
+         CALL ZSYTRI_3( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRI_3( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTRI_3( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZSYTRI_3( 'U', 0, A, 1, E, IP, W, 0, INFO )
+         CALL CHKXER( 'ZSYTRI_3', INFOT, NOUT, LERR, OK )
+         INFOT = 8
+         CALL ZSYTRI_3( 'U', 0, A, 1, E, IP, W, -2, INFO )
+         CALL CHKXER( 'ZSYTRI_3', INFOT, NOUT, LERR, OK )
+*
+*        ZSYTRI_3X
+*
+         SRNAMT = 'ZSYTRI_3X'
+         INFOT = 1
+         CALL ZSYTRI_3X( '/', 0, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRI_3X( 'U', -1, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3X', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYTRI_3X( 'U', 2, A, 1, E, IP, W, 1, INFO )
+         CALL CHKXER( 'ZSYTRI_3X', INFOT, NOUT, LERR, OK )
+*
+*        ZSYTRS_3
+*
+         SRNAMT = 'ZSYTRS_3'
+         INFOT = 1
+         CALL ZSYTRS_3( '/', 0, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYTRS_3( 'U', -1, 0, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZSYTRS_3( 'U', 0, -1, A, 1, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZSYTRS_3( 'U', 2, 1, A, 1, E, IP, B, 2, INFO )
+         CALL CHKXER( 'ZSYTRS_3', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZSYTRS_3( 'U', 2, 1, A, 2, E, IP, B, 1, INFO )
+         CALL CHKXER( 'ZSYTRS_3', INFOT, NOUT, LERR, OK )
+*
+*        ZSYCON_3
+*
+         SRNAMT = 'ZSYCON_3'
+         INFOT = 1
+         CALL ZSYCON_3( '/', 0, A, 1,  E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYCON_3( 'U', -1, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 4
+         CALL ZSYCON_3( 'U', 2, A, 1, E, IP, ANRM, RCOND, W, INFO )
+         CALL CHKXER( 'ZSYCON_3', INFOT, NOUT, LERR, OK )
+         INFOT = 7
+         CALL ZSYCON_3( 'U', 1, A, 1, E, IP, -1.0D0, RCOND, W, INFO)
+         CALL CHKXER( 'ZSYCON_3', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
+*        Test error exits of the routines that use factorization
+*        of a symmetric indefinite packed matrix with patrial
+*        (Bunch-Kaufman) pivoting.
+*
 *        ZSPTRF
 *
          SRNAMT = 'ZSPTRF'
diff --git a/TESTING/LIN/zerrvx.f b/TESTING/LIN/zerrvx.f
index ca0618b2..0eed4a51 100644
--- a/TESTING/LIN/zerrvx.f
+++ b/TESTING/LIN/zerrvx.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2013
+*> \date November 2016
 *
 *> \ingroup complex16_lin
 *
 *  =====================================================================
       SUBROUTINE ZERRVX( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2013
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -82,7 +82,7 @@
       DOUBLE PRECISION   C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
      $                   RF( NMAX ), RW( NMAX )
       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -90,10 +90,11 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           CHKXER, ZGBSV, ZGBSVX, ZGESV, ZGESVX, ZGTSV,
-     $                   ZGTSVX, ZHESV, ZHESV_ROOK, ZHESVX, ZHPSV,
-     $                   ZHPSVX, ZPBSV, ZPBSVX, ZPOSV, ZPOSVX, ZPPSV,
-     $                   ZPPSVX, ZPTSV, ZPTSVX, ZSPSV, ZSPSVX, ZSYSV,
-     $                   ZSYSV_AA, ZSYSV_ROOK, ZSYSVX
+     $                   ZGTSVX, ZHESV, ZHESV_RK, ZHESV_ROOK, ZHESVX,
+     $                   ZHPSV, ZHPSVX, ZPBSV, ZPBSVX, ZPOSV, ZPOSVX,
+     $                   ZPPSV, ZPPSVX, ZPTSV, ZPTSVX, ZSPSV, ZSPSVX,
+     $                   ZSYSV, ZSYSV_AA, ZSYSV_RK, ZSYSV_ROOK,
+     $                   ZSYSVX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -123,6 +124,7 @@
      $                   -1.D0 / DBLE( I+J ) )
    10    CONTINUE
          B( J ) = 0.D0
+         E( J ) = 0.D0
          R1( J ) = 0.D0
          R2( J ) = 0.D0
          W( J ) = 0.D0
@@ -593,6 +595,12 @@
          INFOT = 8
          CALL ZHESV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'ZHESV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHESV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZHESV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHESV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZHESV ', INFOT, NOUT, LERR, OK )
 *
 *        ZHESVX
 *
@@ -634,25 +642,6 @@
      $                RCOND, R1, R2, W, 3, RW, INFO )
          CALL CHKXER( 'ZHESVX', INFOT, NOUT, LERR, OK )
 *
-      ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
-*
-*        ZHESV_AA
-*
-        SRNAMT = 'ZHESV_AA'
-        INFOT = 1
-        CALL ZHESV_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'ZHESV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 2
-        CALL ZHESV_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'ZHESV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 3
-        CALL ZHESV_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'ZHESV_AA', INFOT, NOUT, LERR, OK )
-        INFOT = 8
-        CALL ZHESV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
-        CALL CHKXER( 'ZHESV_AA', INFOT, NOUT, LERR, OK )
-*
-
       ELSE IF( LSAMEN( 2, C2, 'HR' ) ) THEN
 *
 *        ZHESV_ROOK
@@ -670,6 +659,65 @@
          INFOT = 8
          CALL ZHESV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'ZHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHESV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHESV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZHESV_ROOK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
+*
+*        ZSYSV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a Hermitian indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'ZHESV_RK'
+         INFOT = 1
+         CALL ZHESV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHESV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHESV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHESV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZHESV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZHESV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZHESV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
+*
+*        ZHESV_AA
+*
+        SRNAMT = 'ZHESV_AA'
+        INFOT = 1
+        CALL ZHESV_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
+        CALL CHKXER( 'ZHESV_AA', INFOT, NOUT, LERR, OK )
+        INFOT = 2
+        CALL ZHESV_AA( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
+        CALL CHKXER( 'ZHESV_AA', INFOT, NOUT, LERR, OK )
+        INFOT = 3
+        CALL ZHESV_AA( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
+        CALL CHKXER( 'ZHESV_AA', INFOT, NOUT, LERR, OK )
+        INFOT = 8
+        CALL ZHESV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
+        CALL CHKXER( 'ZHESV_AA', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
 *
@@ -734,6 +782,12 @@
          INFOT = 8
          CALL ZSYSV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'ZSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZSYSV ', INFOT, NOUT, LERR, OK )
 *
 *        ZSYSVX
 *
@@ -792,6 +846,46 @@
          INFOT = 8
          CALL ZSYSV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'ZSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        ZSYSV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'ZSYSV_RK'
+         INFOT = 1
+         CALL ZSYSV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYSV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZSYSV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZSYSV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZSYSV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
diff --git a/TESTING/LIN/zerrvxx.f b/TESTING/LIN/zerrvxx.f
index 747d84ad..d2006667 100644
--- a/TESTING/LIN/zerrvxx.f
+++ b/TESTING/LIN/zerrvxx.f
@@ -48,17 +48,17 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date November 2015
+*> \date November 2016
 *
 *> \ingroup complex16_lin
 *
 *  =====================================================================
       SUBROUTINE ZERRVX( PATH, NUNIT )
 *
-*  -- LAPACK test routine (version 3.6.0) --
+*  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     November 2015
+*     November 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER*3        PATH
@@ -85,7 +85,7 @@
      $                   RF( NMAX ), RW( NMAX ), ERR_BNDS_N( NMAX, 3 ),
      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
-     $                   W( 2*NMAX ), X( NMAX )
+     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAMEN
@@ -93,11 +93,11 @@
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           CHKXER, ZGBSV, ZGBSVX, ZGESV, ZGESVX, ZGTSV,
-     $                   ZGTSVX, ZHESV, ZHESV_ROOK, ZHESVX, ZHPSV,
-     $                   ZHPSVX, ZPBSV, ZPBSVX, ZPOSV, ZPOSVX, ZPPSV,
-     $                   ZPPSVX, ZPTSV, ZPTSVX, ZSPSV, ZSPSVX, ZSYSV,
-     $                   ZSYSV_ROOK, ZSYSVX, ZGESVXX, ZSYSVXX, ZPOSVXX,
-     $                   ZHESVXX, ZGBSVXX
+     $                   ZGTSVX, ZHESV, ZHESV_RK, ZHESV_ROOK, ZHESVX,
+     $                   ZHPSV, ZHPSVX, ZPBSV, ZPBSVX, ZPOSV, ZPOSVX,
+     $                   ZPPSV, ZPPSVX, ZPTSV, ZPTSVX, ZSPSV, ZSPSVX,
+     $                   ZSYSV, ZSYSV_RK, ZSYSV_ROOK, ZSYSVX, ZGESVXX,
+     $                   ZSYSVXX, ZPOSVXX, ZHESVXX, ZGBSVXX
 *     ..
 *     .. Scalars in Common ..
       LOGICAL            LERR, OK
@@ -127,6 +127,7 @@
      $                   -1.D0 / DBLE( I+J ) )
    10    CONTINUE
          B( J ) = 0.D0
+         E( J ) = 0.D0
          R1( J ) = 0.D0
          R2( J ) = 0.D0
          W( J ) = 0.D0
@@ -835,6 +836,12 @@
          INFOT = 8
          CALL ZHESV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'ZHESV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHESV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZHESV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHESV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZHESV ', INFOT, NOUT, LERR, OK )
 *
 *        ZHESVX
 *
@@ -951,6 +958,47 @@
          INFOT = 8
          CALL ZHESV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'ZHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHESV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZHESV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZHESV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZHESV_ROOK', INFOT, NOUT, LERR, OK )
+*
+      ELSE IF( LSAMEN( 2, C2, 'HK' ) ) THEN
+*
+*        ZSYSV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a Hermitian indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'ZHESV_RK'
+         INFOT = 1
+         CALL ZHESV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZHESV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZHESV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZHESV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZHESV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZHESV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZHESV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZHESV_RK', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
 *
@@ -1015,6 +1063,12 @@
          INFOT = 8
          CALL ZSYSV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'ZSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZSYSV ', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZSYSV( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZSYSV ', INFOT, NOUT, LERR, OK )
 *
 *        ZSYSVX
 *
@@ -1141,6 +1195,46 @@
          INFOT = 8
          CALL ZSYSV_ROOK( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
          CALL CHKXER( 'ZSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZSYSV_ROOK', INFOT, NOUT, LERR, OK )
+         INFOT = 10
+         CALL ZSYSV_ROOK( 'U', 0, 0, A, 1, IP, B, 1, W, -2, INFO )
+*
+      ELSE IF( LSAMEN( 2, C2, 'SK' ) ) THEN
+*
+*        ZSYSV_RK
+*
+*        Test error exits of the driver that uses factorization
+*        of a symmetric indefinite matrix with rook
+*        (bounded Bunch-Kaufman) pivoting with the new storage
+*        format for factors L ( or U) and D.
+*
+*        L (or U) is stored in A, diagonal of D is stored on the
+*        diagonal of A, subdiagonal of D is stored in a separate array E.
+*
+         SRNAMT = 'ZSYSV_RK'
+         INFOT = 1
+         CALL ZSYSV_RK( '/', 0, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 2
+         CALL ZSYSV_RK( 'U', -1, 0, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 3
+         CALL ZSYSV_RK( 'U', 0, -1, A, 1, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 5
+         CALL ZSYSV_RK( 'U', 2, 0, A, 1, E, IP, B, 2, W, 1, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 9
+         CALL ZSYSV_RK( 'U', 2, 0, A, 2, E, IP, B, 1, W, 1, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, 0, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
+         INFOT = 11
+         CALL ZSYSV_RK( 'U', 0, 0, A, 1, E, IP, B, 1, W, -2, INFO )
+         CALL CHKXER( 'ZSYSV_RK', INFOT, NOUT, LERR, OK )
 *
       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
 *
diff --git a/TESTING/LIN/zhet01_3.f b/TESTING/LIN/zhet01_3.f
new file mode 100644
index 00000000..cfe22585
--- /dev/null
+++ b/TESTING/LIN/zhet01_3.f
@@ -0,0 +1,264 @@
+*> \brief \b ZHET01_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZHET01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+*                            LDC, RWORK, RESID )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            LDA, LDAFAC, LDC, N
+*       DOUBLE PRECISION   RESID
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   RWORK( * )
+*       COMPLEX*16         A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+*                          E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZHET01_3 reconstructs a Hermitian indefinite matrix A from its
+*> block L*D*L' or U*D*U' factorization computed by ZHETRF_RK
+*> (or ZHETRF_BK) and computes the residual
+*>    norm( C - A ) / ( N * norm(A) * EPS ),
+*> where C is the reconstructed matrix and EPS is the machine epsilon.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          The original Hermitian matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N)
+*> \endverbatim
+*>
+*> \param[in] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX*16 array, dimension (LDAFAC,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by ZHETRF_RK and ZHETRF_BK:
+*>            a) ONLY diagonal elements of the Hermitian block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDAFAC
+*> \verbatim
+*>          LDAFAC is INTEGER
+*>          The leading dimension of the array AFAC.
+*>          LDAFAC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the Hermitian block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          The pivot indices from ZHETRF_RK (or ZHETRF_BK).
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*>          C is COMPLEX*16 array, dimension (LDC,N)
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] RESID
+*> \verbatim
+*>          RESID is DOUBLE PRECISION
+*>          If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS )
+*>          If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16_lin
+*
+*  =====================================================================
+      SUBROUTINE ZHET01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+     $                     LDC, RWORK, RESID )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            LDA, LDAFAC, LDC, N
+      DOUBLE PRECISION   RESID
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   RWORK( * )
+      COMPLEX*16         A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+     $                   E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      COMPLEX*16         CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, INFO, J
+      DOUBLE PRECISION   ANORM, EPS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      DOUBLE PRECISION   ZLANHE, DLAMCH
+      EXTERNAL           LSAME, ZLANHE, DLAMCH
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZLASET, ZLAVHE_ROOK, ZSYCONVF_ROOK
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DIMAG, DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick exit if N = 0.
+*
+      IF( N.LE.0 ) THEN
+         RESID = ZERO
+         RETURN
+      END IF
+*
+*     a) Revert to multiplyers of L
+*
+      CALL ZSYCONVF_ROOK( UPLO, 'R', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+*     1) Determine EPS and the norm of A.
+*
+      EPS = DLAMCH( 'Epsilon' )
+      ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
+*
+*     Check the imaginary parts of the diagonal elements and return with
+*     an error code if any are nonzero.
+*
+      DO J = 1, N
+         IF( DIMAG( AFAC( J, J ) ).NE.ZERO ) THEN
+            RESID = ONE / EPS
+            RETURN
+         END IF
+      END DO
+*
+*     2) Initialize C to the identity matrix.
+*
+      CALL ZLASET( 'Full', N, N, CZERO, CONE, C, LDC )
+*
+*     3) Call ZLAVHE_ROOK to form the product D * U' (or D * L' ).
+*
+      CALL ZLAVHE_ROOK( UPLO, 'Conjugate', 'Non-unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     4) Call ZLAVHE_RK again to multiply by U (or L ).
+*
+      CALL ZLAVHE_ROOK( UPLO, 'No transpose', 'Unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     5) Compute the difference  C - A .
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+         DO J = 1, N
+            DO I = 1, J - 1
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+            C( J, J ) = C( J, J ) - DBLE( A( J, J ) )
+         END DO
+      ELSE
+         DO J = 1, N
+            C( J, J ) = C( J, J ) - DBLE( A( J, J ) )
+            DO I = J + 1, N
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      END IF
+*
+*     6) Compute norm( C - A ) / ( N * norm(A) * EPS )
+*
+      RESID = ZLANHE( '1', UPLO, N, C, LDC, RWORK )
+*
+      IF( ANORM.LE.ZERO ) THEN
+         IF( RESID.NE.ZERO )
+     $      RESID = ONE / EPS
+      ELSE
+         RESID = ( ( RESID/DBLE( N ) )/ANORM ) / EPS
+      END IF
+*
+*     b) Convert to factor of L (or U)
+*
+      CALL ZSYCONVF_ROOK( UPLO, 'C', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+      RETURN
+*
+*     End of ZHET01_3
+*
+      END
diff --git a/TESTING/LIN/zhet01_aa.f b/TESTING/LIN/zhet01_aa.f
index d1328c88..c4734fcd 100644
--- a/TESTING/LIN/zhet01_aa.f
+++ b/TESTING/LIN/zhet01_aa.f
@@ -9,17 +9,17 @@
 *  ===========
 *
 *       SUBROUTINE ZHET01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV,
-*                          C, LDC, RWORK, RESID )
+*                             C, LDC, RWORK, RESID )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
 *       INTEGER            LDA, LDAFAC, LDC, N
-*       COMPLEX*16   RESID
+*       DOUBLE PRECISION   RESID
 *       ..
 *       .. Array Arguments ..
 *       INTEGER            IPIV( * )
-*       COMPLEX*16   A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
-*      $                   RWORK( * )
+*       DOUBLE PRECISION   RWORK( * )
+*       COMPLEX*16         A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
 *       ..
 *
 *
@@ -123,7 +123,7 @@
 *
 *  =====================================================================
       SUBROUTINE ZHET01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
-     $                         LDC, RWORK, RESID )
+     $                      LDC, RWORK, RESID )
 *
 *  -- LAPACK test routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -137,8 +137,8 @@
 *     ..
 *     .. Array Arguments ..
       INTEGER            IPIV( * )
-      COMPLEX*16         A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
-     $                   RWORK( * )
+      DOUBLE PRECISION   RWORK( * )
+      COMPLEX*16         A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
 *     ..
 *
 *  =====================================================================
@@ -197,40 +197,42 @@
      $                   LDC+1 )
             CALL ZLACGV( N-1, C( 1, 2 ), LDC+1 )
          ENDIF
-      ENDIF
 *
-*     Call ZTRMM to form the product U' * D (or L * D ).
+*        Call ZTRMM to form the product U' * D (or L * D ).
 *
-      IF( LSAME( UPLO, 'U' ) ) THEN
-         CALL ZTRMM( 'Left', UPLO, 'Conjugate transpose', 'Unit', N-1,
-     $               N, CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC )
-      ELSE
-         CALL ZTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
-     $               CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
-      END IF
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL ZTRMM( 'Left', UPLO, 'Conjugate transpose', 'Unit',
+     $                  N-1, N, CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ),
+     $                  LDC )
+         ELSE
+            CALL ZTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
+     $                  CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
+         END IF
 *
-*     Call ZTRMM again to multiply by U (or L ).
+*        Call ZTRMM again to multiply by U (or L ).
 *
-      IF( LSAME( UPLO, 'U' ) ) THEN
-         CALL ZTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
-     $               CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
-      ELSE
-         CALL ZTRMM( 'Right', UPLO, 'Conjugate transpose', 'Unit', N,
-     $               N-1, CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC )
-      END IF
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL ZTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
+     $                  CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
+         ELSE
+            CALL ZTRMM( 'Right', UPLO, 'Conjugate transpose', 'Unit', N,
+     $                  N-1, CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ),
+     $                  LDC )
+         END IF
+*
+*        Apply hermitian pivots
 *
-*     Apply hermitian pivots
-*
-      DO J = N, 1, -1
-         I = IPIV( J )
-         IF( I.NE.J )
-     $      CALL ZSWAP( N, C( J, 1 ), LDC, C( I, 1 ), LDC )
-      END DO
-      DO J = N, 1, -1
-         I = IPIV( J )
-         IF( I.NE.J )
-     $      CALL ZSWAP( N, C( 1, J ), 1, C( 1, I ), 1 )
-      END DO
+         DO J = N, 1, -1
+            I = IPIV( J )
+            IF( I.NE.J )
+     $         CALL ZSWAP( N, C( J, 1 ), LDC, C( I, 1 ), LDC )
+         END DO
+         DO J = N, 1, -1
+            I = IPIV( J )
+            IF( I.NE.J )
+     $         CALL ZSWAP( N, C( 1, J ), 1, C( 1, I ), 1 )
+         END DO
+      ENDIF
 *
 *
 *     Compute the difference  C - A .
diff --git a/TESTING/LIN/zsyt01_3.f b/TESTING/LIN/zsyt01_3.f
new file mode 100644
index 00000000..d20c4174
--- /dev/null
+++ b/TESTING/LIN/zsyt01_3.f
@@ -0,0 +1,253 @@
+*> \brief \b ZSYT01_3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+*                            LDC, RWORK, RESID )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            LDA, LDAFAC, LDC, N
+*       DOUBLE PRECISION   RESID
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   RWORK( * )
+*       COMPLEX*16         A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+*                          E( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZSYT01_3 reconstructs a symmetric indefinite matrix A from its
+*> block L*D*L' or U*D*U' factorization computed by ZSYTRF_RK
+*> (or ZSYTRF_BK) and computes the residual
+*>    norm( C - A ) / ( N * norm(A) * EPS ),
+*> where C is the reconstructed matrix and EPS is the machine epsilon.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          symmetric matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          The original symmetric matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N)
+*> \endverbatim
+*>
+*> \param[in] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX*16 array, dimension (LDAFAC,N)
+*>          Diagonal of the block diagonal matrix D and factors U or L
+*>          as computed by ZSYTRF_RK and ZSYTRF_BK:
+*>            a) ONLY diagonal elements of the symmetric block diagonal
+*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
+*>               (superdiagonal (or subdiagonal) elements of D
+*>                should be provided on entry in array E), and
+*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
+*>               If UPLO = 'L': factor L in the subdiagonal part of A.
+*> \endverbatim
+*>
+*> \param[in] LDAFAC
+*> \verbatim
+*>          LDAFAC is INTEGER
+*>          The leading dimension of the array AFAC.
+*>          LDAFAC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] E
+*> \verbatim
+*>          E is COMPLEX*16 array, dimension (N)
+*>          On entry, contains the superdiagonal (or subdiagonal)
+*>          elements of the symmetric block diagonal matrix D
+*>          with 1-by-1 or 2-by-2 diagonal blocks, where
+*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not refernced;
+*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          The pivot indices from ZSYTRF_RK (or ZSYTRF_BK).
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*>          C is COMPLEX*16 array, dimension (LDC,N)
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is DOUBLE PRECISION array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] RESID
+*> \verbatim
+*>          RESID is DOUBLE PRECISION
+*>          If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS )
+*>          If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*> \ingroup complex16_lin
+*
+*  =====================================================================
+      SUBROUTINE ZSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
+     $                     LDC, RWORK, RESID )
+*
+*  -- LAPACK test routine (version 3.7.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            LDA, LDAFAC, LDC, N
+      DOUBLE PRECISION   RESID
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      DOUBLE PRECISION   RWORK( * )
+      COMPLEX*16         A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+     $                   E( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      COMPLEX*16         CZERO, CONE
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
+     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, INFO, J
+      DOUBLE PRECISION   ANORM, EPS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      DOUBLE PRECISION   DLAMCH, ZLANSY
+      EXTERNAL           LSAME, DLAMCH, ZLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZLASET, ZLAVSY_ROOK, ZSYCONVF_ROOK
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick exit if N = 0.
+*
+      IF( N.LE.0 ) THEN
+         RESID = ZERO
+         RETURN
+      END IF
+*
+*     a) Revert to multiplyers of L
+*
+      CALL ZSYCONVF_ROOK( UPLO, 'R', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+*     1) Determine EPS and the norm of A.
+*
+      EPS = DLAMCH( 'Epsilon' )
+      ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+*     2) Initialize C to the identity matrix.
+*
+      CALL ZLASET( 'Full', N, N, CZERO, CONE, C, LDC )
+*
+*     3) Call ZLAVSY_ROOK to form the product D * U' (or D * L' ).
+*
+      CALL ZLAVSY_ROOK( UPLO, 'Transpose', 'Non-unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     4) Call ZLAVSY_ROOK again to multiply by U (or L ).
+*
+      CALL ZLAVSY_ROOK( UPLO, 'No transpose', 'Unit', N, N, AFAC,
+     $                  LDAFAC, IPIV, C, LDC, INFO )
+*
+*     5) Compute the difference  C - A .
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+         DO J = 1, N
+            DO I = 1, J
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      ELSE
+         DO J = 1, N
+            DO I = J, N
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      END IF
+*
+*     6) Compute norm( C - A ) / ( N * norm(A) * EPS )
+*
+      RESID = ZLANSY( '1', UPLO, N, C, LDC, RWORK )
+*
+      IF( ANORM.LE.ZERO ) THEN
+         IF( RESID.NE.ZERO )
+     $      RESID = ONE / EPS
+      ELSE
+         RESID = ( ( RESID / DBLE( N ) ) / ANORM ) / EPS
+      END IF
+
+*
+*     b) Convert to factor of L (or U)
+*
+      CALL ZSYCONVF_ROOK( UPLO, 'C', N, AFAC, LDAFAC, E, IPIV, INFO )
+*
+      RETURN
+*
+*     End of ZSYT01_3
+*
+      END
diff --git a/TESTING/LIN/zsyt01_aa.f b/TESTING/LIN/zsyt01_aa.f
new file mode 100644
index 00000000..988f4beb
--- /dev/null
+++ b/TESTING/LIN/zsyt01_aa.f
@@ -0,0 +1,265 @@
+*> \brief \b ZSYT01
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC,
+*                             RWORK, RESID )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            LDA, LDAFAC, LDC, N
+*       DOUBLE PRECISION   RESID
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       DOUBLE PRECISION   RWORK( * )
+*       COMPLEX*16         A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZSYT01 reconstructs a hermitian indefinite matrix A from its
+*> block L*D*L' or U*D*U' factorization and computes the residual
+*>    norm( C - A ) / ( N * norm(A) * EPS ),
+*> where C is the reconstructed matrix and EPS is the machine epsilon.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          hermitian matrix A is stored:
+*>          = 'U':  Upper triangular
+*>          = 'L':  Lower triangular
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          The original hermitian matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N)
+*> \endverbatim
+*>
+*> \param[in] AFAC
+*> \verbatim
+*>          AFAC is COMPLEX*16 array, dimension (LDAFAC,N)
+*>          The factored form of the matrix A.  AFAC contains the block
+*>          diagonal matrix D and the multipliers used to obtain the
+*>          factor L or U from the block L*D*L' or U*D*U' factorization
+*>          as computed by ZSYTRF.
+*> \endverbatim
+*>
+*> \param[in] LDAFAC
+*> \verbatim
+*>          LDAFAC is INTEGER
+*>          The leading dimension of the array AFAC.  LDAFAC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          The pivot indices from ZSYTRF.
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*>          C is COMPLEX*16 array, dimension (LDC,N)
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*>          RWORK is COMPLEX*16 array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] RESID
+*> \verbatim
+*>          RESID is COMPLEX*16
+*>          If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS )
+*>          If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2016
+*
+*  @generated from LIN/dsyt01_aa.f, fortran d -> z, Thu Nov 17 13:01:50 2016
+*
+*> \ingroup complex16_lin
+*
+*  =====================================================================
+      SUBROUTINE ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
+     $                      LDC, RWORK, RESID )
+*
+*  -- LAPACK test routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2016
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            LDA, LDAFAC, LDC, N
+      DOUBLE PRECISION   RESID
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      COMPLEX*16         A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
+      DOUBLE PRECISION   RWORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+      COMPLEX*16         CZERO, CONE
+      PARAMETER          ( CZERO = 0.0E+0, CONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, J
+      DOUBLE PRECISION   ANORM, EPS
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      DOUBLE PRECISION   DLAMCH, ZLANSY
+      EXTERNAL           LSAME, DLAMCH, ZLANSY
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZLASET, ZLAVSY
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick exit if N = 0.
+*
+      IF( N.LE.0 ) THEN
+         RESID = ZERO
+         RETURN
+      END IF
+*
+*     Determine EPS and the norm of A.
+*
+      EPS = DLAMCH( 'Epsilon' )
+      ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
+*
+*     Initialize C to the tridiagonal matrix T.
+*
+      CALL ZLASET( 'Full', N, N, CZERO, CZERO, C, LDC )
+      CALL ZLACPY( 'F', 1, N, AFAC( 1, 1 ), LDAFAC+1, C( 1, 1 ), LDC+1 )
+      IF( N.GT.1 ) THEN
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL ZLACPY( 'F', 1, N-1, AFAC( 1, 2 ), LDAFAC+1, C( 1, 2 ),
+     $                   LDC+1 )
+            CALL ZLACPY( 'F', 1, N-1, AFAC( 1, 2 ), LDAFAC+1, C( 2, 1 ),
+     $                   LDC+1 )
+         ELSE
+            CALL ZLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 1, 2 ),
+     $                   LDC+1 )
+            CALL ZLACPY( 'F', 1, N-1, AFAC( 2, 1 ), LDAFAC+1, C( 2, 1 ),
+     $                   LDC+1 )
+         ENDIF
+*
+*        Call ZTRMM to form the product U' * D (or L * D ).
+*
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL ZTRMM( 'Left', UPLO, 'Transpose', 'Unit', N-1, N,
+     $                  CONE, AFAC( 1, 2 ), LDAFAC, C( 2, 1 ), LDC )
+         ELSE
+            CALL ZTRMM( 'Left', UPLO, 'No transpose', 'Unit', N-1, N,
+     $                  CONE, AFAC( 2, 1 ), LDAFAC, C( 2, 1 ), LDC )
+         END IF
+*
+*        Call ZTRMM again to multiply by U (or L ).
+*
+         IF( LSAME( UPLO, 'U' ) ) THEN
+            CALL ZTRMM( 'Right', UPLO, 'No transpose', 'Unit', N, N-1,
+     $                  CONE, AFAC( 1, 2 ), LDAFAC, C( 1, 2 ), LDC )
+         ELSE
+            CALL ZTRMM( 'Right', UPLO, 'Transpose', 'Unit', N, N-1,
+     $                  CONE, AFAC( 2, 1 ), LDAFAC, C( 1, 2 ), LDC )
+         END IF
+      ENDIF
+*
+*     Apply symmetric pivots
+*
+      DO J = N, 1, -1
+         I = IPIV( J )
+         IF( I.NE.J )
+     $      CALL ZSWAP( N, C( J, 1 ), LDC, C( I, 1 ), LDC )
+      END DO
+      DO J = N, 1, -1
+         I = IPIV( J )
+         IF( I.NE.J )
+     $      CALL ZSWAP( N, C( 1, J ), 1, C( 1, I ), 1 )
+      END DO
+*
+*
+*     Compute the difference  C - A .
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+         DO J = 1, N
+            DO I = 1, J
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      ELSE
+         DO J = 1, N
+            DO I = J, N
+               C( I, J ) = C( I, J ) - A( I, J )
+            END DO
+         END DO
+      END IF
+*
+*     Compute norm( C - A ) / ( N * norm(A) * EPS )
+*
+      RESID = ZLANSY( '1', UPLO, N, C, LDC, RWORK )
+*
+      IF( ANORM.LE.ZERO ) THEN
+         IF( RESID.NE.ZERO )
+     $      RESID = ONE / EPS
+      ELSE
+         RESID = ( ( RESID / DBLE( N ) ) / ANORM ) / EPS
+      END IF
+*
+      RETURN
+*
+*     End of ZSYT01
+*
+      END
diff --git a/TESTING/MATGEN/CMakeLists.txt b/TESTING/MATGEN/CMakeLists.txt
index 011aea15..09b6e3b4 100644
--- a/TESTING/MATGEN/CMakeLists.txt
+++ b/TESTING/MATGEN/CMakeLists.txt
@@ -31,23 +31,23 @@
 #
 #######################################################################
 
-set(SCATGEN  slatm1.f slaran.f slarnd.f)
+set(SCATGEN slatm1.f slaran.f slarnd.f)
 
-set(SMATGEN  slatms.f slatme.f slatmr.f slatmt.f
+set(SMATGEN slatms.f slatme.f slatmr.f slatmt.f
    slagge.f slagsy.f slakf2.f slarge.f slaror.f slarot.f slatm2.f
    slatm3.f slatm5.f slatm6.f slatm7.f slahilb.f)
 
-set(CMATGEN  clatms.f clatme.f clatmr.f clatmt.f
+set(CMATGEN clatms.f clatme.f clatmr.f clatmt.f
    clagge.f claghe.f clagsy.f clakf2.f clarge.f claror.f clarot.f
    clatm1.f clarnd.f clatm2.f clatm3.f clatm5.f clatm6.f clahilb.f slatm7.f)
 
-set(DZATGEN  dlatm1.f dlaran.f dlarnd.f)
+set(DZATGEN dlatm1.f dlaran.f dlarnd.f)
 
-set(DMATGEN  dlatms.f dlatme.f dlatmr.f dlatmt.f
+set(DMATGEN dlatms.f dlatme.f dlatmr.f dlatmt.f
    dlagge.f dlagsy.f dlakf2.f dlarge.f dlaror.f dlarot.f dlatm2.f
    dlatm3.f dlatm5.f dlatm6.f dlatm7.f dlahilb.f)
 
-set(ZMATGEN  zlatms.f zlatme.f zlatmr.f zlatmt.f
+set(ZMATGEN zlatms.f zlatme.f zlatmr.f zlatmt.f
   zlagge.f zlaghe.f zlagsy.f zlakf2.f zlarge.f zlaror.f zlarot.f
   zlatm1.f zlarnd.f zlatm2.f zlatm3.f zlatm5.f zlatm6.f zlahilb.f dlatm7.f)
 
@@ -58,18 +58,18 @@ if(BUILD_DOUBLE)
   set(ALLOBJ ${ALLOBJ} ${DMATGEN} ${DZATGEN})
 endif()
 if(BUILD_COMPLEX)
-  set(ALLOBJ  ${ALLOBJ} ${CMATGEN} ${SCATGEN})
+  set(ALLOBJ ${ALLOBJ} ${CMATGEN} ${SCATGEN})
 endif()
 if(BUILD_COMPLEX16)
   set(ALLOBJ ${ALLOBJ} ${ZMATGEN} ${DZATGEN})
 endif()
 
-if (NOT ALLOBJ)
-set(ALLOBJ ${SMATGEN} ${CMATGEN} ${SCATGEN} ${DMATGEN} ${ZMATGEN}
-  ${DZATGEN})
+if(NOT ALLOBJ)
+  set(ALLOBJ ${SMATGEN} ${CMATGEN} ${SCATGEN} ${DMATGEN} ${ZMATGEN}
+    ${DZATGEN})
 else()
   list(REMOVE_DUPLICATES ALLOBJ)
 endif()
-add_library(tmglib ${ALLOBJ} )
+add_library(tmglib ${ALLOBJ})
 target_link_libraries(tmglib ${LAPACK_LIBRARIES})
 lapack_install_library(tmglib)
diff --git a/TESTING/MATGEN/Makefile b/TESTING/MATGEN/Makefile
index 49bc645f..34a6ff07 100644
--- a/TESTING/MATGEN/Makefile
+++ b/TESTING/MATGEN/Makefile
@@ -53,9 +53,9 @@ ZMATGEN = zlatms.o zlatme.o zlatmr.o zlatmt.o \
    zlagge.o zlaghe.o zlagsy.o zlakf2.o zlarge.o zlaror.o zlarot.o \
    zlatm1.o zlarnd.o zlatm2.o zlatm3.o zlatm5.o zlatm6.o zlahilb.o
 
-all:	../../$(TMGLIB)
+all: ../../$(TMGLIB)
 
-ALLOBJ = $(SMATGEN) $(CMATGEN) $(SCATGEN) $(DMATGEN) $(ZMATGEN)	\
+ALLOBJ = $(SMATGEN) $(CMATGEN) $(SCATGEN) $(DMATGEN) $(ZMATGEN) \
 	$(DZATGEN)
 
 ../../$(TMGLIB): $(ALLOBJ)
@@ -92,7 +92,7 @@ clean:
 	rm -f *.o
 
 .f.o:
-	$(FORTRAN) $(OPTS) -c $< -o $@
+	$(FORTRAN) $(OPTS) -c -o $@ $<
 
-slaran.o: slaran.f ; $(FORTRAN) $(NOOPT) -c $<
-dlaran.o: dlaran.f ; $(FORTRAN) $(NOOPT) -c $<
+slaran.o: slaran.f ; $(FORTRAN) $(NOOPT) -c -o $@ $<
+dlaran.o: dlaran.f ; $(FORTRAN) $(NOOPT) -c -o $@ $<
diff --git a/TESTING/Makefile b/TESTING/Makefile
index 968a9a2b..dfb5fc17 100644
--- a/TESTING/Makefile
+++ b/TESTING/Makefile
@@ -38,21 +38,22 @@
 include ../make.inc
 
 ifneq ($(strip $(VARLIB)),)
-    LAPACKLIB :=  $(VARLIB) ../$(LAPACKLIB)
+    LAPACKLIB := $(VARLIB) ../$(LAPACKLIB)
 endif
 
 
-all:     single complex double complex16 singleproto doubleproto complexproto complex16proto
+all: single complex double complex16 singleproto doubleproto complexproto complex16proto
 
 SEIGTST= snep.out \
          ssep.out \
+         sse2.out \
          ssvd.out \
          sec.out \
          sed.out \
          sgg.out \
          sgd.out \
          ssb.out \
-	 ssg.out \
+         ssg.out \
          sbal.out \
          sbak.out \
          sgbal.out \
@@ -66,13 +67,14 @@ SEIGTST= snep.out \
 
 CEIGTST= cnep.out \
          csep.out \
+         cse2.out \
          csvd.out \
          cec.out \
          ced.out \
          cgg.out \
          cgd.out \
          csb.out \
-	 csg.out \
+         csg.out \
          cbal.out \
          cbak.out \
          cgbal.out \
@@ -86,13 +88,14 @@ CEIGTST= cnep.out \
 
 DEIGTST= dnep.out \
          dsep.out \
+         dse2.out \
          dsvd.out \
          dec.out \
          ded.out \
          dgg.out \
          dgd.out \
          dsb.out \
-	 dsg.out \
+         dsg.out \
          dbal.out \
          dbak.out \
          dgbal.out \
@@ -106,13 +109,14 @@ DEIGTST= dnep.out \
 
 ZEIGTST= znep.out \
          zsep.out \
+         zse2.out \
          zsvd.out \
          zec.out \
          zed.out \
          zgg.out \
          zgd.out \
          zsb.out \
-	 zsg.out \
+         zsg.out \
          zbal.out \
          zbak.out \
          zgbal.out \
@@ -184,31 +188,31 @@ dstest.out: dstest.in xlintstds
 # ======== COMPLEX-COMPLEX16 LIN TESTS ========================
 
 zctest.out: zctest.in xlintstzc
-	@echo Testing COMPLEX-COMPLEX16 LAPACK protoype linear equation routines
+	@echo Testing COMPLEX-COMPLEX16 LAPACK prototype linear equation routines
 	./xlintstzc < zctest.in > $@ 2>&1
 #
 # ======== SINGLE RFP LIN TESTS ========================
 
 stest_rfp.out: stest_rfp.in xlintstrfs
-	@echo Testing REAL LAPACK RFP protoype linear equation routines
+	@echo Testing REAL LAPACK RFP prototype linear equation routines
 	./xlintstrfs < stest_rfp.in > $@ 2>&1
 #
 # ======== COMPLEX16 RFP LIN TESTS ========================
 
 dtest_rfp.out: dtest_rfp.in xlintstrfd
-	@echo Testing DOUBLE PRECISION LAPACK RFP protoype linear equation routines
+	@echo Testing DOUBLE PRECISION LAPACK RFP prototype linear equation routines
 	./xlintstrfd < dtest_rfp.in > $@ 2>&1
 #
 # ======== COMPLEX16 RFP LIN TESTS ========================
 
 ctest_rfp.out: ctest_rfp.in xlintstrfc
-	@echo Testing COMPLEX LAPACK RFP protoype linear equation routines
+	@echo Testing COMPLEX LAPACK RFP prototype linear equation routines
 	./xlintstrfc < ctest_rfp.in > $@ 2>&1
 #
 # ======== COMPLEX16 RFP LIN TESTS ========================
 
 ztest_rfp.out: ztest_rfp.in xlintstrfz
-	@echo Testing COMPLEX16 LAPACK RFP protoype linear equation routines
+	@echo Testing COMPLEX16 LAPACK RFP prototype linear equation routines
 	./xlintstrfz < ztest_rfp.in > $@ 2>&1
 #
 #
@@ -223,6 +227,10 @@ ssep.out: sep.in xeigtsts
 	@echo SEP: Testing Symmetric Eigenvalue Problem routines
 	./xeigtsts < sep.in > $@ 2>&1
 
+sse2.out: se2.in xeigtsts
+	@echo SEP: Testing Symmetric Eigenvalue Problem routines
+	./xeigtsts < se2.in > $@ 2>&1
+
 ssvd.out: svd.in xeigtsts
 	@echo SVD: Testing Singular Value Decomposition routines
 	./xeigtsts < svd.in > $@ 2>&1
@@ -268,7 +276,7 @@ sgbak.out: sgbak.in xeigtsts
 	./xeigtsts < sgbak.in > $@ 2>&1
 
 sbb.out: sbb.in xeigtsts
-	@echo SBB:  Testing banded Singular Value Decomposition routines
+	@echo SBB: Testing banded Singular Value Decomposition routines
 	./xeigtsts < sbb.in > $@ 2>&1
 
 sglm.out: glm.in xeigtsts
@@ -301,6 +309,10 @@ csep.out: sep.in xeigtstc
 	@echo SEP: Testing Symmetric Eigenvalue Problem routines
 	./xeigtstc < sep.in > $@ 2>&1
 
+cse2.out: se2.in xeigtstc
+	@echo SEP: Testing Symmetric Eigenvalue Problem routines
+	./xeigtstc < se2.in > $@ 2>&1
+
 csvd.out: svd.in xeigtstc
 	@echo SVD: Testing Singular Value Decomposition routines
 	./xeigtstc < svd.in > $@ 2>&1
@@ -346,7 +358,7 @@ cgbak.out: cgbak.in xeigtstc
 	./xeigtstc < cgbak.in > $@ 2>&1
 
 cbb.out: cbb.in xeigtstc
-	@echo CBB:  Testing banded Singular Value Decomposition routines
+	@echo CBB: Testing banded Singular Value Decomposition routines
 	./xeigtstc < cbb.in > $@ 2>&1
 
 cglm.out: glm.in xeigtstc
@@ -379,6 +391,10 @@ dsep.out: sep.in xeigtstd
 	@echo SEP: Testing Symmetric Eigenvalue Problem routines
 	./xeigtstd < sep.in > $@ 2>&1
 
+dse2.out: se2.in xeigtstd
+	@echo SEP: Testing Symmetric Eigenvalue Problem routines
+	./xeigtstd < se2.in > $@ 2>&1
+
 dsvd.out: svd.in xeigtstd
 	@echo SVD: Testing Singular Value Decomposition routines
 	./xeigtstd < svd.in > $@ 2>&1
@@ -412,7 +428,7 @@ dbal.out: dbal.in xeigtstd
 	./xeigtstd < dbal.in > $@ 2>&1
 
 dbak.out: dbak.in xeigtstd
-	@echo DGEBAK:  Testing the back transformation of a DOUBLE PRECISION balanced matrix
+	@echo DGEBAK: Testing the back transformation of a DOUBLE PRECISION balanced matrix
 	./xeigtstd < dbak.in > $@ 2>&1
 
 dgbal.out: dgbal.in xeigtstd
@@ -424,7 +440,7 @@ dgbak.out: dgbak.in xeigtstd
 	./xeigtstd < dgbak.in > $@ 2>&1
 
 dbb.out: dbb.in xeigtstd
-	@echo DBB:  Testing banded Singular Value Decomposition routines
+	@echo DBB: Testing banded Singular Value Decomposition routines
 	./xeigtstd < dbb.in > $@ 2>&1
 
 dglm.out: glm.in xeigtstd
@@ -457,6 +473,10 @@ zsep.out: sep.in xeigtstz
 	@echo SEP: Testing Symmetric Eigenvalue Problem routines
 	./xeigtstz < sep.in > $@ 2>&1
 
+zse2.out: se2.in xeigtstz
+	@echo SEP: Testing Symmetric Eigenvalue Problem routines
+	./xeigtstz < se2.in > $@ 2>&1
+
 zsvd.out: svd.in xeigtstz
 	@echo SVD: Testing Singular Value Decomposition routines
 	./xeigtstz < svd.in > $@ 2>&1
@@ -526,46 +546,46 @@ zlse.out: lse.in xeigtstz
 	./xeigtstz < lse.in > $@ 2>&1
 # ==============================================================================
 
-xlintsts:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
+xlintsts: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
 	cd LIN ; $(MAKE) single
 
-xlintstc:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
+xlintstc: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
 	cd LIN ; $(MAKE) complex
 
-xlintstd:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
+xlintstd: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
 	cd LIN ; $(MAKE) double
 
-xlintstz:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
+xlintstz: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
 	cd LIN ; $(MAKE) complex16
 
-xlintstrfs:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
+xlintstrfs: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
 	cd LIN ; $(MAKE) proto-single
 
-xlintstrfc:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
+xlintstrfc: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
 	cd LIN ; $(MAKE) proto-complex
 
-xlintstrfd:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
+xlintstrfd: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
 	cd LIN ; $(MAKE) proto-double
 
-xlintstrfz:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
+xlintstrfz: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
 	cd LIN ; $(MAKE) proto-complex16
 
-xlintstds:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
+xlintstds: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
 	cd LIN ; $(MAKE) proto-double
 
-xlintstzc:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
+xlintstzc: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
 	cd LIN ; $(MAKE) proto-complex16
 
-xeigtsts:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
+xeigtsts: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
 	cd EIG ; $(MAKE) single
 
-xeigtstc:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
+xeigtstc: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
 	cd EIG ; $(MAKE) complex
 
-xeigtstd:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
+xeigtstd: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
 	cd EIG ; $(MAKE) double
 
-xeigtstz:	../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
+xeigtstz: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
 	cd EIG ; $(MAKE) complex16
 
 clean:
diff --git a/TESTING/ctest.in b/TESTING/ctest.in
index b8a197a9..c5ed21fd 100755..100644
--- a/TESTING/ctest.in
+++ b/TESTING/ctest.in
@@ -24,10 +24,12 @@ CPB    8               List types on next line if 0 < NTYPES <  8
 CPT   12               List types on next line if 0 < NTYPES < 12
 CHE   10               List types on next line if 0 < NTYPES < 10
 CHR   10               List types on next line if 0 < NTYPES < 10
+CHK   10               List types on next line if 0 < NTYPES < 10
 CHA   10               List types on next line if 0 < NTYPES < 10
 CHP   10               List types on next line if 0 < NTYPES < 10
 CSY   11               List types on next line if 0 < NTYPES < 11
 CSR   11               List types on next line if 0 < NTYPES < 11
+CSK   11               List types on next line if 0 < NTYPES < 11
 CSP   11               List types on next line if 0 < NTYPES < 11
 CTR   18               List types on next line if 0 < NTYPES < 18
 CTP   18               List types on next line if 0 < NTYPES < 18
diff --git a/TESTING/dtest.in b/TESTING/dtest.in
index 3742b060..d05a27ca 100755..100644
--- a/TESTING/dtest.in
+++ b/TESTING/dtest.in
@@ -22,9 +22,10 @@ DPS    9               List types on next line if 0 < NTYPES <  9
 DPP    9               List types on next line if 0 < NTYPES <  9
 DPB    8               List types on next line if 0 < NTYPES <  8
 DPT   12               List types on next line if 0 < NTYPES < 12
-DSA   10               List types on next line if 0 < NTYPES < 10
 DSY   10               List types on next line if 0 < NTYPES < 10
 DSR   10               List types on next line if 0 < NTYPES < 10
+DSK   10               List types on next line if 0 < NTYPES < 10
+DSA   10               List types on next line if 0 < NTYPES < 10
 DSP   10               List types on next line if 0 < NTYPES < 10
 DTR   18               List types on next line if 0 < NTYPES < 18
 DTP   18               List types on next line if 0 < NTYPES < 18
diff --git a/TESTING/se2.in b/TESTING/se2.in
new file mode 100644
index 00000000..e20649c9
--- /dev/null
+++ b/TESTING/se2.in
@@ -0,0 +1,15 @@
+SE2:  Data file for testing Symmetric Eigenvalue Problem routines
+6                                 Number of values of N
+0 1 2 3 5 20                      Values of N (dimension)
+5                                 Number of values of NB
+1 3  3  3 10                      Values of NB (blocksize)
+2 2  2  2  2                      Values of NBMIN (minimum blocksize)
+1 0  5  9  1                      Values of NX (crossover point)
+50.0                              Threshold value
+T                                 Put T to test the LAPACK routines
+T                                 Put T to test the driver routines
+T                                 Put T to test the error exits
+1                                 Code to interpret the seed
+SE2 20
+1 2 3 4 5 6 7 8 10 11 12 13 14 15 16 17 18 19 20 21
+
diff --git a/TESTING/stest.in b/TESTING/stest.in
index 16529646..30f1c470 100755..100644
--- a/TESTING/stest.in
+++ b/TESTING/stest.in
@@ -22,9 +22,10 @@ SPS    9               List types on next line if 0 < NTYPES <  9
 SPP    9               List types on next line if 0 < NTYPES <  9
 SPB    8               List types on next line if 0 < NTYPES <  8
 SPT   12               List types on next line if 0 < NTYPES < 12
-SSA   10               List types on next line if 0 < NTYPES < 10
 SSY   10               List types on next line if 0 < NTYPES < 10
 SSR   10               List types on next line if 0 < NTYPES < 10
+SSK   10               List types on next line if 0 < NTYPES < 10
+SSA   10               List types on next line if 0 < NTYPES < 10
 SSP   10               List types on next line if 0 < NTYPES < 10
 STR   18               List types on next line if 0 < NTYPES < 18
 STP   18               List types on next line if 0 < NTYPES < 18
diff --git a/TESTING/ztest.in b/TESTING/ztest.in
index f3eabb5e..aba4a3d5 100755..100644
--- a/TESTING/ztest.in
+++ b/TESTING/ztest.in
@@ -22,12 +22,14 @@ ZPS    9               List types on next line if 0 < NTYPES <  9
 ZPP    9               List types on next line if 0 < NTYPES <  9
 ZPB    8               List types on next line if 0 < NTYPES <  8
 ZPT   12               List types on next line if 0 < NTYPES < 12
-ZHA   10               List types on next line if 0 < NTYPES < 10
 ZHE   10               List types on next line if 0 < NTYPES < 10
 ZHR   10               List types on next line if 0 < NTYPES < 10
+ZHK   10               List types on next line if 0 < NTYPES < 10
+ZHA   10               List types on next line if 0 < NTYPES < 10
 ZHP   10               List types on next line if 0 < NTYPES < 10
 ZSY   11               List types on next line if 0 < NTYPES < 11
 ZSR   11               List types on next line if 0 < NTYPES < 11
+ZSK   11               List types on next line if 0 < NTYPES < 11
 ZSP   11               List types on next line if 0 < NTYPES < 11
 ZTR   18               List types on next line if 0 < NTYPES < 18
 ZTP   18               List types on next line if 0 < NTYPES < 18
diff --git a/lapack_testing.py b/lapack_testing.py
index 4ffd72a0..a3d05a95 100755
--- a/lapack_testing.py
+++ b/lapack_testing.py
@@ -226,19 +226,19 @@ for dtype in range_prec:
         sys.stdout.flush()
 
     dtests = (
-    ("nep", "sep", "svd",
+    ("nep", "sep", "se2", "svd",
     letter+"ec",letter+"ed",letter+"gg",
     letter+"gd",letter+"sb",letter+"sg",
     letter+"bb","glm","gqr",
     "gsv","csd","lse",
     letter+"test", letter+dtypes[0][dtype-1]+"test",letter+"test_rfp"),
-    ("Nonsymmetric Eigenvalue Problem", "Symmetric Eigenvalue Problem", "Singular Value Decomposition",
+    ("Nonsymmetric Eigenvalue Problem", "Symmetric Eigenvalue Problem", "Symmetric Eigenvalue Problem 2 stage", "Singular Value Decomposition",
     "Eigen Condition","Nonsymmetric Eigenvalue","Nonsymmetric Generalized Eigenvalue Problem",
     "Nonsymmetric Generalized Eigenvalue Problem driver", "Symmetric Eigenvalue Problem", "Symmetric Eigenvalue Generalized Problem",
     "Banded Singular Value Decomposition routines", "Generalized Linear Regression Model routines", "Generalized QR and RQ factorization routines",
     "Generalized Singular Value Decomposition routines", "CS Decomposition routines", "Constrained Linear Least Squares routines",
     "Linear Equation routines", "Mixed Precision linear equation routines","RFP linear equation routines"),
-    (letter+"nep", letter+"sep", letter+"svd",
+    (letter+"nep", letter+"sep", letter+"se2", letter+"svd",
     letter+"ec",letter+"ed",letter+"gg",
     letter+"gd",letter+"sb",letter+"sg",
     letter+"bb",letter+"glm",letter+"gqr",