298 files changed, 0 insertions, 94514 deletions

diff --git a/src/lib/lapack/Makefile.am b/src/lib/lapack/Makefile.am
deleted file mode 100644
index 13904af1..00000000
--- a/src/lib/lapack/Makefile.am
+++ /dev/null
@@ -1,322 +0,0 @@
-##########
-### Sylvestre Ledru <sylvestre.ledru@inria.fr>
-### INRIA - Scilab 2006
-##########
-
-#### Target ######
-modulename=lapack
-
-pkglib_LTLIBRARIES = libscilapack.la
-
-noinst_LTLIBRARIES = libdummy-lapack.la
-
-LAPACK_FORTRAN_SOURCES = dlasv2.f \
-zgeqpf.f \
-zrot.f \
-dpotrf.f \
-zunmr3.f \
-zlanhs.f \
-zgebak.f \
-zbdsqr.f \
-zunmrz.f \
-dgetc2.f \
-zlaqp2.f \
-dsytrd.f \
-dsytd2.f \
-zlange.f \
-dlansp.f \
-dhgeqz.f \
-dlasq2.f \
-dtrevc.f \
-dgelsy.f \
-zladiv.f \
-dlaswp.f \
-dormlq.f \
-dorml2.f \
-dlaexc.f \
-zlahqr.f \
-zdrot.f \
-dlabad.f \
-dlarft.f \
-zlassq.f \
-dlartg.f \
-zlarf.f \
-ztrexc.f \
-zgeev.f \
-dggbal.f \
-dtrtrs.f \
-zlatdf.f \
-dgeqr2.f \
-zlarfg.f \
-dgetrs.f \
-dlag2.f \
-dlaqge.f \
-dpotf2.f \
-zgetrf.f \
-ztgsy2.f \
-zgebal.f \
-dspgst.f \
-dormqr.f \
-drscl.f \
-dtrti2.f \
-dlaset.f \
-dgeesx.f \
-dpocon.f \
-dlasyf.f \
-dgerq2.f \
-dlasq3.f \
-dlansy.f \
-dgehrd.f \
-dgehd2.f \
-dsptrd.f \
-dorgtr.f \
-dormrq.f \
-dorm2r.f \
-dormr2.f \
-zgges.f \
-zunglq.f \
-zlanhe.f \
-zungl2.f \
-zhetrd.f \
-zhetd2.f \
-dlacon.f \
-dgesvx.f \
-zgetf2.f \
-ztgevc.f \
-dsteqr.f \
-dgelqf.f \
-zlarzb.f \
-zlarfx.f \
-dsysv.f \
-zlaqps.f \
-dtzrqf.f \
-dsytrf.f \
-xerbla.f \
-dtrsyl.f \
-dgelss.f \
-dtgsen.f \
-zgecon.f \
-dormbr.f \
-zlatrz.f \
-zungqr.f \
-dlabrd.f \
-dlasq4.f \
-dggev.f \
-dpptrf.f \
-zgelq2.f \
-dgeqpf.f \
-dormr3.f \
-dlanhs.f \
-dgerfs.f \
-dlarz.f \
-zgebrd.f \
-zgebd2.f \
-dgebak.f \
-dormrz.f \
-dbdsqr.f \
-dspev.f \
-dlaqp2.f \
-zung2r.f \
-dlange.f \
-zgeqrf.f \
-dormql.f \
-zgesvd.f \
-dladiv.f \
-dlas2.f \
-dgeequ.f \
-dsytf2.f \
-dlahqr.f \
-zlatrs.f \
-zheev.f \
-ztgex2.f \
-zlaic1.f \
-ztrsen.f \
-zlacgv.f \
-dgees.f \
-dlassq.f \
-zlascl.f \
-dtrexc.f \
-dlasq5.f \
-dormhr.f \
-zgesc2.f \
-dlatdf.f \
-dsycon.f \
-dlarfg.f \
-dorm2l.f \
-dsptrf.f \
-zungbr.f \
-dgesv.f \
-dgetrf.f \
-zhseqr.f \
-dtgsy2.f \
-dlaev2.f \
-dgebal.f \
-zlarfb.f \
-zlahrd.f \
-dlantr.f \
-zgghrd.f \
-dlatzm.f \
-ztgsyl.f \
-ztrtri.f \
-zlatrd.f \
-zlacpy.f \
-zgetri.f \
-dlasr.f \
-zgeqp3.f \
-zungql.f \
-dlanst.f \
-zlarzt.f \
-dorglq.f \
-dorgl2.f \
-dlasq6.f \
-dlasy2.f \
-dopgtr.f \
-dgeqlf.f \
-dgetf2.f \
-dtgevc.f \
-zunghr.f \
-dlarzb.f \
-dlarfx.f \
-zung2l.f \
-zggev.f \
-dzsum1.f \
-dlaqps.f \
-dtrcon.f \
-dlasrt.f \
-dsyev.f \
-dorgqr.f \
-dgecon.f \
-dlatrz.f \
-zlarz.f \
-ztgexc.f \
-zggbak.f \
-ztzrzf.f \
-dpotrs.f \
-dsytri.f \
-dgelq2.f \
-zpotrf.f \
-dgebrd.f \
-dgebd2.f \
-zgetc2.f \
-dorgrq.f \
-dorg2r.f \
-dorgr2.f \
-zhgeqz.f \
-dgeqrf.f \
-dlaln2.f \
-dgesvd.f \
-ztrevc.f \
-zgelsy.f \
-zgees.f \
-zlaswp.f \
-dspgv.f \
-dlanv2.f \
-zunmlq.f \
-dlae2.f \
-zunml2.f \
-dlatrs.f \
-dtgex2.f \
-dlaic1.f \
-dgels.f \
-dtrsen.f \
-zdrscl.f \
-zlarft.f \
-dlascl.f \
-zlartg.f \
-zggbal.f \
-dgesc2.f \
-dgerqf.f \
-zgeqr2.f \
-zgetrs.f \
-ilaenv.f \
-dorgbr.f \
-zpotf2.f \
-dhseqr.f \
-dlarf.f \
-dgegs.f \
-dgeev.f \
-dlarfb.f \
-zlasr.f \
-dlapy2.f \
-zunmqr.f \
-ztrti2.f \
-dlahrd.f \
-dgghrd.f \
-zlaset.f \
-dtgsyl.f \
-dtrtri.f \
-dlatrd.f \
-dlacpy.f \
-dgetri.f \
-zgehrd.f \
-zgehd2.f \
-dgeqp3.f \
-dorgql.f \
-zungtr.f \
-zunm2r.f \
-dlarzt.f \
-dlapmt.f \
-ieeeck.f \
-dlasq1.f \
-dorghr.f \
-zlacon.f \
-dgelsx.f \
-dsterf.f \
-zsteqr.f \
-zgelqf.f \
-dsytrs.f \
-dgges.f \
-dorg2l.f \
-dlapy3.f \
-lsame.f \
-ztrsyl.f \
-izmax1.f \
-ztgsen.f \
-zunmbr.f \
-zlabrd.f \
-dtgexc.f \
-dgeql2.f \
-dlagv2.f \
-dggbak.f \
-dtzrzf.f \
-zlaqr0.f \
-dlacn2.f \
-zlacn2.f \
-dlazq3.f \
-zlahr2.f \
-dlaqr0.f \
-iparmq.f \
-disnan.f \
-dlaisnan.f \
-dlahr2.f \
-zlaqr3.f \
-zlaqr4.f \
-zlaqr5.f \
-dlazq4.f \
-dlaqr3.f \
-dlaqr4.f \
-dlaqr5.f \
-zlaqr2.f \
-zlaqr1.f \
-dlaqr2.f \
-dlaqr1.f
-
-HEAD = $(top_builddir)/includes/lapack.h
-
-libscilapack_la_SOURCES = $(HEAD) $(LAPACK_FORTRAN_SOURCES)
-
-libdummy_lapack_la_SOURCES = dlamch.f slamch.f
-
-libdummy_lapack_la_FFLAGS = `echo "@FFLAGS@"| sed -e 's|-O[0-9+]|-O0|'`
-
-
-libscilapack_la_LIBADD = libdummy-lapack.la \
-			$(top_builddir)/lib/blas/libsciblas.la
-
-libscilapack_la_PKGCONFIG = lapack.pc
-
-libdummy_lapack_la-dlamch.lo: dlamch.f
-	$(LIBTOOL) --tag=F77 --mode=compile $(F77) $(libdummy_lapack_la_FFLAGS) -c -o libdummy_lapack_la-dlamch.lo `test -f 'dlamch.f' || echo '$(srcdir)/'`dlamch.f
-
-libdummy_lapack_la-slamch.lo: slamch.f
-	$(LIBTOOL) --tag=F77 --mode=compile $(F77) $(libdummy_lapack_la_FFLAGS) -c -o libdummy_lapack_la-slamch.lo `test -f 'slamch.f' || echo '$(srcdir)/'`slamch.f
diff --git a/src/lib/lapack/Makefile.in b/src/lib/lapack/Makefile.in
deleted file mode 100644
index 51b22b91..00000000
--- a/src/lib/lapack/Makefile.in
+++ /dev/null
@@ -1,838 +0,0 @@
-# Makefile.in generated by automake 1.10.1 from Makefile.am.
-# @configure_input@
-
-# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
-# 2003, 2004, 2005, 2006, 2007, 2008  Free Software Foundation, Inc.
-# This Makefile.in is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
-# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-# PARTICULAR PURPOSE.
-
-@SET_MAKE@
-
-##########
-### Sylvestre Ledru <sylvestre.ledru@inria.fr>
-### INRIA - Scilab 2006
-##########
-
-VPATH = @srcdir@
-pkgdatadir = $(datadir)/@PACKAGE@
-pkglibdir = $(libdir)/@PACKAGE@
-pkgincludedir = $(includedir)/@PACKAGE@
-am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
-install_sh_DATA = $(install_sh) -c -m 644
-install_sh_PROGRAM = $(install_sh) -c
-install_sh_SCRIPT = $(install_sh) -c
-INSTALL_HEADER = $(INSTALL_DATA)
-transform = $(program_transform_name)
-NORMAL_INSTALL = :
-PRE_INSTALL = :
-POST_INSTALL = :
-NORMAL_UNINSTALL = :
-PRE_UNINSTALL = :
-POST_UNINSTALL = :
-build_triplet = @build@
-host_triplet = @host@
-subdir = lib/lapack
-DIST_COMMON = README $(srcdir)/Makefile.am $(srcdir)/Makefile.in
-ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
-am__aclocal_m4_deps = $(top_srcdir)/configure.ac
-am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
-	$(ACLOCAL_M4)
-mkinstalldirs = $(install_sh) -d
-CONFIG_HEADER = $(top_builddir)/includes/machine.h
-CONFIG_CLEAN_FILES =
-am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
-am__vpath_adj = case $$p in \
-    $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
-    *) f=$$p;; \
-  esac;
-am__strip_dir = `echo $$p | sed -e 's|^.*/||'`;
-am__installdirs = "$(DESTDIR)$(pkglibdir)"
-pkglibLTLIBRARIES_INSTALL = $(INSTALL)
-LTLIBRARIES = $(noinst_LTLIBRARIES) $(pkglib_LTLIBRARIES)
-libdummy_lapack_la_LIBADD =
-am_libdummy_lapack_la_OBJECTS = libdummy_lapack_la-dlamch.lo \
-	libdummy_lapack_la-slamch.lo
-libdummy_lapack_la_OBJECTS = $(am_libdummy_lapack_la_OBJECTS)
-libdummy_lapack_la_LINK = $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) \
-	$(LIBTOOLFLAGS) --mode=link $(F77LD) \
-	$(libdummy_lapack_la_FFLAGS) $(FFLAGS) $(AM_LDFLAGS) \
-	$(LDFLAGS) -o $@
-libscilapack_la_DEPENDENCIES = libdummy-lapack.la \
-	$(top_builddir)/lib/blas/libsciblas.la
-am__objects_1 =
-am__objects_2 = dlasv2.lo zgeqpf.lo zrot.lo dpotrf.lo zunmr3.lo \
-	zlanhs.lo zgebak.lo zbdsqr.lo zunmrz.lo dgetc2.lo zlaqp2.lo \
-	dsytrd.lo dsytd2.lo zlange.lo dlansp.lo dhgeqz.lo dlasq2.lo \
-	dtrevc.lo dgelsy.lo zladiv.lo dlaswp.lo dormlq.lo dorml2.lo \
-	dlaexc.lo zlahqr.lo zdrot.lo dlabad.lo dlarft.lo zlassq.lo \
-	dlartg.lo zlarf.lo ztrexc.lo zgeev.lo dggbal.lo dtrtrs.lo \
-	zlatdf.lo dgeqr2.lo zlarfg.lo dgetrs.lo dlag2.lo dlaqge.lo \
-	dpotf2.lo zgetrf.lo ztgsy2.lo zgebal.lo dspgst.lo dormqr.lo \
-	drscl.lo dtrti2.lo dlaset.lo dgeesx.lo dpocon.lo dlasyf.lo \
-	dgerq2.lo dlasq3.lo dlansy.lo dgehrd.lo dgehd2.lo dsptrd.lo \
-	dorgtr.lo dormrq.lo dorm2r.lo dormr2.lo zgges.lo zunglq.lo \
-	zlanhe.lo zungl2.lo zhetrd.lo zhetd2.lo dlacon.lo dgesvx.lo \
-	zgetf2.lo ztgevc.lo dsteqr.lo dgelqf.lo zlarzb.lo zlarfx.lo \
-	dsysv.lo zlaqps.lo dtzrqf.lo dsytrf.lo xerbla.lo dtrsyl.lo \
-	dgelss.lo dtgsen.lo zgecon.lo dormbr.lo zlatrz.lo zungqr.lo \
-	dlabrd.lo dlasq4.lo dggev.lo dpptrf.lo zgelq2.lo dgeqpf.lo \
-	dormr3.lo dlanhs.lo dgerfs.lo dlarz.lo zgebrd.lo zgebd2.lo \
-	dgebak.lo dormrz.lo dbdsqr.lo dspev.lo dlaqp2.lo zung2r.lo \
-	dlange.lo zgeqrf.lo dormql.lo zgesvd.lo dladiv.lo dlas2.lo \
-	dgeequ.lo dsytf2.lo dlahqr.lo zlatrs.lo zheev.lo ztgex2.lo \
-	zlaic1.lo ztrsen.lo zlacgv.lo dgees.lo dlassq.lo zlascl.lo \
-	dtrexc.lo dlasq5.lo dormhr.lo zgesc2.lo dlatdf.lo dsycon.lo \
-	dlarfg.lo dorm2l.lo dsptrf.lo zungbr.lo dgesv.lo dgetrf.lo \
-	zhseqr.lo dtgsy2.lo dlaev2.lo dgebal.lo zlarfb.lo zlahrd.lo \
-	dlantr.lo zgghrd.lo dlatzm.lo ztgsyl.lo ztrtri.lo zlatrd.lo \
-	zlacpy.lo zgetri.lo dlasr.lo zgeqp3.lo zungql.lo dlanst.lo \
-	zlarzt.lo dorglq.lo dorgl2.lo dlasq6.lo dlasy2.lo dopgtr.lo \
-	dgeqlf.lo dgetf2.lo dtgevc.lo zunghr.lo dlarzb.lo dlarfx.lo \
-	zung2l.lo zggev.lo dzsum1.lo dlaqps.lo dtrcon.lo dlasrt.lo \
-	dsyev.lo dorgqr.lo dgecon.lo dlatrz.lo zlarz.lo ztgexc.lo \
-	zggbak.lo ztzrzf.lo dpotrs.lo dsytri.lo dgelq2.lo zpotrf.lo \
-	dgebrd.lo dgebd2.lo zgetc2.lo dorgrq.lo dorg2r.lo dorgr2.lo \
-	zhgeqz.lo dgeqrf.lo dlaln2.lo dgesvd.lo ztrevc.lo zgelsy.lo \
-	zgees.lo zlaswp.lo dspgv.lo dlanv2.lo zunmlq.lo dlae2.lo \
-	zunml2.lo dlatrs.lo dtgex2.lo dlaic1.lo dgels.lo dtrsen.lo \
-	zdrscl.lo zlarft.lo dlascl.lo zlartg.lo zggbal.lo dgesc2.lo \
-	dgerqf.lo zgeqr2.lo zgetrs.lo ilaenv.lo dorgbr.lo zpotf2.lo \
-	dhseqr.lo dlarf.lo dgegs.lo dgeev.lo dlarfb.lo zlasr.lo \
-	dlapy2.lo zunmqr.lo ztrti2.lo dlahrd.lo dgghrd.lo zlaset.lo \
-	dtgsyl.lo dtrtri.lo dlatrd.lo dlacpy.lo dgetri.lo zgehrd.lo \
-	zgehd2.lo dgeqp3.lo dorgql.lo zungtr.lo zunm2r.lo dlarzt.lo \
-	dlapmt.lo ieeeck.lo dlasq1.lo dorghr.lo zlacon.lo dgelsx.lo \
-	dsterf.lo zsteqr.lo zgelqf.lo dsytrs.lo dgges.lo dorg2l.lo \
-	dlapy3.lo lsame.lo ztrsyl.lo izmax1.lo ztgsen.lo zunmbr.lo \
-	zlabrd.lo dtgexc.lo dgeql2.lo dlagv2.lo dggbak.lo dtzrzf.lo \
-	zlaqr0.lo dlacn2.lo zlacn2.lo dlazq3.lo zlahr2.lo dlaqr0.lo \
-	iparmq.lo disnan.lo dlaisnan.lo dlahr2.lo zlaqr3.lo zlaqr4.lo \
-	zlaqr5.lo dlazq4.lo dlaqr3.lo dlaqr4.lo dlaqr5.lo zlaqr2.lo \
-	zlaqr1.lo dlaqr2.lo dlaqr1.lo
-am_libscilapack_la_OBJECTS = $(am__objects_1) $(am__objects_2)
-libscilapack_la_OBJECTS = $(am_libscilapack_la_OBJECTS)
-DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)/includes
-F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
-LTF77COMPILE = $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
-	--mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
-F77LD = $(F77)
-F77LINK = $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
-	--mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) $(AM_LDFLAGS) \
-	$(LDFLAGS) -o $@
-COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
-	$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
-LTCOMPILE = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
-	--mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
-	$(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
-CCLD = $(CC)
-LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
-	--mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \
-	$(LDFLAGS) -o $@
-SOURCES = $(libdummy_lapack_la_SOURCES) $(libscilapack_la_SOURCES)
-DIST_SOURCES = $(libdummy_lapack_la_SOURCES) \
-	$(libscilapack_la_SOURCES)
-ETAGS = etags
-CTAGS = ctags
-DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
-ACLOCAL = @ACLOCAL@
-AMTAR = @AMTAR@
-AR = @AR@
-AUTOCONF = @AUTOCONF@
-AUTOHEADER = @AUTOHEADER@
-AUTOMAKE = @AUTOMAKE@
-AWK = @AWK@
-CC = @CC@
-CCDEPMODE = @CCDEPMODE@
-CFLAGS = @CFLAGS@
-CPP = @CPP@
-CPPFLAGS = @CPPFLAGS@
-CXX = @CXX@
-CXXCPP = @CXXCPP@
-CXXDEPMODE = @CXXDEPMODE@
-CXXFLAGS = @CXXFLAGS@
-CYGPATH_W = @CYGPATH_W@
-DEFS = @DEFS@
-DEPDIR = @DEPDIR@
-DSYMUTIL = @DSYMUTIL@
-ECHO = @ECHO@
-ECHO_C = @ECHO_C@
-ECHO_N = @ECHO_N@
-ECHO_T = @ECHO_T@
-EGREP = @EGREP@
-EXEEXT = @EXEEXT@
-F77 = @F77@
-FFLAGS = @FFLAGS@
-GREP = @GREP@
-INSTALL = @INSTALL@
-INSTALL_DATA = @INSTALL_DATA@
-INSTALL_PROGRAM = @INSTALL_PROGRAM@
-INSTALL_SCRIPT = @INSTALL_SCRIPT@
-INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
-LDFLAGS = @LDFLAGS@
-LIBMATH = @LIBMATH@
-LIBOBJS = @LIBOBJS@
-LIBS = @LIBS@
-LIBTOOL = @LIBTOOL@
-LN_S = @LN_S@
-LTLIBOBJS = @LTLIBOBJS@
-MAINT = @MAINT@
-MAKEINFO = @MAKEINFO@
-MKDIR_P = @MKDIR_P@
-NMEDIT = @NMEDIT@
-OBJEXT = @OBJEXT@
-PACKAGE = @PACKAGE@
-PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
-PACKAGE_NAME = @PACKAGE_NAME@
-PACKAGE_STRING = @PACKAGE_STRING@
-PACKAGE_TARNAME = @PACKAGE_TARNAME@
-PACKAGE_VERSION = @PACKAGE_VERSION@
-PATH_SEPARATOR = @PATH_SEPARATOR@
-RANLIB = @RANLIB@
-SED = @SED@
-SET_MAKE = @SET_MAKE@
-SHELL = @SHELL@
-STRIP = @STRIP@
-VERSION = @VERSION@
-abs_builddir = @abs_builddir@
-abs_srcdir = @abs_srcdir@
-abs_top_builddir = @abs_top_builddir@
-abs_top_srcdir = @abs_top_srcdir@
-ac_ct_CC = @ac_ct_CC@
-ac_ct_CXX = @ac_ct_CXX@
-ac_ct_F77 = @ac_ct_F77@
-am__include = @am__include@
-am__leading_dot = @am__leading_dot@
-am__quote = @am__quote@
-am__tar = @am__tar@
-am__untar = @am__untar@
-bindir = @bindir@
-build = @build@
-build_alias = @build_alias@
-build_cpu = @build_cpu@
-build_os = @build_os@
-build_vendor = @build_vendor@
-builddir = @builddir@
-datadir = @datadir@
-datarootdir = @datarootdir@
-docdir = @docdir@
-dvidir = @dvidir@
-exec_prefix = @exec_prefix@
-host = @host@
-host_alias = @host_alias@
-host_cpu = @host_cpu@
-host_os = @host_os@
-host_vendor = @host_vendor@
-htmldir = @htmldir@
-includedir = @includedir@
-infodir = @infodir@
-install_sh = @install_sh@
-libdir = @libdir@
-libexecdir = @libexecdir@
-localedir = @localedir@
-localstatedir = @localstatedir@
-mandir = @mandir@
-mkdir_p = @mkdir_p@
-oldincludedir = @oldincludedir@
-pdfdir = @pdfdir@
-prefix = @prefix@
-program_transform_name = @program_transform_name@
-psdir = @psdir@
-sbindir = @sbindir@
-sharedstatedir = @sharedstatedir@
-srcdir = @srcdir@
-sysconfdir = @sysconfdir@
-target_alias = @target_alias@
-top_builddir = @top_builddir@
-top_srcdir = @top_srcdir@
-
-#### Target ######
-modulename = lapack
-pkglib_LTLIBRARIES = libscilapack.la
-noinst_LTLIBRARIES = libdummy-lapack.la
-LAPACK_FORTRAN_SOURCES = dlasv2.f \
-zgeqpf.f \
-zrot.f \
-dpotrf.f \
-zunmr3.f \
-zlanhs.f \
-zgebak.f \
-zbdsqr.f \
-zunmrz.f \
-dgetc2.f \
-zlaqp2.f \
-dsytrd.f \
-dsytd2.f \
-zlange.f \
-dlansp.f \
-dhgeqz.f \
-dlasq2.f \
-dtrevc.f \
-dgelsy.f \
-zladiv.f \
-dlaswp.f \
-dormlq.f \
-dorml2.f \
-dlaexc.f \
-zlahqr.f \
-zdrot.f \
-dlabad.f \
-dlarft.f \
-zlassq.f \
-dlartg.f \
-zlarf.f \
-ztrexc.f \
-zgeev.f \
-dggbal.f \
-dtrtrs.f \
-zlatdf.f \
-dgeqr2.f \
-zlarfg.f \
-dgetrs.f \
-dlag2.f \
-dlaqge.f \
-dpotf2.f \
-zgetrf.f \
-ztgsy2.f \
-zgebal.f \
-dspgst.f \
-dormqr.f \
-drscl.f \
-dtrti2.f \
-dlaset.f \
-dgeesx.f \
-dpocon.f \
-dlasyf.f \
-dgerq2.f \
-dlasq3.f \
-dlansy.f \
-dgehrd.f \
-dgehd2.f \
-dsptrd.f \
-dorgtr.f \
-dormrq.f \
-dorm2r.f \
-dormr2.f \
-zgges.f \
-zunglq.f \
-zlanhe.f \
-zungl2.f \
-zhetrd.f \
-zhetd2.f \
-dlacon.f \
-dgesvx.f \
-zgetf2.f \
-ztgevc.f \
-dsteqr.f \
-dgelqf.f \
-zlarzb.f \
-zlarfx.f \
-dsysv.f \
-zlaqps.f \
-dtzrqf.f \
-dsytrf.f \
-xerbla.f \
-dtrsyl.f \
-dgelss.f \
-dtgsen.f \
-zgecon.f \
-dormbr.f \
-zlatrz.f \
-zungqr.f \
-dlabrd.f \
-dlasq4.f \
-dggev.f \
-dpptrf.f \
-zgelq2.f \
-dgeqpf.f \
-dormr3.f \
-dlanhs.f \
-dgerfs.f \
-dlarz.f \
-zgebrd.f \
-zgebd2.f \
-dgebak.f \
-dormrz.f \
-dbdsqr.f \
-dspev.f \
-dlaqp2.f \
-zung2r.f \
-dlange.f \
-zgeqrf.f \
-dormql.f \
-zgesvd.f \
-dladiv.f \
-dlas2.f \
-dgeequ.f \
-dsytf2.f \
-dlahqr.f \
-zlatrs.f \
-zheev.f \
-ztgex2.f \
-zlaic1.f \
-ztrsen.f \
-zlacgv.f \
-dgees.f \
-dlassq.f \
-zlascl.f \
-dtrexc.f \
-dlasq5.f \
-dormhr.f \
-zgesc2.f \
-dlatdf.f \
-dsycon.f \
-dlarfg.f \
-dorm2l.f \
-dsptrf.f \
-zungbr.f \
-dgesv.f \
-dgetrf.f \
-zhseqr.f \
-dtgsy2.f \
-dlaev2.f \
-dgebal.f \
-zlarfb.f \
-zlahrd.f \
-dlantr.f \
-zgghrd.f \
-dlatzm.f \
-ztgsyl.f \
-ztrtri.f \
-zlatrd.f \
-zlacpy.f \
-zgetri.f \
-dlasr.f \
-zgeqp3.f \
-zungql.f \
-dlanst.f \
-zlarzt.f \
-dorglq.f \
-dorgl2.f \
-dlasq6.f \
-dlasy2.f \
-dopgtr.f \
-dgeqlf.f \
-dgetf2.f \
-dtgevc.f \
-zunghr.f \
-dlarzb.f \
-dlarfx.f \
-zung2l.f \
-zggev.f \
-dzsum1.f \
-dlaqps.f \
-dtrcon.f \
-dlasrt.f \
-dsyev.f \
-dorgqr.f \
-dgecon.f \
-dlatrz.f \
-zlarz.f \
-ztgexc.f \
-zggbak.f \
-ztzrzf.f \
-dpotrs.f \
-dsytri.f \
-dgelq2.f \
-zpotrf.f \
-dgebrd.f \
-dgebd2.f \
-zgetc2.f \
-dorgrq.f \
-dorg2r.f \
-dorgr2.f \
-zhgeqz.f \
-dgeqrf.f \
-dlaln2.f \
-dgesvd.f \
-ztrevc.f \
-zgelsy.f \
-zgees.f \
-zlaswp.f \
-dspgv.f \
-dlanv2.f \
-zunmlq.f \
-dlae2.f \
-zunml2.f \
-dlatrs.f \
-dtgex2.f \
-dlaic1.f \
-dgels.f \
-dtrsen.f \
-zdrscl.f \
-zlarft.f \
-dlascl.f \
-zlartg.f \
-zggbal.f \
-dgesc2.f \
-dgerqf.f \
-zgeqr2.f \
-zgetrs.f \
-ilaenv.f \
-dorgbr.f \
-zpotf2.f \
-dhseqr.f \
-dlarf.f \
-dgegs.f \
-dgeev.f \
-dlarfb.f \
-zlasr.f \
-dlapy2.f \
-zunmqr.f \
-ztrti2.f \
-dlahrd.f \
-dgghrd.f \
-zlaset.f \
-dtgsyl.f \
-dtrtri.f \
-dlatrd.f \
-dlacpy.f \
-dgetri.f \
-zgehrd.f \
-zgehd2.f \
-dgeqp3.f \
-dorgql.f \
-zungtr.f \
-zunm2r.f \
-dlarzt.f \
-dlapmt.f \
-ieeeck.f \
-dlasq1.f \
-dorghr.f \
-zlacon.f \
-dgelsx.f \
-dsterf.f \
-zsteqr.f \
-zgelqf.f \
-dsytrs.f \
-dgges.f \
-dorg2l.f \
-dlapy3.f \
-lsame.f \
-ztrsyl.f \
-izmax1.f \
-ztgsen.f \
-zunmbr.f \
-zlabrd.f \
-dtgexc.f \
-dgeql2.f \
-dlagv2.f \
-dggbak.f \
-dtzrzf.f \
-zlaqr0.f \
-dlacn2.f \
-zlacn2.f \
-dlazq3.f \
-zlahr2.f \
-dlaqr0.f \
-iparmq.f \
-disnan.f \
-dlaisnan.f \
-dlahr2.f \
-zlaqr3.f \
-zlaqr4.f \
-zlaqr5.f \
-dlazq4.f \
-dlaqr3.f \
-dlaqr4.f \
-dlaqr5.f \
-zlaqr2.f \
-zlaqr1.f \
-dlaqr2.f \
-dlaqr1.f
-
-HEAD = $(top_builddir)/includes/lapack.h
-libscilapack_la_SOURCES = $(HEAD) $(LAPACK_FORTRAN_SOURCES)
-libdummy_lapack_la_SOURCES = dlamch.f slamch.f
-libdummy_lapack_la_FFLAGS = `echo "@FFLAGS@"| sed -e 's|-O[0-9+]|-O0|'`
-libscilapack_la_LIBADD = libdummy-lapack.la \
-			$(top_builddir)/lib/blas/libsciblas.la
-
-libscilapack_la_PKGCONFIG = lapack.pc
-all: all-am
-
-.SUFFIXES:
-.SUFFIXES: .f .lo .o .obj
-$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am  $(am__configure_deps)
-	@for dep in $?; do \
-	  case '$(am__configure_deps)' in \
-	    *$$dep*) \
-	      cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \
-		&& exit 0; \
-	      exit 1;; \
-	  esac; \
-	done; \
-	echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign  lib/lapack/Makefile'; \
-	cd $(top_srcdir) && \
-	  $(AUTOMAKE) --foreign  lib/lapack/Makefile
-.PRECIOUS: Makefile
-Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
-	@case '$?' in \
-	  *config.status*) \
-	    cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
-	  *) \
-	    echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
-	    cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
-	esac;
-
-$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
-	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
-
-$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
-	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
-$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
-	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
-
-clean-noinstLTLIBRARIES:
-	-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
-	@list='$(noinst_LTLIBRARIES)'; for p in $$list; do \
-	  dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \
-	  test "$$dir" != "$$p" || dir=.; \
-	  echo "rm -f \"$${dir}/so_locations\""; \
-	  rm -f "$${dir}/so_locations"; \
-	done
-install-pkglibLTLIBRARIES: $(pkglib_LTLIBRARIES)
-	@$(NORMAL_INSTALL)
-	test -z "$(pkglibdir)" || $(MKDIR_P) "$(DESTDIR)$(pkglibdir)"
-	@list='$(pkglib_LTLIBRARIES)'; for p in $$list; do \
-	  if test -f $$p; then \
-	    f=$(am__strip_dir) \
-	    echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(pkglibLTLIBRARIES_INSTALL) $(INSTALL_STRIP_FLAG) '$$p' '$(DESTDIR)$(pkglibdir)/$$f'"; \
-	    $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(pkglibLTLIBRARIES_INSTALL) $(INSTALL_STRIP_FLAG) "$$p" "$(DESTDIR)$(pkglibdir)/$$f"; \
-	  else :; fi; \
-	done
-
-uninstall-pkglibLTLIBRARIES:
-	@$(NORMAL_UNINSTALL)
-	@list='$(pkglib_LTLIBRARIES)'; for p in $$list; do \
-	  p=$(am__strip_dir) \
-	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(pkglibdir)/$$p'"; \
-	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(pkglibdir)/$$p"; \
-	done
-
-clean-pkglibLTLIBRARIES:
-	-test -z "$(pkglib_LTLIBRARIES)" || rm -f $(pkglib_LTLIBRARIES)
-	@list='$(pkglib_LTLIBRARIES)'; for p in $$list; do \
-	  dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \
-	  test "$$dir" != "$$p" || dir=.; \
-	  echo "rm -f \"$${dir}/so_locations\""; \
-	  rm -f "$${dir}/so_locations"; \
-	done
-libdummy-lapack.la: $(libdummy_lapack_la_OBJECTS) $(libdummy_lapack_la_DEPENDENCIES) 
-	$(libdummy_lapack_la_LINK)  $(libdummy_lapack_la_OBJECTS) $(libdummy_lapack_la_LIBADD) $(LIBS)
-libscilapack.la: $(libscilapack_la_OBJECTS) $(libscilapack_la_DEPENDENCIES) 
-	$(F77LINK) -rpath $(pkglibdir) $(libscilapack_la_OBJECTS) $(libscilapack_la_LIBADD) $(LIBS)
-
-mostlyclean-compile:
-	-rm -f *.$(OBJEXT)
-
-distclean-compile:
-	-rm -f *.tab.c
-
-.f.o:
-	$(F77COMPILE) -c -o $@ $<
-
-.f.obj:
-	$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
-
-.f.lo:
-	$(LTF77COMPILE) -c -o $@ $<
-
-mostlyclean-libtool:
-	-rm -f *.lo
-
-clean-libtool:
-	-rm -rf .libs _libs
-
-ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
-	list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
-	unique=`for i in $$list; do \
-	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
-	  done | \
-	  $(AWK) '{ files[$$0] = 1; nonemtpy = 1; } \
-	      END { if (nonempty) { for (i in files) print i; }; }'`; \
-	mkid -fID $$unique
-tags: TAGS
-
-TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
-		$(TAGS_FILES) $(LISP)
-	tags=; \
-	here=`pwd`; \
-	list='$(SOURCES) $(HEADERS)  $(LISP) $(TAGS_FILES)'; \
-	unique=`for i in $$list; do \
-	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
-	  done | \
-	  $(AWK) '{ files[$$0] = 1; nonempty = 1; } \
-	      END { if (nonempty) { for (i in files) print i; }; }'`; \
-	if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \
-	  test -n "$$unique" || unique=$$empty_fix; \
-	  $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
-	    $$tags $$unique; \
-	fi
-ctags: CTAGS
-CTAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
-		$(TAGS_FILES) $(LISP)
-	tags=; \
-	list='$(SOURCES) $(HEADERS)  $(LISP) $(TAGS_FILES)'; \
-	unique=`for i in $$list; do \
-	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
-	  done | \
-	  $(AWK) '{ files[$$0] = 1; nonempty = 1; } \
-	      END { if (nonempty) { for (i in files) print i; }; }'`; \
-	test -z "$(CTAGS_ARGS)$$tags$$unique" \
-	  || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
-	     $$tags $$unique
-
-GTAGS:
-	here=`$(am__cd) $(top_builddir) && pwd` \
-	  && cd $(top_srcdir) \
-	  && gtags -i $(GTAGS_ARGS) $$here
-
-distclean-tags:
-	-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
-
-distdir: $(DISTFILES)
-	@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
-	topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
-	list='$(DISTFILES)'; \
-	  dist_files=`for file in $$list; do echo $$file; done | \
-	  sed -e "s|^$$srcdirstrip/||;t" \
-	      -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
-	case $$dist_files in \
-	  */*) $(MKDIR_P) `echo "$$dist_files" | \
-			   sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
-			   sort -u` ;; \
-	esac; \
-	for file in $$dist_files; do \
-	  if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
-	  if test -d $$d/$$file; then \
-	    dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
-	    if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
-	      cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \
-	    fi; \
-	    cp -pR $$d/$$file $(distdir)$$dir || exit 1; \
-	  else \
-	    test -f $(distdir)/$$file \
-	    || cp -p $$d/$$file $(distdir)/$$file \
-	    || exit 1; \
-	  fi; \
-	done
-check-am: all-am
-check: check-am
-all-am: Makefile $(LTLIBRARIES)
-installdirs:
-	for dir in "$(DESTDIR)$(pkglibdir)"; do \
-	  test -z "$$dir" || $(MKDIR_P) "$$dir"; \
-	done
-install: install-am
-install-exec: install-exec-am
-install-data: install-data-am
-uninstall: uninstall-am
-
-install-am: all-am
-	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
-
-installcheck: installcheck-am
-install-strip:
-	$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
-	  install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
-	  `test -z '$(STRIP)' || \
-	    echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
-mostlyclean-generic:
-
-clean-generic:
-
-distclean-generic:
-	-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-
-maintainer-clean-generic:
-	@echo "This command is intended for maintainers to use"
-	@echo "it deletes files that may require special tools to rebuild."
-clean: clean-am
-
-clean-am: clean-generic clean-libtool clean-noinstLTLIBRARIES \
-	clean-pkglibLTLIBRARIES mostlyclean-am
-
-distclean: distclean-am
-	-rm -f Makefile
-distclean-am: clean-am distclean-compile distclean-generic \
-	distclean-tags
-
-dvi: dvi-am
-
-dvi-am:
-
-html: html-am
-
-info: info-am
-
-info-am:
-
-install-data-am:
-
-install-dvi: install-dvi-am
-
-install-exec-am: install-pkglibLTLIBRARIES
-
-install-html: install-html-am
-
-install-info: install-info-am
-
-install-man:
-
-install-pdf: install-pdf-am
-
-install-ps: install-ps-am
-
-installcheck-am:
-
-maintainer-clean: maintainer-clean-am
-	-rm -f Makefile
-maintainer-clean-am: distclean-am maintainer-clean-generic
-
-mostlyclean: mostlyclean-am
-
-mostlyclean-am: mostlyclean-compile mostlyclean-generic \
-	mostlyclean-libtool
-
-pdf: pdf-am
-
-pdf-am:
-
-ps: ps-am
-
-ps-am:
-
-uninstall-am: uninstall-pkglibLTLIBRARIES
-
-.MAKE: install-am install-strip
-
-.PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \
-	clean-libtool clean-noinstLTLIBRARIES clean-pkglibLTLIBRARIES \
-	ctags distclean distclean-compile distclean-generic \
-	distclean-libtool distclean-tags distdir dvi dvi-am html \
-	html-am info info-am install install-am install-data \
-	install-data-am install-dvi install-dvi-am install-exec \
-	install-exec-am install-html install-html-am install-info \
-	install-info-am install-man install-pdf install-pdf-am \
-	install-pkglibLTLIBRARIES install-ps install-ps-am \
-	install-strip installcheck installcheck-am installdirs \
-	maintainer-clean maintainer-clean-generic mostlyclean \
-	mostlyclean-compile mostlyclean-generic mostlyclean-libtool \
-	pdf pdf-am ps ps-am tags uninstall uninstall-am \
-	uninstall-pkglibLTLIBRARIES
-
-
-libdummy_lapack_la-dlamch.lo: dlamch.f
-	$(LIBTOOL) --tag=F77 --mode=compile $(F77) $(libdummy_lapack_la_FFLAGS) -c -o libdummy_lapack_la-dlamch.lo `test -f 'dlamch.f' || echo '$(srcdir)/'`dlamch.f
-
-libdummy_lapack_la-slamch.lo: slamch.f
-	$(LIBTOOL) --tag=F77 --mode=compile $(F77) $(libdummy_lapack_la_FFLAGS) -c -o libdummy_lapack_la-slamch.lo `test -f 'slamch.f' || echo '$(srcdir)/'`slamch.f
-# Tell versions [3.59,3.63) of GNU make to not export all variables.
-# Otherwise a system limit (for SysV at least) may be exceeded.
-.NOEXPORT:
diff --git a/src/lib/lapack/README b/src/lib/lapack/README
deleted file mode 100644
index c14fb64f..00000000
--- a/src/lib/lapack/README
+++ /dev/null
@@ -1,5 +0,0 @@
-This directory contains LAPACK routines.
-File xerbla.f is not used. 
-A customized version of xerbla
-for Scilab is in SCIDIR/system/xerbla.f
-
diff --git a/src/lib/lapack/dbdsqr.f b/src/lib/lapack/dbdsqr.f
deleted file mode 100644
index b9f87ec1..00000000
--- a/src/lib/lapack/dbdsqr.f
+++ /dev/null
@@ -1,742 +0,0 @@
-      SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
-     $                   LDU, C, LDC, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   C( LDC, * ), D( * ), E( * ), U( LDU, * ),
-     $                   VT( LDVT, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DBDSQR computes the singular values and, optionally, the right and/or
-*  left singular vectors from the singular value decomposition (SVD) of
-*  a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
-*  zero-shift QR algorithm.  The SVD of B has the form
-* 
-*     B = Q * S * P**T
-* 
-*  where S is the diagonal matrix of singular values, Q is an orthogonal
-*  matrix of left singular vectors, and P is an orthogonal matrix of
-*  right singular vectors.  If left singular vectors are requested, this
-*  subroutine actually returns U*Q instead of Q, and, if right singular
-*  vectors are requested, this subroutine returns P**T*VT instead of
-*  P**T, for given real input matrices U and VT.  When U and VT are the
-*  orthogonal matrices that reduce a general matrix A to bidiagonal
-*  form:  A = U*B*VT, as computed by DGEBRD, then
-*
-*     A = (U*Q) * S * (P**T*VT)
-*
-*  is the SVD of A.  Optionally, the subroutine may also compute Q**T*C
-*  for a given real input matrix C.
-*
-*  See "Computing  Small Singular Values of Bidiagonal Matrices With
-*  Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
-*  LAPACK Working Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11,
-*  no. 5, pp. 873-912, Sept 1990) and
-*  "Accurate singular values and differential qd algorithms," by
-*  B. Parlett and V. Fernando, Technical Report CPAM-554, Mathematics
-*  Department, University of California at Berkeley, July 1992
-*  for a detailed description of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  B is upper bidiagonal;
-*          = 'L':  B is lower bidiagonal.
-*
-*  N       (input) INTEGER
-*          The order of the matrix B.  N >= 0.
-*
-*  NCVT    (input) INTEGER
-*          The number of columns of the matrix VT. NCVT >= 0.
-*
-*  NRU     (input) INTEGER
-*          The number of rows of the matrix U. NRU >= 0.
-*
-*  NCC     (input) INTEGER
-*          The number of columns of the matrix C. NCC >= 0.
-*
-*  D       (input/output) DOUBLE PRECISION array, dimension (N)
-*          On entry, the n diagonal elements of the bidiagonal matrix B.
-*          On exit, if INFO=0, the singular values of B in decreasing
-*          order.
-*
-*  E       (input/output) DOUBLE PRECISION array, dimension (N-1)
-*          On entry, the N-1 offdiagonal elements of the bidiagonal
-*          matrix B. 
-*          On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
-*          will contain the diagonal and superdiagonal elements of a
-*          bidiagonal matrix orthogonally equivalent to the one given
-*          as input.
-*
-*  VT      (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT)
-*          On entry, an N-by-NCVT matrix VT.
-*          On exit, VT is overwritten by P**T * VT.
-*          Not referenced if NCVT = 0.
-*
-*  LDVT    (input) INTEGER
-*          The leading dimension of the array VT.
-*          LDVT >= max(1,N) if NCVT > 0; LDVT >= 1 if NCVT = 0.
-*
-*  U       (input/output) DOUBLE PRECISION array, dimension (LDU, N)
-*          On entry, an NRU-by-N matrix U.
-*          On exit, U is overwritten by U * Q.
-*          Not referenced if NRU = 0.
-*
-*  LDU     (input) INTEGER
-*          The leading dimension of the array U.  LDU >= max(1,NRU).
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC, NCC)
-*          On entry, an N-by-NCC matrix C.
-*          On exit, C is overwritten by Q**T * C.
-*          Not referenced if NCC = 0.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C.
-*          LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (2*N)
-*          if NCVT = NRU = NCC = 0, (max(1, 4*N-4)) otherwise
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  If INFO = -i, the i-th argument had an illegal value
-*          > 0:  the algorithm did not converge; D and E contain the
-*                elements of a bidiagonal matrix which is orthogonally
-*                similar to the input matrix B;  if INFO = i, i
-*                elements of E have not converged to zero.
-*
-*  Internal Parameters
-*  ===================
-*
-*  TOLMUL  DOUBLE PRECISION, default = max(10,min(100,EPS**(-1/8)))
-*          TOLMUL controls the convergence criterion of the QR loop.
-*          If it is positive, TOLMUL*EPS is the desired relative
-*             precision in the computed singular values.
-*          If it is negative, abs(TOLMUL*EPS*sigma_max) is the
-*             desired absolute accuracy in the computed singular
-*             values (corresponds to relative accuracy
-*             abs(TOLMUL*EPS) in the largest singular value.
-*          abs(TOLMUL) should be between 1 and 1/EPS, and preferably
-*             between 10 (for fast convergence) and .1/EPS
-*             (for there to be some accuracy in the results).
-*          Default is to lose at either one eighth or 2 of the
-*             available decimal digits in each computed singular value
-*             (whichever is smaller).
-*
-*  MAXITR  INTEGER, default = 6
-*          MAXITR controls the maximum number of passes of the
-*          algorithm through its inner loop. The algorithms stops
-*          (and so fails to converge) if the number of passes
-*          through the inner loop exceeds MAXITR*N**2.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D0 )
-      DOUBLE PRECISION   NEGONE
-      PARAMETER          ( NEGONE = -1.0D0 )
-      DOUBLE PRECISION   HNDRTH
-      PARAMETER          ( HNDRTH = 0.01D0 )
-      DOUBLE PRECISION   TEN
-      PARAMETER          ( TEN = 10.0D0 )
-      DOUBLE PRECISION   HNDRD
-      PARAMETER          ( HNDRD = 100.0D0 )
-      DOUBLE PRECISION   MEIGTH
-      PARAMETER          ( MEIGTH = -0.125D0 )
-      INTEGER            MAXITR
-      PARAMETER          ( MAXITR = 6 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LOWER, ROTATE
-      INTEGER            I, IDIR, ISUB, ITER, J, LL, LLL, M, MAXIT, NM1,
-     $                   NM12, NM13, OLDLL, OLDM
-      DOUBLE PRECISION   ABSE, ABSS, COSL, COSR, CS, EPS, F, G, H, MU,
-     $                   OLDCS, OLDSN, R, SHIFT, SIGMN, SIGMX, SINL,
-     $                   SINR, SLL, SMAX, SMIN, SMINL, SMINOA,
-     $                   SN, THRESH, TOL, TOLMUL, UNFL
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARTG, DLAS2, DLASQ1, DLASR, DLASV2, DROT,
-     $                   DSCAL, DSWAP, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX, MIN, SIGN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      LOWER = LSAME( UPLO, 'L' )
-      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LOWER ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( NCVT.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( NRU.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( NCC.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( ( NCVT.EQ.0 .AND. LDVT.LT.1 ) .OR.
-     $         ( NCVT.GT.0 .AND. LDVT.LT.MAX( 1, N ) ) ) THEN
-         INFO = -9
-      ELSE IF( LDU.LT.MAX( 1, NRU ) ) THEN
-         INFO = -11
-      ELSE IF( ( NCC.EQ.0 .AND. LDC.LT.1 ) .OR.
-     $         ( NCC.GT.0 .AND. LDC.LT.MAX( 1, N ) ) ) THEN
-         INFO = -13
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DBDSQR', -INFO )
-         RETURN
-      END IF
-      IF( N.EQ.0 )
-     $   RETURN
-      IF( N.EQ.1 )
-     $   GO TO 160
-*
-*     ROTATE is true if any singular vectors desired, false otherwise
-*
-      ROTATE = ( NCVT.GT.0 ) .OR. ( NRU.GT.0 ) .OR. ( NCC.GT.0 )
-*
-*     If no singular vectors desired, use qd algorithm
-*
-      IF( .NOT.ROTATE ) THEN
-         CALL DLASQ1( N, D, E, WORK, INFO )
-         RETURN
-      END IF
-*
-      NM1 = N - 1
-      NM12 = NM1 + NM1
-      NM13 = NM12 + NM1
-      IDIR = 0
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'Epsilon' )
-      UNFL = DLAMCH( 'Safe minimum' )
-*
-*     If matrix lower bidiagonal, rotate to be upper bidiagonal
-*     by applying Givens rotations on the left
-*
-      IF( LOWER ) THEN
-         DO 10 I = 1, N - 1
-            CALL DLARTG( D( I ), E( I ), CS, SN, R )
-            D( I ) = R
-            E( I ) = SN*D( I+1 )
-            D( I+1 ) = CS*D( I+1 )
-            WORK( I ) = CS
-            WORK( NM1+I ) = SN
-   10    CONTINUE
-*
-*        Update singular vectors if desired
-*
-         IF( NRU.GT.0 )
-     $      CALL DLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ), WORK( N ), U,
-     $                  LDU )
-         IF( NCC.GT.0 )
-     $      CALL DLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ), WORK( N ), C,
-     $                  LDC )
-      END IF
-*
-*     Compute singular values to relative accuracy TOL
-*     (By setting TOL to be negative, algorithm will compute
-*     singular values to absolute accuracy ABS(TOL)*norm(input matrix))
-*
-      TOLMUL = MAX( TEN, MIN( HNDRD, EPS**MEIGTH ) )
-      TOL = TOLMUL*EPS
-*
-*     Compute approximate maximum, minimum singular values
-*
-      SMAX = ZERO
-      DO 20 I = 1, N
-         SMAX = MAX( SMAX, ABS( D( I ) ) )
-   20 CONTINUE
-      DO 30 I = 1, N - 1
-         SMAX = MAX( SMAX, ABS( E( I ) ) )
-   30 CONTINUE
-      SMINL = ZERO
-      IF( TOL.GE.ZERO ) THEN
-*
-*        Relative accuracy desired
-*
-         SMINOA = ABS( D( 1 ) )
-         IF( SMINOA.EQ.ZERO )
-     $      GO TO 50
-         MU = SMINOA
-         DO 40 I = 2, N
-            MU = ABS( D( I ) )*( MU / ( MU+ABS( E( I-1 ) ) ) )
-            SMINOA = MIN( SMINOA, MU )
-            IF( SMINOA.EQ.ZERO )
-     $         GO TO 50
-   40    CONTINUE
-   50    CONTINUE
-         SMINOA = SMINOA / SQRT( DBLE( N ) )
-         THRESH = MAX( TOL*SMINOA, MAXITR*N*N*UNFL )
-      ELSE
-*
-*        Absolute accuracy desired
-*
-         THRESH = MAX( ABS( TOL )*SMAX, MAXITR*N*N*UNFL )
-      END IF
-*
-*     Prepare for main iteration loop for the singular values
-*     (MAXIT is the maximum number of passes through the inner
-*     loop permitted before nonconvergence signalled.)
-*
-      MAXIT = MAXITR*N*N
-      ITER = 0
-      OLDLL = -1
-      OLDM = -1
-*
-*     M points to last element of unconverged part of matrix
-*
-      M = N
-*
-*     Begin main iteration loop
-*
-   60 CONTINUE
-*
-*     Check for convergence or exceeding iteration count
-*
-      IF( M.LE.1 )
-     $   GO TO 160
-      IF( ITER.GT.MAXIT )
-     $   GO TO 200
-*
-*     Find diagonal block of matrix to work on
-*
-      IF( TOL.LT.ZERO .AND. ABS( D( M ) ).LE.THRESH )
-     $   D( M ) = ZERO
-      SMAX = ABS( D( M ) )
-      SMIN = SMAX
-      DO 70 LLL = 1, M - 1
-         LL = M - LLL
-         ABSS = ABS( D( LL ) )
-         ABSE = ABS( E( LL ) )
-         IF( TOL.LT.ZERO .AND. ABSS.LE.THRESH )
-     $      D( LL ) = ZERO
-         IF( ABSE.LE.THRESH )
-     $      GO TO 80
-         SMIN = MIN( SMIN, ABSS )
-         SMAX = MAX( SMAX, ABSS, ABSE )
-   70 CONTINUE
-      LL = 0
-      GO TO 90
-   80 CONTINUE
-      E( LL ) = ZERO
-*
-*     Matrix splits since E(LL) = 0
-*
-      IF( LL.EQ.M-1 ) THEN
-*
-*        Convergence of bottom singular value, return to top of loop
-*
-         M = M - 1
-         GO TO 60
-      END IF
-   90 CONTINUE
-      LL = LL + 1
-*
-*     E(LL) through E(M-1) are nonzero, E(LL-1) is zero
-*
-      IF( LL.EQ.M-1 ) THEN
-*
-*        2 by 2 block, handle separately
-*
-         CALL DLASV2( D( M-1 ), E( M-1 ), D( M ), SIGMN, SIGMX, SINR,
-     $                COSR, SINL, COSL )
-         D( M-1 ) = SIGMX
-         E( M-1 ) = ZERO
-         D( M ) = SIGMN
-*
-*        Compute singular vectors, if desired
-*
-         IF( NCVT.GT.0 )
-     $      CALL DROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, COSR,
-     $                 SINR )
-         IF( NRU.GT.0 )
-     $      CALL DROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL )
-         IF( NCC.GT.0 )
-     $      CALL DROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL,
-     $                 SINL )
-         M = M - 2
-         GO TO 60
-      END IF
-*
-*     If working on new submatrix, choose shift direction
-*     (from larger end diagonal element towards smaller)
-*
-      IF( LL.GT.OLDM .OR. M.LT.OLDLL ) THEN
-         IF( ABS( D( LL ) ).GE.ABS( D( M ) ) ) THEN
-*
-*           Chase bulge from top (big end) to bottom (small end)
-*
-            IDIR = 1
-         ELSE
-*
-*           Chase bulge from bottom (big end) to top (small end)
-*
-            IDIR = 2
-         END IF
-      END IF
-*
-*     Apply convergence tests
-*
-      IF( IDIR.EQ.1 ) THEN
-*
-*        Run convergence test in forward direction
-*        First apply standard test to bottom of matrix
-*
-         IF( ABS( E( M-1 ) ).LE.ABS( TOL )*ABS( D( M ) ) .OR.
-     $       ( TOL.LT.ZERO .AND. ABS( E( M-1 ) ).LE.THRESH ) ) THEN
-            E( M-1 ) = ZERO
-            GO TO 60
-         END IF
-*
-         IF( TOL.GE.ZERO ) THEN
-*
-*           If relative accuracy desired,
-*           apply convergence criterion forward
-*
-            MU = ABS( D( LL ) )
-            SMINL = MU
-            DO 100 LLL = LL, M - 1
-               IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
-                  E( LLL ) = ZERO
-                  GO TO 60
-               END IF
-               MU = ABS( D( LLL+1 ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
-               SMINL = MIN( SMINL, MU )
-  100       CONTINUE
-         END IF
-*
-      ELSE
-*
-*        Run convergence test in backward direction
-*        First apply standard test to top of matrix
-*
-         IF( ABS( E( LL ) ).LE.ABS( TOL )*ABS( D( LL ) ) .OR.
-     $       ( TOL.LT.ZERO .AND. ABS( E( LL ) ).LE.THRESH ) ) THEN
-            E( LL ) = ZERO
-            GO TO 60
-         END IF
-*
-         IF( TOL.GE.ZERO ) THEN
-*
-*           If relative accuracy desired,
-*           apply convergence criterion backward
-*
-            MU = ABS( D( M ) )
-            SMINL = MU
-            DO 110 LLL = M - 1, LL, -1
-               IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
-                  E( LLL ) = ZERO
-                  GO TO 60
-               END IF
-               MU = ABS( D( LLL ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
-               SMINL = MIN( SMINL, MU )
-  110       CONTINUE
-         END IF
-      END IF
-      OLDLL = LL
-      OLDM = M
-*
-*     Compute shift.  First, test if shifting would ruin relative
-*     accuracy, and if so set the shift to zero.
-*
-      IF( TOL.GE.ZERO .AND. N*TOL*( SMINL / SMAX ).LE.
-     $    MAX( EPS, HNDRTH*TOL ) ) THEN
-*
-*        Use a zero shift to avoid loss of relative accuracy
-*
-         SHIFT = ZERO
-      ELSE
-*
-*        Compute the shift from 2-by-2 block at end of matrix
-*
-         IF( IDIR.EQ.1 ) THEN
-            SLL = ABS( D( LL ) )
-            CALL DLAS2( D( M-1 ), E( M-1 ), D( M ), SHIFT, R )
-         ELSE
-            SLL = ABS( D( M ) )
-            CALL DLAS2( D( LL ), E( LL ), D( LL+1 ), SHIFT, R )
-         END IF
-*
-*        Test if shift negligible, and if so set to zero
-*
-         IF( SLL.GT.ZERO ) THEN
-            IF( ( SHIFT / SLL )**2.LT.EPS )
-     $         SHIFT = ZERO
-         END IF
-      END IF
-*
-*     Increment iteration count
-*
-      ITER = ITER + M - LL
-*
-*     If SHIFT = 0, do simplified QR iteration
-*
-      IF( SHIFT.EQ.ZERO ) THEN
-         IF( IDIR.EQ.1 ) THEN
-*
-*           Chase bulge from top to bottom
-*           Save cosines and sines for later singular vector updates
-*
-            CS = ONE
-            OLDCS = ONE
-            DO 120 I = LL, M - 1
-               CALL DLARTG( D( I )*CS, E( I ), CS, SN, R )
-               IF( I.GT.LL )
-     $            E( I-1 ) = OLDSN*R
-               CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) )
-               WORK( I-LL+1 ) = CS
-               WORK( I-LL+1+NM1 ) = SN
-               WORK( I-LL+1+NM12 ) = OLDCS
-               WORK( I-LL+1+NM13 ) = OLDSN
-  120       CONTINUE
-            H = D( M )*CS
-            D( M ) = H*OLDCS
-            E( M-1 ) = H*OLDSN
-*
-*           Update singular vectors
-*
-            IF( NCVT.GT.0 )
-     $         CALL DLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ),
-     $                     WORK( N ), VT( LL, 1 ), LDVT )
-            IF( NRU.GT.0 )
-     $         CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ),
-     $                     WORK( NM13+1 ), U( 1, LL ), LDU )
-            IF( NCC.GT.0 )
-     $         CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ),
-     $                     WORK( NM13+1 ), C( LL, 1 ), LDC )
-*
-*           Test convergence
-*
-            IF( ABS( E( M-1 ) ).LE.THRESH )
-     $         E( M-1 ) = ZERO
-*
-         ELSE
-*
-*           Chase bulge from bottom to top
-*           Save cosines and sines for later singular vector updates
-*
-            CS = ONE
-            OLDCS = ONE
-            DO 130 I = M, LL + 1, -1
-               CALL DLARTG( D( I )*CS, E( I-1 ), CS, SN, R )
-               IF( I.LT.M )
-     $            E( I ) = OLDSN*R
-               CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) )
-               WORK( I-LL ) = CS
-               WORK( I-LL+NM1 ) = -SN
-               WORK( I-LL+NM12 ) = OLDCS
-               WORK( I-LL+NM13 ) = -OLDSN
-  130       CONTINUE
-            H = D( LL )*CS
-            D( LL ) = H*OLDCS
-            E( LL ) = H*OLDSN
-*
-*           Update singular vectors
-*
-            IF( NCVT.GT.0 )
-     $         CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ),
-     $                     WORK( NM13+1 ), VT( LL, 1 ), LDVT )
-            IF( NRU.GT.0 )
-     $         CALL DLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ),
-     $                     WORK( N ), U( 1, LL ), LDU )
-            IF( NCC.GT.0 )
-     $         CALL DLASR( 'L', 'V', 'B', M-LL+1, NCC, WORK( 1 ),
-     $                     WORK( N ), C( LL, 1 ), LDC )
-*
-*           Test convergence
-*
-            IF( ABS( E( LL ) ).LE.THRESH )
-     $         E( LL ) = ZERO
-         END IF
-      ELSE
-*
-*        Use nonzero shift
-*
-         IF( IDIR.EQ.1 ) THEN
-*
-*           Chase bulge from top to bottom
-*           Save cosines and sines for later singular vector updates
-*
-            F = ( ABS( D( LL ) )-SHIFT )*
-     $          ( SIGN( ONE, D( LL ) )+SHIFT / D( LL ) )
-            G = E( LL )
-            DO 140 I = LL, M - 1
-               CALL DLARTG( F, G, COSR, SINR, R )
-               IF( I.GT.LL )
-     $            E( I-1 ) = R
-               F = COSR*D( I ) + SINR*E( I )
-               E( I ) = COSR*E( I ) - SINR*D( I )
-               G = SINR*D( I+1 )
-               D( I+1 ) = COSR*D( I+1 )
-               CALL DLARTG( F, G, COSL, SINL, R )
-               D( I ) = R
-               F = COSL*E( I ) + SINL*D( I+1 )
-               D( I+1 ) = COSL*D( I+1 ) - SINL*E( I )
-               IF( I.LT.M-1 ) THEN
-                  G = SINL*E( I+1 )
-                  E( I+1 ) = COSL*E( I+1 )
-               END IF
-               WORK( I-LL+1 ) = COSR
-               WORK( I-LL+1+NM1 ) = SINR
-               WORK( I-LL+1+NM12 ) = COSL
-               WORK( I-LL+1+NM13 ) = SINL
-  140       CONTINUE
-            E( M-1 ) = F
-*
-*           Update singular vectors
-*
-            IF( NCVT.GT.0 )
-     $         CALL DLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ),
-     $                     WORK( N ), VT( LL, 1 ), LDVT )
-            IF( NRU.GT.0 )
-     $         CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ),
-     $                     WORK( NM13+1 ), U( 1, LL ), LDU )
-            IF( NCC.GT.0 )
-     $         CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ),
-     $                     WORK( NM13+1 ), C( LL, 1 ), LDC )
-*
-*           Test convergence
-*
-            IF( ABS( E( M-1 ) ).LE.THRESH )
-     $         E( M-1 ) = ZERO
-*
-         ELSE
-*
-*           Chase bulge from bottom to top
-*           Save cosines and sines for later singular vector updates
-*
-            F = ( ABS( D( M ) )-SHIFT )*( SIGN( ONE, D( M ) )+SHIFT /
-     $          D( M ) )
-            G = E( M-1 )
-            DO 150 I = M, LL + 1, -1
-               CALL DLARTG( F, G, COSR, SINR, R )
-               IF( I.LT.M )
-     $            E( I ) = R
-               F = COSR*D( I ) + SINR*E( I-1 )
-               E( I-1 ) = COSR*E( I-1 ) - SINR*D( I )
-               G = SINR*D( I-1 )
-               D( I-1 ) = COSR*D( I-1 )
-               CALL DLARTG( F, G, COSL, SINL, R )
-               D( I ) = R
-               F = COSL*E( I-1 ) + SINL*D( I-1 )
-               D( I-1 ) = COSL*D( I-1 ) - SINL*E( I-1 )
-               IF( I.GT.LL+1 ) THEN
-                  G = SINL*E( I-2 )
-                  E( I-2 ) = COSL*E( I-2 )
-               END IF
-               WORK( I-LL ) = COSR
-               WORK( I-LL+NM1 ) = -SINR
-               WORK( I-LL+NM12 ) = COSL
-               WORK( I-LL+NM13 ) = -SINL
-  150       CONTINUE
-            E( LL ) = F
-*
-*           Test convergence
-*
-            IF( ABS( E( LL ) ).LE.THRESH )
-     $         E( LL ) = ZERO
-*
-*           Update singular vectors if desired
-*
-            IF( NCVT.GT.0 )
-     $         CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ),
-     $                     WORK( NM13+1 ), VT( LL, 1 ), LDVT )
-            IF( NRU.GT.0 )
-     $         CALL DLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ),
-     $                     WORK( N ), U( 1, LL ), LDU )
-            IF( NCC.GT.0 )
-     $         CALL DLASR( 'L', 'V', 'B', M-LL+1, NCC, WORK( 1 ),
-     $                     WORK( N ), C( LL, 1 ), LDC )
-         END IF
-      END IF
-*
-*     QR iteration finished, go back and check convergence
-*
-      GO TO 60
-*
-*     All singular values converged, so make them positive
-*
-  160 CONTINUE
-      DO 170 I = 1, N
-         IF( D( I ).LT.ZERO ) THEN
-            D( I ) = -D( I )
-*
-*           Change sign of singular vectors, if desired
-*
-            IF( NCVT.GT.0 )
-     $         CALL DSCAL( NCVT, NEGONE, VT( I, 1 ), LDVT )
-         END IF
-  170 CONTINUE
-*
-*     Sort the singular values into decreasing order (insertion sort on
-*     singular values, but only one transposition per singular vector)
-*
-      DO 190 I = 1, N - 1
-*
-*        Scan for smallest D(I)
-*
-         ISUB = 1
-         SMIN = D( 1 )
-         DO 180 J = 2, N + 1 - I
-            IF( D( J ).LE.SMIN ) THEN
-               ISUB = J
-               SMIN = D( J )
-            END IF
-  180    CONTINUE
-         IF( ISUB.NE.N+1-I ) THEN
-*
-*           Swap singular values and vectors
-*
-            D( ISUB ) = D( N+1-I )
-            D( N+1-I ) = SMIN
-            IF( NCVT.GT.0 )
-     $         CALL DSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( N+1-I, 1 ),
-     $                     LDVT )
-            IF( NRU.GT.0 )
-     $         CALL DSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 )
-            IF( NCC.GT.0 )
-     $         CALL DSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC )
-         END IF
-  190 CONTINUE
-      GO TO 220
-*
-*     Maximum number of iterations exceeded, failure to converge
-*
-  200 CONTINUE
-      INFO = 0
-      DO 210 I = 1, N - 1
-         IF( E( I ).NE.ZERO )
-     $      INFO = INFO + 1
-  210 CONTINUE
-  220 CONTINUE
-      RETURN
-*
-*     End of DBDSQR
-*
-      END
diff --git a/src/lib/lapack/dgebak.f b/src/lib/lapack/dgebak.f
deleted file mode 100644
index b8e9be56..00000000
--- a/src/lib/lapack/dgebak.f
+++ /dev/null
@@ -1,188 +0,0 @@
-      SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOB, SIDE
-      INTEGER            IHI, ILO, INFO, LDV, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   SCALE( * ), V( LDV, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEBAK forms the right or left eigenvectors of a real general matrix
-*  by backward transformation on the computed eigenvectors of the
-*  balanced matrix output by DGEBAL.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          Specifies the type of backward transformation required:
-*          = 'N', do nothing, return immediately;
-*          = 'P', do backward transformation for permutation only;
-*          = 'S', do backward transformation for scaling only;
-*          = 'B', do backward transformations for both permutation and
-*                 scaling.
-*          JOB must be the same as the argument JOB supplied to DGEBAL.
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'R':  V contains right eigenvectors;
-*          = 'L':  V contains left eigenvectors.
-*
-*  N       (input) INTEGER
-*          The number of rows of the matrix V.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          The integers ILO and IHI determined by DGEBAL.
-*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-*  SCALE   (input) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutation and scaling factors, as returned
-*          by DGEBAL.
-*
-*  M       (input) INTEGER
-*          The number of columns of the matrix V.  M >= 0.
-*
-*  V       (input/output) DOUBLE PRECISION array, dimension (LDV,M)
-*          On entry, the matrix of right or left eigenvectors to be
-*          transformed, as returned by DHSEIN or DTREVC.
-*          On exit, V is overwritten by the transformed eigenvectors.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V. LDV >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFTV, RIGHTV
-      INTEGER            I, II, K
-      DOUBLE PRECISION   S
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSCAL, DSWAP, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and Test the input parameters
-*
-      RIGHTV = LSAME( SIDE, 'R' )
-      LEFTV = LSAME( SIDE, 'L' )
-*
-      INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
-         INFO = -4
-      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
-         INFO = -5
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -7
-      ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEBAK', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-      IF( M.EQ.0 )
-     $   RETURN
-      IF( LSAME( JOB, 'N' ) )
-     $   RETURN
-*
-      IF( ILO.EQ.IHI )
-     $   GO TO 30
-*
-*     Backward balance
-*
-      IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
-         IF( RIGHTV ) THEN
-            DO 10 I = ILO, IHI
-               S = SCALE( I )
-               CALL DSCAL( M, S, V( I, 1 ), LDV )
-   10       CONTINUE
-         END IF
-*
-         IF( LEFTV ) THEN
-            DO 20 I = ILO, IHI
-               S = ONE / SCALE( I )
-               CALL DSCAL( M, S, V( I, 1 ), LDV )
-   20       CONTINUE
-         END IF
-*
-      END IF
-*
-*     Backward permutation
-*
-*     For  I = ILO-1 step -1 until 1,
-*              IHI+1 step 1 until N do --
-*
-   30 CONTINUE
-      IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
-         IF( RIGHTV ) THEN
-            DO 40 II = 1, N
-               I = II
-               IF( I.GE.ILO .AND. I.LE.IHI )
-     $            GO TO 40
-               IF( I.LT.ILO )
-     $            I = ILO - II
-               K = SCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 40
-               CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-   40       CONTINUE
-         END IF
-*
-         IF( LEFTV ) THEN
-            DO 50 II = 1, N
-               I = II
-               IF( I.GE.ILO .AND. I.LE.IHI )
-     $            GO TO 50
-               IF( I.LT.ILO )
-     $            I = ILO - II
-               K = SCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 50
-               CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-   50       CONTINUE
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DGEBAK
-*
-      END
diff --git a/src/lib/lapack/dgebal.f b/src/lib/lapack/dgebal.f
deleted file mode 100644
index 1796577b..00000000
--- a/src/lib/lapack/dgebal.f
+++ /dev/null
@@ -1,322 +0,0 @@
-      SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOB
-      INTEGER            IHI, ILO, INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), SCALE( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEBAL balances a general real matrix A.  This involves, first,
-*  permuting A by a similarity transformation to isolate eigenvalues
-*  in the first 1 to ILO-1 and last IHI+1 to N elements on the
-*  diagonal; and second, applying a diagonal similarity transformation
-*  to rows and columns ILO to IHI to make the rows and columns as
-*  close in norm as possible.  Both steps are optional.
-*
-*  Balancing may reduce the 1-norm of the matrix, and improve the
-*  accuracy of the computed eigenvalues and/or eigenvectors.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          Specifies the operations to be performed on A:
-*          = 'N':  none:  simply set ILO = 1, IHI = N, SCALE(I) = 1.0
-*                  for i = 1,...,N;
-*          = 'P':  permute only;
-*          = 'S':  scale only;
-*          = 'B':  both permute and scale.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the input matrix A.
-*          On exit,  A is overwritten by the balanced matrix.
-*          If JOB = 'N', A is not referenced.
-*          See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  ILO     (output) INTEGER
-*  IHI     (output) INTEGER
-*          ILO and IHI are set to integers such that on exit
-*          A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
-*          If JOB = 'N' or 'S', ILO = 1 and IHI = N.
-*
-*  SCALE   (output) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutations and scaling factors applied to
-*          A.  If P(j) is the index of the row and column interchanged
-*          with row and column j and D(j) is the scaling factor
-*          applied to row and column j, then
-*          SCALE(j) = P(j)    for j = 1,...,ILO-1
-*                   = D(j)    for j = ILO,...,IHI
-*                   = P(j)    for j = IHI+1,...,N.
-*          The order in which the interchanges are made is N to IHI+1,
-*          then 1 to ILO-1.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The permutations consist of row and column interchanges which put
-*  the matrix in the form
-*
-*             ( T1   X   Y  )
-*     P A P = (  0   B   Z  )
-*             (  0   0   T2 )
-*
-*  where T1 and T2 are upper triangular matrices whose eigenvalues lie
-*  along the diagonal.  The column indices ILO and IHI mark the starting
-*  and ending columns of the submatrix B. Balancing consists of applying
-*  a diagonal similarity transformation inv(D) * B * D to make the
-*  1-norms of each row of B and its corresponding column nearly equal.
-*  The output matrix is
-*
-*     ( T1     X*D          Y    )
-*     (  0  inv(D)*B*D  inv(D)*Z ).
-*     (  0      0           T2   )
-*
-*  Information about the permutations P and the diagonal matrix D is
-*  returned in the vector SCALE.
-*
-*  This subroutine is based on the EISPACK routine BALANC.
-*
-*  Modified by Tzu-Yi Chen, Computer Science Division, University of
-*    California at Berkeley, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-      DOUBLE PRECISION   SCLFAC
-      PARAMETER          ( SCLFAC = 2.0D+0 )
-      DOUBLE PRECISION   FACTOR
-      PARAMETER          ( FACTOR = 0.95D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOCONV
-      INTEGER            I, ICA, IEXC, IRA, J, K, L, M
-      DOUBLE PRECISION   C, CA, F, G, R, RA, S, SFMAX1, SFMAX2, SFMIN1,
-     $                   SFMIN2
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, IDAMAX, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSCAL, DSWAP, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
-         INFO = -1
-      ELSE IF( 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( 'DGEBAL', -INFO )
-         RETURN
-      END IF
-*
-      K = 1
-      L = N
-*
-      IF( N.EQ.0 )
-     $   GO TO 210
-*
-      IF( LSAME( JOB, 'N' ) ) THEN
-         DO 10 I = 1, N
-            SCALE( I ) = ONE
-   10    CONTINUE
-         GO TO 210
-      END IF
-*
-      IF( LSAME( JOB, 'S' ) )
-     $   GO TO 120
-*
-*     Permutation to isolate eigenvalues if possible
-*
-      GO TO 50
-*
-*     Row and column exchange.
-*
-   20 CONTINUE
-      SCALE( M ) = J
-      IF( J.EQ.M )
-     $   GO TO 30
-*
-      CALL DSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
-      CALL DSWAP( N-K+1, A( J, K ), LDA, A( M, K ), LDA )
-*
-   30 CONTINUE
-      GO TO ( 40, 80 )IEXC
-*
-*     Search for rows isolating an eigenvalue and push them down.
-*
-   40 CONTINUE
-      IF( L.EQ.1 )
-     $   GO TO 210
-      L = L - 1
-*
-   50 CONTINUE
-      DO 70 J = L, 1, -1
-*
-         DO 60 I = 1, L
-            IF( I.EQ.J )
-     $         GO TO 60
-            IF( A( J, I ).NE.ZERO )
-     $         GO TO 70
-   60    CONTINUE
-*
-         M = L
-         IEXC = 1
-         GO TO 20
-   70 CONTINUE
-*
-      GO TO 90
-*
-*     Search for columns isolating an eigenvalue and push them left.
-*
-   80 CONTINUE
-      K = K + 1
-*
-   90 CONTINUE
-      DO 110 J = K, L
-*
-         DO 100 I = K, L
-            IF( I.EQ.J )
-     $         GO TO 100
-            IF( A( I, J ).NE.ZERO )
-     $         GO TO 110
-  100    CONTINUE
-*
-         M = K
-         IEXC = 2
-         GO TO 20
-  110 CONTINUE
-*
-  120 CONTINUE
-      DO 130 I = K, L
-         SCALE( I ) = ONE
-  130 CONTINUE
-*
-      IF( LSAME( JOB, 'P' ) )
-     $   GO TO 210
-*
-*     Balance the submatrix in rows K to L.
-*
-*     Iterative loop for norm reduction
-*
-      SFMIN1 = DLAMCH( 'S' ) / DLAMCH( 'P' )
-      SFMAX1 = ONE / SFMIN1
-      SFMIN2 = SFMIN1*SCLFAC
-      SFMAX2 = ONE / SFMIN2
-  140 CONTINUE
-      NOCONV = .FALSE.
-*
-      DO 200 I = K, L
-         C = ZERO
-         R = ZERO
-*
-         DO 150 J = K, L
-            IF( J.EQ.I )
-     $         GO TO 150
-            C = C + ABS( A( J, I ) )
-            R = R + ABS( A( I, J ) )
-  150    CONTINUE
-         ICA = IDAMAX( L, A( 1, I ), 1 )
-         CA = ABS( A( ICA, I ) )
-         IRA = IDAMAX( N-K+1, A( I, K ), LDA )
-         RA = ABS( A( I, IRA+K-1 ) )
-*
-*        Guard against zero C or R due to underflow.
-*
-         IF( C.EQ.ZERO .OR. R.EQ.ZERO )
-     $      GO TO 200
-         G = R / SCLFAC
-         F = ONE
-         S = C + R
-  160    CONTINUE
-         IF( C.GE.G .OR. MAX( F, C, CA ).GE.SFMAX2 .OR.
-     $       MIN( R, G, RA ).LE.SFMIN2 )GO TO 170
-         F = F*SCLFAC
-         C = C*SCLFAC
-         CA = CA*SCLFAC
-         R = R / SCLFAC
-         G = G / SCLFAC
-         RA = RA / SCLFAC
-         GO TO 160
-*
-  170    CONTINUE
-         G = C / SCLFAC
-  180    CONTINUE
-         IF( G.LT.R .OR. MAX( R, RA ).GE.SFMAX2 .OR.
-     $       MIN( F, C, G, CA ).LE.SFMIN2 )GO TO 190
-         F = F / SCLFAC
-         C = C / SCLFAC
-         G = G / SCLFAC
-         CA = CA / SCLFAC
-         R = R*SCLFAC
-         RA = RA*SCLFAC
-         GO TO 180
-*
-*        Now balance.
-*
-  190    CONTINUE
-         IF( ( C+R ).GE.FACTOR*S )
-     $      GO TO 200
-         IF( F.LT.ONE .AND. SCALE( I ).LT.ONE ) THEN
-            IF( F*SCALE( I ).LE.SFMIN1 )
-     $         GO TO 200
-         END IF
-         IF( F.GT.ONE .AND. SCALE( I ).GT.ONE ) THEN
-            IF( SCALE( I ).GE.SFMAX1 / F )
-     $         GO TO 200
-         END IF
-         G = ONE / F
-         SCALE( I ) = SCALE( I )*F
-         NOCONV = .TRUE.
-*
-         CALL DSCAL( N-K+1, G, A( I, K ), LDA )
-         CALL DSCAL( L, F, A( 1, I ), 1 )
-*
-  200 CONTINUE
-*
-      IF( NOCONV )
-     $   GO TO 140
-*
-  210 CONTINUE
-      ILO = K
-      IHI = L
-*
-      RETURN
-*
-*     End of DGEBAL
-*
-      END
diff --git a/src/lib/lapack/dgebd2.f b/src/lib/lapack/dgebd2.f
deleted file mode 100644
index b9eb6387..00000000
--- a/src/lib/lapack/dgebd2.f
+++ /dev/null
@@ -1,239 +0,0 @@
-      SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), D( * ), E( * ), TAUP( * ),
-     $                   TAUQ( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEBD2 reduces a real general m by n matrix A to upper or lower
-*  bidiagonal form B by an orthogonal transformation: Q' * A * P = B.
-*
-*  If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows in the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns in the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the m by n general matrix to be reduced.
-*          On exit,
-*          if m >= n, the diagonal and the first superdiagonal are
-*            overwritten with the upper bidiagonal matrix B; the
-*            elements below the diagonal, with the array TAUQ, represent
-*            the orthogonal matrix Q as a product of elementary
-*            reflectors, and the elements above the first superdiagonal,
-*            with the array TAUP, represent the orthogonal matrix P as
-*            a product of elementary reflectors;
-*          if m < n, the diagonal and the first subdiagonal are
-*            overwritten with the lower bidiagonal matrix B; the
-*            elements below the first subdiagonal, with the array TAUQ,
-*            represent the orthogonal matrix Q as a product of
-*            elementary reflectors, and the elements above the diagonal,
-*            with the array TAUP, represent the orthogonal matrix P as
-*            a product of elementary reflectors.
-*          See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  D       (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The diagonal elements of the bidiagonal matrix B:
-*          D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
-*          The off-diagonal elements of the bidiagonal matrix B:
-*          if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
-*          if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
-*
-*  TAUQ    (output) DOUBLE PRECISION array dimension (min(M,N))
-*          The scalar factors of the elementary reflectors which
-*          represent the orthogonal matrix Q. See Further Details.
-*
-*  TAUP    (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors which
-*          represent the orthogonal matrix P. See Further Details.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (max(M,N))
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit.
-*          < 0: if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The matrices Q and P are represented as products of elementary
-*  reflectors:
-*
-*  If m >= n,
-*
-*     Q = H(1) H(2) . . . H(n)  and  P = G(1) G(2) . . . G(n-1)
-*
-*  Each H(i) and G(i) has the form:
-*
-*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'
-*
-*  where tauq and taup are real scalars, and v and u are real vectors;
-*  v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
-*  u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
-*  tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  If m < n,
-*
-*     Q = H(1) H(2) . . . H(m-1)  and  P = G(1) G(2) . . . G(m)
-*
-*  Each H(i) and G(i) has the form:
-*
-*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'
-*
-*  where tauq and taup are real scalars, and v and u are real vectors;
-*  v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
-*  u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
-*  tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  The contents of A on exit are illustrated by the following examples:
-*
-*  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):
-*
-*    (  d   e   u1  u1  u1 )           (  d   u1  u1  u1  u1  u1 )
-*    (  v1  d   e   u2  u2 )           (  e   d   u2  u2  u2  u2 )
-*    (  v1  v2  d   e   u3 )           (  v1  e   d   u3  u3  u3 )
-*    (  v1  v2  v3  d   e  )           (  v1  v2  e   d   u4  u4 )
-*    (  v1  v2  v3  v4  d  )           (  v1  v2  v3  e   d   u5 )
-*    (  v1  v2  v3  v4  v5 )
-*
-*  where d and e denote diagonal and off-diagonal elements of B, vi
-*  denotes an element of the vector defining H(i), and ui an element of
-*  the vector defining G(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DLARFG, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.LT.0 ) THEN
-         CALL XERBLA( 'DGEBD2', -INFO )
-         RETURN
-      END IF
-*
-      IF( M.GE.N ) THEN
-*
-*        Reduce to upper bidiagonal form
-*
-         DO 10 I = 1, N
-*
-*           Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
-            CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
-     $                   TAUQ( I ) )
-            D( I ) = A( I, I )
-            A( I, I ) = ONE
-*
-*           Apply H(i) to A(i:m,i+1:n) from the left
-*
-            IF( I.LT.N )
-     $         CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
-     $                     A( I, I+1 ), LDA, WORK )
-            A( I, I ) = D( I )
-*
-            IF( I.LT.N ) THEN
-*
-*              Generate elementary reflector G(i) to annihilate
-*              A(i,i+2:n)
-*
-               CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
-     $                      LDA, TAUP( I ) )
-               E( I ) = A( I, I+1 )
-               A( I, I+1 ) = ONE
-*
-*              Apply G(i) to A(i+1:m,i+1:n) from the right
-*
-               CALL DLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
-     $                     TAUP( I ), A( I+1, I+1 ), LDA, WORK )
-               A( I, I+1 ) = E( I )
-            ELSE
-               TAUP( I ) = ZERO
-            END IF
-   10    CONTINUE
-      ELSE
-*
-*        Reduce to lower bidiagonal form
-*
-         DO 20 I = 1, M
-*
-*           Generate elementary reflector G(i) to annihilate A(i,i+1:n)
-*
-            CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
-     $                   TAUP( I ) )
-            D( I ) = A( I, I )
-            A( I, I ) = ONE
-*
-*           Apply G(i) to A(i+1:m,i:n) from the right
-*
-            IF( I.LT.M )
-     $         CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
-     $                     TAUP( I ), A( I+1, I ), LDA, WORK )
-            A( I, I ) = D( I )
-*
-            IF( I.LT.M ) THEN
-*
-*              Generate elementary reflector H(i) to annihilate
-*              A(i+2:m,i)
-*
-               CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
-     $                      TAUQ( I ) )
-               E( I ) = A( I+1, I )
-               A( I+1, I ) = ONE
-*
-*              Apply H(i) to A(i+1:m,i+1:n) from the left
-*
-               CALL DLARF( 'Left', M-I, N-I, A( I+1, I ), 1, TAUQ( I ),
-     $                     A( I+1, I+1 ), LDA, WORK )
-               A( I+1, I ) = E( I )
-            ELSE
-               TAUQ( I ) = ZERO
-            END IF
-   20    CONTINUE
-      END IF
-      RETURN
-*
-*     End of DGEBD2
-*
-      END
diff --git a/src/lib/lapack/dgebrd.f b/src/lib/lapack/dgebrd.f
deleted file mode 100644
index 6544715d..00000000
--- a/src/lib/lapack/dgebrd.f
+++ /dev/null
@@ -1,268 +0,0 @@
-      SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), D( * ), E( * ), TAUP( * ),
-     $                   TAUQ( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEBRD reduces a general real M-by-N matrix A to upper or lower
-*  bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
-*
-*  If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows in the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns in the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N general matrix to be reduced.
-*          On exit,
-*          if m >= n, the diagonal and the first superdiagonal are
-*            overwritten with the upper bidiagonal matrix B; the
-*            elements below the diagonal, with the array TAUQ, represent
-*            the orthogonal matrix Q as a product of elementary
-*            reflectors, and the elements above the first superdiagonal,
-*            with the array TAUP, represent the orthogonal matrix P as
-*            a product of elementary reflectors;
-*          if m < n, the diagonal and the first subdiagonal are
-*            overwritten with the lower bidiagonal matrix B; the
-*            elements below the first subdiagonal, with the array TAUQ,
-*            represent the orthogonal matrix Q as a product of
-*            elementary reflectors, and the elements above the diagonal,
-*            with the array TAUP, represent the orthogonal matrix P as
-*            a product of elementary reflectors.
-*          See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  D       (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The diagonal elements of the bidiagonal matrix B:
-*          D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
-*          The off-diagonal elements of the bidiagonal matrix B:
-*          if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
-*          if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
-*
-*  TAUQ    (output) DOUBLE PRECISION array dimension (min(M,N))
-*          The scalar factors of the elementary reflectors which
-*          represent the orthogonal matrix Q. See Further Details.
-*
-*  TAUP    (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors which
-*          represent the orthogonal matrix P. See Further Details.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The length of the array WORK.  LWORK >= max(1,M,N).
-*          For optimum performance LWORK >= (M+N)*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The matrices Q and P are represented as products of elementary
-*  reflectors:
-*
-*  If m >= n,
-*
-*     Q = H(1) H(2) . . . H(n)  and  P = G(1) G(2) . . . G(n-1)
-*
-*  Each H(i) and G(i) has the form:
-*
-*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'
-*
-*  where tauq and taup are real scalars, and v and u are real vectors;
-*  v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
-*  u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
-*  tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  If m < n,
-*
-*     Q = H(1) H(2) . . . H(m-1)  and  P = G(1) G(2) . . . G(m)
-*
-*  Each H(i) and G(i) has the form:
-*
-*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'
-*
-*  where tauq and taup are real scalars, and v and u are real vectors;
-*  v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
-*  u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
-*  tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  The contents of A on exit are illustrated by the following examples:
-*
-*  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):
-*
-*    (  d   e   u1  u1  u1 )           (  d   u1  u1  u1  u1  u1 )
-*    (  v1  d   e   u2  u2 )           (  e   d   u2  u2  u2  u2 )
-*    (  v1  v2  d   e   u3 )           (  v1  e   d   u3  u3  u3 )
-*    (  v1  v2  v3  d   e  )           (  v1  v2  e   d   u4  u4 )
-*    (  v1  v2  v3  v4  d  )           (  v1  v2  v3  e   d   u5 )
-*    (  v1  v2  v3  v4  v5 )
-*
-*  where d and e denote diagonal and off-diagonal elements of B, vi
-*  denotes an element of the vector defining H(i), and ui an element of
-*  the vector defining G(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
-     $                   NBMIN, NX
-      DOUBLE PRECISION   WS
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEBD2, DGEMM, DLABRD, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) )
-      LWKOPT = ( M+N )*NB
-      WORK( 1 ) = DBLE( LWKOPT )
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.LT.0 ) THEN
-         CALL XERBLA( 'DGEBRD', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      MINMN = MIN( M, N )
-      IF( MINMN.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      WS = MAX( M, N )
-      LDWRKX = M
-      LDWRKY = N
-*
-      IF( NB.GT.1 .AND. NB.LT.MINMN ) THEN
-*
-*        Set the crossover point NX.
-*
-         NX = MAX( NB, ILAENV( 3, 'DGEBRD', ' ', M, N, -1, -1 ) )
-*
-*        Determine when to switch from blocked to unblocked code.
-*
-         IF( NX.LT.MINMN ) THEN
-            WS = ( M+N )*NB
-            IF( LWORK.LT.WS ) THEN
-*
-*              Not enough work space for the optimal NB, consider using
-*              a smaller block size.
-*
-               NBMIN = ILAENV( 2, 'DGEBRD', ' ', M, N, -1, -1 )
-               IF( LWORK.GE.( M+N )*NBMIN ) THEN
-                  NB = LWORK / ( M+N )
-               ELSE
-                  NB = 1
-                  NX = MINMN
-               END IF
-            END IF
-         END IF
-      ELSE
-         NX = MINMN
-      END IF
-*
-      DO 30 I = 1, MINMN - NX, NB
-*
-*        Reduce rows and columns i:i+nb-1 to bidiagonal form and return
-*        the matrices X and Y which are needed to update the unreduced
-*        part of the matrix
-*
-         CALL DLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ),
-     $                TAUQ( I ), TAUP( I ), WORK, LDWRKX,
-     $                WORK( LDWRKX*NB+1 ), LDWRKY )
-*
-*        Update the trailing submatrix A(i+nb:m,i+nb:n), using an update
-*        of the form  A := A - V*Y' - X*U'
-*
-         CALL DGEMM( 'No transpose', 'Transpose', M-I-NB+1, N-I-NB+1,
-     $               NB, -ONE, A( I+NB, I ), LDA,
-     $               WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE,
-     $               A( I+NB, I+NB ), LDA )
-         CALL DGEMM( 'No transpose', 'No transpose', M-I-NB+1, N-I-NB+1,
-     $               NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA,
-     $               ONE, A( I+NB, I+NB ), LDA )
-*
-*        Copy diagonal and off-diagonal elements of B back into A
-*
-         IF( M.GE.N ) THEN
-            DO 10 J = I, I + NB - 1
-               A( J, J ) = D( J )
-               A( J, J+1 ) = E( J )
-   10       CONTINUE
-         ELSE
-            DO 20 J = I, I + NB - 1
-               A( J, J ) = D( J )
-               A( J+1, J ) = E( J )
-   20       CONTINUE
-         END IF
-   30 CONTINUE
-*
-*     Use unblocked code to reduce the remainder of the matrix
-*
-      CALL DGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ),
-     $             TAUQ( I ), TAUP( I ), WORK, IINFO )
-      WORK( 1 ) = WS
-      RETURN
-*
-*     End of DGEBRD
-*
-      END
diff --git a/src/lib/lapack/dgecon.f b/src/lib/lapack/dgecon.f
deleted file mode 100644
index 807cafca..00000000
--- a/src/lib/lapack/dgecon.f
+++ /dev/null
@@ -1,185 +0,0 @@
-      SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     Modified to call DLACN2 in place of DLACON, 5 Feb 03, SJH.
-*
-*     .. Scalar Arguments ..
-      CHARACTER          NORM
-      INTEGER            INFO, LDA, N
-      DOUBLE PRECISION   ANORM, RCOND
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGECON estimates the reciprocal of the condition number of a general
-*  real matrix A, in either the 1-norm or the infinity-norm, using
-*  the LU factorization computed by DGETRF.
-*
-*  An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*  condition number is computed as
-*     RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies whether the 1-norm condition number or the
-*          infinity-norm condition number is required:
-*          = '1' or 'O':  1-norm;
-*          = 'I':         Infinity-norm.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The factors L and U from the factorization A = P*L*U
-*          as computed by DGETRF.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  ANORM   (input) DOUBLE PRECISION
-*          If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*          If NORM = 'I', the infinity-norm of the original matrix A.
-*
-*  RCOND   (output) DOUBLE PRECISION
-*          The reciprocal of the condition number of the matrix A,
-*          computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (4*N)
-*
-*  IWORK   (workspace) INTEGER array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            ONENRM
-      CHARACTER          NORMIN
-      INTEGER            IX, KASE, KASE1
-      DOUBLE PRECISION   AINVNM, SCALE, SL, SMLNUM, SU
-*     ..
-*     .. Local Arrays ..
-      INTEGER            ISAVE( 3 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, IDAMAX, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLACN2, DLATRS, DRSCL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
-      IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) 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 = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGECON', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      RCOND = ZERO
-      IF( N.EQ.0 ) THEN
-         RCOND = ONE
-         RETURN
-      ELSE IF( ANORM.EQ.ZERO ) THEN
-         RETURN
-      END IF
-*
-      SMLNUM = DLAMCH( 'Safe minimum' )
-*
-*     Estimate the norm of inv(A).
-*
-      AINVNM = ZERO
-      NORMIN = 'N'
-      IF( ONENRM ) THEN
-         KASE1 = 1
-      ELSE
-         KASE1 = 2
-      END IF
-      KASE = 0
-   10 CONTINUE
-      CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
-      IF( KASE.NE.0 ) THEN
-         IF( KASE.EQ.KASE1 ) THEN
-*
-*           Multiply by inv(L).
-*
-            CALL DLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A,
-     $                   LDA, WORK, SL, WORK( 2*N+1 ), INFO )
-*
-*           Multiply by inv(U).
-*
-            CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
-     $                   A, LDA, WORK, SU, WORK( 3*N+1 ), INFO )
-         ELSE
-*
-*           Multiply by inv(U').
-*
-            CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A,
-     $                   LDA, WORK, SU, WORK( 3*N+1 ), INFO )
-*
-*           Multiply by inv(L').
-*
-            CALL DLATRS( 'Lower', 'Transpose', 'Unit', NORMIN, N, A,
-     $                   LDA, WORK, SL, WORK( 2*N+1 ), INFO )
-         END IF
-*
-*        Divide X by 1/(SL*SU) if doing so will not cause overflow.
-*
-         SCALE = SL*SU
-         NORMIN = 'Y'
-         IF( SCALE.NE.ONE ) THEN
-            IX = IDAMAX( N, WORK, 1 )
-            IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
-     $         GO TO 20
-            CALL DRSCL( N, SCALE, WORK, 1 )
-         END IF
-         GO TO 10
-      END IF
-*
-*     Compute the estimate of the reciprocal condition number.
-*
-      IF( AINVNM.NE.ZERO )
-     $   RCOND = ( ONE / AINVNM ) / ANORM
-*
-   20 CONTINUE
-      RETURN
-*
-*     End of DGECON
-*
-      END
diff --git a/src/lib/lapack/dgeequ.f b/src/lib/lapack/dgeequ.f
deleted file mode 100644
index b703116e..00000000
--- a/src/lib/lapack/dgeequ.f
+++ /dev/null
@@ -1,225 +0,0 @@
-      SUBROUTINE DGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-      DOUBLE PRECISION   AMAX, COLCND, ROWCND
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( * ), R( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEEQU computes row and column scalings intended to equilibrate an
-*  M-by-N matrix A and reduce its condition number.  R returns the row
-*  scale factors and C the column scale factors, chosen to try to make
-*  the largest element in each row and column of the matrix B with
-*  elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
-*
-*  R(i) and C(j) are restricted to be between SMLNUM = smallest safe
-*  number and BIGNUM = largest safe number.  Use of these scaling
-*  factors is not guaranteed to reduce the condition number of A but
-*  works well in practice.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The M-by-N matrix whose equilibration factors are
-*          to be computed.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  R       (output) DOUBLE PRECISION array, dimension (M)
-*          If INFO = 0 or INFO > M, R contains the row scale factors
-*          for A.
-*
-*  C       (output) DOUBLE PRECISION array, dimension (N)
-*          If INFO = 0,  C contains the column scale factors for A.
-*
-*  ROWCND  (output) DOUBLE PRECISION
-*          If INFO = 0 or INFO > M, ROWCND contains the ratio of the
-*          smallest R(i) to the largest R(i).  If ROWCND >= 0.1 and
-*          AMAX is neither too large nor too small, it is not worth
-*          scaling by R.
-*
-*  COLCND  (output) DOUBLE PRECISION
-*          If INFO = 0, COLCND contains the ratio of the smallest
-*          C(i) to the largest C(i).  If COLCND >= 0.1, it is not
-*          worth scaling by C.
-*
-*  AMAX    (output) DOUBLE PRECISION
-*          Absolute value of largest matrix element.  If AMAX is very
-*          close to overflow or very close to underflow, the matrix
-*          should be scaled.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i,  and i is
-*                <= M:  the i-th row of A is exactly zero
-*                >  M:  the (i-M)-th column of A is exactly zero
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   BIGNUM, RCMAX, RCMIN, SMLNUM
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEEQU', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         ROWCND = ONE
-         COLCND = ONE
-         AMAX = ZERO
-         RETURN
-      END IF
-*
-*     Get machine constants.
-*
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-*
-*     Compute row scale factors.
-*
-      DO 10 I = 1, M
-         R( I ) = ZERO
-   10 CONTINUE
-*
-*     Find the maximum element in each row.
-*
-      DO 30 J = 1, N
-         DO 20 I = 1, M
-            R( I ) = MAX( R( I ), ABS( A( I, J ) ) )
-   20    CONTINUE
-   30 CONTINUE
-*
-*     Find the maximum and minimum scale factors.
-*
-      RCMIN = BIGNUM
-      RCMAX = ZERO
-      DO 40 I = 1, M
-         RCMAX = MAX( RCMAX, R( I ) )
-         RCMIN = MIN( RCMIN, R( I ) )
-   40 CONTINUE
-      AMAX = RCMAX
-*
-      IF( RCMIN.EQ.ZERO ) THEN
-*
-*        Find the first zero scale factor and return an error code.
-*
-         DO 50 I = 1, M
-            IF( R( I ).EQ.ZERO ) THEN
-               INFO = I
-               RETURN
-            END IF
-   50    CONTINUE
-      ELSE
-*
-*        Invert the scale factors.
-*
-         DO 60 I = 1, M
-            R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
-   60    CONTINUE
-*
-*        Compute ROWCND = min(R(I)) / max(R(I))
-*
-         ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
-      END IF
-*
-*     Compute column scale factors
-*
-      DO 70 J = 1, N
-         C( J ) = ZERO
-   70 CONTINUE
-*
-*     Find the maximum element in each column,
-*     assuming the row scaling computed above.
-*
-      DO 90 J = 1, N
-         DO 80 I = 1, M
-            C( J ) = MAX( C( J ), ABS( A( I, J ) )*R( I ) )
-   80    CONTINUE
-   90 CONTINUE
-*
-*     Find the maximum and minimum scale factors.
-*
-      RCMIN = BIGNUM
-      RCMAX = ZERO
-      DO 100 J = 1, N
-         RCMIN = MIN( RCMIN, C( J ) )
-         RCMAX = MAX( RCMAX, C( J ) )
-  100 CONTINUE
-*
-      IF( RCMIN.EQ.ZERO ) THEN
-*
-*        Find the first zero scale factor and return an error code.
-*
-         DO 110 J = 1, N
-            IF( C( J ).EQ.ZERO ) THEN
-               INFO = M + J
-               RETURN
-            END IF
-  110    CONTINUE
-      ELSE
-*
-*        Invert the scale factors.
-*
-         DO 120 J = 1, N
-            C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
-  120    CONTINUE
-*
-*        Compute COLCND = min(C(J)) / max(C(J))
-*
-         COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
-      END IF
-*
-      RETURN
-*
-*     End of DGEEQU
-*
-      END
diff --git a/src/lib/lapack/dgees.f b/src/lib/lapack/dgees.f
deleted file mode 100644
index 96ba8019..00000000
--- a/src/lib/lapack/dgees.f
+++ /dev/null
@@ -1,434 +0,0 @@
-      SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI,
-     $                  VS, LDVS, WORK, LWORK, BWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBVS, SORT
-      INTEGER            INFO, LDA, LDVS, LWORK, N, SDIM
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            BWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
-     $                   WR( * )
-*     ..
-*     .. Function Arguments ..
-      LOGICAL            SELECT
-      EXTERNAL           SELECT
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEES computes for an N-by-N real nonsymmetric matrix A, the
-*  eigenvalues, the real Schur form T, and, optionally, the matrix of
-*  Schur vectors Z.  This gives the Schur factorization A = Z*T*(Z**T).
-*
-*  Optionally, it also orders the eigenvalues on the diagonal of the
-*  real Schur form so that selected eigenvalues are at the top left.
-*  The leading columns of Z then form an orthonormal basis for the
-*  invariant subspace corresponding to the selected eigenvalues.
-*
-*  A matrix is in real Schur form if it is upper quasi-triangular with
-*  1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the
-*  form
-*          [  a  b  ]
-*          [  c  a  ]
-*
-*  where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
-*
-*  Arguments
-*  =========
-*
-*  JOBVS   (input) CHARACTER*1
-*          = 'N': Schur vectors are not computed;
-*          = 'V': Schur vectors are computed.
-*
-*  SORT    (input) CHARACTER*1
-*          Specifies whether or not to order the eigenvalues on the
-*          diagonal of the Schur form.
-*          = 'N': Eigenvalues are not ordered;
-*          = 'S': Eigenvalues are ordered (see SELECT).
-*
-*  SELECT  (external procedure) LOGICAL FUNCTION of two DOUBLE PRECISION arguments
-*          SELECT must be declared EXTERNAL in the calling subroutine.
-*          If SORT = 'S', SELECT is used to select eigenvalues to sort
-*          to the top left of the Schur form.
-*          If SORT = 'N', SELECT is not referenced.
-*          An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
-*          SELECT(WR(j),WI(j)) is true; i.e., if either one of a complex
-*          conjugate pair of eigenvalues is selected, then both complex
-*          eigenvalues are selected.
-*          Note that a selected complex eigenvalue may no longer
-*          satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
-*          ordering may change the value of complex eigenvalues
-*          (especially if the eigenvalue is ill-conditioned); in this
-*          case INFO is set to N+2 (see INFO below).
-*
-*  N       (input) INTEGER
-*          The order of the matrix A. N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the N-by-N matrix A.
-*          On exit, A has been overwritten by its real Schur form T.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  SDIM    (output) INTEGER
-*          If SORT = 'N', SDIM = 0.
-*          If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*                         for which SELECT is true. (Complex conjugate
-*                         pairs for which SELECT is true for either
-*                         eigenvalue count as 2.)
-*
-*  WR      (output) DOUBLE PRECISION array, dimension (N)
-*  WI      (output) DOUBLE PRECISION array, dimension (N)
-*          WR and WI contain the real and imaginary parts,
-*          respectively, of the computed eigenvalues in the same order
-*          that they appear on the diagonal of the output Schur form T.
-*          Complex conjugate pairs of eigenvalues will appear
-*          consecutively with the eigenvalue having the positive
-*          imaginary part first.
-*
-*  VS      (output) DOUBLE PRECISION array, dimension (LDVS,N)
-*          If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
-*          vectors.
-*          If JOBVS = 'N', VS is not referenced.
-*
-*  LDVS    (input) INTEGER
-*          The leading dimension of the array VS.  LDVS >= 1; if
-*          JOBVS = 'V', LDVS >= N.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) contains the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,3*N).
-*          For good performance, LWORK must generally be larger.
-*
-*          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.
-*
-*  BWORK   (workspace) LOGICAL array, dimension (N)
-*          Not referenced if SORT = 'N'.
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value.
-*          > 0: if INFO = i, and i is
-*             <= N: the QR algorithm failed to compute all the
-*                   eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
-*                   contain those eigenvalues which have converged; if
-*                   JOBVS = 'V', VS contains the matrix which reduces A
-*                   to its partially converged Schur form.
-*             = N+1: the eigenvalues could not be reordered because some
-*                   eigenvalues were too close to separate (the problem
-*                   is very ill-conditioned);
-*             = N+2: after reordering, roundoff changed values of some
-*                   complex eigenvalues so that leading eigenvalues in
-*                   the Schur form no longer satisfy SELECT=.TRUE.  This
-*                   could also be caused by underflow due to scaling.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTST,
-     $                   WANTVS
-      INTEGER            HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
-     $                   IHI, ILO, INXT, IP, ITAU, IWRK, MAXWRK, MINWRK
-      DOUBLE PRECISION   ANRM, BIGNUM, CSCALE, EPS, S, SEP, SMLNUM
-*     ..
-*     .. Local Arrays ..
-      INTEGER            IDUM( 1 )
-      DOUBLE PRECISION   DUM( 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY,
-     $                   DLABAD, DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           LSAME, ILAENV, DLAMCH, DLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      WANTVS = LSAME( JOBVS, 'V' )
-      WANTST = LSAME( SORT, 'S' )
-      IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
-         INFO = -1
-      ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      ELSE IF( LDVS.LT.1 .OR. ( WANTVS .AND. LDVS.LT.N ) ) THEN
-         INFO = -11
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       NB refers to the optimal block size for the immediately
-*       following subroutine, as returned by ILAENV.
-*       HSWORK refers to the workspace preferred by DHSEQR, as
-*       calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-*       the worst case.)
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( N.EQ.0 ) THEN
-            MINWRK = 1
-            MAXWRK = 1
-         ELSE
-            MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
-            MINWRK = 3*N
-*
-            CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
-     $             WORK, -1, IEVAL )
-            HSWORK = WORK( 1 )
-*
-            IF( .NOT.WANTVS ) THEN
-               MAXWRK = MAX( MAXWRK, N + HSWORK )
-            ELSE
-               MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
-     $                       'DORGHR', ' ', N, 1, N, -1 ) )
-               MAXWRK = MAX( MAXWRK, N + HSWORK )
-            END IF
-         END IF
-         WORK( 1 ) = MAXWRK
-*
-         IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
-            INFO = -13
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEES ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         SDIM = 0
-         RETURN
-      END IF
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SQRT( SMLNUM ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', N, N, A, LDA, DUM )
-      SCALEA = .FALSE.
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         SCALEA = .TRUE.
-         CSCALE = SMLNUM
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         SCALEA = .TRUE.
-         CSCALE = BIGNUM
-      END IF
-      IF( SCALEA )
-     $   CALL DLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-*     Permute the matrix to make it more nearly triangular
-*     (Workspace: need N)
-*
-      IBAL = 1
-      CALL DGEBAL( 'P', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
-*
-*     Reduce to upper Hessenberg form
-*     (Workspace: need 3*N, prefer 2*N+N*NB)
-*
-      ITAU = N + IBAL
-      IWRK = N + ITAU
-      CALL DGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
-     $             LWORK-IWRK+1, IERR )
-*
-      IF( WANTVS ) THEN
-*
-*        Copy Householder vectors to VS
-*
-         CALL DLACPY( 'L', N, N, A, LDA, VS, LDVS )
-*
-*        Generate orthogonal matrix in VS
-*        (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
-         CALL DORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
-     $                LWORK-IWRK+1, IERR )
-      END IF
-*
-      SDIM = 0
-*
-*     Perform QR iteration, accumulating Schur vectors in VS if desired
-*     (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
-      IWRK = ITAU
-      CALL DHSEQR( 'S', JOBVS, N, ILO, IHI, A, LDA, WR, WI, VS, LDVS,
-     $             WORK( IWRK ), LWORK-IWRK+1, IEVAL )
-      IF( IEVAL.GT.0 )
-     $   INFO = IEVAL
-*
-*     Sort eigenvalues if desired
-*
-      IF( WANTST .AND. INFO.EQ.0 ) THEN
-         IF( SCALEA ) THEN
-            CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WR, N, IERR )
-            CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WI, N, IERR )
-         END IF
-         DO 10 I = 1, N
-            BWORK( I ) = SELECT( WR( I ), WI( I ) )
-   10    CONTINUE
-*
-*        Reorder eigenvalues and transform Schur vectors
-*        (Workspace: none needed)
-*
-         CALL DTRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, WI,
-     $                SDIM, S, SEP, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1,
-     $                ICOND )
-         IF( ICOND.GT.0 )
-     $      INFO = N + ICOND
-      END IF
-*
-      IF( WANTVS ) THEN
-*
-*        Undo balancing
-*        (Workspace: need N)
-*
-         CALL DGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS,
-     $                IERR )
-      END IF
-*
-      IF( SCALEA ) THEN
-*
-*        Undo scaling for the Schur form of A
-*
-         CALL DLASCL( 'H', 0, 0, CSCALE, ANRM, N, N, A, LDA, IERR )
-         CALL DCOPY( N, A, LDA+1, WR, 1 )
-         IF( CSCALE.EQ.SMLNUM ) THEN
-*
-*           If scaling back towards underflow, adjust WI if an
-*           offdiagonal element of a 2-by-2 block in the Schur form
-*           underflows.
-*
-            IF( IEVAL.GT.0 ) THEN
-               I1 = IEVAL + 1
-               I2 = IHI - 1
-               CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI,
-     $                      MAX( ILO-1, 1 ), IERR )
-            ELSE IF( WANTST ) THEN
-               I1 = 1
-               I2 = N - 1
-            ELSE
-               I1 = ILO
-               I2 = IHI - 1
-            END IF
-            INXT = I1 - 1
-            DO 20 I = I1, I2
-               IF( I.LT.INXT )
-     $            GO TO 20
-               IF( WI( I ).EQ.ZERO ) THEN
-                  INXT = I + 1
-               ELSE
-                  IF( A( I+1, I ).EQ.ZERO ) THEN
-                     WI( I ) = ZERO
-                     WI( I+1 ) = ZERO
-                  ELSE IF( A( I+1, I ).NE.ZERO .AND. A( I, I+1 ).EQ.
-     $                     ZERO ) THEN
-                     WI( I ) = ZERO
-                     WI( I+1 ) = ZERO
-                     IF( I.GT.1 )
-     $                  CALL DSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 )
-                     IF( N.GT.I+1 )
-     $                  CALL DSWAP( N-I-1, A( I, I+2 ), LDA,
-     $                              A( I+1, I+2 ), LDA )
-                     IF( WANTVS ) THEN
-                        CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 )
-                     END IF
-                     A( I, I+1 ) = A( I+1, I )
-                     A( I+1, I ) = ZERO
-                  END IF
-                  INXT = I + 2
-               END IF
-   20       CONTINUE
-         END IF
-*
-*        Undo scaling for the imaginary part of the eigenvalues
-*
-         CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-IEVAL, 1,
-     $                WI( IEVAL+1 ), MAX( N-IEVAL, 1 ), IERR )
-      END IF
-*
-      IF( WANTST .AND. INFO.EQ.0 ) THEN
-*
-*        Check if reordering successful
-*
-         LASTSL = .TRUE.
-         LST2SL = .TRUE.
-         SDIM = 0
-         IP = 0
-         DO 30 I = 1, N
-            CURSL = SELECT( WR( I ), WI( I ) )
-            IF( WI( I ).EQ.ZERO ) THEN
-               IF( CURSL )
-     $            SDIM = SDIM + 1
-               IP = 0
-               IF( CURSL .AND. .NOT.LASTSL )
-     $            INFO = N + 2
-            ELSE
-               IF( IP.EQ.1 ) THEN
-*
-*                 Last eigenvalue of conjugate pair
-*
-                  CURSL = CURSL .OR. LASTSL
-                  LASTSL = CURSL
-                  IF( CURSL )
-     $               SDIM = SDIM + 2
-                  IP = -1
-                  IF( CURSL .AND. .NOT.LST2SL )
-     $               INFO = N + 2
-               ELSE
-*
-*                 First eigenvalue of conjugate pair
-*
-                  IP = 1
-               END IF
-            END IF
-            LST2SL = LASTSL
-            LASTSL = CURSL
-   30    CONTINUE
-      END IF
-*
-      WORK( 1 ) = MAXWRK
-      RETURN
-*
-*     End of DGEES
-*
-      END
diff --git a/src/lib/lapack/dgeesx.f b/src/lib/lapack/dgeesx.f
deleted file mode 100644
index deb30ab2..00000000
--- a/src/lib/lapack/dgeesx.f
+++ /dev/null
@@ -1,527 +0,0 @@
-      SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
-     $                   WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
-     $                   IWORK, LIWORK, BWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBVS, SENSE, SORT
-      INTEGER            INFO, LDA, LDVS, LIWORK, LWORK, N, SDIM
-      DOUBLE PRECISION   RCONDE, RCONDV
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            BWORK( * )
-      INTEGER            IWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
-     $                   WR( * )
-*     ..
-*     .. Function Arguments ..
-      LOGICAL            SELECT
-      EXTERNAL           SELECT
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEESX computes for an N-by-N real nonsymmetric matrix A, the
-*  eigenvalues, the real Schur form T, and, optionally, the matrix of
-*  Schur vectors Z.  This gives the Schur factorization A = Z*T*(Z**T).
-*
-*  Optionally, it also orders the eigenvalues on the diagonal of the
-*  real Schur form so that selected eigenvalues are at the top left;
-*  computes a reciprocal condition number for the average of the
-*  selected eigenvalues (RCONDE); and computes a reciprocal condition
-*  number for the right invariant subspace corresponding to the
-*  selected eigenvalues (RCONDV).  The leading columns of Z form an
-*  orthonormal basis for this invariant subspace.
-*
-*  For further explanation of the reciprocal condition numbers RCONDE
-*  and RCONDV, see Section 4.10 of the LAPACK Users' Guide (where
-*  these quantities are called s and sep respectively).
-*
-*  A real matrix is in real Schur form if it is upper quasi-triangular
-*  with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in
-*  the form
-*            [  a  b  ]
-*            [  c  a  ]
-*
-*  where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
-*
-*  Arguments
-*  =========
-*
-*  JOBVS   (input) CHARACTER*1
-*          = 'N': Schur vectors are not computed;
-*          = 'V': Schur vectors are computed.
-*
-*  SORT    (input) CHARACTER*1
-*          Specifies whether or not to order the eigenvalues on the
-*          diagonal of the Schur form.
-*          = 'N': Eigenvalues are not ordered;
-*          = 'S': Eigenvalues are ordered (see SELECT).
-*
-*  SELECT  (external procedure) LOGICAL FUNCTION of two DOUBLE PRECISION arguments
-*          SELECT must be declared EXTERNAL in the calling subroutine.
-*          If SORT = 'S', SELECT is used to select eigenvalues to sort
-*          to the top left of the Schur form.
-*          If SORT = 'N', SELECT is not referenced.
-*          An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
-*          SELECT(WR(j),WI(j)) is true; i.e., if either one of a
-*          complex conjugate pair of eigenvalues is selected, then both
-*          are.  Note that a selected complex eigenvalue may no longer
-*          satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
-*          ordering may change the value of complex eigenvalues
-*          (especially if the eigenvalue is ill-conditioned); in this
-*          case INFO may be set to N+3 (see INFO below).
-*
-*  SENSE   (input) CHARACTER*1
-*          Determines which reciprocal condition numbers are computed.
-*          = 'N': None are computed;
-*          = 'E': Computed for average of selected eigenvalues only;
-*          = 'V': Computed for selected right invariant subspace only;
-*          = 'B': Computed for both.
-*          If SENSE = 'E', 'V' or 'B', SORT must equal 'S'.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A. N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA, N)
-*          On entry, the N-by-N matrix A.
-*          On exit, A is overwritten by its real Schur form T.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  SDIM    (output) INTEGER
-*          If SORT = 'N', SDIM = 0.
-*          If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*                         for which SELECT is true. (Complex conjugate
-*                         pairs for which SELECT is true for either
-*                         eigenvalue count as 2.)
-*
-*  WR      (output) DOUBLE PRECISION array, dimension (N)
-*  WI      (output) DOUBLE PRECISION array, dimension (N)
-*          WR and WI contain the real and imaginary parts, respectively,
-*          of the computed eigenvalues, in the same order that they
-*          appear on the diagonal of the output Schur form T.  Complex
-*          conjugate pairs of eigenvalues appear consecutively with the
-*          eigenvalue having the positive imaginary part first.
-*
-*  VS      (output) DOUBLE PRECISION array, dimension (LDVS,N)
-*          If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
-*          vectors.
-*          If JOBVS = 'N', VS is not referenced.
-*
-*  LDVS    (input) INTEGER
-*          The leading dimension of the array VS.  LDVS >= 1, and if
-*          JOBVS = 'V', LDVS >= N.
-*
-*  RCONDE  (output) DOUBLE PRECISION
-*          If SENSE = 'E' or 'B', RCONDE contains the reciprocal
-*          condition number for the average of the selected eigenvalues.
-*          Not referenced if SENSE = 'N' or 'V'.
-*
-*  RCONDV  (output) DOUBLE PRECISION
-*          If SENSE = 'V' or 'B', RCONDV contains the reciprocal
-*          condition number for the selected right invariant subspace.
-*          Not referenced if SENSE = 'N' or 'E'.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,3*N).
-*          Also, if SENSE = 'E' or 'V' or 'B',
-*          LWORK >= N+2*SDIM*(N-SDIM), where SDIM is the number of
-*          selected eigenvalues computed by this routine.  Note that
-*          N+2*SDIM*(N-SDIM) <= N+N*N/2. Note also that an error is only
-*          returned if LWORK < max(1,3*N), but if SENSE = 'E' or 'V' or
-*          'B' this may not be large enough.
-*          For good performance, LWORK must generally be larger.
-*
-*          If LWORK = -1, then a workspace query is assumed; the routine
-*          only calculates upper bounds on the optimal sizes of the
-*          arrays WORK and IWORK, returns these values as the first
-*          entries of the WORK and IWORK arrays, and no error messages
-*          related to LWORK or LIWORK are issued by XERBLA.
-*
-*  IWORK   (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
-*          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*
-*  LIWORK  (input) INTEGER
-*          The dimension of the array IWORK.
-*          LIWORK >= 1; if SENSE = 'V' or 'B', LIWORK >= SDIM*(N-SDIM).
-*          Note that SDIM*(N-SDIM) <= N*N/4. Note also that an error is
-*          only returned if LIWORK < 1, but if SENSE = 'V' or 'B' this
-*          may not be large enough.
-*
-*          If LIWORK = -1, then a workspace query is assumed; the
-*          routine only calculates upper bounds on the optimal sizes of
-*          the arrays WORK and IWORK, returns these values as the first
-*          entries of the WORK and IWORK arrays, and no error messages
-*          related to LWORK or LIWORK are issued by XERBLA.
-*
-*  BWORK   (workspace) LOGICAL array, dimension (N)
-*          Not referenced if SORT = 'N'.
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value.
-*          > 0: if INFO = i, and i is
-*             <= N: the QR algorithm failed to compute all the
-*                   eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
-*                   contain those eigenvalues which have converged; if
-*                   JOBVS = 'V', VS contains the transformation which
-*                   reduces A to its partially converged Schur form.
-*             = N+1: the eigenvalues could not be reordered because some
-*                   eigenvalues were too close to separate (the problem
-*                   is very ill-conditioned);
-*             = N+2: after reordering, roundoff changed values of some
-*                   complex eigenvalues so that leading eigenvalues in
-*                   the Schur form no longer satisfy SELECT=.TRUE.  This
-*                   could also be caused by underflow due to scaling.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTSB,
-     $                   WANTSE, WANTSN, WANTST, WANTSV, WANTVS
-      INTEGER            HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
-     $                   IHI, ILO, INXT, IP, ITAU, IWRK, LIWRK, LWRK,
-     $                   MAXWRK, MINWRK
-      DOUBLE PRECISION   ANRM, BIGNUM, CSCALE, EPS, SMLNUM
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   DUM( 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY,
-     $                   DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           LSAME, ILAENV, DLABAD, DLAMCH, DLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      WANTVS = LSAME( JOBVS, 'V' )
-      WANTST = LSAME( SORT, 'S' )
-      WANTSN = LSAME( SENSE, 'N' )
-      WANTSE = LSAME( SENSE, 'E' )
-      WANTSV = LSAME( SENSE, 'V' )
-      WANTSB = LSAME( SENSE, 'B' )
-      LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-      IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
-         INFO = -1
-      ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
-         INFO = -2
-      ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR.
-     $         ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN
-         INFO = -4
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDVS.LT.1 .OR. ( WANTVS .AND. LDVS.LT.N ) ) THEN
-         INFO = -12
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "RWorkspace:" describe the
-*       minimal amount of real workspace needed at that point in the
-*       code, as well as the preferred amount for good performance.
-*       IWorkspace refers to integer workspace.
-*       NB refers to the optimal block size for the immediately
-*       following subroutine, as returned by ILAENV.
-*       HSWORK refers to the workspace preferred by DHSEQR, as
-*       calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-*       the worst case.
-*       If SENSE = 'E', 'V' or 'B', then the amount of workspace needed
-*       depends on SDIM, which is computed by the routine DTRSEN later
-*       in the code.)
-*
-      IF( INFO.EQ.0 ) THEN
-         LIWRK = 1
-         IF( N.EQ.0 ) THEN
-            MINWRK = 1
-            LWRK = 1
-         ELSE
-            MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
-            MINWRK = 3*N
-*
-            CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
-     $             WORK, -1, IEVAL )
-            HSWORK = WORK( 1 )
-*
-            IF( .NOT.WANTVS ) THEN
-               MAXWRK = MAX( MAXWRK, N + HSWORK )
-            ELSE
-               MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
-     $                       'DORGHR', ' ', N, 1, N, -1 ) )
-               MAXWRK = MAX( MAXWRK, N + HSWORK )
-            END IF
-            LWRK = MAXWRK
-            IF( .NOT.WANTSN )
-     $         LWRK = MAX( LWRK, N + ( N*N )/2 )
-            IF( WANTSV .OR. WANTSB )
-     $         LIWRK = ( N*N )/4
-         END IF
-         IWORK( 1 ) = LIWRK
-         WORK( 1 ) = LWRK
-*
-         IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
-            INFO = -16
-         ELSE IF( LIWORK.LT.1 .AND. .NOT.LQUERY ) THEN
-            INFO = -18
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEESX', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         SDIM = 0
-         RETURN
-      END IF
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SQRT( SMLNUM ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', N, N, A, LDA, DUM )
-      SCALEA = .FALSE.
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         SCALEA = .TRUE.
-         CSCALE = SMLNUM
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         SCALEA = .TRUE.
-         CSCALE = BIGNUM
-      END IF
-      IF( SCALEA )
-     $   CALL DLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-*     Permute the matrix to make it more nearly triangular
-*     (RWorkspace: need N)
-*
-      IBAL = 1
-      CALL DGEBAL( 'P', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
-*
-*     Reduce to upper Hessenberg form
-*     (RWorkspace: need 3*N, prefer 2*N+N*NB)
-*
-      ITAU = N + IBAL
-      IWRK = N + ITAU
-      CALL DGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
-     $             LWORK-IWRK+1, IERR )
-*
-      IF( WANTVS ) THEN
-*
-*        Copy Householder vectors to VS
-*
-         CALL DLACPY( 'L', N, N, A, LDA, VS, LDVS )
-*
-*        Generate orthogonal matrix in VS
-*        (RWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
-         CALL DORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
-     $                LWORK-IWRK+1, IERR )
-      END IF
-*
-      SDIM = 0
-*
-*     Perform QR iteration, accumulating Schur vectors in VS if desired
-*     (RWorkspace: need N+1, prefer N+HSWORK (see comments) )
-*
-      IWRK = ITAU
-      CALL DHSEQR( 'S', JOBVS, N, ILO, IHI, A, LDA, WR, WI, VS, LDVS,
-     $             WORK( IWRK ), LWORK-IWRK+1, IEVAL )
-      IF( IEVAL.GT.0 )
-     $   INFO = IEVAL
-*
-*     Sort eigenvalues if desired
-*
-      IF( WANTST .AND. INFO.EQ.0 ) THEN
-         IF( SCALEA ) THEN
-            CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WR, N, IERR )
-            CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, WI, N, IERR )
-         END IF
-         DO 10 I = 1, N
-            BWORK( I ) = SELECT( WR( I ), WI( I ) )
-   10    CONTINUE
-*
-*        Reorder eigenvalues, transform Schur vectors, and compute
-*        reciprocal condition numbers
-*        (RWorkspace: if SENSE is not 'N', need N+2*SDIM*(N-SDIM)
-*                     otherwise, need N )
-*        (IWorkspace: if SENSE is 'V' or 'B', need SDIM*(N-SDIM)
-*                     otherwise, need 0 )
-*
-         CALL DTRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, WI,
-     $                SDIM, RCONDE, RCONDV, WORK( IWRK ), LWORK-IWRK+1,
-     $                IWORK, LIWORK, ICOND )
-         IF( .NOT.WANTSN )
-     $      MAXWRK = MAX( MAXWRK, N+2*SDIM*( N-SDIM ) )
-         IF( ICOND.EQ.-15 ) THEN
-*
-*           Not enough real workspace
-*
-            INFO = -16
-         ELSE IF( ICOND.EQ.-17 ) THEN
-*
-*           Not enough integer workspace
-*
-            INFO = -18
-         ELSE IF( ICOND.GT.0 ) THEN
-*
-*           DTRSEN failed to reorder or to restore standard Schur form
-*
-            INFO = ICOND + N
-         END IF
-      END IF
-*
-      IF( WANTVS ) THEN
-*
-*        Undo balancing
-*        (RWorkspace: need N)
-*
-         CALL DGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS,
-     $                IERR )
-      END IF
-*
-      IF( SCALEA ) THEN
-*
-*        Undo scaling for the Schur form of A
-*
-         CALL DLASCL( 'H', 0, 0, CSCALE, ANRM, N, N, A, LDA, IERR )
-         CALL DCOPY( N, A, LDA+1, WR, 1 )
-         IF( ( WANTSV .OR. WANTSB ) .AND. INFO.EQ.0 ) THEN
-            DUM( 1 ) = RCONDV
-            CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR )
-            RCONDV = DUM( 1 )
-         END IF
-         IF( CSCALE.EQ.SMLNUM ) THEN
-*
-*           If scaling back towards underflow, adjust WI if an
-*           offdiagonal element of a 2-by-2 block in the Schur form
-*           underflows.
-*
-            IF( IEVAL.GT.0 ) THEN
-               I1 = IEVAL + 1
-               I2 = IHI - 1
-               CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
-     $                      IERR )
-            ELSE IF( WANTST ) THEN
-               I1 = 1
-               I2 = N - 1
-            ELSE
-               I1 = ILO
-               I2 = IHI - 1
-            END IF
-            INXT = I1 - 1
-            DO 20 I = I1, I2
-               IF( I.LT.INXT )
-     $            GO TO 20
-               IF( WI( I ).EQ.ZERO ) THEN
-                  INXT = I + 1
-               ELSE
-                  IF( A( I+1, I ).EQ.ZERO ) THEN
-                     WI( I ) = ZERO
-                     WI( I+1 ) = ZERO
-                  ELSE IF( A( I+1, I ).NE.ZERO .AND. A( I, I+1 ).EQ.
-     $                     ZERO ) THEN
-                     WI( I ) = ZERO
-                     WI( I+1 ) = ZERO
-                     IF( I.GT.1 )
-     $                  CALL DSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 )
-                     IF( N.GT.I+1 )
-     $                  CALL DSWAP( N-I-1, A( I, I+2 ), LDA,
-     $                              A( I+1, I+2 ), LDA )
-                     CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 )
-                     A( I, I+1 ) = A( I+1, I )
-                     A( I+1, I ) = ZERO
-                  END IF
-                  INXT = I + 2
-               END IF
-   20       CONTINUE
-         END IF
-         CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-IEVAL, 1,
-     $                WI( IEVAL+1 ), MAX( N-IEVAL, 1 ), IERR )
-      END IF
-*
-      IF( WANTST .AND. INFO.EQ.0 ) THEN
-*
-*        Check if reordering successful
-*
-         LASTSL = .TRUE.
-         LST2SL = .TRUE.
-         SDIM = 0
-         IP = 0
-         DO 30 I = 1, N
-            CURSL = SELECT( WR( I ), WI( I ) )
-            IF( WI( I ).EQ.ZERO ) THEN
-               IF( CURSL )
-     $            SDIM = SDIM + 1
-               IP = 0
-               IF( CURSL .AND. .NOT.LASTSL )
-     $            INFO = N + 2
-            ELSE
-               IF( IP.EQ.1 ) THEN
-*
-*                 Last eigenvalue of conjugate pair
-*
-                  CURSL = CURSL .OR. LASTSL
-                  LASTSL = CURSL
-                  IF( CURSL )
-     $               SDIM = SDIM + 2
-                  IP = -1
-                  IF( CURSL .AND. .NOT.LST2SL )
-     $               INFO = N + 2
-               ELSE
-*
-*                 First eigenvalue of conjugate pair
-*
-                  IP = 1
-               END IF
-            END IF
-            LST2SL = LASTSL
-            LASTSL = CURSL
-   30    CONTINUE
-      END IF
-*
-      WORK( 1 ) = MAXWRK
-      IF( WANTSV .OR. WANTSB ) THEN
-         IWORK( 1 ) = MAX( 1, SDIM*( N-SDIM ) )
-      ELSE
-         IWORK( 1 ) = 1
-      END IF
-*
-      RETURN
-*
-*     End of DGEESX
-*
-      END
diff --git a/src/lib/lapack/dgeev.f b/src/lib/lapack/dgeev.f
deleted file mode 100644
index 50e08a9c..00000000
--- a/src/lib/lapack/dgeev.f
+++ /dev/null
@@ -1,423 +0,0 @@
-      SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
-     $                  LDVR, WORK, LWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBVL, JOBVR
-      INTEGER            INFO, LDA, LDVL, LDVR, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
-     $                   WI( * ), WORK( * ), WR( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEEV computes for an N-by-N real nonsymmetric matrix A, the
-*  eigenvalues and, optionally, the left and/or right eigenvectors.
-*
-*  The right eigenvector v(j) of A satisfies
-*                   A * v(j) = lambda(j) * v(j)
-*  where lambda(j) is its eigenvalue.
-*  The left eigenvector u(j) of A satisfies
-*                u(j)**H * A = lambda(j) * u(j)**H
-*  where u(j)**H denotes the conjugate transpose of u(j).
-*
-*  The computed eigenvectors are normalized to have Euclidean norm
-*  equal to 1 and largest component real.
-*
-*  Arguments
-*  =========
-*
-*  JOBVL   (input) CHARACTER*1
-*          = 'N': left eigenvectors of A are not computed;
-*          = 'V': left eigenvectors of A are computed.
-*
-*  JOBVR   (input) CHARACTER*1
-*          = 'N': right eigenvectors of A are not computed;
-*          = 'V': right eigenvectors of A are computed.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A. N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the N-by-N matrix A.
-*          On exit, A has been overwritten.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  WR      (output) DOUBLE PRECISION array, dimension (N)
-*  WI      (output) DOUBLE PRECISION array, dimension (N)
-*          WR and WI contain the real and imaginary parts,
-*          respectively, of the computed eigenvalues.  Complex
-*          conjugate pairs of eigenvalues appear consecutively
-*          with the eigenvalue having the positive imaginary part
-*          first.
-*
-*  VL      (output) DOUBLE PRECISION array, dimension (LDVL,N)
-*          If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*          after another in the columns of VL, in the same order
-*          as their eigenvalues.
-*          If JOBVL = 'N', VL is not referenced.
-*          If the j-th eigenvalue is real, then u(j) = VL(:,j),
-*          the j-th column of VL.
-*          If the j-th and (j+1)-st eigenvalues form a complex
-*          conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
-*          u(j+1) = VL(:,j) - i*VL(:,j+1).
-*
-*  LDVL    (input) INTEGER
-*          The leading dimension of the array VL.  LDVL >= 1; if
-*          JOBVL = 'V', LDVL >= N.
-*
-*  VR      (output) DOUBLE PRECISION array, dimension (LDVR,N)
-*          If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*          after another in the columns of VR, in the same order
-*          as their eigenvalues.
-*          If JOBVR = 'N', VR is not referenced.
-*          If the j-th eigenvalue is real, then v(j) = VR(:,j),
-*          the j-th column of VR.
-*          If the j-th and (j+1)-st eigenvalues form a complex
-*          conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
-*          v(j+1) = VR(:,j) - i*VR(:,j+1).
-*
-*  LDVR    (input) INTEGER
-*          The leading dimension of the array VR.  LDVR >= 1; if
-*          JOBVR = 'V', LDVR >= N.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,3*N), and
-*          if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N.  For good
-*          performance, LWORK must generally be larger.
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          > 0:  if INFO = i, the QR algorithm failed to compute all the
-*                eigenvalues, and no eigenvectors have been computed;
-*                elements i+1:N of WR and WI contain eigenvalues which
-*                have converged.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, SCALEA, WANTVL, WANTVR
-      CHARACTER          SIDE
-      INTEGER            HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K,
-     $                   MAXWRK, MINWRK, NOUT
-      DOUBLE PRECISION   ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
-     $                   SN
-*     ..
-*     .. Local Arrays ..
-      LOGICAL            SELECT( 1 )
-      DOUBLE PRECISION   DUM( 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY,
-     $                   DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC,
-     $                   XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX, ILAENV
-      DOUBLE PRECISION   DLAMCH, DLANGE, DLAPY2, DNRM2
-      EXTERNAL           LSAME, IDAMAX, ILAENV, DLAMCH, DLANGE, DLAPY2,
-     $                   DNRM2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      WANTVL = LSAME( JOBVL, 'V' )
-      WANTVR = LSAME( JOBVR, 'V' )
-      IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
-         INFO = -1
-      ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN
-         INFO = -9
-      ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN
-         INFO = -11
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       NB refers to the optimal block size for the immediately
-*       following subroutine, as returned by ILAENV.
-*       HSWORK refers to the workspace preferred by DHSEQR, as
-*       calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-*       the worst case.)
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( N.EQ.0 ) THEN
-            MINWRK = 1
-            MAXWRK = 1
-         ELSE
-            MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
-            IF( WANTVL ) THEN
-               MINWRK = 4*N
-               MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
-     $                       'DORGHR', ' ', N, 1, N, -1 ) )
-               CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL,
-     $                WORK, -1, INFO )
-               HSWORK = WORK( 1 )
-               MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
-               MAXWRK = MAX( MAXWRK, 4*N )
-            ELSE IF( WANTVR ) THEN
-               MINWRK = 4*N
-               MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1,
-     $                       'DORGHR', ' ', N, 1, N, -1 ) )
-               CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR,
-     $                WORK, -1, INFO )
-               HSWORK = WORK( 1 )
-               MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
-               MAXWRK = MAX( MAXWRK, 4*N )
-            ELSE 
-               MINWRK = 3*N
-               CALL DHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR,
-     $                WORK, -1, INFO )
-               HSWORK = WORK( 1 )
-               MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK )
-            END IF
-            MAXWRK = MAX( MAXWRK, MINWRK )
-         END IF
-         WORK( 1 ) = MAXWRK
-*
-         IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
-            INFO = -13
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEEV ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SQRT( SMLNUM ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', N, N, A, LDA, DUM )
-      SCALEA = .FALSE.
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         SCALEA = .TRUE.
-         CSCALE = SMLNUM
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         SCALEA = .TRUE.
-         CSCALE = BIGNUM
-      END IF
-      IF( SCALEA )
-     $   CALL DLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-*     Balance the matrix
-*     (Workspace: need N)
-*
-      IBAL = 1
-      CALL DGEBAL( 'B', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
-*
-*     Reduce to upper Hessenberg form
-*     (Workspace: need 3*N, prefer 2*N+N*NB)
-*
-      ITAU = IBAL + N
-      IWRK = ITAU + N
-      CALL DGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
-     $             LWORK-IWRK+1, IERR )
-*
-      IF( WANTVL ) THEN
-*
-*        Want left eigenvectors
-*        Copy Householder vectors to VL
-*
-         SIDE = 'L'
-         CALL DLACPY( 'L', N, N, A, LDA, VL, LDVL )
-*
-*        Generate orthogonal matrix in VL
-*        (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
-         CALL DORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
-     $                LWORK-IWRK+1, IERR )
-*
-*        Perform QR iteration, accumulating Schur vectors in VL
-*        (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
-         IWRK = ITAU
-         CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL,
-     $                WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
-         IF( WANTVR ) THEN
-*
-*           Want left and right eigenvectors
-*           Copy Schur vectors to VR
-*
-            SIDE = 'B'
-            CALL DLACPY( 'F', N, N, VL, LDVL, VR, LDVR )
-         END IF
-*
-      ELSE IF( WANTVR ) THEN
-*
-*        Want right eigenvectors
-*        Copy Householder vectors to VR
-*
-         SIDE = 'R'
-         CALL DLACPY( 'L', N, N, A, LDA, VR, LDVR )
-*
-*        Generate orthogonal matrix in VR
-*        (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*
-         CALL DORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
-     $                LWORK-IWRK+1, IERR )
-*
-*        Perform QR iteration, accumulating Schur vectors in VR
-*        (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
-         IWRK = ITAU
-         CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
-     $                WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
-      ELSE
-*
-*        Compute eigenvalues only
-*        (Workspace: need N+1, prefer N+HSWORK (see comments) )
-*
-         IWRK = ITAU
-         CALL DHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR,
-     $                WORK( IWRK ), LWORK-IWRK+1, INFO )
-      END IF
-*
-*     If INFO > 0 from DHSEQR, then quit
-*
-      IF( INFO.GT.0 )
-     $   GO TO 50
-*
-      IF( WANTVL .OR. WANTVR ) THEN
-*
-*        Compute left and/or right eigenvectors
-*        (Workspace: need 4*N)
-*
-         CALL DTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
-     $                N, NOUT, WORK( IWRK ), IERR )
-      END IF
-*
-      IF( WANTVL ) THEN
-*
-*        Undo balancing of left eigenvectors
-*        (Workspace: need N)
-*
-         CALL DGEBAK( 'B', 'L', N, ILO, IHI, WORK( IBAL ), N, VL, LDVL,
-     $                IERR )
-*
-*        Normalize left eigenvectors and make largest component real
-*
-         DO 20 I = 1, N
-            IF( WI( I ).EQ.ZERO ) THEN
-               SCL = ONE / DNRM2( N, VL( 1, I ), 1 )
-               CALL DSCAL( N, SCL, VL( 1, I ), 1 )
-            ELSE IF( WI( I ).GT.ZERO ) THEN
-               SCL = ONE / DLAPY2( DNRM2( N, VL( 1, I ), 1 ),
-     $               DNRM2( N, VL( 1, I+1 ), 1 ) )
-               CALL DSCAL( N, SCL, VL( 1, I ), 1 )
-               CALL DSCAL( N, SCL, VL( 1, I+1 ), 1 )
-               DO 10 K = 1, N
-                  WORK( IWRK+K-1 ) = VL( K, I )**2 + VL( K, I+1 )**2
-   10          CONTINUE
-               K = IDAMAX( N, WORK( IWRK ), 1 )
-               CALL DLARTG( VL( K, I ), VL( K, I+1 ), CS, SN, R )
-               CALL DROT( N, VL( 1, I ), 1, VL( 1, I+1 ), 1, CS, SN )
-               VL( K, I+1 ) = ZERO
-            END IF
-   20    CONTINUE
-      END IF
-*
-      IF( WANTVR ) THEN
-*
-*        Undo balancing of right eigenvectors
-*        (Workspace: need N)
-*
-         CALL DGEBAK( 'B', 'R', N, ILO, IHI, WORK( IBAL ), N, VR, LDVR,
-     $                IERR )
-*
-*        Normalize right eigenvectors and make largest component real
-*
-         DO 40 I = 1, N
-            IF( WI( I ).EQ.ZERO ) THEN
-               SCL = ONE / DNRM2( N, VR( 1, I ), 1 )
-               CALL DSCAL( N, SCL, VR( 1, I ), 1 )
-            ELSE IF( WI( I ).GT.ZERO ) THEN
-               SCL = ONE / DLAPY2( DNRM2( N, VR( 1, I ), 1 ),
-     $               DNRM2( N, VR( 1, I+1 ), 1 ) )
-               CALL DSCAL( N, SCL, VR( 1, I ), 1 )
-               CALL DSCAL( N, SCL, VR( 1, I+1 ), 1 )
-               DO 30 K = 1, N
-                  WORK( IWRK+K-1 ) = VR( K, I )**2 + VR( K, I+1 )**2
-   30          CONTINUE
-               K = IDAMAX( N, WORK( IWRK ), 1 )
-               CALL DLARTG( VR( K, I ), VR( K, I+1 ), CS, SN, R )
-               CALL DROT( N, VR( 1, I ), 1, VR( 1, I+1 ), 1, CS, SN )
-               VR( K, I+1 ) = ZERO
-            END IF
-   40    CONTINUE
-      END IF
-*
-*     Undo scaling if necessary
-*
-   50 CONTINUE
-      IF( SCALEA ) THEN
-         CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ),
-     $                MAX( N-INFO, 1 ), IERR )
-         CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ),
-     $                MAX( N-INFO, 1 ), IERR )
-         IF( INFO.GT.0 ) THEN
-            CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WR, N,
-     $                   IERR )
-            CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
-     $                   IERR )
-         END IF
-      END IF
-*
-      WORK( 1 ) = MAXWRK
-      RETURN
-*
-*     End of DGEEV
-*
-      END
diff --git a/src/lib/lapack/dgegs.f b/src/lib/lapack/dgegs.f
deleted file mode 100644
index 85c32531..00000000
--- a/src/lib/lapack/dgegs.f
+++ /dev/null
@@ -1,438 +0,0 @@
-      SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR,
-     $                  ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK,
-     $                  LWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBVSL, JOBVSR
-      INTEGER            INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-     $                   B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
-     $                   VSR( LDVSR, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  This routine is deprecated and has been replaced by routine DGGES.
-*
-*  DGEGS computes the eigenvalues, real Schur form, and, optionally,
-*  left and or/right Schur vectors of a real matrix pair (A,B).
-*  Given two square matrices A and B, the generalized real Schur
-*  factorization has the form
-*
-*    A = Q*S*Z**T,  B = Q*T*Z**T
-*
-*  where Q and Z are orthogonal matrices, T is upper triangular, and S
-*  is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
-*  blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
-*  of eigenvalues of (A,B).  The columns of Q are the left Schur vectors
-*  and the columns of Z are the right Schur vectors.
-*
-*  If only the eigenvalues of (A,B) are needed, the driver routine
-*  DGEGV should be used instead.  See DGEGV for a description of the
-*  eigenvalues of the generalized nonsymmetric eigenvalue problem
-*  (GNEP).
-*
-*  Arguments
-*  =========
-*
-*  JOBVSL  (input) CHARACTER*1
-*          = 'N':  do not compute the left Schur vectors;
-*          = 'V':  compute the left Schur vectors (returned in VSL).
-*
-*  JOBVSR  (input) CHARACTER*1
-*          = 'N':  do not compute the right Schur vectors;
-*          = 'V':  compute the right Schur vectors (returned in VSR).
-*
-*  N       (input) INTEGER
-*          The order of the matrices A, B, VSL, and VSR.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA, N)
-*          On entry, the matrix A.
-*          On exit, the upper quasi-triangular matrix S from the
-*          generalized real Schur factorization.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of A.  LDA >= max(1,N).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB, N)
-*          On entry, the matrix B.
-*          On exit, the upper triangular matrix T from the generalized
-*          real Schur factorization.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of B.  LDB >= max(1,N).
-*
-*  ALPHAR  (output) DOUBLE PRECISION array, dimension (N)
-*          The real parts of each scalar alpha defining an eigenvalue
-*          of GNEP.
-*
-*  ALPHAI  (output) DOUBLE PRECISION array, dimension (N)
-*          The imaginary parts of each scalar alpha defining an
-*          eigenvalue of GNEP.  If ALPHAI(j) is zero, then the j-th
-*          eigenvalue is real; if positive, then the j-th and (j+1)-st
-*          eigenvalues are a complex conjugate pair, with
-*          ALPHAI(j+1) = -ALPHAI(j).
-*
-*  BETA    (output) DOUBLE PRECISION array, dimension (N)
-*          The scalars beta that define the eigenvalues of GNEP.
-*          Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
-*          beta = BETA(j) represent the j-th eigenvalue of the matrix
-*          pair (A,B), in one of the forms lambda = alpha/beta or
-*          mu = beta/alpha.  Since either lambda or mu may overflow,
-*          they should not, in general, be computed.
-*
-*  VSL     (output) DOUBLE PRECISION array, dimension (LDVSL,N)
-*          If JOBVSL = 'V', the matrix of left Schur vectors Q.
-*          Not referenced if JOBVSL = 'N'.
-*
-*  LDVSL   (input) INTEGER
-*          The leading dimension of the matrix VSL. LDVSL >=1, and
-*          if JOBVSL = 'V', LDVSL >= N.
-*
-*  VSR     (output) DOUBLE PRECISION array, dimension (LDVSR,N)
-*          If JOBVSR = 'V', the matrix of right Schur vectors Z.
-*          Not referenced if JOBVSR = 'N'.
-*
-*  LDVSR   (input) INTEGER
-*          The leading dimension of the matrix VSR. LDVSR >= 1, and
-*          if JOBVSR = 'V', LDVSR >= N.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,4*N).
-*          For good performance, LWORK must generally be larger.
-*          To compute the optimal value of LWORK, call ILAENV to get
-*          blocksizes (for DGEQRF, DORMQR, and DORGQR.)  Then compute:
-*          NB  -- MAX of the blocksizes for DGEQRF, DORMQR, and DORGQR
-*          The optimal LWORK is  2*N + N*(NB+1).
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          = 1,...,N:
-*                The QZ iteration failed.  (A,B) are not in Schur
-*                form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
-*                be correct for j=INFO+1,...,N.
-*          > N:  errors that usually indicate LAPACK problems:
-*                =N+1: error return from DGGBAL
-*                =N+2: error return from DGEQRF
-*                =N+3: error return from DORMQR
-*                =N+4: error return from DORGQR
-*                =N+5: error return from DGGHRD
-*                =N+6: error return from DHGEQZ (other than failed
-*                                                iteration)
-*                =N+7: error return from DGGBAK (computing VSL)
-*                =N+8: error return from DGGBAK (computing VSR)
-*                =N+9: error return from DLASCL (various places)
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            ILASCL, ILBSCL, ILVSL, ILVSR, LQUERY
-      INTEGER            ICOLS, IHI, IINFO, IJOBVL, IJOBVR, ILEFT, ILO,
-     $                   IRIGHT, IROWS, ITAU, IWORK, LOPT, LWKMIN,
-     $                   LWKOPT, NB, NB1, NB2, NB3
-      DOUBLE PRECISION   ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
-     $                   SAFMIN, SMLNUM
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY,
-     $                   DLASCL, DLASET, DORGQR, DORMQR, XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           LSAME, ILAENV, DLAMCH, DLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          INT, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode the input arguments
-*
-      IF( LSAME( JOBVSL, 'N' ) ) THEN
-         IJOBVL = 1
-         ILVSL = .FALSE.
-      ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
-         IJOBVL = 2
-         ILVSL = .TRUE.
-      ELSE
-         IJOBVL = -1
-         ILVSL = .FALSE.
-      END IF
-*
-      IF( LSAME( JOBVSR, 'N' ) ) THEN
-         IJOBVR = 1
-         ILVSR = .FALSE.
-      ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
-         IJOBVR = 2
-         ILVSR = .TRUE.
-      ELSE
-         IJOBVR = -1
-         ILVSR = .FALSE.
-      END IF
-*
-*     Test the input arguments
-*
-      LWKMIN = MAX( 4*N, 1 )
-      LWKOPT = LWKMIN
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      INFO = 0
-      IF( IJOBVL.LE.0 ) THEN
-         INFO = -1
-      ELSE IF( IJOBVR.LE.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
-         INFO = -12
-      ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
-         INFO = -14
-      ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
-         INFO = -16
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         NB1 = ILAENV( 1, 'DGEQRF', ' ', N, N, -1, -1 )
-         NB2 = ILAENV( 1, 'DORMQR', ' ', N, N, N, -1 )
-         NB3 = ILAENV( 1, 'DORGQR', ' ', N, N, N, -1 )
-         NB = MAX( NB1, NB2, NB3 )
-         LOPT = 2*N + N*( NB+1 )
-         WORK( 1 ) = LOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEGS ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'E' )*DLAMCH( 'B' )
-      SAFMIN = DLAMCH( 'S' )
-      SMLNUM = N*SAFMIN / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', N, N, A, LDA, WORK )
-      ILASCL = .FALSE.
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         ANRMTO = SMLNUM
-         ILASCL = .TRUE.
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         ANRMTO = BIGNUM
-         ILASCL = .TRUE.
-      END IF
-*
-      IF( ILASCL ) THEN
-         CALL DLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO )
-         IF( IINFO.NE.0 ) THEN
-            INFO = N + 9
-            RETURN
-         END IF
-      END IF
-*
-*     Scale B if max element outside range [SMLNUM,BIGNUM]
-*
-      BNRM = DLANGE( 'M', N, N, B, LDB, WORK )
-      ILBSCL = .FALSE.
-      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-         BNRMTO = SMLNUM
-         ILBSCL = .TRUE.
-      ELSE IF( BNRM.GT.BIGNUM ) THEN
-         BNRMTO = BIGNUM
-         ILBSCL = .TRUE.
-      END IF
-*
-      IF( ILBSCL ) THEN
-         CALL DLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO )
-         IF( IINFO.NE.0 ) THEN
-            INFO = N + 9
-            RETURN
-         END IF
-      END IF
-*
-*     Permute the matrix to make it more nearly triangular
-*     Workspace layout:  (2*N words -- "work..." not actually used)
-*        left_permutation, right_permutation, work...
-*
-      ILEFT = 1
-      IRIGHT = N + 1
-      IWORK = IRIGHT + N
-      CALL DGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
-     $             WORK( IRIGHT ), WORK( IWORK ), IINFO )
-      IF( IINFO.NE.0 ) THEN
-         INFO = N + 1
-         GO TO 10
-      END IF
-*
-*     Reduce B to triangular form, and initialize VSL and/or VSR
-*     Workspace layout:  ("work..." must have at least N words)
-*        left_permutation, right_permutation, tau, work...
-*
-      IROWS = IHI + 1 - ILO
-      ICOLS = N + 1 - ILO
-      ITAU = IWORK
-      IWORK = ITAU + IROWS
-      CALL DGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
-     $             WORK( IWORK ), LWORK+1-IWORK, IINFO )
-      IF( IINFO.GE.0 )
-     $   LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
-      IF( IINFO.NE.0 ) THEN
-         INFO = N + 2
-         GO TO 10
-      END IF
-*
-      CALL DORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
-     $             WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWORK ),
-     $             LWORK+1-IWORK, IINFO )
-      IF( IINFO.GE.0 )
-     $   LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
-      IF( IINFO.NE.0 ) THEN
-         INFO = N + 3
-         GO TO 10
-      END IF
-*
-      IF( ILVSL ) THEN
-         CALL DLASET( 'Full', N, N, ZERO, ONE, VSL, LDVSL )
-         CALL DLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
-     $                VSL( ILO+1, ILO ), LDVSL )
-         CALL DORGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
-     $                WORK( ITAU ), WORK( IWORK ), LWORK+1-IWORK,
-     $                IINFO )
-         IF( IINFO.GE.0 )
-     $      LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
-         IF( IINFO.NE.0 ) THEN
-            INFO = N + 4
-            GO TO 10
-         END IF
-      END IF
-*
-      IF( ILVSR )
-     $   CALL DLASET( 'Full', N, N, ZERO, ONE, VSR, LDVSR )
-*
-*     Reduce to generalized Hessenberg form
-*
-      CALL DGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
-     $             LDVSL, VSR, LDVSR, IINFO )
-      IF( IINFO.NE.0 ) THEN
-         INFO = N + 5
-         GO TO 10
-      END IF
-*
-*     Perform QZ algorithm, computing Schur vectors if desired
-*     Workspace layout:  ("work..." must have at least 1 word)
-*        left_permutation, right_permutation, work...
-*
-      IWORK = ITAU
-      CALL DHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
-     $             ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
-     $             WORK( IWORK ), LWORK+1-IWORK, IINFO )
-      IF( IINFO.GE.0 )
-     $   LWKOPT = MAX( LWKOPT, INT( WORK( IWORK ) )+IWORK-1 )
-      IF( IINFO.NE.0 ) THEN
-         IF( IINFO.GT.0 .AND. IINFO.LE.N ) THEN
-            INFO = IINFO
-         ELSE IF( IINFO.GT.N .AND. IINFO.LE.2*N ) THEN
-            INFO = IINFO - N
-         ELSE
-            INFO = N + 6
-         END IF
-         GO TO 10
-      END IF
-*
-*     Apply permutation to VSL and VSR
-*
-      IF( ILVSL ) THEN
-         CALL DGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
-     $                WORK( IRIGHT ), N, VSL, LDVSL, IINFO )
-         IF( IINFO.NE.0 ) THEN
-            INFO = N + 7
-            GO TO 10
-         END IF
-      END IF
-      IF( ILVSR ) THEN
-         CALL DGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
-     $                WORK( IRIGHT ), N, VSR, LDVSR, IINFO )
-         IF( IINFO.NE.0 ) THEN
-            INFO = N + 8
-            GO TO 10
-         END IF
-      END IF
-*
-*     Undo scaling
-*
-      IF( ILASCL ) THEN
-         CALL DLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO )
-         IF( IINFO.NE.0 ) THEN
-            INFO = N + 9
-            RETURN
-         END IF
-         CALL DLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHAR, N,
-     $                IINFO )
-         IF( IINFO.NE.0 ) THEN
-            INFO = N + 9
-            RETURN
-         END IF
-         CALL DLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHAI, N,
-     $                IINFO )
-         IF( IINFO.NE.0 ) THEN
-            INFO = N + 9
-            RETURN
-         END IF
-      END IF
-*
-      IF( ILBSCL ) THEN
-         CALL DLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO )
-         IF( IINFO.NE.0 ) THEN
-            INFO = N + 9
-            RETURN
-         END IF
-         CALL DLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO )
-         IF( IINFO.NE.0 ) THEN
-            INFO = N + 9
-            RETURN
-         END IF
-      END IF
-*
-   10 CONTINUE
-      WORK( 1 ) = LWKOPT
-*
-      RETURN
-*
-*     End of DGEGS
-*
-      END
diff --git a/src/lib/lapack/dgehd2.f b/src/lib/lapack/dgehd2.f
deleted file mode 100644
index 28d1cc8d..00000000
--- a/src/lib/lapack/dgehd2.f
+++ /dev/null
@@ -1,149 +0,0 @@
-      SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, ILO, INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEHD2 reduces a real general matrix A to upper Hessenberg form H by
-*  an orthogonal similarity transformation:  Q' * A * Q = H .
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          It is assumed that A is already upper triangular in rows
-*          and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*          set by a previous call to DGEBAL; otherwise they should be
-*          set to 1 and N respectively. See Further Details.
-*          1 <= ILO <= IHI <= max(1,N).
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the n by n general matrix to be reduced.
-*          On exit, the upper triangle and the first subdiagonal of A
-*          are overwritten with the upper Hessenberg matrix H, 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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (N-1)
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of (ihi-ilo) elementary
-*  reflectors
-*
-*     Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
-*  exit in A(i+2:ihi,i), and tau in TAU(i).
-*
-*  The contents of A are illustrated by the following example, with
-*  n = 7, ilo = 2 and ihi = 6:
-*
-*  on entry,                        on exit,
-*
-*  ( a   a   a   a   a   a   a )    (  a   a   h   h   h   h   a )
-*  (     a   a   a   a   a   a )    (      a   h   h   h   h   a )
-*  (     a   a   a   a   a   a )    (      h   h   h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  h   h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  v3  h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  v3  v4  h   h   h )
-*  (                         a )    (                          a )
-*
-*  where a denotes an element of the original matrix A, h denotes a
-*  modified element of the upper Hessenberg matrix H, and vi denotes an
-*  element of the vector defining H(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-      DOUBLE PRECISION   AII
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DLARFG, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      IF( N.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
-         INFO = -2
-      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEHD2', -INFO )
-         RETURN
-      END IF
-*
-      DO 10 I = ILO, IHI - 1
-*
-*        Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
-*
-         CALL DLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
-     $                TAU( I ) )
-         AII = A( I+1, I )
-         A( I+1, I ) = ONE
-*
-*        Apply H(i) to A(1:ihi,i+1:ihi) from the right
-*
-         CALL DLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
-     $               A( 1, I+1 ), LDA, WORK )
-*
-*        Apply H(i) to A(i+1:ihi,i+1:n) from the left
-*
-         CALL DLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ),
-     $               A( I+1, I+1 ), LDA, WORK )
-*
-         A( I+1, I ) = AII
-   10 CONTINUE
-*
-      RETURN
-*
-*     End of DGEHD2
-*
-      END
diff --git a/src/lib/lapack/dgehrd.f b/src/lib/lapack/dgehrd.f
deleted file mode 100644
index 339ee400..00000000
--- a/src/lib/lapack/dgehrd.f
+++ /dev/null
@@ -1,273 +0,0 @@
-      SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, ILO, INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION  A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEHRD reduces a real general matrix A to upper Hessenberg form H by
-*  an orthogonal similarity transformation:  Q' * A * Q = H .
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          It is assumed that A is already upper triangular in rows
-*          and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*          set by a previous call to DGEBAL; otherwise they should be
-*          set to 1 and N respectively. See Further Details.
-*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the N-by-N general matrix to be reduced.
-*          On exit, the upper triangle and the first subdiagonal of A
-*          are overwritten with the upper Hessenberg matrix H, 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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (N-1)
-*          The scalar factors of the elementary reflectors (see Further
-*          Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
-*          zero.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The length of the array WORK.  LWORK >= max(1,N).
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of (ihi-ilo) elementary
-*  reflectors
-*
-*     Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
-*  exit in A(i+2:ihi,i), and tau in TAU(i).
-*
-*  The contents of A are illustrated by the following example, with
-*  n = 7, ilo = 2 and ihi = 6:
-*
-*  on entry,                        on exit,
-*
-*  ( a   a   a   a   a   a   a )    (  a   a   h   h   h   h   a )
-*  (     a   a   a   a   a   a )    (      a   h   h   h   h   a )
-*  (     a   a   a   a   a   a )    (      h   h   h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  h   h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  v3  h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  v3  v4  h   h   h )
-*  (                         a )    (                          a )
-*
-*  where a denotes an element of the original matrix A, h denotes a
-*  modified element of the upper Hessenberg matrix H, and vi denotes an
-*  element of the vector defining H(i).
-*
-*  This file is a slight modification of LAPACK-3.0's DGEHRD
-*  subroutine incorporating improvements proposed by Quintana-Orti and
-*  Van de Geijn (2005). 
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            NBMAX, LDT
-      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
-      DOUBLE PRECISION  ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, 
-     $                     ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, J, LDWORK, LWKOPT, NB,
-     $                   NBMIN, NH, NX
-      DOUBLE PRECISION  EI
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION  T( LDT, NBMAX )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DGEHD2, DGEMM, DLAHR2, DLARFB, DTRMM,
-     $                   XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
-      LWKOPT = N*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( N.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
-         INFO = -2
-      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -8
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEHRD', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Set elements 1:ILO-1 and IHI:N-1 of TAU to zero
-*
-      DO 10 I = 1, ILO - 1
-         TAU( I ) = ZERO
-   10 CONTINUE
-      DO 20 I = MAX( 1, IHI ), N - 1
-         TAU( I ) = ZERO
-   20 CONTINUE
-*
-*     Quick return if possible
-*
-      NH = IHI - ILO + 1
-      IF( NH.LE.1 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-*     Determine the block size
-*
-      NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
-      NBMIN = 2
-      IWS = 1
-      IF( NB.GT.1 .AND. NB.LT.NH ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code
-*        (last block is always handled by unblocked code)
-*
-         NX = MAX( NB, ILAENV( 3, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
-         IF( NX.LT.NH ) THEN
-*
-*           Determine if workspace is large enough for blocked code
-*
-            IWS = N*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  determine the
-*              minimum value of NB, and reduce NB or force use of
-*              unblocked code
-*
-               NBMIN = MAX( 2, ILAENV( 2, 'DGEHRD', ' ', N, ILO, IHI,
-     $                 -1 ) )
-               IF( LWORK.GE.N*NBMIN ) THEN
-                  NB = LWORK / N
-               ELSE
-                  NB = 1
-               END IF
-            END IF
-         END IF
-      END IF
-      LDWORK = N
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.NH ) THEN
-*
-*        Use unblocked code below
-*
-         I = ILO
-*
-      ELSE
-*
-*        Use blocked code
-*
-         DO 40 I = ILO, IHI - 1 - NX, NB
-            IB = MIN( NB, IHI-I )
-*
-*           Reduce columns i:i+ib-1 to Hessenberg form, returning the
-*           matrices V and T of the block reflector H = I - V*T*V'
-*           which performs the reduction, and also the matrix Y = A*V*T
-*
-            CALL DLAHR2( IHI, I, IB, A( 1, I ), LDA, TAU( I ), T, LDT,
-     $                   WORK, LDWORK )
-*
-*           Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
-*           right, computing  A := A - Y * V'. V(i+ib,ib-1) must be set
-*           to 1
-*
-            EI = A( I+IB, I+IB-1 )
-            A( I+IB, I+IB-1 ) = ONE
-            CALL DGEMM( 'No transpose', 'Transpose', 
-     $                  IHI, IHI-I-IB+1,
-     $                  IB, -ONE, WORK, LDWORK, A( I+IB, I ), LDA, ONE,
-     $                  A( 1, I+IB ), LDA )
-            A( I+IB, I+IB-1 ) = EI
-*
-*           Apply the block reflector H to A(1:i,i+1:i+ib-1) from the
-*           right
-*
-            CALL DTRMM( 'Right', 'Lower', 'Transpose',
-     $                  'Unit', I, IB-1,
-     $                  ONE, A( I+1, I ), LDA, WORK, LDWORK )
-            DO 30 J = 0, IB-2
-               CALL DAXPY( I, -ONE, WORK( LDWORK*J+1 ), 1,
-     $                     A( 1, I+J+1 ), 1 )
-   30       CONTINUE
-*
-*           Apply the block reflector H to A(i+1:ihi,i+ib:n) from the
-*           left
-*
-            CALL DLARFB( 'Left', 'Transpose', 'Forward',
-     $                   'Columnwise',
-     $                   IHI-I, N-I-IB+1, IB, A( I+1, I ), LDA, T, LDT,
-     $                   A( I+1, I+IB ), LDA, WORK, LDWORK )
-   40    CONTINUE
-      END IF
-*
-*     Use unblocked code to reduce the rest of the matrix
-*
-      CALL DGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
-      WORK( 1 ) = IWS
-*
-      RETURN
-*
-*     End of DGEHRD
-*
-      END
diff --git a/src/lib/lapack/dgelq2.f b/src/lib/lapack/dgelq2.f
deleted file mode 100644
index f3540505..00000000
--- a/src/lib/lapack/dgelq2.f
+++ /dev/null
@@ -1,121 +0,0 @@
-      SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGELQ2 computes an LQ factorization of a real m by n matrix A:
-*  A = L * Q.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the m by n matrix A.
-*          On exit, the elements on and below the diagonal of the array
-*          contain the m by min(m,n) lower trapezoidal matrix L (L is
-*          lower triangular if m <= n); the elements above the diagonal,
-*          with the array TAU, represent the orthogonal matrix Q as a
-*          product of elementary reflectors (see Further Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (M)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
-*  and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, K
-      DOUBLE PRECISION   AII
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DLARFG, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGELQ2', -INFO )
-         RETURN
-      END IF
-*
-      K = MIN( M, N )
-*
-      DO 10 I = 1, K
-*
-*        Generate elementary reflector H(i) to annihilate A(i,i+1:n)
-*
-         CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
-     $                TAU( I ) )
-         IF( I.LT.M ) THEN
-*
-*           Apply H(i) to A(i+1:m,i:n) from the right
-*
-            AII = A( I, I )
-            A( I, I ) = ONE
-            CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
-     $                  A( I+1, I ), LDA, WORK )
-            A( I, I ) = AII
-         END IF
-   10 CONTINUE
-      RETURN
-*
-*     End of DGELQ2
-*
-      END
diff --git a/src/lib/lapack/dgelqf.f b/src/lib/lapack/dgelqf.f
deleted file mode 100644
index 063a38ba..00000000
--- a/src/lib/lapack/dgelqf.f
+++ /dev/null
@@ -1,195 +0,0 @@
-      SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGELQF computes an LQ factorization of a real M-by-N matrix A:
-*  A = L * Q.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the elements on and below the diagonal of the array
-*          contain the m-by-min(m,n) lower trapezoidal matrix L (L is
-*          lower triangular if m <= n); the elements above the diagonal,
-*          with the array TAU, represent the orthogonal matrix Q as a
-*          product of elementary reflectors (see Further Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,M).
-*          For optimum performance LWORK >= M*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
-*  and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
-     $                   NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGELQ2, DLARFB, DLARFT, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-      LWKOPT = M*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
-         INFO = -7
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGELQF', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      K = MIN( M, N )
-      IF( K.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = M
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'DGELQF', ' ', M, N, -1, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = M
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'DGELQF', ' ', M, N, -1,
-     $                 -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code initially
-*
-         DO 10 I = 1, K - NX, NB
-            IB = MIN( K-I+1, NB )
-*
-*           Compute the LQ factorization of the current block
-*           A(i:i+ib-1,i:n)
-*
-            CALL DGELQ2( IB, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
-     $                   IINFO )
-            IF( I+IB.LE.M ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i) H(i+1) . . . H(i+ib-1)
-*
-               CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
-     $                      LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H to A(i+ib:m,i:n) from the right
-*
-               CALL DLARFB( 'Right', 'No transpose', 'Forward',
-     $                      'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ),
-     $                      LDA, WORK, LDWORK, A( I+IB, I ), LDA,
-     $                      WORK( IB+1 ), LDWORK )
-            END IF
-   10    CONTINUE
-      ELSE
-         I = 1
-      END IF
-*
-*     Use unblocked code to factor the last or only block.
-*
-      IF( I.LE.K )
-     $   CALL DGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
-     $                IINFO )
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of DGELQF
-*
-      END
diff --git a/src/lib/lapack/dgels.f b/src/lib/lapack/dgels.f
deleted file mode 100644
index 4fa1e229..00000000
--- a/src/lib/lapack/dgels.f
+++ /dev/null
@@ -1,422 +0,0 @@
-      SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,
-     $                  INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TRANS
-      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGELS solves overdetermined or underdetermined real linear systems
-*  involving an M-by-N matrix A, or its transpose, using a QR or LQ
-*  factorization of A.  It is assumed that A has full rank.
-*
-*  The following options are provided:
-*
-*  1. If TRANS = 'N' and m >= n:  find the least squares solution of
-*     an overdetermined system, i.e., solve the least squares problem
-*                  minimize || B - A*X ||.
-*
-*  2. If TRANS = 'N' and m < n:  find the minimum norm solution of
-*     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.
-*
-*  4. If TRANS = 'T' and m < n:  find the least squares solution of
-*     an overdetermined system, i.e., solve the least squares problem
-*                  minimize || B - A**T * X ||.
-*
-*  Several right hand side vectors b and solution vectors x can be
-*  handled in a single call; they are stored as the columns of the
-*  M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*  matrix X.
-*
-*  Arguments
-*  =========
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': the linear system involves A;
-*          = 'T': the linear system involves A**T.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of
-*          columns of the matrices B and X. NRHS >=0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit,
-*            if M >= N, A is overwritten by details of its QR
-*                       factorization as returned by DGEQRF;
-*            if M <  N, A is overwritten by details of its LQ
-*                       factorization as returned by DGELQF.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the matrix B of right hand side vectors, stored
-*          columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
-*          if TRANS = 'T'.
-*          On exit, if INFO = 0, B is overwritten by the solution
-*          vectors, stored columnwise:
-*          if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
-*          squares solution vectors; the residual sum of squares for the
-*          solution in each column is given by the sum of squares of
-*          elements N+1 to M in that column;
-*          if TRANS = 'N' and m < n, rows 1 to N of B contain the
-*          minimum norm solution vectors;
-*          if TRANS = 'T' and m >= n, rows 1 to M of B contain the
-*          minimum norm solution vectors;
-*          if TRANS = 'T' and m < n, rows 1 to M of B contain the
-*          least squares solution vectors; the residual sum of squares
-*          for the solution in each column is given by the sum of
-*          squares of elements M+1 to N in that column.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= MAX(1,M,N).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          LWORK >= max( 1, MN + max( MN, NRHS ) ).
-*          For optimal performance,
-*          LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
-*          where MN = min(M,N) and NB is the optimum block size.
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO =  i, the i-th diagonal element of the
-*                triangular factor of A is zero, so that A does not have
-*                full rank; the least squares solution could not be
-*                computed.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, TPSD
-      INTEGER            BROW, I, IASCL, IBSCL, J, MN, NB, SCLLEN, WSIZE
-      DOUBLE PRECISION   ANRM, BIGNUM, BNRM, SMLNUM
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   RWORK( 1 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           LSAME, ILAENV, DLABAD, DLAMCH, DLANGE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGELQF, DGEQRF, DLASCL, DLASET, DORMLQ, DORMQR,
-     $                   DTRTRS, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments.
-*
-      INFO = 0
-      MN = MIN( M, N )
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'T' ) ) ) THEN
-         INFO = -1
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( NRHS.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -6
-      ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
-         INFO = -8
-      ELSE IF( LWORK.LT.MAX( 1, MN+MAX( MN, NRHS ) ) .AND. .NOT.LQUERY )
-     $          THEN
-         INFO = -10
-      END IF
-*
-*     Figure out optimal block size
-*
-      IF( INFO.EQ.0 .OR. INFO.EQ.-10 ) THEN
-*
-         TPSD = .TRUE.
-         IF( LSAME( TRANS, 'N' ) )
-     $      TPSD = .FALSE.
-*
-         IF( M.GE.N ) THEN
-            NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-            IF( TPSD ) THEN
-               NB = MAX( NB, ILAENV( 1, 'DORMQR', 'LN', M, NRHS, N,
-     $              -1 ) )
-            ELSE
-               NB = MAX( NB, ILAENV( 1, 'DORMQR', 'LT', M, NRHS, N,
-     $              -1 ) )
-            END IF
-         ELSE
-            NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-            IF( TPSD ) THEN
-               NB = MAX( NB, ILAENV( 1, 'DORMLQ', 'LT', N, NRHS, M,
-     $              -1 ) )
-            ELSE
-               NB = MAX( NB, ILAENV( 1, 'DORMLQ', 'LN', N, NRHS, M,
-     $              -1 ) )
-            END IF
-         END IF
-*
-         WSIZE = MAX( 1, MN+MAX( MN, NRHS )*NB )
-         WORK( 1 ) = DBLE( WSIZE )
-*
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGELS ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( MIN( M, N, NRHS ).EQ.0 ) THEN
-         CALL DLASET( 'Full', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
-         RETURN
-      END IF
-*
-*     Get machine parameters
-*
-      SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Scale A, B if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', M, N, A, LDA, RWORK )
-      IASCL = 0
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-*        Scale matrix norm up to SMLNUM
-*
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
-         IASCL = 1
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-*        Scale matrix norm down to BIGNUM
-*
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
-         IASCL = 2
-      ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-*        Matrix all zero. Return zero solution.
-*
-         CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
-         GO TO 50
-      END IF
-*
-      BROW = M
-      IF( TPSD )
-     $   BROW = N
-      BNRM = DLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
-      IBSCL = 0
-      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-*        Scale matrix norm up to SMLNUM
-*
-         CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, BROW, NRHS, B, LDB,
-     $                INFO )
-         IBSCL = 1
-      ELSE IF( BNRM.GT.BIGNUM ) THEN
-*
-*        Scale matrix norm down to BIGNUM
-*
-         CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, BROW, NRHS, B, LDB,
-     $                INFO )
-         IBSCL = 2
-      END IF
-*
-      IF( M.GE.N ) THEN
-*
-*        compute QR factorization of A
-*
-         CALL DGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN,
-     $                INFO )
-*
-*        workspace at least N, optimally N*NB
-*
-         IF( .NOT.TPSD ) THEN
-*
-*           Least-Squares Problem min || A * X - B ||
-*
-*           B(1:M,1:NRHS) := Q' * B(1:M,1:NRHS)
-*
-            CALL DORMQR( 'Left', 'Transpose', M, NRHS, N, A, LDA,
-     $                   WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
-     $                   INFO )
-*
-*           workspace at least NRHS, optimally NRHS*NB
-*
-*           B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
-*
-            CALL DTRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS,
-     $                   A, LDA, B, LDB, INFO )
-*
-            IF( INFO.GT.0 ) THEN
-               RETURN
-            END IF
-*
-            SCLLEN = N
-*
-         ELSE
-*
-*           Overdetermined system of equations A' * X = B
-*
-*           B(1:N,1:NRHS) := inv(R') * B(1:N,1:NRHS)
-*
-            CALL DTRTRS( 'Upper', 'Transpose', 'Non-unit', N, NRHS,
-     $                   A, LDA, B, LDB, INFO )
-*
-            IF( INFO.GT.0 ) THEN
-               RETURN
-            END IF
-*
-*           B(N+1:M,1:NRHS) = ZERO
-*
-            DO 20 J = 1, NRHS
-               DO 10 I = N + 1, M
-                  B( I, J ) = ZERO
-   10          CONTINUE
-   20       CONTINUE
-*
-*           B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
-*
-            CALL DORMQR( 'Left', 'No transpose', M, NRHS, N, A, LDA,
-     $                   WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
-     $                   INFO )
-*
-*           workspace at least NRHS, optimally NRHS*NB
-*
-            SCLLEN = M
-*
-         END IF
-*
-      ELSE
-*
-*        Compute LQ factorization of A
-*
-         CALL DGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN,
-     $                INFO )
-*
-*        workspace at least M, optimally M*NB.
-*
-         IF( .NOT.TPSD ) THEN
-*
-*           underdetermined system of equations A * X = B
-*
-*           B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS)
-*
-            CALL DTRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS,
-     $                   A, LDA, B, LDB, INFO )
-*
-            IF( INFO.GT.0 ) THEN
-               RETURN
-            END IF
-*
-*           B(M+1:N,1:NRHS) = 0
-*
-            DO 40 J = 1, NRHS
-               DO 30 I = M + 1, N
-                  B( I, J ) = ZERO
-   30          CONTINUE
-   40       CONTINUE
-*
-*           B(1:N,1:NRHS) := Q(1:N,:)' * B(1:M,1:NRHS)
-*
-            CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA,
-     $                   WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
-     $                   INFO )
-*
-*           workspace at least NRHS, optimally NRHS*NB
-*
-            SCLLEN = N
-*
-         ELSE
-*
-*           overdetermined system min || A' * X - B ||
-*
-*           B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
-*
-            CALL DORMLQ( 'Left', 'No transpose', N, NRHS, M, A, LDA,
-     $                   WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
-     $                   INFO )
-*
-*           workspace at least NRHS, optimally NRHS*NB
-*
-*           B(1:M,1:NRHS) := inv(L') * B(1:M,1:NRHS)
-*
-            CALL DTRTRS( 'Lower', 'Transpose', 'Non-unit', M, NRHS,
-     $                   A, LDA, B, LDB, INFO )
-*
-            IF( INFO.GT.0 ) THEN
-               RETURN
-            END IF
-*
-            SCLLEN = M
-*
-         END IF
-*
-      END IF
-*
-*     Undo scaling
-*
-      IF( IASCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
-     $                INFO )
-      ELSE IF( IASCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
-     $                INFO )
-      END IF
-      IF( IBSCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
-     $                INFO )
-      ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
-     $                INFO )
-      END IF
-*
-   50 CONTINUE
-      WORK( 1 ) = DBLE( WSIZE )
-*
-      RETURN
-*
-*     End of DGELS
-*
-      END
diff --git a/src/lib/lapack/dgelss.f b/src/lib/lapack/dgelss.f
deleted file mode 100644
index f024e138..00000000
--- a/src/lib/lapack/dgelss.f
+++ /dev/null
@@ -1,617 +0,0 @@
-      SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
-      DOUBLE PRECISION   RCOND
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGELSS computes the minimum norm solution to a real linear least
-*  squares problem:
-*
-*  Minimize 2-norm(| b - A*x |).
-*
-*  using the singular value decomposition (SVD) of A. A is an M-by-N
-*  matrix which may be rank-deficient.
-*
-*  Several right hand side vectors b and solution vectors x can be
-*  handled in a single call; they are stored as the columns of the
-*  M-by-NRHS right hand side matrix B and the N-by-NRHS solution matrix
-*  X.
-*
-*  The effective rank of A is determined by treating as zero those
-*  singular values which are less than RCOND times the largest singular
-*  value.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A. N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of columns
-*          of the matrices B and X. NRHS >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the first min(m,n) rows of A are overwritten with
-*          its right singular vectors, stored rowwise.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the M-by-NRHS right hand side matrix B.
-*          On exit, B is overwritten by the N-by-NRHS solution
-*          matrix X.  If m >= n and RANK = n, the residual
-*          sum-of-squares for the solution in the i-th column is given
-*          by the sum of squares of elements n+1:m in that column.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1,max(M,N)).
-*
-*  S       (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The singular values of A in decreasing order.
-*          The condition number of A in the 2-norm = S(1)/S(min(m,n)).
-*
-*  RCOND   (input) DOUBLE PRECISION
-*          RCOND is used to determine the effective rank of A.
-*          Singular values S(i) <= RCOND*S(1) are treated as zero.
-*          If RCOND < 0, machine precision is used instead.
-*
-*  RANK    (output) INTEGER
-*          The effective rank of A, i.e., the number of singular values
-*          which are greater than RCOND*S(1).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= 1, and also:
-*          LWORK >= 3*min(M,N) + max( 2*min(M,N), max(M,N), NRHS )
-*          For good performance, LWORK should generally be larger.
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          > 0:  the algorithm for computing the SVD failed to converge;
-*                if INFO = i, i off-diagonal elements of an intermediate
-*                bidiagonal form did not converge to zero.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            BDSPAC, BL, CHUNK, I, IASCL, IBSCL, IE, IL,
-     $                   ITAU, ITAUP, ITAUQ, IWORK, LDWORK, MAXMN,
-     $                   MAXWRK, MINMN, MINWRK, MM, MNTHR
-      DOUBLE PRECISION   ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM, THR
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   VDUM( 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DBDSQR, DCOPY, DGEBRD, DGELQF, DGEMM, DGEMV,
-     $                   DGEQRF, DLABAD, DLACPY, DLASCL, DLASET, DORGBR,
-     $                   DORMBR, DORMLQ, DORMQR, DRSCL, XERBLA
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           ILAENV, DLAMCH, DLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      MINMN = MIN( M, N )
-      MAXMN = MAX( M, N )
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) 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, M ) ) THEN
-         INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, MAXMN ) ) THEN
-         INFO = -7
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       NB refers to the optimal block size for the immediately
-*       following subroutine, as returned by ILAENV.)
-*
-      IF( INFO.EQ.0 ) THEN
-         MINWRK = 1
-         MAXWRK = 1
-         IF( MINMN.GT.0 ) THEN
-            MM = M
-            MNTHR = ILAENV( 6, 'DGELSS', ' ', M, N, NRHS, -1 )
-            IF( M.GE.N .AND. M.GE.MNTHR ) THEN
-*
-*              Path 1a - overdetermined, with many more rows than
-*                        columns
-*
-               MM = N
-               MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'DGEQRF', ' ', M,
-     $                       N, -1, -1 ) )
-               MAXWRK = MAX( MAXWRK, N + NRHS*ILAENV( 1, 'DORMQR', 'LT',
-     $                       M, NRHS, N, -1 ) )
-            END IF
-            IF( M.GE.N ) THEN
-*
-*              Path 1 - overdetermined or exactly determined
-*
-*              Compute workspace needed for DBDSQR
-*
-               BDSPAC = MAX( 1, 5*N )
-               MAXWRK = MAX( MAXWRK, 3*N + ( MM + N )*ILAENV( 1,
-     $                       'DGEBRD', ' ', MM, N, -1, -1 ) )
-               MAXWRK = MAX( MAXWRK, 3*N + NRHS*ILAENV( 1, 'DORMBR',
-     $                       'QLT', MM, NRHS, N, -1 ) )
-               MAXWRK = MAX( MAXWRK, 3*N + ( N - 1 )*ILAENV( 1,
-     $                       'DORGBR', 'P', N, N, N, -1 ) )
-               MAXWRK = MAX( MAXWRK, BDSPAC )
-               MAXWRK = MAX( MAXWRK, N*NRHS )
-               MINWRK = MAX( 3*N + MM, 3*N + NRHS, BDSPAC )
-               MAXWRK = MAX( MINWRK, MAXWRK )
-            END IF
-            IF( N.GT.M ) THEN
-*
-*              Compute workspace needed for DBDSQR
-*
-               BDSPAC = MAX( 1, 5*M )
-               MINWRK = MAX( 3*M+NRHS, 3*M+N, BDSPAC )
-               IF( N.GE.MNTHR ) THEN
-*
-*                 Path 2a - underdetermined, with many more columns
-*                 than rows
-*
-                  MAXWRK = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1,
-     $                                  -1 )
-                  MAXWRK = MAX( MAXWRK, M*M + 4*M + 2*M*ILAENV( 1,
-     $                          'DGEBRD', ' ', M, M, -1, -1 ) )
-                  MAXWRK = MAX( MAXWRK, M*M + 4*M + NRHS*ILAENV( 1,
-     $                          'DORMBR', 'QLT', M, NRHS, M, -1 ) )
-                  MAXWRK = MAX( MAXWRK, M*M + 4*M +
-     $                          ( M - 1 )*ILAENV( 1, 'DORGBR', 'P', M,
-     $                          M, M, -1 ) )
-                  MAXWRK = MAX( MAXWRK, M*M + M + BDSPAC )
-                  IF( NRHS.GT.1 ) THEN
-                     MAXWRK = MAX( MAXWRK, M*M + M + M*NRHS )
-                  ELSE
-                     MAXWRK = MAX( MAXWRK, M*M + 2*M )
-                  END IF
-                  MAXWRK = MAX( MAXWRK, M + NRHS*ILAENV( 1, 'DORMLQ',
-     $                          'LT', N, NRHS, M, -1 ) )
-               ELSE
-*
-*                 Path 2 - underdetermined
-*
-                  MAXWRK = 3*M + ( N + M )*ILAENV( 1, 'DGEBRD', ' ', M,
-     $                     N, -1, -1 )
-                  MAXWRK = MAX( MAXWRK, 3*M + NRHS*ILAENV( 1, 'DORMBR',
-     $                          'QLT', M, NRHS, M, -1 ) )
-                  MAXWRK = MAX( MAXWRK, 3*M + M*ILAENV( 1, 'DORGBR',
-     $                          'P', M, N, M, -1 ) )
-                  MAXWRK = MAX( MAXWRK, BDSPAC )
-                  MAXWRK = MAX( MAXWRK, N*NRHS )
-               END IF
-            END IF
-            MAXWRK = MAX( MINWRK, MAXWRK )
-         END IF
-         WORK( 1 ) = MAXWRK
-*
-         IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
-     $      INFO = -12
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGELSS', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         RANK = 0
-         RETURN
-      END IF
-*
-*     Get machine parameters
-*
-      EPS = DLAMCH( 'P' )
-      SFMIN = DLAMCH( 'S' )
-      SMLNUM = SFMIN / EPS
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', M, N, A, LDA, WORK )
-      IASCL = 0
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-*        Scale matrix norm up to SMLNUM
-*
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
-         IASCL = 1
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-*        Scale matrix norm down to BIGNUM
-*
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
-         IASCL = 2
-      ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-*        Matrix all zero. Return zero solution.
-*
-         CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
-         CALL DLASET( 'F', MINMN, 1, ZERO, ZERO, S, 1 )
-         RANK = 0
-         GO TO 70
-      END IF
-*
-*     Scale B if max element outside range [SMLNUM,BIGNUM]
-*
-      BNRM = DLANGE( 'M', M, NRHS, B, LDB, WORK )
-      IBSCL = 0
-      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-*        Scale matrix norm up to SMLNUM
-*
-         CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
-         IBSCL = 1
-      ELSE IF( BNRM.GT.BIGNUM ) THEN
-*
-*        Scale matrix norm down to BIGNUM
-*
-         CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
-         IBSCL = 2
-      END IF
-*
-*     Overdetermined case
-*
-      IF( M.GE.N ) THEN
-*
-*        Path 1 - overdetermined or exactly determined
-*
-         MM = M
-         IF( M.GE.MNTHR ) THEN
-*
-*           Path 1a - overdetermined, with many more rows than columns
-*
-            MM = N
-            ITAU = 1
-            IWORK = ITAU + N
-*
-*           Compute A=Q*R
-*           (Workspace: need 2*N, prefer N+N*NB)
-*
-            CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
-     $                   LWORK-IWORK+1, INFO )
-*
-*           Multiply B by transpose(Q)
-*           (Workspace: need N+NRHS, prefer N+NRHS*NB)
-*
-            CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), B,
-     $                   LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
-*           Zero out below R
-*
-            IF( N.GT.1 )
-     $         CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
-         END IF
-*
-         IE = 1
-         ITAUQ = IE + N
-         ITAUP = ITAUQ + N
-         IWORK = ITAUP + N
-*
-*        Bidiagonalize R in A
-*        (Workspace: need 3*N+MM, prefer 3*N+(MM+N)*NB)
-*
-         CALL DGEBRD( MM, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
-     $                WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
-     $                INFO )
-*
-*        Multiply B by transpose of left bidiagonalizing vectors of R
-*        (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB)
-*
-         CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, WORK( ITAUQ ),
-     $                B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
-*        Generate right bidiagonalizing vectors of R in A
-*        (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
-         CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
-     $                WORK( IWORK ), LWORK-IWORK+1, INFO )
-         IWORK = IE + N
-*
-*        Perform bidiagonal QR iteration
-*          multiply B by transpose of left singular vectors
-*          compute right singular vectors in A
-*        (Workspace: need BDSPAC)
-*
-         CALL DBDSQR( 'U', N, N, 0, NRHS, S, WORK( IE ), A, LDA, VDUM,
-     $                1, B, LDB, WORK( IWORK ), INFO )
-         IF( INFO.NE.0 )
-     $      GO TO 70
-*
-*        Multiply B by reciprocals of singular values
-*
-         THR = MAX( RCOND*S( 1 ), SFMIN )
-         IF( RCOND.LT.ZERO )
-     $      THR = MAX( EPS*S( 1 ), SFMIN )
-         RANK = 0
-         DO 10 I = 1, N
-            IF( S( I ).GT.THR ) THEN
-               CALL DRSCL( NRHS, S( I ), B( I, 1 ), LDB )
-               RANK = RANK + 1
-            ELSE
-               CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
-            END IF
-   10    CONTINUE
-*
-*        Multiply B by right singular vectors
-*        (Workspace: need N, prefer N*NRHS)
-*
-         IF( LWORK.GE.LDB*NRHS .AND. NRHS.GT.1 ) THEN
-            CALL DGEMM( 'T', 'N', N, NRHS, N, ONE, A, LDA, B, LDB, ZERO,
-     $                  WORK, LDB )
-            CALL DLACPY( 'G', N, NRHS, WORK, LDB, B, LDB )
-         ELSE IF( NRHS.GT.1 ) THEN
-            CHUNK = LWORK / N
-            DO 20 I = 1, NRHS, CHUNK
-               BL = MIN( NRHS-I+1, CHUNK )
-               CALL DGEMM( 'T', 'N', N, BL, N, ONE, A, LDA, B( 1, I ),
-     $                     LDB, ZERO, WORK, N )
-               CALL DLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
-   20       CONTINUE
-         ELSE
-            CALL DGEMV( 'T', N, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
-            CALL DCOPY( N, WORK, 1, B, 1 )
-         END IF
-*
-      ELSE IF( N.GE.MNTHR .AND. LWORK.GE.4*M+M*M+
-     $         MAX( M, 2*M-4, NRHS, N-3*M ) ) THEN
-*
-*        Path 2a - underdetermined, with many more columns than rows
-*        and sufficient workspace for an efficient algorithm
-*
-         LDWORK = M
-         IF( LWORK.GE.MAX( 4*M+M*LDA+MAX( M, 2*M-4, NRHS, N-3*M ),
-     $       M*LDA+M+M*NRHS ) )LDWORK = LDA
-         ITAU = 1
-         IWORK = M + 1
-*
-*        Compute A=L*Q
-*        (Workspace: need 2*M, prefer M+M*NB)
-*
-         CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
-     $                LWORK-IWORK+1, INFO )
-         IL = IWORK
-*
-*        Copy L to WORK(IL), zeroing out above it
-*
-         CALL DLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWORK )
-         CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, WORK( IL+LDWORK ),
-     $                LDWORK )
-         IE = IL + LDWORK*M
-         ITAUQ = IE + M
-         ITAUP = ITAUQ + M
-         IWORK = ITAUP + M
-*
-*        Bidiagonalize L in WORK(IL)
-*        (Workspace: need M*M+5*M, prefer M*M+4*M+2*M*NB)
-*
-         CALL DGEBRD( M, M, WORK( IL ), LDWORK, S, WORK( IE ),
-     $                WORK( ITAUQ ), WORK( ITAUP ), WORK( IWORK ),
-     $                LWORK-IWORK+1, INFO )
-*
-*        Multiply B by transpose of left bidiagonalizing vectors of L
-*        (Workspace: need M*M+4*M+NRHS, prefer M*M+4*M+NRHS*NB)
-*
-         CALL DORMBR( 'Q', 'L', 'T', M, NRHS, M, WORK( IL ), LDWORK,
-     $                WORK( ITAUQ ), B, LDB, WORK( IWORK ),
-     $                LWORK-IWORK+1, INFO )
-*
-*        Generate right bidiagonalizing vectors of R in WORK(IL)
-*        (Workspace: need M*M+5*M-1, prefer M*M+4*M+(M-1)*NB)
-*
-         CALL DORGBR( 'P', M, M, M, WORK( IL ), LDWORK, WORK( ITAUP ),
-     $                WORK( IWORK ), LWORK-IWORK+1, INFO )
-         IWORK = IE + M
-*
-*        Perform bidiagonal QR iteration,
-*           computing right singular vectors of L in WORK(IL) and
-*           multiplying B by transpose of left singular vectors
-*        (Workspace: need M*M+M+BDSPAC)
-*
-         CALL DBDSQR( 'U', M, M, 0, NRHS, S, WORK( IE ), WORK( IL ),
-     $                LDWORK, A, LDA, B, LDB, WORK( IWORK ), INFO )
-         IF( INFO.NE.0 )
-     $      GO TO 70
-*
-*        Multiply B by reciprocals of singular values
-*
-         THR = MAX( RCOND*S( 1 ), SFMIN )
-         IF( RCOND.LT.ZERO )
-     $      THR = MAX( EPS*S( 1 ), SFMIN )
-         RANK = 0
-         DO 30 I = 1, M
-            IF( S( I ).GT.THR ) THEN
-               CALL DRSCL( NRHS, S( I ), B( I, 1 ), LDB )
-               RANK = RANK + 1
-            ELSE
-               CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
-            END IF
-   30    CONTINUE
-         IWORK = IE
-*
-*        Multiply B by right singular vectors of L in WORK(IL)
-*        (Workspace: need M*M+2*M, prefer M*M+M+M*NRHS)
-*
-         IF( LWORK.GE.LDB*NRHS+IWORK-1 .AND. NRHS.GT.1 ) THEN
-            CALL DGEMM( 'T', 'N', M, NRHS, M, ONE, WORK( IL ), LDWORK,
-     $                  B, LDB, ZERO, WORK( IWORK ), LDB )
-            CALL DLACPY( 'G', M, NRHS, WORK( IWORK ), LDB, B, LDB )
-         ELSE IF( NRHS.GT.1 ) THEN
-            CHUNK = ( LWORK-IWORK+1 ) / M
-            DO 40 I = 1, NRHS, CHUNK
-               BL = MIN( NRHS-I+1, CHUNK )
-               CALL DGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), LDWORK,
-     $                     B( 1, I ), LDB, ZERO, WORK( IWORK ), M )
-               CALL DLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
-     $                      LDB )
-   40       CONTINUE
-         ELSE
-            CALL DGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, 1 ),
-     $                  1, ZERO, WORK( IWORK ), 1 )
-            CALL DCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
-         END IF
-*
-*        Zero out below first M rows of B
-*
-         CALL DLASET( 'F', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
-         IWORK = ITAU + M
-*
-*        Multiply transpose(Q) by B
-*        (Workspace: need M+NRHS, prefer M+NRHS*NB)
-*
-         CALL DORMLQ( 'L', 'T', N, NRHS, M, A, LDA, WORK( ITAU ), B,
-     $                LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
-      ELSE
-*
-*        Path 2 - remaining underdetermined cases
-*
-         IE = 1
-         ITAUQ = IE + M
-         ITAUP = ITAUQ + M
-         IWORK = ITAUP + M
-*
-*        Bidiagonalize A
-*        (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
-         CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
-     $                WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
-     $                INFO )
-*
-*        Multiply B by transpose of left bidiagonalizing vectors
-*        (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB)
-*
-         CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAUQ ),
-     $                B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO )
-*
-*        Generate right bidiagonalizing vectors in A
-*        (Workspace: need 4*M, prefer 3*M+M*NB)
-*
-         CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
-     $                WORK( IWORK ), LWORK-IWORK+1, INFO )
-         IWORK = IE + M
-*
-*        Perform bidiagonal QR iteration,
-*           computing right singular vectors of A in A and
-*           multiplying B by transpose of left singular vectors
-*        (Workspace: need BDSPAC)
-*
-         CALL DBDSQR( 'L', M, N, 0, NRHS, S, WORK( IE ), A, LDA, VDUM,
-     $                1, B, LDB, WORK( IWORK ), INFO )
-         IF( INFO.NE.0 )
-     $      GO TO 70
-*
-*        Multiply B by reciprocals of singular values
-*
-         THR = MAX( RCOND*S( 1 ), SFMIN )
-         IF( RCOND.LT.ZERO )
-     $      THR = MAX( EPS*S( 1 ), SFMIN )
-         RANK = 0
-         DO 50 I = 1, M
-            IF( S( I ).GT.THR ) THEN
-               CALL DRSCL( NRHS, S( I ), B( I, 1 ), LDB )
-               RANK = RANK + 1
-            ELSE
-               CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB )
-            END IF
-   50    CONTINUE
-*
-*        Multiply B by right singular vectors of A
-*        (Workspace: need N, prefer N*NRHS)
-*
-         IF( LWORK.GE.LDB*NRHS .AND. NRHS.GT.1 ) THEN
-            CALL DGEMM( 'T', 'N', N, NRHS, M, ONE, A, LDA, B, LDB, ZERO,
-     $                  WORK, LDB )
-            CALL DLACPY( 'F', N, NRHS, WORK, LDB, B, LDB )
-         ELSE IF( NRHS.GT.1 ) THEN
-            CHUNK = LWORK / N
-            DO 60 I = 1, NRHS, CHUNK
-               BL = MIN( NRHS-I+1, CHUNK )
-               CALL DGEMM( 'T', 'N', N, BL, M, ONE, A, LDA, B( 1, I ),
-     $                     LDB, ZERO, WORK, N )
-               CALL DLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
-   60       CONTINUE
-         ELSE
-            CALL DGEMV( 'T', M, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
-            CALL DCOPY( N, WORK, 1, B, 1 )
-         END IF
-      END IF
-*
-*     Undo scaling
-*
-      IF( IASCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
-         CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
-     $                INFO )
-      ELSE IF( IASCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
-         CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
-     $                INFO )
-      END IF
-      IF( IBSCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
-      ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
-      END IF
-*
-   70 CONTINUE
-      WORK( 1 ) = MAXWRK
-      RETURN
-*
-*     End of DGELSS
-*
-      END
diff --git a/src/lib/lapack/dgelsx.f b/src/lib/lapack/dgelsx.f
deleted file mode 100644
index a597cd47..00000000
--- a/src/lib/lapack/dgelsx.f
+++ /dev/null
@@ -1,349 +0,0 @@
-      SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
-     $                   WORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LDB, M, N, NRHS, RANK
-      DOUBLE PRECISION   RCOND
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  This routine is deprecated and has been replaced by routine DGELSY.
-*
-*  DGELSX computes the minimum-norm solution to a real linear least
-*  squares problem:
-*      minimize || A * X - B ||
-*  using a complete orthogonal factorization of A.  A is an M-by-N
-*  matrix which may be rank-deficient.
-*
-*  Several right hand side vectors b and solution vectors x can be
-*  handled in a single call; they are stored as the columns of the
-*  M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*  matrix X.
-*
-*  The routine first computes a QR factorization with column pivoting:
-*      A * P = Q * [ R11 R12 ]
-*                  [  0  R22 ]
-*  with R11 defined as the largest leading submatrix whose estimated
-*  condition number is less than 1/RCOND.  The order of R11, RANK,
-*  is the effective rank of A.
-*
-*  Then, R22 is considered to be negligible, and R12 is annihilated
-*  by orthogonal transformations from the right, arriving at the
-*  complete orthogonal factorization:
-*     A * P = Q * [ T11 0 ] * Z
-*                 [  0  0 ]
-*  The minimum-norm solution is then
-*     X = P * Z' [ inv(T11)*Q1'*B ]
-*                [        0       ]
-*  where Q1 consists of the first RANK columns of Q.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of
-*          columns of matrices B and X. NRHS >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, A has been overwritten by details of its
-*          complete orthogonal factorization.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the M-by-NRHS right hand side matrix B.
-*          On exit, the N-by-NRHS solution matrix X.
-*          If m >= n and RANK = n, the residual sum-of-squares for
-*          the solution in the i-th column is given by the sum of
-*          squares of elements N+1:M in that column.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1,M,N).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          On entry, if JPVT(i) .ne. 0, the i-th column of A is an
-*          initial column, otherwise it is a free column.  Before
-*          the QR factorization of A, all initial columns are
-*          permuted to the leading positions; only the remaining
-*          free columns are moved as a result of column pivoting
-*          during the factorization.
-*          On exit, if JPVT(i) = k, then the i-th column of A*P
-*          was the k-th column of A.
-*
-*  RCOND   (input) DOUBLE PRECISION
-*          RCOND is used to determine the effective rank of A, which
-*          is defined as the order of the largest leading triangular
-*          submatrix R11 in the QR factorization with pivoting of A,
-*          whose estimated condition number < 1/RCOND.
-*
-*  RANK    (output) INTEGER
-*          The effective rank of A, i.e., the order of the submatrix
-*          R11.  This is the same as the order of the submatrix T11
-*          in the complete orthogonal factorization of A.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension
-*                      (max( min(M,N)+3*N, 2*min(M,N)+NRHS )),
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            IMAX, IMIN
-      PARAMETER          ( IMAX = 1, IMIN = 2 )
-      DOUBLE PRECISION   ZERO, ONE, DONE, NTDONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, DONE = ZERO,
-     $                   NTDONE = ONE )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, IASCL, IBSCL, ISMAX, ISMIN, J, K, MN
-      DOUBLE PRECISION   ANRM, BIGNUM, BNRM, C1, C2, S1, S2, SMAX,
-     $                   SMAXPR, SMIN, SMINPR, SMLNUM, T1, T2
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           DLAMCH, DLANGE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEQPF, DLAIC1, DLASCL, DLASET, DLATZM, DORM2R,
-     $                   DTRSM, DTZRQF, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-      MN = MIN( M, N )
-      ISMIN = MN + 1
-      ISMAX = 2*MN + 1
-*
-*     Test the input arguments.
-*
-      INFO = 0
-      IF( M.LT.0 ) 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, M ) ) THEN
-         INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
-         INFO = -7
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGELSX', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( MIN( M, N, NRHS ).EQ.0 ) THEN
-         RANK = 0
-         RETURN
-      END IF
-*
-*     Get machine parameters
-*
-      SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Scale A, B if max elements outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', M, N, A, LDA, WORK )
-      IASCL = 0
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-*        Scale matrix norm up to SMLNUM
-*
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
-         IASCL = 1
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-*        Scale matrix norm down to BIGNUM
-*
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
-         IASCL = 2
-      ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-*        Matrix all zero. Return zero solution.
-*
-         CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
-         RANK = 0
-         GO TO 100
-      END IF
-*
-      BNRM = DLANGE( 'M', M, NRHS, B, LDB, WORK )
-      IBSCL = 0
-      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-*        Scale matrix norm up to SMLNUM
-*
-         CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
-         IBSCL = 1
-      ELSE IF( BNRM.GT.BIGNUM ) THEN
-*
-*        Scale matrix norm down to BIGNUM
-*
-         CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
-         IBSCL = 2
-      END IF
-*
-*     Compute QR factorization with column pivoting of A:
-*        A * P = Q * R
-*
-      CALL DGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), INFO )
-*
-*     workspace 3*N. Details of Householder rotations stored
-*     in WORK(1:MN).
-*
-*     Determine RANK using incremental condition estimation
-*
-      WORK( ISMIN ) = ONE
-      WORK( ISMAX ) = ONE
-      SMAX = ABS( A( 1, 1 ) )
-      SMIN = SMAX
-      IF( ABS( A( 1, 1 ) ).EQ.ZERO ) THEN
-         RANK = 0
-         CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
-         GO TO 100
-      ELSE
-         RANK = 1
-      END IF
-*
-   10 CONTINUE
-      IF( RANK.LT.MN ) THEN
-         I = RANK + 1
-         CALL DLAIC1( IMIN, RANK, WORK( ISMIN ), SMIN, A( 1, I ),
-     $                A( I, I ), SMINPR, S1, C1 )
-         CALL DLAIC1( IMAX, RANK, WORK( ISMAX ), SMAX, A( 1, I ),
-     $                A( I, I ), SMAXPR, S2, C2 )
-*
-         IF( SMAXPR*RCOND.LE.SMINPR ) THEN
-            DO 20 I = 1, RANK
-               WORK( ISMIN+I-1 ) = S1*WORK( ISMIN+I-1 )
-               WORK( ISMAX+I-1 ) = S2*WORK( ISMAX+I-1 )
-   20       CONTINUE
-            WORK( ISMIN+RANK ) = C1
-            WORK( ISMAX+RANK ) = C2
-            SMIN = SMINPR
-            SMAX = SMAXPR
-            RANK = RANK + 1
-            GO TO 10
-         END IF
-      END IF
-*
-*     Logically partition R = [ R11 R12 ]
-*                             [  0  R22 ]
-*     where R11 = R(1:RANK,1:RANK)
-*
-*     [R11,R12] = [ T11, 0 ] * Y
-*
-      IF( RANK.LT.N )
-     $   CALL DTZRQF( RANK, N, A, LDA, WORK( MN+1 ), INFO )
-*
-*     Details of Householder rotations stored in WORK(MN+1:2*MN)
-*
-*     B(1:M,1:NRHS) := Q' * B(1:M,1:NRHS)
-*
-      CALL DORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ),
-     $             B, LDB, WORK( 2*MN+1 ), INFO )
-*
-*     workspace NRHS
-*
-*     B(1:RANK,1:NRHS) := inv(T11) * B(1:RANK,1:NRHS)
-*
-      CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', RANK,
-     $            NRHS, ONE, A, LDA, B, LDB )
-*
-      DO 40 I = RANK + 1, N
-         DO 30 J = 1, NRHS
-            B( I, J ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-*
-*     B(1:N,1:NRHS) := Y' * B(1:N,1:NRHS)
-*
-      IF( RANK.LT.N ) THEN
-         DO 50 I = 1, RANK
-            CALL DLATZM( 'Left', N-RANK+1, NRHS, A( I, RANK+1 ), LDA,
-     $                   WORK( MN+I ), B( I, 1 ), B( RANK+1, 1 ), LDB,
-     $                   WORK( 2*MN+1 ) )
-   50    CONTINUE
-      END IF
-*
-*     workspace NRHS
-*
-*     B(1:N,1:NRHS) := P * B(1:N,1:NRHS)
-*
-      DO 90 J = 1, NRHS
-         DO 60 I = 1, N
-            WORK( 2*MN+I ) = NTDONE
-   60    CONTINUE
-         DO 80 I = 1, N
-            IF( WORK( 2*MN+I ).EQ.NTDONE ) THEN
-               IF( JPVT( I ).NE.I ) THEN
-                  K = I
-                  T1 = B( K, J )
-                  T2 = B( JPVT( K ), J )
-   70             CONTINUE
-                  B( JPVT( K ), J ) = T1
-                  WORK( 2*MN+K ) = DONE
-                  T1 = T2
-                  K = JPVT( K )
-                  T2 = B( JPVT( K ), J )
-                  IF( JPVT( K ).NE.I )
-     $               GO TO 70
-                  B( I, J ) = T1
-                  WORK( 2*MN+K ) = DONE
-               END IF
-            END IF
-   80    CONTINUE
-   90 CONTINUE
-*
-*     Undo scaling
-*
-      IF( IASCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
-         CALL DLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA,
-     $                INFO )
-      ELSE IF( IASCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
-         CALL DLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA,
-     $                INFO )
-      END IF
-      IF( IBSCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
-      ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
-      END IF
-*
-  100 CONTINUE
-*
-      RETURN
-*
-*     End of DGELSX
-*
-      END
diff --git a/src/lib/lapack/dgelsy.f b/src/lib/lapack/dgelsy.f
deleted file mode 100644
index 4334650f..00000000
--- a/src/lib/lapack/dgelsy.f
+++ /dev/null
@@ -1,391 +0,0 @@
-      SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
-      DOUBLE PRECISION   RCOND
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGELSY computes the minimum-norm solution to a real linear least
-*  squares problem:
-*      minimize || A * X - B ||
-*  using a complete orthogonal factorization of A.  A is an M-by-N
-*  matrix which may be rank-deficient.
-*
-*  Several right hand side vectors b and solution vectors x can be
-*  handled in a single call; they are stored as the columns of the
-*  M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*  matrix X.
-*
-*  The routine first computes a QR factorization with column pivoting:
-*      A * P = Q * [ R11 R12 ]
-*                  [  0  R22 ]
-*  with R11 defined as the largest leading submatrix whose estimated
-*  condition number is less than 1/RCOND.  The order of R11, RANK,
-*  is the effective rank of A.
-*
-*  Then, R22 is considered to be negligible, and R12 is annihilated
-*  by orthogonal transformations from the right, arriving at the
-*  complete orthogonal factorization:
-*     A * P = Q * [ T11 0 ] * Z
-*                 [  0  0 ]
-*  The minimum-norm solution is then
-*     X = P * Z' [ inv(T11)*Q1'*B ]
-*                [        0       ]
-*  where Q1 consists of the first RANK columns of Q.
-*
-*  This routine is basically identical to the original xGELSX except
-*  three differences:
-*    o The call to the subroutine xGEQPF has been substituted by the
-*      the call to the subroutine xGEQP3. This subroutine is a Blas-3
-*      version of the QR factorization with column pivoting.
-*    o Matrix B (the right hand side) is updated with Blas-3.
-*    o The permutation of matrix B (the right hand side) is faster and
-*      more simple.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of
-*          columns of matrices B and X. NRHS >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, A has been overwritten by details of its
-*          complete orthogonal factorization.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the M-by-NRHS right hand side matrix B.
-*          On exit, the N-by-NRHS solution matrix X.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1,M,N).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*          to the front of AP, otherwise column i is a free column.
-*          On exit, if JPVT(i) = k, then the i-th column of AP
-*          was the k-th column of A.
-*
-*  RCOND   (input) DOUBLE PRECISION
-*          RCOND is used to determine the effective rank of A, which
-*          is defined as the order of the largest leading triangular
-*          submatrix R11 in the QR factorization with pivoting of A,
-*          whose estimated condition number < 1/RCOND.
-*
-*  RANK    (output) INTEGER
-*          The effective rank of A, i.e., the order of the submatrix
-*          R11.  This is the same as the order of the submatrix T11
-*          in the complete orthogonal factorization of A.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          The unblocked strategy requires that:
-*             LWORK >= MAX( MN+3*N+1, 2*MN+NRHS ),
-*          where MN = min( M, N ).
-*          The block algorithm requires that:
-*             LWORK >= MAX( MN+2*N+NB*(N+1), 2*MN+NB*NRHS ),
-*          where NB is an upper bound on the blocksize returned
-*          by ILAENV for the routines DGEQP3, DTZRZF, STZRQF, DORMQR,
-*          and DORMRZ.
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: If INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*    E. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            IMAX, IMIN
-      PARAMETER          ( IMAX = 1, IMIN = 2 )
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IASCL, IBSCL, ISMAX, ISMIN, J, LWKMIN,
-     $                   LWKOPT, MN, NB, NB1, NB2, NB3, NB4
-      DOUBLE PRECISION   ANRM, BIGNUM, BNRM, C1, C2, S1, S2, SMAX,
-     $                   SMAXPR, SMIN, SMINPR, SMLNUM, WSIZE
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           ILAENV, DLAMCH, DLANGE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEQP3, DLABAD, DLAIC1, DLASCL, DLASET,
-     $                   DORMQR, DORMRZ, DTRSM, DTZRZF, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-      MN = MIN( M, N )
-      ISMIN = MN + 1
-      ISMAX = 2*MN + 1
-*
-*     Test the input arguments.
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) 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, M ) ) THEN
-         INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
-         INFO = -7
-      END IF
-*
-*     Figure out optimal block size
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( MN.EQ.0 .OR. NRHS.EQ.0 ) THEN
-            LWKMIN = 1
-            LWKOPT = 1
-         ELSE
-            NB1 = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-            NB2 = ILAENV( 1, 'DGERQF', ' ', M, N, -1, -1 )
-            NB3 = ILAENV( 1, 'DORMQR', ' ', M, N, NRHS, -1 )
-            NB4 = ILAENV( 1, 'DORMRQ', ' ', M, N, NRHS, -1 )
-            NB = MAX( NB1, NB2, NB3, NB4 )
-            LWKMIN = MN + MAX( 2*MN, N + 1, MN + NRHS )
-            LWKOPT = MAX( LWKMIN,
-     $                    MN + 2*N + NB*( N + 1 ), 2*MN + NB*NRHS )
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
-            INFO = -12
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGELSY', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( MN.EQ.0 .OR. NRHS.EQ.0 ) THEN
-         RANK = 0
-         RETURN
-      END IF
-*
-*     Get machine parameters
-*
-      SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Scale A, B if max entries outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', M, N, A, LDA, WORK )
-      IASCL = 0
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-*        Scale matrix norm up to SMLNUM
-*
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
-         IASCL = 1
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-*        Scale matrix norm down to BIGNUM
-*
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
-         IASCL = 2
-      ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-*        Matrix all zero. Return zero solution.
-*
-         CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
-         RANK = 0
-         GO TO 70
-      END IF
-*
-      BNRM = DLANGE( 'M', M, NRHS, B, LDB, WORK )
-      IBSCL = 0
-      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-*        Scale matrix norm up to SMLNUM
-*
-         CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
-         IBSCL = 1
-      ELSE IF( BNRM.GT.BIGNUM ) THEN
-*
-*        Scale matrix norm down to BIGNUM
-*
-         CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
-         IBSCL = 2
-      END IF
-*
-*     Compute QR factorization with column pivoting of A:
-*        A * P = Q * R
-*
-      CALL DGEQP3( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ),
-     $             LWORK-MN, INFO )
-      WSIZE = MN + WORK( MN+1 )
-*
-*     workspace: MN+2*N+NB*(N+1).
-*     Details of Householder rotations stored in WORK(1:MN).
-*
-*     Determine RANK using incremental condition estimation
-*
-      WORK( ISMIN ) = ONE
-      WORK( ISMAX ) = ONE
-      SMAX = ABS( A( 1, 1 ) )
-      SMIN = SMAX
-      IF( ABS( A( 1, 1 ) ).EQ.ZERO ) THEN
-         RANK = 0
-         CALL DLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
-         GO TO 70
-      ELSE
-         RANK = 1
-      END IF
-*
-   10 CONTINUE
-      IF( RANK.LT.MN ) THEN
-         I = RANK + 1
-         CALL DLAIC1( IMIN, RANK, WORK( ISMIN ), SMIN, A( 1, I ),
-     $                A( I, I ), SMINPR, S1, C1 )
-         CALL DLAIC1( IMAX, RANK, WORK( ISMAX ), SMAX, A( 1, I ),
-     $                A( I, I ), SMAXPR, S2, C2 )
-*
-         IF( SMAXPR*RCOND.LE.SMINPR ) THEN
-            DO 20 I = 1, RANK
-               WORK( ISMIN+I-1 ) = S1*WORK( ISMIN+I-1 )
-               WORK( ISMAX+I-1 ) = S2*WORK( ISMAX+I-1 )
-   20       CONTINUE
-            WORK( ISMIN+RANK ) = C1
-            WORK( ISMAX+RANK ) = C2
-            SMIN = SMINPR
-            SMAX = SMAXPR
-            RANK = RANK + 1
-            GO TO 10
-         END IF
-      END IF
-*
-*     workspace: 3*MN.
-*
-*     Logically partition R = [ R11 R12 ]
-*                             [  0  R22 ]
-*     where R11 = R(1:RANK,1:RANK)
-*
-*     [R11,R12] = [ T11, 0 ] * Y
-*
-      IF( RANK.LT.N )
-     $   CALL DTZRZF( RANK, N, A, LDA, WORK( MN+1 ), WORK( 2*MN+1 ),
-     $                LWORK-2*MN, INFO )
-*
-*     workspace: 2*MN.
-*     Details of Householder rotations stored in WORK(MN+1:2*MN)
-*
-*     B(1:M,1:NRHS) := Q' * B(1:M,1:NRHS)
-*
-      CALL DORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ),
-     $             B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO )
-      WSIZE = MAX( WSIZE, 2*MN+WORK( 2*MN+1 ) )
-*
-*     workspace: 2*MN+NB*NRHS.
-*
-*     B(1:RANK,1:NRHS) := inv(T11) * B(1:RANK,1:NRHS)
-*
-      CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', RANK,
-     $            NRHS, ONE, A, LDA, B, LDB )
-*
-      DO 40 J = 1, NRHS
-         DO 30 I = RANK + 1, N
-            B( I, J ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-*
-*     B(1:N,1:NRHS) := Y' * B(1:N,1:NRHS)
-*
-      IF( RANK.LT.N ) THEN
-         CALL DORMRZ( 'Left', 'Transpose', N, NRHS, RANK, N-RANK, A,
-     $                LDA, WORK( MN+1 ), B, LDB, WORK( 2*MN+1 ),
-     $                LWORK-2*MN, INFO )
-      END IF
-*
-*     workspace: 2*MN+NRHS.
-*
-*     B(1:N,1:NRHS) := P * B(1:N,1:NRHS)
-*
-      DO 60 J = 1, NRHS
-         DO 50 I = 1, N
-            WORK( JPVT( I ) ) = B( I, J )
-   50    CONTINUE
-         CALL DCOPY( N, WORK( 1 ), 1, B( 1, J ), 1 )
-   60 CONTINUE
-*
-*     workspace: N.
-*
-*     Undo scaling
-*
-      IF( IASCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
-         CALL DLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA,
-     $                INFO )
-      ELSE IF( IASCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
-         CALL DLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA,
-     $                INFO )
-      END IF
-      IF( IBSCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
-      ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
-      END IF
-*
-   70 CONTINUE
-      WORK( 1 ) = LWKOPT
-*
-      RETURN
-*
-*     End of DGELSY
-*
-      END
diff --git a/src/lib/lapack/dgeql2.f b/src/lib/lapack/dgeql2.f
deleted file mode 100644
index aa45113c..00000000
--- a/src/lib/lapack/dgeql2.f
+++ /dev/null
@@ -1,122 +0,0 @@
-      SUBROUTINE DGEQL2( M, N, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEQL2 computes a QL factorization of a real m by n matrix A:
-*  A = Q * L.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the m by n matrix A.
-*          On exit, if m >= n, the lower triangle of the subarray
-*          A(m-n+1:m,1:n) contains the n by n lower triangular matrix L;
-*          if m <= n, the elements on and below the (n-m)-th
-*          superdiagonal contain the m by n lower trapezoidal matrix L;
-*          the remaining elements, with the array TAU, represent the
-*          orthogonal matrix Q as a product of elementary reflectors
-*          (see Further Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
-*  A(1:m-k+i-1,n-k+i), and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, K
-      DOUBLE PRECISION   AII
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DLARFG, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEQL2', -INFO )
-         RETURN
-      END IF
-*
-      K = MIN( M, N )
-*
-      DO 10 I = K, 1, -1
-*
-*        Generate elementary reflector H(i) to annihilate
-*        A(1:m-k+i-1,n-k+i)
-*
-         CALL DLARFG( M-K+I, A( M-K+I, N-K+I ), A( 1, N-K+I ), 1,
-     $                TAU( I ) )
-*
-*        Apply H(i) to A(1:m-k+i,1:n-k+i-1) from the left
-*
-         AII = A( M-K+I, N-K+I )
-         A( M-K+I, N-K+I ) = ONE
-         CALL DLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, TAU( I ),
-     $               A, LDA, WORK )
-         A( M-K+I, N-K+I ) = AII
-   10 CONTINUE
-      RETURN
-*
-*     End of DGEQL2
-*
-      END
diff --git a/src/lib/lapack/dgeqlf.f b/src/lib/lapack/dgeqlf.f
deleted file mode 100644
index ec293574..00000000
--- a/src/lib/lapack/dgeqlf.f
+++ /dev/null
@@ -1,213 +0,0 @@
-      SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEQLF computes a QL factorization of a real M-by-N matrix A:
-*  A = Q * L.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit,
-*          if m >= n, the lower triangle of the subarray
-*          A(m-n+1:m,1:n) contains the N-by-N lower triangular matrix L;
-*          if m <= n, the elements on and below the (n-m)-th
-*          superdiagonal contain the M-by-N lower trapezoidal matrix L;
-*          the remaining elements, with the array TAU, represent the
-*          orthogonal matrix Q as a product of elementary reflectors
-*          (see Further Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,N).
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(k) . . . H(2) H(1), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
-*  A(1:m-k+i-1,n-k+i), and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, K, KI, KK, LDWORK, LWKOPT,
-     $                   MU, NB, NBMIN, NU, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEQL2, DLARFB, DLARFT, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         K = MIN( M, N )
-         IF( K.EQ.0 ) THEN
-            LWKOPT = 1
-         ELSE
-            NB = ILAENV( 1, 'DGEQLF', ' ', M, N, -1, -1 )
-            LWKOPT = N*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-            INFO = -7
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEQLF', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( K.EQ.0 ) THEN
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 1
-      IWS = N
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'DGEQLF', ' ', M, N, -1, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = N
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'DGEQLF', ' ', M, N, -1,
-     $                 -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code initially.
-*        The last kk columns are handled by the block method.
-*
-         KI = ( ( K-NX-1 ) / NB )*NB
-         KK = MIN( K, KI+NB )
-*
-         DO 10 I = K - KK + KI + 1, K - KK + 1, -NB
-            IB = MIN( K-I+1, NB )
-*
-*           Compute the QL factorization of the current block
-*           A(1:m-k+i+ib-1,n-k+i:n-k+i+ib-1)
-*
-            CALL DGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, TAU( I ),
-     $                   WORK, IINFO )
-            IF( N-K+I.GT.1 ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i+ib-1) . . . H(i+1) H(i)
-*
-               CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
-     $                      A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H' to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
-*
-               CALL DLARFB( 'Left', 'Transpose', 'Backward',
-     $                      'Columnwise', M-K+I+IB-1, N-K+I-1, IB,
-     $                      A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA,
-     $                      WORK( IB+1 ), LDWORK )
-            END IF
-   10    CONTINUE
-         MU = M - K + I + NB - 1
-         NU = N - K + I + NB - 1
-      ELSE
-         MU = M
-         NU = N
-      END IF
-*
-*     Use unblocked code to factor the last or only block
-*
-      IF( MU.GT.0 .AND. NU.GT.0 )
-     $   CALL DGEQL2( MU, NU, A, LDA, TAU, WORK, IINFO )
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of DGEQLF
-*
-      END
diff --git a/src/lib/lapack/dgeqp3.f b/src/lib/lapack/dgeqp3.f
deleted file mode 100644
index d6bc537d..00000000
--- a/src/lib/lapack/dgeqp3.f
+++ /dev/null
@@ -1,287 +0,0 @@
-      SUBROUTINE DGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEQP3 computes a QR factorization with column pivoting of a
-*  matrix A:  A*P = Q*R  using Level 3 BLAS.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the upper triangle of the array contains the
-*          min(M,N)-by-N upper trapezoidal matrix R; the elements below
-*          the diagonal, together with the array TAU, represent the
-*          orthogonal matrix Q as a product of min(M,N) elementary
-*          reflectors.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          On entry, if JPVT(J).ne.0, the J-th column of A is permuted
-*          to the front of A*P (a leading column); if JPVT(J)=0,
-*          the J-th column of A is a free column.
-*          On exit, if JPVT(J)=K, then the J-th column of A*P was the
-*          the K-th column of A.
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO=0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= 3*N+1.
-*          For optimal performance LWORK >= 2*N+( 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.
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit.
-*          < 0: if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real/complex scalar, and v is a real/complex vector
-*  with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in
-*  A(i+1:m,i), and tau in TAU(i).
-*
-*  Based on contributions by
-*    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*    X. Sun, Computer Science Dept., Duke University, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            INB, INBMIN, IXOVER
-      PARAMETER          ( INB = 1, INBMIN = 2, IXOVER = 3 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            FJB, IWS, J, JB, LWKOPT, MINMN, MINWS, NA, NB,
-     $                   NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEQRF, DLAQP2, DLAQPS, DORMQR, DSWAP, XERBLA
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DNRM2
-      EXTERNAL           ILAENV, DNRM2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          INT, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test input arguments
-*     ====================
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         MINMN = MIN( M, N )
-         IF( MINMN.EQ.0 ) THEN
-            IWS = 1
-            LWKOPT = 1
-         ELSE
-            IWS = 3*N + 1
-            NB = ILAENV( INB, 'DGEQRF', ' ', M, N, -1, -1 )
-            LWKOPT = 2*N + ( N + 1 )*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
-            INFO = -8
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEQP3', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( MINMN.EQ.0 ) THEN
-         RETURN
-      END IF
-*
-*     Move initial columns up front.
-*
-      NFXD = 1
-      DO 10 J = 1, N
-         IF( JPVT( J ).NE.0 ) THEN
-            IF( J.NE.NFXD ) THEN
-               CALL DSWAP( M, A( 1, J ), 1, A( 1, NFXD ), 1 )
-               JPVT( J ) = JPVT( NFXD )
-               JPVT( NFXD ) = J
-            ELSE
-               JPVT( J ) = J
-            END IF
-            NFXD = NFXD + 1
-         ELSE
-            JPVT( J ) = J
-         END IF
-   10 CONTINUE
-      NFXD = NFXD - 1
-*
-*     Factorize fixed columns
-*     =======================
-*
-*     Compute the QR factorization of fixed columns and update
-*     remaining columns.
-*
-      IF( NFXD.GT.0 ) THEN
-         NA = MIN( M, NFXD )
-*CC      CALL DGEQR2( M, NA, A, LDA, TAU, WORK, INFO )
-         CALL DGEQRF( M, NA, A, LDA, TAU, WORK, LWORK, INFO )
-         IWS = MAX( IWS, INT( WORK( 1 ) ) )
-         IF( NA.LT.N ) THEN
-*CC         CALL DORM2R( 'Left', 'Transpose', M, N-NA, NA, A, LDA,
-*CC  $                   TAU, A( 1, NA+1 ), LDA, WORK, INFO )
-            CALL DORMQR( 'Left', 'Transpose', M, N-NA, NA, A, LDA, TAU,
-     $                   A( 1, NA+1 ), LDA, WORK, LWORK, INFO )
-            IWS = MAX( IWS, INT( WORK( 1 ) ) )
-         END IF
-      END IF
-*
-*     Factorize free columns
-*     ======================
-*
-      IF( NFXD.LT.MINMN ) THEN
-*
-         SM = M - NFXD
-         SN = N - NFXD
-         SMINMN = MINMN - NFXD
-*
-*        Determine the block size.
-*
-         NB = ILAENV( INB, 'DGEQRF', ' ', SM, SN, -1, -1 )
-         NBMIN = 2
-         NX = 0
-*
-         IF( ( NB.GT.1 ) .AND. ( NB.LT.SMINMN ) ) THEN
-*
-*           Determine when to cross over from blocked to unblocked code.
-*
-            NX = MAX( 0, ILAENV( IXOVER, 'DGEQRF', ' ', SM, SN, -1,
-     $           -1 ) )
-*
-*
-            IF( NX.LT.SMINMN ) THEN
-*
-*              Determine if workspace is large enough for blocked code.
-*
-               MINWS = 2*SN + ( SN+1 )*NB
-               IWS = MAX( IWS, MINWS )
-               IF( LWORK.LT.MINWS ) THEN
-*
-*                 Not enough workspace to use optimal NB: Reduce NB and
-*                 determine the minimum value of NB.
-*
-                  NB = ( LWORK-2*SN ) / ( SN+1 )
-                  NBMIN = MAX( 2, ILAENV( INBMIN, 'DGEQRF', ' ', SM, SN,
-     $                    -1, -1 ) )
-*
-*
-               END IF
-            END IF
-         END IF
-*
-*        Initialize partial column norms. The first N elements of work
-*        store the exact column norms.
-*
-         DO 20 J = NFXD + 1, N
-            WORK( J ) = DNRM2( SM, A( NFXD+1, J ), 1 )
-            WORK( N+J ) = WORK( J )
-   20    CONTINUE
-*
-         IF( ( NB.GE.NBMIN ) .AND. ( NB.LT.SMINMN ) .AND.
-     $       ( NX.LT.SMINMN ) ) THEN
-*
-*           Use blocked code initially.
-*
-            J = NFXD + 1
-*
-*           Compute factorization: while loop.
-*
-*
-            TOPBMN = MINMN - NX
-   30       CONTINUE
-            IF( J.LE.TOPBMN ) THEN
-               JB = MIN( NB, TOPBMN-J+1 )
-*
-*              Factorize JB columns among columns J:N.
-*
-               CALL DLAQPS( M, N-J+1, J-1, JB, FJB, A( 1, J ), LDA,
-     $                      JPVT( J ), TAU( J ), WORK( J ), WORK( N+J ),
-     $                      WORK( 2*N+1 ), WORK( 2*N+JB+1 ), N-J+1 )
-*
-               J = J + FJB
-               GO TO 30
-            END IF
-         ELSE
-            J = NFXD + 1
-         END IF
-*
-*        Use unblocked code to factor the last or only block.
-*
-*
-         IF( J.LE.MINMN )
-     $      CALL DLAQP2( M, N-J+1, J-1, A( 1, J ), LDA, JPVT( J ),
-     $                   TAU( J ), WORK( J ), WORK( N+J ),
-     $                   WORK( 2*N+1 ) )
-*
-      END IF
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of DGEQP3
-*
-      END
diff --git a/src/lib/lapack/dgeqpf.f b/src/lib/lapack/dgeqpf.f
deleted file mode 100644
index 1b7acd6d..00000000
--- a/src/lib/lapack/dgeqpf.f
+++ /dev/null
@@ -1,231 +0,0 @@
-      SUBROUTINE DGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO )
-*
-*  -- LAPACK deprecated driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  This routine is deprecated and has been replaced by routine DGEQP3.
-*
-*  DGEQPF computes a QR factorization with column pivoting of a
-*  real M-by-N matrix A: A*P = Q*R.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A. N >= 0
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the upper triangle of the array contains the
-*          min(M,N)-by-N upper triangular matrix R; the elements
-*          below the diagonal, together with the array TAU,
-*          represent the orthogonal matrix Q as a product of
-*          min(m,n) elementary reflectors.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*          to the front of A*P (a leading column); if JPVT(i) = 0,
-*          the i-th column of A is a free column.
-*          On exit, if JPVT(i) = k, then the i-th column of A*P
-*          was the k-th column of A.
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (3*N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(n)
-*
-*  Each H(i) has the form
-*
-*     H = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).
-*
-*  The matrix P is represented in jpvt as follows: If
-*     jpvt(j) = i
-*  then the jth column of P is the ith canonical unit vector.
-*
-*  Partial column norm updating strategy modified by
-*    Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*    University of Zagreb, Croatia.
-*    June 2006.
-*  For more details see LAPACK Working Note 176.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ITEMP, J, MA, MN, PVT
-      DOUBLE PRECISION   AII, TEMP, TEMP2, TOL3Z
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEQR2, DLARF, DLARFG, DORM2R, DSWAP, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
-*     ..
-*     .. External Functions ..
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH, DNRM2
-      EXTERNAL           IDAMAX, DLAMCH, DNRM2
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEQPF', -INFO )
-         RETURN
-      END IF
-*
-      MN = MIN( M, N )
-      TOL3Z = SQRT(DLAMCH('Epsilon'))
-*
-*     Move initial columns up front
-*
-      ITEMP = 1
-      DO 10 I = 1, N
-         IF( JPVT( I ).NE.0 ) THEN
-            IF( I.NE.ITEMP ) THEN
-               CALL DSWAP( M, A( 1, I ), 1, A( 1, ITEMP ), 1 )
-               JPVT( I ) = JPVT( ITEMP )
-               JPVT( ITEMP ) = I
-            ELSE
-               JPVT( I ) = I
-            END IF
-            ITEMP = ITEMP + 1
-         ELSE
-            JPVT( I ) = I
-         END IF
-   10 CONTINUE
-      ITEMP = ITEMP - 1
-*
-*     Compute the QR factorization and update remaining columns
-*
-      IF( ITEMP.GT.0 ) THEN
-         MA = MIN( ITEMP, M )
-         CALL DGEQR2( M, MA, A, LDA, TAU, WORK, INFO )
-         IF( MA.LT.N ) THEN
-            CALL DORM2R( 'Left', 'Transpose', M, N-MA, MA, A, LDA, TAU,
-     $                   A( 1, MA+1 ), LDA, WORK, INFO )
-         END IF
-      END IF
-*
-      IF( ITEMP.LT.MN ) THEN
-*
-*        Initialize partial column norms. The first n elements of
-*        work store the exact column norms.
-*
-         DO 20 I = ITEMP + 1, N
-            WORK( I ) = DNRM2( M-ITEMP, A( ITEMP+1, I ), 1 )
-            WORK( N+I ) = WORK( I )
-   20    CONTINUE
-*
-*        Compute factorization
-*
-         DO 40 I = ITEMP + 1, MN
-*
-*           Determine ith pivot column and swap if necessary
-*
-            PVT = ( I-1 ) + IDAMAX( N-I+1, WORK( I ), 1 )
-*
-            IF( PVT.NE.I ) THEN
-               CALL DSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
-               ITEMP = JPVT( PVT )
-               JPVT( PVT ) = JPVT( I )
-               JPVT( I ) = ITEMP
-               WORK( PVT ) = WORK( I )
-               WORK( N+PVT ) = WORK( N+I )
-            END IF
-*
-*           Generate elementary reflector H(i)
-*
-            IF( I.LT.M ) THEN
-               CALL DLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, TAU( I ) )
-            ELSE
-               CALL DLARFG( 1, A( M, M ), A( M, M ), 1, TAU( M ) )
-            END IF
-*
-            IF( I.LT.N ) THEN
-*
-*              Apply H(i) to A(i:m,i+1:n) from the left
-*
-               AII = A( I, I )
-               A( I, I ) = ONE
-               CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ),
-     $                     A( I, I+1 ), LDA, WORK( 2*N+1 ) )
-               A( I, I ) = AII
-            END IF
-*
-*           Update partial column norms
-*
-            DO 30 J = I + 1, N
-               IF( WORK( J ).NE.ZERO ) THEN
-*
-*                 NOTE: The following 4 lines follow from the analysis in
-*                 Lapack Working Note 176.
-*                 
-                  TEMP = ABS( A( I, J ) ) / WORK( J )
-                  TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
-                  TEMP2 = TEMP*( WORK( J ) / WORK( N+J ) )**2
-                  IF( TEMP2 .LE. TOL3Z ) THEN 
-                     IF( M-I.GT.0 ) THEN
-                        WORK( J ) = DNRM2( M-I, A( I+1, J ), 1 )
-                        WORK( N+J ) = WORK( J )
-                     ELSE
-                        WORK( J ) = ZERO
-                        WORK( N+J ) = ZERO
-                     END IF
-                  ELSE
-                     WORK( J ) = WORK( J )*SQRT( TEMP )
-                  END IF
-               END IF
-   30       CONTINUE
-*
-   40    CONTINUE
-      END IF
-      RETURN
-*
-*     End of DGEQPF
-*
-      END
diff --git a/src/lib/lapack/dgeqr2.f b/src/lib/lapack/dgeqr2.f
deleted file mode 100644
index 9872a162..00000000
--- a/src/lib/lapack/dgeqr2.f
+++ /dev/null
@@ -1,121 +0,0 @@
-      SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEQR2 computes a QR factorization of a real m by n matrix A:
-*  A = Q * R.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the m by n matrix A.
-*          On exit, the elements on and above the diagonal of the array
-*          contain the min(m,n) by n upper trapezoidal matrix R (R is
-*          upper triangular if m >= n); the elements below the diagonal,
-*          with the array TAU, represent the orthogonal matrix Q as a
-*          product of elementary reflectors (see Further Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*  and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, K
-      DOUBLE PRECISION   AII
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DLARFG, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEQR2', -INFO )
-         RETURN
-      END IF
-*
-      K = MIN( M, N )
-*
-      DO 10 I = 1, K
-*
-*        Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
-         CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
-     $                TAU( I ) )
-         IF( I.LT.N ) THEN
-*
-*           Apply H(i) to A(i:m,i+1:n) from the left
-*
-            AII = A( I, I )
-            A( I, I ) = ONE
-            CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
-     $                  A( I, I+1 ), LDA, WORK )
-            A( I, I ) = AII
-         END IF
-   10 CONTINUE
-      RETURN
-*
-*     End of DGEQR2
-*
-      END
diff --git a/src/lib/lapack/dgeqrf.f b/src/lib/lapack/dgeqrf.f
deleted file mode 100644
index 1e940597..00000000
--- a/src/lib/lapack/dgeqrf.f
+++ /dev/null
@@ -1,196 +0,0 @@
-      SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGEQRF computes a QR factorization of a real M-by-N matrix A:
-*  A = Q * R.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the elements on and above the diagonal of the array
-*          contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-*          upper triangular if m >= n); the elements below the diagonal,
-*          with the array TAU, represent the orthogonal matrix Q as a
-*          product of min(m,n) elementary reflectors (see Further
-*          Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,N).
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*  and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
-     $                   NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEQR2, DLARFB, DLARFT, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-      LWKOPT = N*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -7
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGEQRF', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      K = MIN( M, N )
-      IF( K.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = N
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'DGEQRF', ' ', M, N, -1, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = N
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'DGEQRF', ' ', M, N, -1,
-     $                 -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code initially
-*
-         DO 10 I = 1, K - NX, NB
-            IB = MIN( K-I+1, NB )
-*
-*           Compute the QR factorization of the current block
-*           A(i:m,i:i+ib-1)
-*
-            CALL DGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
-     $                   IINFO )
-            IF( I+IB.LE.N ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i) H(i+1) . . . H(i+ib-1)
-*
-               CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
-     $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H' to A(i:m,i+ib:n) from the left
-*
-               CALL DLARFB( 'Left', 'Transpose', 'Forward',
-     $                      'Columnwise', M-I+1, N-I-IB+1, IB,
-     $                      A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
-     $                      LDA, WORK( IB+1 ), LDWORK )
-            END IF
-   10    CONTINUE
-      ELSE
-         I = 1
-      END IF
-*
-*     Use unblocked code to factor the last or only block.
-*
-      IF( I.LE.K )
-     $   CALL DGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
-     $                IINFO )
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of DGEQRF
-*
-      END
diff --git a/src/lib/lapack/dgerfs.f b/src/lib/lapack/dgerfs.f
deleted file mode 100644
index bada6e56..00000000
--- a/src/lib/lapack/dgerfs.f
+++ /dev/null
@@ -1,336 +0,0 @@
-      SUBROUTINE DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
-     $                   X, LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     Modified to call DLACN2 in place of DLACON, 5 Feb 03, SJH.
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TRANS
-      INTEGER            INFO, LDA, LDAF, LDB, LDX, N, NRHS
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * ), IWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-     $                   BERR( * ), FERR( * ), WORK( * ), X( LDX, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGERFS improves the computed solution to a system of linear
-*  equations and provides error bounds and backward error estimates for
-*  the solution.
-*
-*  Arguments
-*  =========
-*
-*  TRANS   (input) CHARACTER*1
-*          Specifies the form of the system of equations:
-*          = 'N':  A * X = B     (No transpose)
-*          = 'T':  A**T * X = B  (Transpose)
-*          = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of columns
-*          of the matrices B and X.  NRHS >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The original N-by-N matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  AF      (input) DOUBLE PRECISION array, dimension (LDAF,N)
-*          The factors L and U from the factorization A = P*L*U
-*          as computed by DGETRF.
-*
-*  LDAF    (input) INTEGER
-*          The leading dimension of the array AF.  LDAF >= max(1,N).
-*
-*  IPIV    (input) INTEGER array, dimension (N)
-*          The pivot indices from DGETRF; for 1<=i<=N, row i of the
-*          matrix was interchanged with row IPIV(i).
-*
-*  B       (input) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          The right hand side matrix B.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  X       (input/output) DOUBLE PRECISION array, dimension (LDX,NRHS)
-*          On entry, the solution matrix X, as computed by DGETRS.
-*          On exit, the improved solution matrix X.
-*
-*  LDX     (input) INTEGER
-*          The leading dimension of the array X.  LDX >= max(1,N).
-*
-*  FERR    (output) DOUBLE PRECISION array, dimension (NRHS)
-*          The estimated forward error bound for each solution vector
-*          X(j) (the j-th column of the solution matrix X).
-*          If XTRUE is the true solution corresponding to X(j), FERR(j)
-*          is an estimated upper bound for the magnitude of the largest
-*          element in (X(j) - XTRUE) divided by the magnitude of the
-*          largest element in X(j).  The estimate is as reliable as
-*          the estimate for RCOND, and is almost always a slight
-*          overestimate of the true error.
-*
-*  BERR    (output) DOUBLE PRECISION array, dimension (NRHS)
-*          The componentwise relative backward error of each solution
-*          vector X(j) (i.e., the smallest relative change in
-*          any element of A or B that makes X(j) an exact solution).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (3*N)
-*
-*  IWORK   (workspace) INTEGER array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Internal Parameters
-*  ===================
-*
-*  ITMAX is the maximum number of steps of iterative refinement.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            ITMAX
-      PARAMETER          ( ITMAX = 5 )
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-      DOUBLE PRECISION   TWO
-      PARAMETER          ( TWO = 2.0D+0 )
-      DOUBLE PRECISION   THREE
-      PARAMETER          ( THREE = 3.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOTRAN
-      CHARACTER          TRANST
-      INTEGER            COUNT, I, J, K, KASE, NZ
-      DOUBLE PRECISION   EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
-*     ..
-*     .. Local Arrays ..
-      INTEGER            ISAVE( 3 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DCOPY, DGEMV, DGETRS, DLACN2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, DLAMCH
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      NOTRAN = LSAME( TRANS, 'N' )
-      IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
-     $    LSAME( TRANS, 'C' ) ) 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( LDAF.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -10
-      ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
-         INFO = -12
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGERFS', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
-         DO 10 J = 1, NRHS
-            FERR( J ) = ZERO
-            BERR( J ) = ZERO
-   10    CONTINUE
-         RETURN
-      END IF
-*
-      IF( NOTRAN ) THEN
-         TRANST = 'T'
-      ELSE
-         TRANST = 'N'
-      END IF
-*
-*     NZ = maximum number of nonzero elements in each row of A, plus 1
-*
-      NZ = N + 1
-      EPS = DLAMCH( 'Epsilon' )
-      SAFMIN = DLAMCH( 'Safe minimum' )
-      SAFE1 = NZ*SAFMIN
-      SAFE2 = SAFE1 / EPS
-*
-*     Do for each right hand side
-*
-      DO 140 J = 1, NRHS
-*
-         COUNT = 1
-         LSTRES = THREE
-   20    CONTINUE
-*
-*        Loop until stopping criterion is satisfied.
-*
-*        Compute residual R = B - op(A) * X,
-*        where op(A) = A, A**T, or A**H, depending on TRANS.
-*
-         CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 )
-         CALL DGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE,
-     $               WORK( N+1 ), 1 )
-*
-*        Compute componentwise relative backward error from formula
-*
-*        max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
-*
-*        where abs(Z) is the componentwise absolute value of the matrix
-*        or vector Z.  If the i-th component of the denominator is less
-*        than SAFE2, then SAFE1 is added to the i-th components of the
-*        numerator and denominator before dividing.
-*
-         DO 30 I = 1, N
-            WORK( I ) = ABS( B( I, J ) )
-   30    CONTINUE
-*
-*        Compute abs(op(A))*abs(X) + abs(B).
-*
-         IF( NOTRAN ) THEN
-            DO 50 K = 1, N
-               XK = ABS( X( K, J ) )
-               DO 40 I = 1, N
-                  WORK( I ) = WORK( I ) + ABS( A( I, K ) )*XK
-   40          CONTINUE
-   50       CONTINUE
-         ELSE
-            DO 70 K = 1, N
-               S = ZERO
-               DO 60 I = 1, N
-                  S = S + ABS( A( I, K ) )*ABS( X( I, J ) )
-   60          CONTINUE
-               WORK( K ) = WORK( K ) + S
-   70       CONTINUE
-         END IF
-         S = ZERO
-         DO 80 I = 1, N
-            IF( WORK( I ).GT.SAFE2 ) THEN
-               S = MAX( S, ABS( WORK( N+I ) ) / WORK( I ) )
-            ELSE
-               S = MAX( S, ( ABS( WORK( N+I ) )+SAFE1 ) /
-     $             ( WORK( I )+SAFE1 ) )
-            END IF
-   80    CONTINUE
-         BERR( J ) = S
-*
-*        Test stopping criterion. Continue iterating if
-*           1) The residual BERR(J) is larger than machine epsilon, and
-*           2) BERR(J) decreased by at least a factor of 2 during the
-*              last iteration, and
-*           3) At most ITMAX iterations tried.
-*
-         IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
-     $       COUNT.LE.ITMAX ) THEN
-*
-*           Update solution and try again.
-*
-            CALL DGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
-     $                   INFO )
-            CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 )
-            LSTRES = BERR( J )
-            COUNT = COUNT + 1
-            GO TO 20
-         END IF
-*
-*        Bound error from formula
-*
-*        norm(X - XTRUE) / norm(X) .le. FERR =
-*        norm( abs(inv(op(A)))*
-*           ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)
-*
-*        where
-*          norm(Z) is the magnitude of the largest component of Z
-*          inv(op(A)) is the inverse of op(A)
-*          abs(Z) is the componentwise absolute value of the matrix or
-*             vector Z
-*          NZ is the maximum number of nonzeros in any row of A, plus 1
-*          EPS is machine epsilon
-*
-*        The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))
-*        is incremented by SAFE1 if the i-th component of
-*        abs(op(A))*abs(X) + abs(B) is less than SAFE2.
-*
-*        Use DLACN2 to estimate the infinity-norm of the matrix
-*           inv(op(A)) * diag(W),
-*        where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) )))
-*
-         DO 90 I = 1, N
-            IF( WORK( I ).GT.SAFE2 ) THEN
-               WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I )
-            ELSE
-               WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1
-            END IF
-   90    CONTINUE
-*
-         KASE = 0
-  100    CONTINUE
-         CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ),
-     $                KASE, ISAVE )
-         IF( KASE.NE.0 ) THEN
-            IF( KASE.EQ.1 ) THEN
-*
-*              Multiply by diag(W)*inv(op(A)**T).
-*
-               CALL DGETRS( TRANST, N, 1, AF, LDAF, IPIV, WORK( N+1 ),
-     $                      N, INFO )
-               DO 110 I = 1, N
-                  WORK( N+I ) = WORK( I )*WORK( N+I )
-  110          CONTINUE
-            ELSE
-*
-*              Multiply by inv(op(A))*diag(W).
-*
-               DO 120 I = 1, N
-                  WORK( N+I ) = WORK( I )*WORK( N+I )
-  120          CONTINUE
-               CALL DGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N,
-     $                      INFO )
-            END IF
-            GO TO 100
-         END IF
-*
-*        Normalize error.
-*
-         LSTRES = ZERO
-         DO 130 I = 1, N
-            LSTRES = MAX( LSTRES, ABS( X( I, J ) ) )
-  130    CONTINUE
-         IF( LSTRES.NE.ZERO )
-     $      FERR( J ) = FERR( J ) / LSTRES
-*
-  140 CONTINUE
-*
-      RETURN
-*
-*     End of DGERFS
-*
-      END
diff --git a/src/lib/lapack/dgerq2.f b/src/lib/lapack/dgerq2.f
deleted file mode 100644
index 4dfe8b0f..00000000
--- a/src/lib/lapack/dgerq2.f
+++ /dev/null
@@ -1,122 +0,0 @@
-      SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGERQ2 computes an RQ factorization of a real m by n matrix A:
-*  A = R * Q.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the m by n matrix A.
-*          On exit, if m <= n, the upper triangle of the subarray
-*          A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
-*          if m >= n, the elements on and above the (m-n)-th subdiagonal
-*          contain the m by n upper trapezoidal matrix R; the remaining
-*          elements, with the array TAU, represent the orthogonal matrix
-*          Q as a product of elementary reflectors (see Further
-*          Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (M)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
-*  A(m-k+i,1:n-k+i-1), and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, K
-      DOUBLE PRECISION   AII
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DLARFG, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGERQ2', -INFO )
-         RETURN
-      END IF
-*
-      K = MIN( M, N )
-*
-      DO 10 I = K, 1, -1
-*
-*        Generate elementary reflector H(i) to annihilate
-*        A(m-k+i,1:n-k+i-1)
-*
-         CALL DLARFG( N-K+I, A( M-K+I, N-K+I ), A( M-K+I, 1 ), LDA,
-     $                TAU( I ) )
-*
-*        Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
-*
-         AII = A( M-K+I, N-K+I )
-         A( M-K+I, N-K+I ) = ONE
-         CALL DLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
-     $               TAU( I ), A, LDA, WORK )
-         A( M-K+I, N-K+I ) = AII
-   10 CONTINUE
-      RETURN
-*
-*     End of DGERQ2
-*
-      END
diff --git a/src/lib/lapack/dgerqf.f b/src/lib/lapack/dgerqf.f
deleted file mode 100644
index 3dc22652..00000000
--- a/src/lib/lapack/dgerqf.f
+++ /dev/null
@@ -1,213 +0,0 @@
-      SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGERQF computes an RQ factorization of a real M-by-N matrix A:
-*  A = R * Q.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit,
-*          if m <= n, the upper triangle of the subarray
-*          A(1:m,n-m+1:n) contains the M-by-M upper triangular matrix R;
-*          if m >= n, the elements on and above the (m-n)-th subdiagonal
-*          contain the M-by-N upper trapezoidal matrix R;
-*          the remaining elements, with the array TAU, represent the
-*          orthogonal matrix Q as a product of min(m,n) elementary
-*          reflectors (see Further Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,M).
-*          For optimum performance LWORK >= M*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
-*  A(m-k+i,1:n-k+i-1), and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, K, KI, KK, LDWORK, LWKOPT,
-     $                   MU, NB, NBMIN, NU, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGERQ2, DLARFB, DLARFT, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         K = MIN( M, N )
-         IF( K.EQ.0 ) THEN
-            LWKOPT = 1
-         ELSE
-            NB = ILAENV( 1, 'DGERQF', ' ', M, N, -1, -1 )
-            LWKOPT = M*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
-            INFO = -7
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGERQF', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( K.EQ.0 ) THEN
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 1
-      IWS = M
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'DGERQF', ' ', M, N, -1, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = M
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'DGERQF', ' ', M, N, -1,
-     $                 -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code initially.
-*        The last kk rows are handled by the block method.
-*
-         KI = ( ( K-NX-1 ) / NB )*NB
-         KK = MIN( K, KI+NB )
-*
-         DO 10 I = K - KK + KI + 1, K - KK + 1, -NB
-            IB = MIN( K-I+1, NB )
-*
-*           Compute the RQ factorization of the current block
-*           A(m-k+i:m-k+i+ib-1,1:n-k+i+ib-1)
-*
-            CALL DGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, TAU( I ),
-     $                   WORK, IINFO )
-            IF( M-K+I.GT.1 ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i+ib-1) . . . H(i+1) H(i)
-*
-               CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB,
-     $                      A( M-K+I, 1 ), LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
-*
-               CALL DLARFB( 'Right', 'No transpose', 'Backward',
-     $                      'Rowwise', M-K+I-1, N-K+I+IB-1, IB,
-     $                      A( M-K+I, 1 ), LDA, WORK, LDWORK, A, LDA,
-     $                      WORK( IB+1 ), LDWORK )
-            END IF
-   10    CONTINUE
-         MU = M - K + I + NB - 1
-         NU = N - K + I + NB - 1
-      ELSE
-         MU = M
-         NU = N
-      END IF
-*
-*     Use unblocked code to factor the last or only block
-*
-      IF( MU.GT.0 .AND. NU.GT.0 )
-     $   CALL DGERQ2( MU, NU, A, LDA, TAU, WORK, IINFO )
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of DGERQF
-*
-      END
diff --git a/src/lib/lapack/dgesc2.f b/src/lib/lapack/dgesc2.f
deleted file mode 100644
index 1b0331f5..00000000
--- a/src/lib/lapack/dgesc2.f
+++ /dev/null
@@ -1,132 +0,0 @@
-      SUBROUTINE DGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            LDA, N
-      DOUBLE PRECISION   SCALE
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * ), JPIV( * )
-      DOUBLE PRECISION   A( LDA, * ), RHS( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGESC2 solves a system of linear equations
-*
-*            A * X = scale* RHS
-*
-*  with a general N-by-N matrix A using the LU factorization with
-*  complete pivoting computed by DGETC2.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the  LU part of the factorization of the n-by-n
-*          matrix A computed by DGETC2:  A = P * L * U * Q
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1, N).
-*
-*  RHS     (input/output) DOUBLE PRECISION array, dimension (N).
-*          On entry, the right hand side vector b.
-*          On exit, the solution vector X.
-*
-*  IPIV    (input) INTEGER array, dimension (N).
-*          The pivot indices; for 1 <= i <= N, row i of the
-*          matrix has been interchanged with row IPIV(i).
-*
-*  JPIV    (input) INTEGER array, dimension (N).
-*          The pivot indices; for 1 <= j <= N, column j of the
-*          matrix has been interchanged with column JPIV(j).
-*
-*  SCALE    (output) DOUBLE PRECISION
-*           On exit, SCALE contains the scale factor. SCALE is chosen
-*           0 <= SCALE <= 1 to prevent owerflow in the solution.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, TWO
-      PARAMETER          ( ONE = 1.0D+0, TWO = 2.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   BIGNUM, EPS, SMLNUM, TEMP
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASWP, DSCAL
-*     ..
-*     .. External Functions ..
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           IDAMAX, DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS
-*     ..
-*     .. Executable Statements ..
-*
-*      Set constant to control owerflow
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' ) / EPS
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Apply permutations IPIV to RHS
-*
-      CALL DLASWP( 1, RHS, LDA, 1, N-1, IPIV, 1 )
-*
-*     Solve for L part
-*
-      DO 20 I = 1, N - 1
-         DO 10 J = I + 1, N
-            RHS( J ) = RHS( J ) - A( J, I )*RHS( I )
-   10    CONTINUE
-   20 CONTINUE
-*
-*     Solve for U part
-*
-      SCALE = ONE
-*
-*     Check for scaling
-*
-      I = IDAMAX( N, RHS, 1 )
-      IF( TWO*SMLNUM*ABS( RHS( I ) ).GT.ABS( A( N, N ) ) ) THEN
-         TEMP = ( ONE / TWO ) / ABS( RHS( I ) )
-         CALL DSCAL( N, TEMP, RHS( 1 ), 1 )
-         SCALE = SCALE*TEMP
-      END IF
-*
-      DO 40 I = N, 1, -1
-         TEMP = ONE / A( I, I )
-         RHS( I ) = RHS( I )*TEMP
-         DO 30 J = I + 1, N
-            RHS( I ) = RHS( I ) - RHS( J )*( A( I, J )*TEMP )
-   30    CONTINUE
-   40 CONTINUE
-*
-*     Apply permutations JPIV to the solution (RHS)
-*
-      CALL DLASWP( 1, RHS, LDA, 1, N-1, JPIV, -1 )
-      RETURN
-*
-*     End of DGESC2
-*
-      END
diff --git a/src/lib/lapack/dgesv.f b/src/lib/lapack/dgesv.f
deleted file mode 100644
index 220ef56f..00000000
--- a/src/lib/lapack/dgesv.f
+++ /dev/null
@@ -1,107 +0,0 @@
-      SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LDB, N, NRHS
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGESV computes the solution to a real system of linear equations
-*     A * X = B,
-*  where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
-*
-*  The LU decomposition with partial pivoting and row interchanges is
-*  used to factor A as
-*     A = P * L * U,
-*  where P is a permutation matrix, L is unit lower triangular, and U is
-*  upper triangular.  The factored form of A is then used to solve the
-*  system of equations A * X = B.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of linear equations, i.e., the order of the
-*          matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of columns
-*          of the matrix B.  NRHS >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the N-by-N coefficient matrix A.
-*          On exit, the factors L and U from the factorization
-*          A = P*L*U; the unit diagonal elements of L are not stored.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (output) INTEGER array, dimension (N)
-*          The pivot indices that define the permutation matrix P;
-*          row i of the matrix was interchanged with row IPIV(i).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the N-by-NRHS matrix of right hand side matrix B.
-*          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, U(i,i) is exactly zero.  The factorization
-*                has been completed, but the factor U is exactly
-*                singular, so the solution could not be computed.
-*
-*  =====================================================================
-*
-*     .. External Subroutines ..
-      EXTERNAL           DGETRF, DGETRS, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF( N.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( NRHS.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -4
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGESV ', -INFO )
-         RETURN
-      END IF
-*
-*     Compute the LU factorization of A.
-*
-      CALL DGETRF( N, N, A, LDA, IPIV, INFO )
-      IF( INFO.EQ.0 ) THEN
-*
-*        Solve the system A*X = B, overwriting B with X.
-*
-         CALL DGETRS( 'No transpose', N, NRHS, A, LDA, IPIV, B, LDB,
-     $                INFO )
-      END IF
-      RETURN
-*
-*     End of DGESV
-*
-      END
diff --git a/src/lib/lapack/dgesvd.f b/src/lib/lapack/dgesvd.f
deleted file mode 100644
index 0b62ca10..00000000
--- a/src/lib/lapack/dgesvd.f
+++ /dev/null
@@ -1,3401 +0,0 @@
-      SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBU, JOBVT
-      INTEGER            INFO, LDA, LDU, LDVT, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), S( * ), U( LDU, * ),
-     $                   VT( LDVT, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGESVD computes the singular value decomposition (SVD) of a real
-*  M-by-N matrix A, optionally computing the left and/or right singular
-*  vectors. The SVD is written
-*
-*       A = U * SIGMA * transpose(V)
-*
-*  where SIGMA is an M-by-N matrix which is zero except for its
-*  min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
-*  V is an N-by-N orthogonal matrix.  The diagonal elements of SIGMA
-*  are the singular values of A; they are real and non-negative, and
-*  are returned in descending order.  The first min(m,n) columns of
-*  U and V are the left and right singular vectors of A.
-*
-*  Note that the routine returns V**T, not V.
-*
-*  Arguments
-*  =========
-*
-*  JOBU    (input) CHARACTER*1
-*          Specifies options for computing all or part of the matrix U:
-*          = 'A':  all M columns of U are returned in array U:
-*          = 'S':  the first min(m,n) columns of U (the left singular
-*                  vectors) are returned in the array U;
-*          = 'O':  the first min(m,n) columns of U (the left singular
-*                  vectors) are overwritten on the array A;
-*          = 'N':  no columns of U (no left singular vectors) are
-*                  computed.
-*
-*  JOBVT   (input) CHARACTER*1
-*          Specifies options for computing all or part of the matrix
-*          V**T:
-*          = 'A':  all N rows of V**T are returned in the array VT;
-*          = 'S':  the first min(m,n) rows of V**T (the right singular
-*                  vectors) are returned in the array VT;
-*          = 'O':  the first min(m,n) rows of V**T (the right singular
-*                  vectors) are overwritten on the array A;
-*          = 'N':  no rows of V**T (no right singular vectors) are
-*                  computed.
-*
-*          JOBVT and JOBU cannot both be 'O'.
-*
-*  M       (input) INTEGER
-*          The number of rows of the input matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the input matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit,
-*          if JOBU = 'O',  A is overwritten with the first min(m,n)
-*                          columns of U (the left singular vectors,
-*                          stored columnwise);
-*          if JOBVT = 'O', A is overwritten with the first min(m,n)
-*                          rows of V**T (the right singular vectors,
-*                          stored rowwise);
-*          if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
-*                          are destroyed.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  S       (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The singular values of A, sorted so that S(i) >= S(i+1).
-*
-*  U       (output) DOUBLE PRECISION array, dimension (LDU,UCOL)
-*          (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'.
-*          If JOBU = 'A', U contains the M-by-M orthogonal matrix U;
-*          if JOBU = 'S', U contains the first min(m,n) columns of U
-*          (the left singular vectors, stored columnwise);
-*          if JOBU = 'N' or 'O', U is not referenced.
-*
-*  LDU     (input) INTEGER
-*          The leading dimension of the array U.  LDU >= 1; if
-*          JOBU = 'S' or 'A', LDU >= M.
-*
-*  VT      (output) DOUBLE PRECISION array, dimension (LDVT,N)
-*          If JOBVT = 'A', VT contains the N-by-N orthogonal matrix
-*          V**T;
-*          if JOBVT = 'S', VT contains the first min(m,n) rows of
-*          V**T (the right singular vectors, stored rowwise);
-*          if JOBVT = 'N' or 'O', VT is not referenced.
-*
-*  LDVT    (input) INTEGER
-*          The leading dimension of the array VT.  LDVT >= 1; if
-*          JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
-*          if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged
-*          superdiagonal elements of an upper bidiagonal matrix B
-*          whose diagonal is in S (not necessarily sorted). B
-*          satisfies A = U * B * VT, so it has the same singular values
-*          as A, and singular vectors related by U and VT.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)).
-*          For good performance, LWORK should generally be larger.
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          > 0:  if DBDSQR did not converge, INFO specifies how many
-*                superdiagonals of an intermediate bidiagonal form B
-*                did not converge to zero. See the description of WORK
-*                above for details.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
-     $                   WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
-      INTEGER            BDSPAC, BLK, CHUNK, I, IE, IERR, IR, ISCL,
-     $                   ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
-     $                   MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
-     $                   NRVT, WRKBL
-      DOUBLE PRECISION   ANRM, BIGNUM, EPS, SMLNUM
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   DUM( 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DBDSQR, DGEBRD, DGELQF, DGEMM, DGEQRF, DLACPY,
-     $                   DLASCL, DLASET, DORGBR, DORGLQ, DORGQR, DORMBR,
-     $                   XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           LSAME, ILAENV, DLAMCH, DLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      MINMN = MIN( M, N )
-      WNTUA = LSAME( JOBU, 'A' )
-      WNTUS = LSAME( JOBU, 'S' )
-      WNTUAS = WNTUA .OR. WNTUS
-      WNTUO = LSAME( JOBU, 'O' )
-      WNTUN = LSAME( JOBU, 'N' )
-      WNTVA = LSAME( JOBVT, 'A' )
-      WNTVS = LSAME( JOBVT, 'S' )
-      WNTVAS = WNTVA .OR. WNTVS
-      WNTVO = LSAME( JOBVT, 'O' )
-      WNTVN = LSAME( JOBVT, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-      IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.( WNTVA .OR. WNTVS .OR. WNTVO .OR. WNTVN ) .OR.
-     $         ( WNTVO .AND. WNTUO ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -6
-      ELSE IF( LDU.LT.1 .OR. ( WNTUAS .AND. LDU.LT.M ) ) THEN
-         INFO = -9
-      ELSE IF( LDVT.LT.1 .OR. ( WNTVA .AND. LDVT.LT.N ) .OR.
-     $         ( WNTVS .AND. LDVT.LT.MINMN ) ) THEN
-         INFO = -11
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       NB refers to the optimal block size for the immediately
-*       following subroutine, as returned by ILAENV.)
-*
-      IF( INFO.EQ.0 ) THEN
-         MINWRK = 1
-         MAXWRK = 1
-         IF( M.GE.N .AND. MINMN.GT.0 ) THEN
-*
-*           Compute space needed for DBDSQR
-*
-            MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 )
-            BDSPAC = 5*N
-            IF( M.GE.MNTHR ) THEN
-               IF( WNTUN ) THEN
-*
-*                 Path 1 (M much larger than N, JOBU='N')
-*
-                  MAXWRK = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1,
-     $                     -1 )
-                  MAXWRK = MAX( MAXWRK, 3*N+2*N*
-     $                     ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
-                  IF( WNTVO .OR. WNTVAS )
-     $               MAXWRK = MAX( MAXWRK, 3*N+( N-1 )*
-     $                        ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
-                  MAXWRK = MAX( MAXWRK, BDSPAC )
-                  MINWRK = MAX( 4*N, BDSPAC )
-               ELSE IF( WNTUO .AND. WNTVN ) THEN
-*
-*                 Path 2 (M much larger than N, JOBU='O', JOBVT='N')
-*
-                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
-     $                    N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+2*N*
-     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+N*
-     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N )
-                  MINWRK = MAX( 3*N+M, BDSPAC )
-               ELSE IF( WNTUO .AND. WNTVAS ) THEN
-*
-*                 Path 3 (M much larger than N, JOBU='O', JOBVT='S' or
-*                 'A')
-*
-                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
-     $                    N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+2*N*
-     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+N*
-     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+( N-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N )
-                  MINWRK = MAX( 3*N+M, BDSPAC )
-               ELSE IF( WNTUS .AND. WNTVN ) THEN
-*
-*                 Path 4 (M much larger than N, JOBU='S', JOBVT='N')
-*
-                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
-     $                    N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+2*N*
-     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+N*
-     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = N*N + WRKBL
-                  MINWRK = MAX( 3*N+M, BDSPAC )
-               ELSE IF( WNTUS .AND. WNTVO ) THEN
-*
-*                 Path 5 (M much larger than N, JOBU='S', JOBVT='O')
-*
-                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
-     $                    N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+2*N*
-     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+N*
-     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+( N-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = 2*N*N + WRKBL
-                  MINWRK = MAX( 3*N+M, BDSPAC )
-               ELSE IF( WNTUS .AND. WNTVAS ) THEN
-*
-*                 Path 6 (M much larger than N, JOBU='S', JOBVT='S' or
-*                 'A')
-*
-                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
-     $                    N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+2*N*
-     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+N*
-     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+( N-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = N*N + WRKBL
-                  MINWRK = MAX( 3*N+M, BDSPAC )
-               ELSE IF( WNTUA .AND. WNTVN ) THEN
-*
-*                 Path 7 (M much larger than N, JOBU='A', JOBVT='N')
-*
-                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'DORGQR', ' ', M,
-     $                    M, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+2*N*
-     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+N*
-     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = N*N + WRKBL
-                  MINWRK = MAX( 3*N+M, BDSPAC )
-               ELSE IF( WNTUA .AND. WNTVO ) THEN
-*
-*                 Path 8 (M much larger than N, JOBU='A', JOBVT='O')
-*
-                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'DORGQR', ' ', M,
-     $                    M, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+2*N*
-     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+N*
-     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+( N-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = 2*N*N + WRKBL
-                  MINWRK = MAX( 3*N+M, BDSPAC )
-               ELSE IF( WNTUA .AND. WNTVAS ) THEN
-*
-*                 Path 9 (M much larger than N, JOBU='A', JOBVT='S' or
-*                 'A')
-*
-                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'DORGQR', ' ', M,
-     $                    M, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+2*N*
-     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+N*
-     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*N+( N-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = N*N + WRKBL
-                  MINWRK = MAX( 3*N+M, BDSPAC )
-               END IF
-            ELSE
-*
-*              Path 10 (M at least N, but not much larger)
-*
-               MAXWRK = 3*N + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N,
-     $                  -1, -1 )
-               IF( WNTUS .OR. WNTUO )
-     $            MAXWRK = MAX( MAXWRK, 3*N+N*
-     $                     ILAENV( 1, 'DORGBR', 'Q', M, N, N, -1 ) )
-               IF( WNTUA )
-     $            MAXWRK = MAX( MAXWRK, 3*N+M*
-     $                     ILAENV( 1, 'DORGBR', 'Q', M, M, N, -1 ) )
-               IF( .NOT.WNTVN )
-     $            MAXWRK = MAX( MAXWRK, 3*N+( N-1 )*
-     $                     ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
-               MAXWRK = MAX( MAXWRK, BDSPAC )
-               MINWRK = MAX( 3*N+M, BDSPAC )
-            END IF
-         ELSE IF( MINMN.GT.0 ) THEN
-*
-*           Compute space needed for DBDSQR
-*
-            MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 )
-            BDSPAC = 5*M
-            IF( N.GE.MNTHR ) THEN
-               IF( WNTVN ) THEN
-*
-*                 Path 1t(N much larger than M, JOBVT='N')
-*
-                  MAXWRK = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1,
-     $                     -1 )
-                  MAXWRK = MAX( MAXWRK, 3*M+2*M*
-     $                     ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
-                  IF( WNTUO .OR. WNTUAS )
-     $               MAXWRK = MAX( MAXWRK, 3*M+M*
-     $                        ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
-                  MAXWRK = MAX( MAXWRK, BDSPAC )
-                  MINWRK = MAX( 4*M, BDSPAC )
-               ELSE IF( WNTVO .AND. WNTUN ) THEN
-*
-*                 Path 2t(N much larger than M, JOBU='N', JOBVT='O')
-*
-                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+2*M*
-     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M )
-                  MINWRK = MAX( 3*M+N, BDSPAC )
-               ELSE IF( WNTVO .AND. WNTUAS ) THEN
-*
-*                 Path 3t(N much larger than M, JOBU='S' or 'A',
-*                 JOBVT='O')
-*
-                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+2*M*
-     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+M*
-     $                    ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M )
-                  MINWRK = MAX( 3*M+N, BDSPAC )
-               ELSE IF( WNTVS .AND. WNTUN ) THEN
-*
-*                 Path 4t(N much larger than M, JOBU='N', JOBVT='S')
-*
-                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+2*M*
-     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = M*M + WRKBL
-                  MINWRK = MAX( 3*M+N, BDSPAC )
-               ELSE IF( WNTVS .AND. WNTUO ) THEN
-*
-*                 Path 5t(N much larger than M, JOBU='O', JOBVT='S')
-*
-                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+2*M*
-     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+M*
-     $                    ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = 2*M*M + WRKBL
-                  MINWRK = MAX( 3*M+N, BDSPAC )
-               ELSE IF( WNTVS .AND. WNTUAS ) THEN
-*
-*                 Path 6t(N much larger than M, JOBU='S' or 'A',
-*                 JOBVT='S')
-*
-                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+2*M*
-     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+M*
-     $                    ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = M*M + WRKBL
-                  MINWRK = MAX( 3*M+N, BDSPAC )
-               ELSE IF( WNTVA .AND. WNTUN ) THEN
-*
-*                 Path 7t(N much larger than M, JOBU='N', JOBVT='A')
-*
-                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'DORGLQ', ' ', N,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+2*M*
-     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = M*M + WRKBL
-                  MINWRK = MAX( 3*M+N, BDSPAC )
-               ELSE IF( WNTVA .AND. WNTUO ) THEN
-*
-*                 Path 8t(N much larger than M, JOBU='O', JOBVT='A')
-*
-                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'DORGLQ', ' ', N,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+2*M*
-     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+M*
-     $                    ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = 2*M*M + WRKBL
-                  MINWRK = MAX( 3*M+N, BDSPAC )
-               ELSE IF( WNTVA .AND. WNTUAS ) THEN
-*
-*                 Path 9t(N much larger than M, JOBU='S' or 'A',
-*                 JOBVT='A')
-*
-                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'DORGLQ', ' ', N,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+2*M*
-     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
-     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 3*M+M*
-     $                    ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, BDSPAC )
-                  MAXWRK = M*M + WRKBL
-                  MINWRK = MAX( 3*M+N, BDSPAC )
-               END IF
-            ELSE
-*
-*              Path 10t(N greater than M, but not much larger)
-*
-               MAXWRK = 3*M + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N,
-     $                  -1, -1 )
-               IF( WNTVS .OR. WNTVO )
-     $            MAXWRK = MAX( MAXWRK, 3*M+M*
-     $                     ILAENV( 1, 'DORGBR', 'P', M, N, M, -1 ) )
-               IF( WNTVA )
-     $            MAXWRK = MAX( MAXWRK, 3*M+N*
-     $                     ILAENV( 1, 'DORGBR', 'P', N, N, M, -1 ) )
-               IF( .NOT.WNTUN )
-     $            MAXWRK = MAX( MAXWRK, 3*M+( M-1 )*
-     $                     ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
-               MAXWRK = MAX( MAXWRK, BDSPAC )
-               MINWRK = MAX( 3*M+N, BDSPAC )
-            END IF
-         END IF
-         MAXWRK = MAX( MAXWRK, MINWRK )
-         WORK( 1 ) = MAXWRK
-*
-         IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
-            INFO = -13
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGESVD', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         RETURN
-      END IF
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = SQRT( DLAMCH( 'S' ) ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', M, N, A, LDA, DUM )
-      ISCL = 0
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         ISCL = 1
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, IERR )
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         ISCL = 1
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, IERR )
-      END IF
-*
-      IF( M.GE.N ) THEN
-*
-*        A has at least as many rows as columns. If A has sufficiently
-*        more rows than columns, first reduce using the QR
-*        decomposition (if sufficient workspace available)
-*
-         IF( M.GE.MNTHR ) THEN
-*
-            IF( WNTUN ) THEN
-*
-*              Path 1 (M much larger than N, JOBU='N')
-*              No left singular vectors to be computed
-*
-               ITAU = 1
-               IWORK = ITAU + N
-*
-*              Compute A=Q*R
-*              (Workspace: need 2*N, prefer N+N*NB)
-*
-               CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
-     $                      LWORK-IWORK+1, IERR )
-*
-*              Zero out below R
-*
-               CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
-               IE = 1
-               ITAUQ = IE + N
-               ITAUP = ITAUQ + N
-               IWORK = ITAUP + N
-*
-*              Bidiagonalize R in A
-*              (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
-               CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
-     $                      WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
-     $                      IERR )
-               NCVT = 0
-               IF( WNTVO .OR. WNTVAS ) THEN
-*
-*                 If right singular vectors desired, generate P'.
-*                 (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
-                  CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  NCVT = N
-               END IF
-               IWORK = IE + N
-*
-*              Perform bidiagonal QR iteration, computing right
-*              singular vectors of A in A if desired
-*              (Workspace: need BDSPAC)
-*
-               CALL DBDSQR( 'U', N, NCVT, 0, 0, S, WORK( IE ), A, LDA,
-     $                      DUM, 1, DUM, 1, WORK( IWORK ), INFO )
-*
-*              If right singular vectors desired in VT, copy them there
-*
-               IF( WNTVAS )
-     $            CALL DLACPY( 'F', N, N, A, LDA, VT, LDVT )
-*
-            ELSE IF( WNTUO .AND. WNTVN ) THEN
-*
-*              Path 2 (M much larger than N, JOBU='O', JOBVT='N')
-*              N left singular vectors to be overwritten on A and
-*              no right singular vectors to be computed
-*
-               IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-*                 Sufficient workspace for a fast algorithm
-*
-                  IR = 1
-                  IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN
-*
-*                    WORK(IU) is LDA by N, WORK(IR) is LDA by N
-*
-                     LDWRKU = LDA
-                     LDWRKR = LDA
-                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN
-*
-*                    WORK(IU) is LDA by N, WORK(IR) is N by N
-*
-                     LDWRKU = LDA
-                     LDWRKR = N
-                  ELSE
-*
-*                    WORK(IU) is LDWRKU by N, WORK(IR) is N by N
-*
-                     LDWRKU = ( LWORK-N*N-N ) / N
-                     LDWRKR = N
-                  END IF
-                  ITAU = IR + LDWRKR*N
-                  IWORK = ITAU + N
-*
-*                 Compute A=Q*R
-*                 (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
-                  CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy R to WORK(IR) and zero out below it
-*
-                  CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
-                  CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ),
-     $                         LDWRKR )
-*
-*                 Generate Q in A
-*                 (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
-                  CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = ITAU
-                  ITAUQ = IE + N
-                  ITAUP = ITAUQ + N
-                  IWORK = ITAUP + N
-*
-*                 Bidiagonalize R in WORK(IR)
-*                 (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
-                  CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Generate left vectors bidiagonalizing R
-*                 (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
-                  CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
-     $                         WORK( ITAUQ ), WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-                  IWORK = IE + N
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of R in WORK(IR)
-*                 (Workspace: need N*N+BDSPAC)
-*
-                  CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, 1,
-     $                         WORK( IR ), LDWRKR, DUM, 1,
-     $                         WORK( IWORK ), INFO )
-                  IU = IE + N
-*
-*                 Multiply Q in A by left singular vectors of R in
-*                 WORK(IR), storing result in WORK(IU) and copying to A
-*                 (Workspace: need N*N+2*N, prefer N*N+M*N+N)
-*
-                  DO 10 I = 1, M, LDWRKU
-                     CHUNK = MIN( M-I+1, LDWRKU )
-                     CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
-     $                           LDA, WORK( IR ), LDWRKR, ZERO,
-     $                           WORK( IU ), LDWRKU )
-                     CALL DLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
-     $                            A( I, 1 ), LDA )
-   10             CONTINUE
-*
-               ELSE
-*
-*                 Insufficient workspace for a fast algorithm
-*
-                  IE = 1
-                  ITAUQ = IE + N
-                  ITAUP = ITAUQ + N
-                  IWORK = ITAUP + N
-*
-*                 Bidiagonalize A
-*                 (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
-*
-                  CALL DGEBRD( M, N, A, LDA, S, WORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Generate left vectors bidiagonalizing A
-*                 (Workspace: need 4*N, prefer 3*N+N*NB)
-*
-                  CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IWORK = IE + N
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of A in A
-*                 (Workspace: need BDSPAC)
-*
-                  CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, 1,
-     $                         A, LDA, DUM, 1, WORK( IWORK ), INFO )
-*
-               END IF
-*
-            ELSE IF( WNTUO .AND. WNTVAS ) THEN
-*
-*              Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A')
-*              N left singular vectors to be overwritten on A and
-*              N right singular vectors to be computed in VT
-*
-               IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-*                 Sufficient workspace for a fast algorithm
-*
-                  IR = 1
-                  IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
-                     LDWRKU = LDA
-                     LDWRKR = LDA
-                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is N by N
-*
-                     LDWRKU = LDA
-                     LDWRKR = N
-                  ELSE
-*
-*                    WORK(IU) is LDWRKU by N and WORK(IR) is N by N
-*
-                     LDWRKU = ( LWORK-N*N-N ) / N
-                     LDWRKR = N
-                  END IF
-                  ITAU = IR + LDWRKR*N
-                  IWORK = ITAU + N
-*
-*                 Compute A=Q*R
-*                 (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
-                  CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy R to VT, zeroing out below it
-*
-                  CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
-                  IF( N.GT.1 )
-     $               CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
-     $                            VT( 2, 1 ), LDVT )
-*
-*                 Generate Q in A
-*                 (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
-                  CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = ITAU
-                  ITAUQ = IE + N
-                  ITAUP = ITAUQ + N
-                  IWORK = ITAUP + N
-*
-*                 Bidiagonalize R in VT, copying result to WORK(IR)
-*                 (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
-                  CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  CALL DLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR )
-*
-*                 Generate left vectors bidiagonalizing R in WORK(IR)
-*                 (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
-                  CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
-     $                         WORK( ITAUQ ), WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-*
-*                 Generate right vectors bidiagonalizing R in VT
-*                 (Workspace: need N*N+4*N-1, prefer N*N+3*N+(N-1)*NB)
-*
-                  CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IWORK = IE + N
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of R in WORK(IR) and computing right
-*                 singular vectors of R in VT
-*                 (Workspace: need N*N+BDSPAC)
-*
-                  CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, LDVT,
-     $                         WORK( IR ), LDWRKR, DUM, 1,
-     $                         WORK( IWORK ), INFO )
-                  IU = IE + N
-*
-*                 Multiply Q in A by left singular vectors of R in
-*                 WORK(IR), storing result in WORK(IU) and copying to A
-*                 (Workspace: need N*N+2*N, prefer N*N+M*N+N)
-*
-                  DO 20 I = 1, M, LDWRKU
-                     CHUNK = MIN( M-I+1, LDWRKU )
-                     CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
-     $                           LDA, WORK( IR ), LDWRKR, ZERO,
-     $                           WORK( IU ), LDWRKU )
-                     CALL DLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
-     $                            A( I, 1 ), LDA )
-   20             CONTINUE
-*
-               ELSE
-*
-*                 Insufficient workspace for a fast algorithm
-*
-                  ITAU = 1
-                  IWORK = ITAU + N
-*
-*                 Compute A=Q*R
-*                 (Workspace: need 2*N, prefer N+N*NB)
-*
-                  CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy R to VT, zeroing out below it
-*
-                  CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
-                  IF( N.GT.1 )
-     $               CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
-     $                            VT( 2, 1 ), LDVT )
-*
-*                 Generate Q in A
-*                 (Workspace: need 2*N, prefer N+N*NB)
-*
-                  CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = ITAU
-                  ITAUQ = IE + N
-                  ITAUP = ITAUQ + N
-                  IWORK = ITAUP + N
-*
-*                 Bidiagonalize R in VT
-*                 (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
-                  CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Multiply Q in A by left vectors bidiagonalizing R
-*                 (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
-                  CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
-     $                         WORK( ITAUQ ), A, LDA, WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-*
-*                 Generate right vectors bidiagonalizing R in VT
-*                 (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
-                  CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IWORK = IE + N
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of A in A and computing right
-*                 singular vectors of A in VT
-*                 (Workspace: need BDSPAC)
-*
-                  CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT, LDVT,
-     $                         A, LDA, DUM, 1, WORK( IWORK ), INFO )
-*
-               END IF
-*
-            ELSE IF( WNTUS ) THEN
-*
-               IF( WNTVN ) THEN
-*
-*                 Path 4 (M much larger than N, JOBU='S', JOBVT='N')
-*                 N left singular vectors to be computed in U and
-*                 no right singular vectors to be computed
-*
-                  IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IR = 1
-                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-*                       WORK(IR) is LDA by N
-*
-                        LDWRKR = LDA
-                     ELSE
-*
-*                       WORK(IR) is N by N
-*
-                        LDWRKR = N
-                     END IF
-                     ITAU = IR + LDWRKR*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R
-*                    (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to WORK(IR), zeroing out below it
-*
-                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ),
-     $                            LDWRKR )
-                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
-     $                            WORK( IR+1 ), LDWRKR )
-*
-*                    Generate Q in A
-*                    (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
-                     CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IR)
-*                    (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left vectors bidiagonalizing R in WORK(IR)
-*                    (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
-                     CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IR)
-*                    (Workspace: need N*N+BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM,
-     $                            1, WORK( IR ), LDWRKR, DUM, 1,
-     $                            WORK( IWORK ), INFO )
-*
-*                    Multiply Q in A by left singular vectors of R in
-*                    WORK(IR), storing result in U
-*                    (Workspace: need N*N)
-*
-                     CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
-     $                           WORK( IR ), LDWRKR, ZERO, U, LDU )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (Workspace: need 2*N, prefer N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (Workspace: need 2*N, prefer N+N*NB)
-*
-                     CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Zero out below R in A
-*
-                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
-     $                            LDA )
-*
-*                    Bidiagonalize R in A
-*                    (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left vectors bidiagonalizing R
-*                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
-                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM,
-     $                            1, U, LDU, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTVO ) THEN
-*
-*                 Path 5 (M much larger than N, JOBU='S', JOBVT='O')
-*                 N left singular vectors to be computed in U and
-*                 N right singular vectors to be overwritten on A
-*
-                  IF( LWORK.GE.2*N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
-*
-*                       WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*N
-                        LDWRKR = LDA
-                     ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
-*
-*                       WORK(IU) is LDA by N and WORK(IR) is N by N
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*N
-                        LDWRKR = N
-                     ELSE
-*
-*                       WORK(IU) is N by N and WORK(IR) is N by N
-*
-                        LDWRKU = N
-                        IR = IU + LDWRKU*N
-                        LDWRKR = N
-                     END IF
-                     ITAU = IR + LDWRKR*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R
-*                    (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to WORK(IU), zeroing out below it
-*
-                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
-     $                            WORK( IU+1 ), LDWRKU )
-*
-*                    Generate Q in A
-*                    (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
-                     CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IU), copying result to
-*                    WORK(IR)
-*                    (Workspace: need 2*N*N+4*N,
-*                                prefer 2*N*N+3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU,
-     $                            WORK( IR ), LDWRKR )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IU)
-*                    (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB)
-*
-                     CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IR)
-*                    (Workspace: need 2*N*N+4*N-1,
-*                                prefer 2*N*N+3*N+(N-1)*NB)
-*
-                     CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IU) and computing
-*                    right singular vectors of R in WORK(IR)
-*                    (Workspace: need 2*N*N+BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ),
-     $                            WORK( IR ), LDWRKR, WORK( IU ),
-     $                            LDWRKU, DUM, 1, WORK( IWORK ), INFO )
-*
-*                    Multiply Q in A by left singular vectors of R in
-*                    WORK(IU), storing result in U
-*                    (Workspace: need N*N)
-*
-                     CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
-     $                           WORK( IU ), LDWRKU, ZERO, U, LDU )
-*
-*                    Copy right singular vectors of R to A
-*                    (Workspace: need N*N)
-*
-                     CALL DLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
-     $                            LDA )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (Workspace: need 2*N, prefer N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (Workspace: need 2*N, prefer N+N*NB)
-*
-                     CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Zero out below R in A
-*
-                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
-     $                            LDA )
-*
-*                    Bidiagonalize R in A
-*                    (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left vectors bidiagonalizing R
-*                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
-                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right vectors bidiagonalizing R in A
-*                    (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
-                     CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in A
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), A,
-     $                            LDA, U, LDU, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTVAS ) THEN
-*
-*                 Path 6 (M much larger than N, JOBU='S', JOBVT='S'
-*                         or 'A')
-*                 N left singular vectors to be computed in U and
-*                 N right singular vectors to be computed in VT
-*
-                  IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-*                       WORK(IU) is LDA by N
-*
-                        LDWRKU = LDA
-                     ELSE
-*
-*                       WORK(IU) is N by N
-*
-                        LDWRKU = N
-                     END IF
-                     ITAU = IU + LDWRKU*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R
-*                    (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to WORK(IU), zeroing out below it
-*
-                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
-     $                            WORK( IU+1 ), LDWRKU )
-*
-*                    Generate Q in A
-*                    (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
-                     CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IU), copying result to VT
-*                    (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
-     $                            LDVT )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IU)
-*                    (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
-                     CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in VT
-*                    (Workspace: need N*N+4*N-1,
-*                                prefer N*N+3*N+(N-1)*NB)
-*
-                     CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IU) and computing
-*                    right singular vectors of R in VT
-*                    (Workspace: need N*N+BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT,
-     $                            LDVT, WORK( IU ), LDWRKU, DUM, 1,
-     $                            WORK( IWORK ), INFO )
-*
-*                    Multiply Q in A by left singular vectors of R in
-*                    WORK(IU), storing result in U
-*                    (Workspace: need N*N)
-*
-                     CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
-     $                           WORK( IU ), LDWRKU, ZERO, U, LDU )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (Workspace: need 2*N, prefer N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (Workspace: need 2*N, prefer N+N*NB)
-*
-                     CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to VT, zeroing out below it
-*
-                     CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
-                     IF( N.GT.1 )
-     $                  CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
-     $                               VT( 2, 1 ), LDVT )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in VT
-*                    (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left bidiagonalizing vectors
-*                    in VT
-*                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
-                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in VT
-*                    (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
-                     CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in VT
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT,
-     $                            LDVT, U, LDU, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               END IF
-*
-            ELSE IF( WNTUA ) THEN
-*
-               IF( WNTVN ) THEN
-*
-*                 Path 7 (M much larger than N, JOBU='A', JOBVT='N')
-*                 M left singular vectors to be computed in U and
-*                 no right singular vectors to be computed
-*
-                  IF( LWORK.GE.N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IR = 1
-                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-*                       WORK(IR) is LDA by N
-*
-                        LDWRKR = LDA
-                     ELSE
-*
-*                       WORK(IR) is N by N
-*
-                        LDWRKR = N
-                     END IF
-                     ITAU = IR + LDWRKR*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Copy R to WORK(IR), zeroing out below it
-*
-                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ),
-     $                            LDWRKR )
-                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
-     $                            WORK( IR+1 ), LDWRKR )
-*
-*                    Generate Q in U
-*                    (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
-*
-                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IR)
-*                    (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IR)
-*                    (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
-                     CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IR)
-*                    (Workspace: need N*N+BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM,
-     $                            1, WORK( IR ), LDWRKR, DUM, 1,
-     $                            WORK( IWORK ), INFO )
-*
-*                    Multiply Q in U by left singular vectors of R in
-*                    WORK(IR), storing result in A
-*                    (Workspace: need N*N)
-*
-                     CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
-     $                           WORK( IR ), LDWRKR, ZERO, A, LDA )
-*
-*                    Copy left singular vectors of A from A to U
-*
-                     CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (Workspace: need 2*N, prefer N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (Workspace: need N+M, prefer N+M*NB)
-*
-                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Zero out below R in A
-*
-                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
-     $                            LDA )
-*
-*                    Bidiagonalize R in A
-*                    (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left bidiagonalizing vectors
-*                    in A
-*                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
-                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM,
-     $                            1, U, LDU, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTVO ) THEN
-*
-*                 Path 8 (M much larger than N, JOBU='A', JOBVT='O')
-*                 M left singular vectors to be computed in U and
-*                 N right singular vectors to be overwritten on A
-*
-                  IF( LWORK.GE.2*N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
-*
-*                       WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*N
-                        LDWRKR = LDA
-                     ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
-*
-*                       WORK(IU) is LDA by N and WORK(IR) is N by N
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*N
-                        LDWRKR = N
-                     ELSE
-*
-*                       WORK(IU) is N by N and WORK(IR) is N by N
-*
-                        LDWRKU = N
-                        IR = IU + LDWRKU*N
-                        LDWRKR = N
-                     END IF
-                     ITAU = IR + LDWRKR*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (Workspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB)
-*
-                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to WORK(IU), zeroing out below it
-*
-                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
-     $                            WORK( IU+1 ), LDWRKU )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IU), copying result to
-*                    WORK(IR)
-*                    (Workspace: need 2*N*N+4*N,
-*                                prefer 2*N*N+3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU,
-     $                            WORK( IR ), LDWRKR )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IU)
-*                    (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB)
-*
-                     CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IR)
-*                    (Workspace: need 2*N*N+4*N-1,
-*                                prefer 2*N*N+3*N+(N-1)*NB)
-*
-                     CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IU) and computing
-*                    right singular vectors of R in WORK(IR)
-*                    (Workspace: need 2*N*N+BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ),
-     $                            WORK( IR ), LDWRKR, WORK( IU ),
-     $                            LDWRKU, DUM, 1, WORK( IWORK ), INFO )
-*
-*                    Multiply Q in U by left singular vectors of R in
-*                    WORK(IU), storing result in A
-*                    (Workspace: need N*N)
-*
-                     CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
-     $                           WORK( IU ), LDWRKU, ZERO, A, LDA )
-*
-*                    Copy left singular vectors of A from A to U
-*
-                     CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
-*
-*                    Copy right singular vectors of R from WORK(IR) to A
-*
-                     CALL DLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
-     $                            LDA )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (Workspace: need 2*N, prefer N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (Workspace: need N+M, prefer N+M*NB)
-*
-                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Zero out below R in A
-*
-                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
-     $                            LDA )
-*
-*                    Bidiagonalize R in A
-*                    (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left bidiagonalizing vectors
-*                    in A
-*                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
-                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in A
-*                    (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
-                     CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in A
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), A,
-     $                            LDA, U, LDU, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTVAS ) THEN
-*
-*                 Path 9 (M much larger than N, JOBU='A', JOBVT='S'
-*                         or 'A')
-*                 M left singular vectors to be computed in U and
-*                 N right singular vectors to be computed in VT
-*
-                  IF( LWORK.GE.N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-*                       WORK(IU) is LDA by N
-*
-                        LDWRKU = LDA
-                     ELSE
-*
-*                       WORK(IU) is N by N
-*
-                        LDWRKU = N
-                     END IF
-                     ITAU = IU + LDWRKU*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
-*
-                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to WORK(IU), zeroing out below it
-*
-                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
-     $                            WORK( IU+1 ), LDWRKU )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IU), copying result to VT
-*                    (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
-     $                            LDVT )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IU)
-*                    (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
-*
-                     CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in VT
-*                    (Workspace: need N*N+4*N-1,
-*                                prefer N*N+3*N+(N-1)*NB)
-*
-                     CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IU) and computing
-*                    right singular vectors of R in VT
-*                    (Workspace: need N*N+BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT,
-     $                            LDVT, WORK( IU ), LDWRKU, DUM, 1,
-     $                            WORK( IWORK ), INFO )
-*
-*                    Multiply Q in U by left singular vectors of R in
-*                    WORK(IU), storing result in A
-*                    (Workspace: need N*N)
-*
-                     CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
-     $                           WORK( IU ), LDWRKU, ZERO, A, LDA )
-*
-*                    Copy left singular vectors of A from A to U
-*
-                     CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (Workspace: need 2*N, prefer N+N*NB)
-*
-                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (Workspace: need N+M, prefer N+M*NB)
-*
-                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R from A to VT, zeroing out below it
-*
-                     CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
-                     IF( N.GT.1 )
-     $                  CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
-     $                               VT( 2, 1 ), LDVT )
-                     IE = ITAU
-                     ITAUQ = IE + N
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in VT
-*                    (Workspace: need 4*N, prefer 3*N+2*N*NB)
-*
-                     CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left bidiagonalizing vectors
-*                    in VT
-*                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
-*
-                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in VT
-*                    (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
-                     CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in VT
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT,
-     $                            LDVT, U, LDU, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               END IF
-*
-            END IF
-*
-         ELSE
-*
-*           M .LT. MNTHR
-*
-*           Path 10 (M at least N, but not much larger)
-*           Reduce to bidiagonal form without QR decomposition
-*
-            IE = 1
-            ITAUQ = IE + N
-            ITAUP = ITAUQ + N
-            IWORK = ITAUP + N
-*
-*           Bidiagonalize A
-*           (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
-*
-            CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
-     $                   WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
-     $                   IERR )
-            IF( WNTUAS ) THEN
-*
-*              If left singular vectors desired in U, copy result to U
-*              and generate left bidiagonalizing vectors in U
-*              (Workspace: need 3*N+NCU, prefer 3*N+NCU*NB)
-*
-               CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
-               IF( WNTUS )
-     $            NCU = N
-               IF( WNTUA )
-     $            NCU = M
-               CALL DORGBR( 'Q', M, NCU, N, U, LDU, WORK( ITAUQ ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTVAS ) THEN
-*
-*              If right singular vectors desired in VT, copy result to
-*              VT and generate right bidiagonalizing vectors in VT
-*              (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
-               CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
-               CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTUO ) THEN
-*
-*              If left singular vectors desired in A, generate left
-*              bidiagonalizing vectors in A
-*              (Workspace: need 4*N, prefer 3*N+N*NB)
-*
-               CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTVO ) THEN
-*
-*              If right singular vectors desired in A, generate right
-*              bidiagonalizing vectors in A
-*              (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
-*
-               CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IWORK = IE + N
-            IF( WNTUAS .OR. WNTUO )
-     $         NRU = M
-            IF( WNTUN )
-     $         NRU = 0
-            IF( WNTVAS .OR. WNTVO )
-     $         NCVT = N
-            IF( WNTVN )
-     $         NCVT = 0
-            IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in U and computing right singular
-*              vectors in VT
-*              (Workspace: need BDSPAC)
-*
-               CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), VT,
-     $                      LDVT, U, LDU, DUM, 1, WORK( IWORK ), INFO )
-            ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in U and computing right singular
-*              vectors in A
-*              (Workspace: need BDSPAC)
-*
-               CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), A, LDA,
-     $                      U, LDU, DUM, 1, WORK( IWORK ), INFO )
-            ELSE
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in A and computing right singular
-*              vectors in VT
-*              (Workspace: need BDSPAC)
-*
-               CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), VT,
-     $                      LDVT, A, LDA, DUM, 1, WORK( IWORK ), INFO )
-            END IF
-*
-         END IF
-*
-      ELSE
-*
-*        A has more columns than rows. If A has sufficiently more
-*        columns than rows, first reduce using the LQ decomposition (if
-*        sufficient workspace available)
-*
-         IF( N.GE.MNTHR ) THEN
-*
-            IF( WNTVN ) THEN
-*
-*              Path 1t(N much larger than M, JOBVT='N')
-*              No right singular vectors to be computed
-*
-               ITAU = 1
-               IWORK = ITAU + M
-*
-*              Compute A=L*Q
-*              (Workspace: need 2*M, prefer M+M*NB)
-*
-               CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
-     $                      LWORK-IWORK+1, IERR )
-*
-*              Zero out above L
-*
-               CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA )
-               IE = 1
-               ITAUQ = IE + M
-               ITAUP = ITAUQ + M
-               IWORK = ITAUP + M
-*
-*              Bidiagonalize L in A
-*              (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
-               CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
-     $                      WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
-     $                      IERR )
-               IF( WNTUO .OR. WNTUAS ) THEN
-*
-*                 If left singular vectors desired, generate Q
-*                 (Workspace: need 4*M, prefer 3*M+M*NB)
-*
-                  CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-               END IF
-               IWORK = IE + M
-               NRU = 0
-               IF( WNTUO .OR. WNTUAS )
-     $            NRU = M
-*
-*              Perform bidiagonal QR iteration, computing left singular
-*              vectors of A in A if desired
-*              (Workspace: need BDSPAC)
-*
-               CALL DBDSQR( 'U', M, 0, NRU, 0, S, WORK( IE ), DUM, 1, A,
-     $                      LDA, DUM, 1, WORK( IWORK ), INFO )
-*
-*              If left singular vectors desired in U, copy them there
-*
-               IF( WNTUAS )
-     $            CALL DLACPY( 'F', M, M, A, LDA, U, LDU )
-*
-            ELSE IF( WNTVO .AND. WNTUN ) THEN
-*
-*              Path 2t(N much larger than M, JOBU='N', JOBVT='O')
-*              M right singular vectors to be overwritten on A and
-*              no left singular vectors to be computed
-*
-               IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-*                 Sufficient workspace for a fast algorithm
-*
-                  IR = 1
-                  IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is LDA by M
-*
-                     LDWRKU = LDA
-                     CHUNK = N
-                     LDWRKR = LDA
-                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is M by M
-*
-                     LDWRKU = LDA
-                     CHUNK = N
-                     LDWRKR = M
-                  ELSE
-*
-*                    WORK(IU) is M by CHUNK and WORK(IR) is M by M
-*
-                     LDWRKU = M
-                     CHUNK = ( LWORK-M*M-M ) / M
-                     LDWRKR = M
-                  END IF
-                  ITAU = IR + LDWRKR*M
-                  IWORK = ITAU + M
-*
-*                 Compute A=L*Q
-*                 (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
-                  CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy L to WORK(IR) and zero out above it
-*
-                  CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR )
-                  CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
-     $                         WORK( IR+LDWRKR ), LDWRKR )
-*
-*                 Generate Q in A
-*                 (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
-                  CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = ITAU
-                  ITAUQ = IE + M
-                  ITAUP = ITAUQ + M
-                  IWORK = ITAUP + M
-*
-*                 Bidiagonalize L in WORK(IR)
-*                 (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
-                  CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, WORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Generate right vectors bidiagonalizing L
-*                 (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB)
-*
-                  CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
-     $                         WORK( ITAUP ), WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-                  IWORK = IE + M
-*
-*                 Perform bidiagonal QR iteration, computing right
-*                 singular vectors of L in WORK(IR)
-*                 (Workspace: need M*M+BDSPAC)
-*
-                  CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
-     $                         WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
-     $                         WORK( IWORK ), INFO )
-                  IU = IE + M
-*
-*                 Multiply right singular vectors of L in WORK(IR) by Q
-*                 in A, storing result in WORK(IU) and copying to A
-*                 (Workspace: need M*M+2*M, prefer M*M+M*N+M)
-*
-                  DO 30 I = 1, N, CHUNK
-                     BLK = MIN( N-I+1, CHUNK )
-                     CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ),
-     $                           LDWRKR, A( 1, I ), LDA, ZERO,
-     $                           WORK( IU ), LDWRKU )
-                     CALL DLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
-     $                            A( 1, I ), LDA )
-   30             CONTINUE
-*
-               ELSE
-*
-*                 Insufficient workspace for a fast algorithm
-*
-                  IE = 1
-                  ITAUQ = IE + M
-                  ITAUP = ITAUQ + M
-                  IWORK = ITAUP + M
-*
-*                 Bidiagonalize A
-*                 (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
-                  CALL DGEBRD( M, N, A, LDA, S, WORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Generate right vectors bidiagonalizing A
-*                 (Workspace: need 4*M, prefer 3*M+M*NB)
-*
-                  CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IWORK = IE + M
-*
-*                 Perform bidiagonal QR iteration, computing right
-*                 singular vectors of A in A
-*                 (Workspace: need BDSPAC)
-*
-                  CALL DBDSQR( 'L', M, N, 0, 0, S, WORK( IE ), A, LDA,
-     $                         DUM, 1, DUM, 1, WORK( IWORK ), INFO )
-*
-               END IF
-*
-            ELSE IF( WNTVO .AND. WNTUAS ) THEN
-*
-*              Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O')
-*              M right singular vectors to be overwritten on A and
-*              M left singular vectors to be computed in U
-*
-               IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-*                 Sufficient workspace for a fast algorithm
-*
-                  IR = 1
-                  IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is LDA by M
-*
-                     LDWRKU = LDA
-                     CHUNK = N
-                     LDWRKR = LDA
-                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is M by M
-*
-                     LDWRKU = LDA
-                     CHUNK = N
-                     LDWRKR = M
-                  ELSE
-*
-*                    WORK(IU) is M by CHUNK and WORK(IR) is M by M
-*
-                     LDWRKU = M
-                     CHUNK = ( LWORK-M*M-M ) / M
-                     LDWRKR = M
-                  END IF
-                  ITAU = IR + LDWRKR*M
-                  IWORK = ITAU + M
-*
-*                 Compute A=L*Q
-*                 (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
-                  CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy L to U, zeroing about above it
-*
-                  CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
-                  CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
-     $                         LDU )
-*
-*                 Generate Q in A
-*                 (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
-                  CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = ITAU
-                  ITAUQ = IE + M
-                  ITAUP = ITAUQ + M
-                  IWORK = ITAUP + M
-*
-*                 Bidiagonalize L in U, copying result to WORK(IR)
-*                 (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
-                  CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  CALL DLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR )
-*
-*                 Generate right vectors bidiagonalizing L in WORK(IR)
-*                 (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB)
-*
-                  CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
-     $                         WORK( ITAUP ), WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-*
-*                 Generate left vectors bidiagonalizing L in U
-*                 (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
-                  CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IWORK = IE + M
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of L in U, and computing right
-*                 singular vectors of L in WORK(IR)
-*                 (Workspace: need M*M+BDSPAC)
-*
-                  CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
-     $                         WORK( IR ), LDWRKR, U, LDU, DUM, 1,
-     $                         WORK( IWORK ), INFO )
-                  IU = IE + M
-*
-*                 Multiply right singular vectors of L in WORK(IR) by Q
-*                 in A, storing result in WORK(IU) and copying to A
-*                 (Workspace: need M*M+2*M, prefer M*M+M*N+M))
-*
-                  DO 40 I = 1, N, CHUNK
-                     BLK = MIN( N-I+1, CHUNK )
-                     CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ),
-     $                           LDWRKR, A( 1, I ), LDA, ZERO,
-     $                           WORK( IU ), LDWRKU )
-                     CALL DLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
-     $                            A( 1, I ), LDA )
-   40             CONTINUE
-*
-               ELSE
-*
-*                 Insufficient workspace for a fast algorithm
-*
-                  ITAU = 1
-                  IWORK = ITAU + M
-*
-*                 Compute A=L*Q
-*                 (Workspace: need 2*M, prefer M+M*NB)
-*
-                  CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy L to U, zeroing out above it
-*
-                  CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
-                  CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
-     $                         LDU )
-*
-*                 Generate Q in A
-*                 (Workspace: need 2*M, prefer M+M*NB)
-*
-                  CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = ITAU
-                  ITAUQ = IE + M
-                  ITAUP = ITAUQ + M
-                  IWORK = ITAUP + M
-*
-*                 Bidiagonalize L in U
-*                 (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
-                  CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Multiply right vectors bidiagonalizing L by Q in A
-*                 (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
-                  CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
-     $                         WORK( ITAUP ), A, LDA, WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-*
-*                 Generate left vectors bidiagonalizing L in U
-*                 (Workspace: need 4*M, prefer 3*M+M*NB)
-*
-                  CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IWORK = IE + M
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of A in U and computing right
-*                 singular vectors of A in A
-*                 (Workspace: need BDSPAC)
-*
-                  CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), A, LDA,
-     $                         U, LDU, DUM, 1, WORK( IWORK ), INFO )
-*
-               END IF
-*
-            ELSE IF( WNTVS ) THEN
-*
-               IF( WNTUN ) THEN
-*
-*                 Path 4t(N much larger than M, JOBU='N', JOBVT='S')
-*                 M right singular vectors to be computed in VT and
-*                 no left singular vectors to be computed
-*
-                  IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IR = 1
-                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-*                       WORK(IR) is LDA by M
-*
-                        LDWRKR = LDA
-                     ELSE
-*
-*                       WORK(IR) is M by M
-*
-                        LDWRKR = M
-                     END IF
-                     ITAU = IR + LDWRKR*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q
-*                    (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to WORK(IR), zeroing out above it
-*
-                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ),
-     $                            LDWRKR )
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
-     $                            WORK( IR+LDWRKR ), LDWRKR )
-*
-*                    Generate Q in A
-*                    (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
-                     CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IR)
-*                    (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right vectors bidiagonalizing L in
-*                    WORK(IR)
-*                    (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
-*
-                     CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing right
-*                    singular vectors of L in WORK(IR)
-*                    (Workspace: need M*M+BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
-     $                            WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
-     $                            WORK( IWORK ), INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IR) by
-*                    Q in A, storing result in VT
-*                    (Workspace: need M*M)
-*
-                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IR ),
-     $                           LDWRKR, A, LDA, ZERO, VT, LDVT )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q
-*                    (Workspace: need 2*M, prefer M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy result to VT
-*
-                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (Workspace: need 2*M, prefer M+M*NB)
-*
-                     CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Zero out above L in A
-*
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
-     $                            LDA )
-*
-*                    Bidiagonalize L in A
-*                    (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right vectors bidiagonalizing L by Q in VT
-*                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
-                     CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing right
-*                    singular vectors of A in VT
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, N, 0, 0, S, WORK( IE ), VT,
-     $                            LDVT, DUM, 1, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTUO ) THEN
-*
-*                 Path 5t(N much larger than M, JOBU='O', JOBVT='S')
-*                 M right singular vectors to be computed in VT and
-*                 M left singular vectors to be overwritten on A
-*
-                  IF( LWORK.GE.2*M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
-*
-*                       WORK(IU) is LDA by M and WORK(IR) is LDA by M
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*M
-                        LDWRKR = LDA
-                     ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
-*
-*                       WORK(IU) is LDA by M and WORK(IR) is M by M
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*M
-                        LDWRKR = M
-                     ELSE
-*
-*                       WORK(IU) is M by M and WORK(IR) is M by M
-*
-                        LDWRKU = M
-                        IR = IU + LDWRKU*M
-                        LDWRKR = M
-                     END IF
-                     ITAU = IR + LDWRKR*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q
-*                    (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to WORK(IU), zeroing out below it
-*
-                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
-     $                            WORK( IU+LDWRKU ), LDWRKU )
-*
-*                    Generate Q in A
-*                    (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
-                     CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IU), copying result to
-*                    WORK(IR)
-*                    (Workspace: need 2*M*M+4*M,
-*                                prefer 2*M*M+3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU,
-     $                            WORK( IR ), LDWRKR )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IU)
-*                    (Workspace: need 2*M*M+4*M-1,
-*                                prefer 2*M*M+3*M+(M-1)*NB)
-*
-                     CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IR)
-*                    (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
-*
-                     CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of L in WORK(IR) and computing
-*                    right singular vectors of L in WORK(IU)
-*                    (Workspace: need 2*M*M+BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
-     $                            WORK( IU ), LDWRKU, WORK( IR ),
-     $                            LDWRKR, DUM, 1, WORK( IWORK ), INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IU) by
-*                    Q in A, storing result in VT
-*                    (Workspace: need M*M)
-*
-                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
-     $                           LDWRKU, A, LDA, ZERO, VT, LDVT )
-*
-*                    Copy left singular vectors of L to A
-*                    (Workspace: need M*M)
-*
-                     CALL DLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
-     $                            LDA )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (Workspace: need 2*M, prefer M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (Workspace: need 2*M, prefer M+M*NB)
-*
-                     CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Zero out above L in A
-*
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
-     $                            LDA )
-*
-*                    Bidiagonalize L in A
-*                    (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right vectors bidiagonalizing L by Q in VT
-*                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
-                     CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors of L in A
-*                    (Workspace: need 4*M, prefer 3*M+M*NB)
-*
-                     CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, compute left
-*                    singular vectors of A in A and compute right
-*                    singular vectors of A in VT
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
-     $                            LDVT, A, LDA, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTUAS ) THEN
-*
-*                 Path 6t(N much larger than M, JOBU='S' or 'A',
-*                         JOBVT='S')
-*                 M right singular vectors to be computed in VT and
-*                 M left singular vectors to be computed in U
-*
-                  IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-*                       WORK(IU) is LDA by N
-*
-                        LDWRKU = LDA
-                     ELSE
-*
-*                       WORK(IU) is LDA by M
-*
-                        LDWRKU = M
-                     END IF
-                     ITAU = IU + LDWRKU*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q
-*                    (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to WORK(IU), zeroing out above it
-*
-                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
-     $                            WORK( IU+LDWRKU ), LDWRKU )
-*
-*                    Generate Q in A
-*                    (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
-                     CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IU), copying result to U
-*                    (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
-     $                            LDU )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IU)
-*                    (Workspace: need M*M+4*M-1,
-*                                prefer M*M+3*M+(M-1)*NB)
-*
-                     CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in U
-*                    (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
-                     CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of L in U and computing right
-*                    singular vectors of L in WORK(IU)
-*                    (Workspace: need M*M+BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
-     $                            WORK( IU ), LDWRKU, U, LDU, DUM, 1,
-     $                            WORK( IWORK ), INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IU) by
-*                    Q in A, storing result in VT
-*                    (Workspace: need M*M)
-*
-                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
-     $                           LDWRKU, A, LDA, ZERO, VT, LDVT )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (Workspace: need 2*M, prefer M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (Workspace: need 2*M, prefer M+M*NB)
-*
-                     CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to U, zeroing out above it
-*
-                     CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
-     $                            LDU )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in U
-*                    (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right bidiagonalizing vectors in U by Q
-*                    in VT
-*                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
-                     CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in U
-*                    (Workspace: need 4*M, prefer 3*M+M*NB)
-*
-                     CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in VT
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
-     $                            LDVT, U, LDU, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               END IF
-*
-            ELSE IF( WNTVA ) THEN
-*
-               IF( WNTUN ) THEN
-*
-*                 Path 7t(N much larger than M, JOBU='N', JOBVT='A')
-*                 N right singular vectors to be computed in VT and
-*                 no left singular vectors to be computed
-*
-                  IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IR = 1
-                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-*                       WORK(IR) is LDA by M
-*
-                        LDWRKR = LDA
-                     ELSE
-*
-*                       WORK(IR) is M by M
-*
-                        LDWRKR = M
-                     END IF
-                     ITAU = IR + LDWRKR*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Copy L to WORK(IR), zeroing out above it
-*
-                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ),
-     $                            LDWRKR )
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
-     $                            WORK( IR+LDWRKR ), LDWRKR )
-*
-*                    Generate Q in VT
-*                    (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
-*
-                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IR)
-*                    (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IR)
-*                    (Workspace: need M*M+4*M-1,
-*                                prefer M*M+3*M+(M-1)*NB)
-*
-                     CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing right
-*                    singular vectors of L in WORK(IR)
-*                    (Workspace: need M*M+BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
-     $                            WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
-     $                            WORK( IWORK ), INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IR) by
-*                    Q in VT, storing result in A
-*                    (Workspace: need M*M)
-*
-                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IR ),
-     $                           LDWRKR, VT, LDVT, ZERO, A, LDA )
-*
-*                    Copy right singular vectors of A from A to VT
-*
-                     CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (Workspace: need 2*M, prefer M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (Workspace: need M+N, prefer M+N*NB)
-*
-                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Zero out above L in A
-*
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
-     $                            LDA )
-*
-*                    Bidiagonalize L in A
-*                    (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right bidiagonalizing vectors in A by Q
-*                    in VT
-*                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
-                     CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing right
-*                    singular vectors of A in VT
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, N, 0, 0, S, WORK( IE ), VT,
-     $                            LDVT, DUM, 1, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTUO ) THEN
-*
-*                 Path 8t(N much larger than M, JOBU='O', JOBVT='A')
-*                 N right singular vectors to be computed in VT and
-*                 M left singular vectors to be overwritten on A
-*
-                  IF( LWORK.GE.2*M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
-*
-*                       WORK(IU) is LDA by M and WORK(IR) is LDA by M
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*M
-                        LDWRKR = LDA
-                     ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
-*
-*                       WORK(IU) is LDA by M and WORK(IR) is M by M
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*M
-                        LDWRKR = M
-                     ELSE
-*
-*                       WORK(IU) is M by M and WORK(IR) is M by M
-*
-                        LDWRKU = M
-                        IR = IU + LDWRKU*M
-                        LDWRKR = M
-                     END IF
-                     ITAU = IR + LDWRKR*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (Workspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB)
-*
-                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to WORK(IU), zeroing out above it
-*
-                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
-     $                            WORK( IU+LDWRKU ), LDWRKU )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IU), copying result to
-*                    WORK(IR)
-*                    (Workspace: need 2*M*M+4*M,
-*                                prefer 2*M*M+3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU,
-     $                            WORK( IR ), LDWRKR )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IU)
-*                    (Workspace: need 2*M*M+4*M-1,
-*                                prefer 2*M*M+3*M+(M-1)*NB)
-*
-                     CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IR)
-*                    (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
-*
-                     CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of L in WORK(IR) and computing
-*                    right singular vectors of L in WORK(IU)
-*                    (Workspace: need 2*M*M+BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
-     $                            WORK( IU ), LDWRKU, WORK( IR ),
-     $                            LDWRKR, DUM, 1, WORK( IWORK ), INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IU) by
-*                    Q in VT, storing result in A
-*                    (Workspace: need M*M)
-*
-                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
-     $                           LDWRKU, VT, LDVT, ZERO, A, LDA )
-*
-*                    Copy right singular vectors of A from A to VT
-*
-                     CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
-*                    Copy left singular vectors of A from WORK(IR) to A
-*
-                     CALL DLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
-     $                            LDA )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (Workspace: need 2*M, prefer M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (Workspace: need M+N, prefer M+N*NB)
-*
-                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Zero out above L in A
-*
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
-     $                            LDA )
-*
-*                    Bidiagonalize L in A
-*                    (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right bidiagonalizing vectors in A by Q
-*                    in VT
-*                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
-                     CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in A
-*                    (Workspace: need 4*M, prefer 3*M+M*NB)
-*
-                     CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in A and computing right
-*                    singular vectors of A in VT
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
-     $                            LDVT, A, LDA, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTUAS ) THEN
-*
-*                 Path 9t(N much larger than M, JOBU='S' or 'A',
-*                         JOBVT='A')
-*                 N right singular vectors to be computed in VT and
-*                 M left singular vectors to be computed in U
-*
-                  IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-*                       WORK(IU) is LDA by M
-*
-                        LDWRKU = LDA
-                     ELSE
-*
-*                       WORK(IU) is M by M
-*
-                        LDWRKU = M
-                     END IF
-                     ITAU = IU + LDWRKU*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
-*
-                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to WORK(IU), zeroing out above it
-*
-                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
-     $                            WORK( IU+LDWRKU ), LDWRKU )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IU), copying result to U
-*                    (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
-     $                            WORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
-     $                            LDU )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IU)
-*                    (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
-*
-                     CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in U
-*                    (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
-*
-                     CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of L in U and computing right
-*                    singular vectors of L in WORK(IU)
-*                    (Workspace: need M*M+BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
-     $                            WORK( IU ), LDWRKU, U, LDU, DUM, 1,
-     $                            WORK( IWORK ), INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IU) by
-*                    Q in VT, storing result in A
-*                    (Workspace: need M*M)
-*
-                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
-     $                           LDWRKU, VT, LDVT, ZERO, A, LDA )
-*
-*                    Copy right singular vectors of A from A to VT
-*
-                     CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (Workspace: need 2*M, prefer M+M*NB)
-*
-                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (Workspace: need M+N, prefer M+N*NB)
-*
-                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to U, zeroing out above it
-*
-                     CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
-                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
-     $                            LDU )
-                     IE = ITAU
-                     ITAUQ = IE + M
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in U
-*                    (Workspace: need 4*M, prefer 3*M+2*M*NB)
-*
-                     CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right bidiagonalizing vectors in U by Q
-*                    in VT
-*                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
-*
-                     CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in U
-*                    (Workspace: need 4*M, prefer 3*M+M*NB)
-*
-                     CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in VT
-*                    (Workspace: need BDSPAC)
-*
-                     CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
-     $                            LDVT, U, LDU, DUM, 1, WORK( IWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               END IF
-*
-            END IF
-*
-         ELSE
-*
-*           N .LT. MNTHR
-*
-*           Path 10t(N greater than M, but not much larger)
-*           Reduce to bidiagonal form without LQ decomposition
-*
-            IE = 1
-            ITAUQ = IE + M
-            ITAUP = ITAUQ + M
-            IWORK = ITAUP + M
-*
-*           Bidiagonalize A
-*           (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
-*
-            CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
-     $                   WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
-     $                   IERR )
-            IF( WNTUAS ) THEN
-*
-*              If left singular vectors desired in U, copy result to U
-*              and generate left bidiagonalizing vectors in U
-*              (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB)
-*
-               CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
-               CALL DORGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTVAS ) THEN
-*
-*              If right singular vectors desired in VT, copy result to
-*              VT and generate right bidiagonalizing vectors in VT
-*              (Workspace: need 3*M+NRVT, prefer 3*M+NRVT*NB)
-*
-               CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
-               IF( WNTVA )
-     $            NRVT = N
-               IF( WNTVS )
-     $            NRVT = M
-               CALL DORGBR( 'P', NRVT, N, M, VT, LDVT, WORK( ITAUP ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTUO ) THEN
-*
-*              If left singular vectors desired in A, generate left
-*              bidiagonalizing vectors in A
-*              (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB)
-*
-               CALL DORGBR( 'Q', M, M, N, A, LDA, WORK( ITAUQ ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTVO ) THEN
-*
-*              If right singular vectors desired in A, generate right
-*              bidiagonalizing vectors in A
-*              (Workspace: need 4*M, prefer 3*M+M*NB)
-*
-               CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IWORK = IE + M
-            IF( WNTUAS .OR. WNTUO )
-     $         NRU = M
-            IF( WNTUN )
-     $         NRU = 0
-            IF( WNTVAS .OR. WNTVO )
-     $         NCVT = N
-            IF( WNTVN )
-     $         NCVT = 0
-            IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in U and computing right singular
-*              vectors in VT
-*              (Workspace: need BDSPAC)
-*
-               CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), VT,
-     $                      LDVT, U, LDU, DUM, 1, WORK( IWORK ), INFO )
-            ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in U and computing right singular
-*              vectors in A
-*              (Workspace: need BDSPAC)
-*
-               CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), A, LDA,
-     $                      U, LDU, DUM, 1, WORK( IWORK ), INFO )
-            ELSE
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in A and computing right singular
-*              vectors in VT
-*              (Workspace: need BDSPAC)
-*
-               CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), VT,
-     $                      LDVT, A, LDA, DUM, 1, WORK( IWORK ), INFO )
-            END IF
-*
-         END IF
-*
-      END IF
-*
-*     If DBDSQR failed to converge, copy unconverged superdiagonals
-*     to WORK( 2:MINMN )
-*
-      IF( INFO.NE.0 ) THEN
-         IF( IE.GT.2 ) THEN
-            DO 50 I = 1, MINMN - 1
-               WORK( I+1 ) = WORK( I+IE-1 )
-   50       CONTINUE
-         END IF
-         IF( IE.LT.2 ) THEN
-            DO 60 I = MINMN - 1, 1, -1
-               WORK( I+1 ) = WORK( I+IE-1 )
-   60       CONTINUE
-         END IF
-      END IF
-*
-*     Undo scaling if necessary
-*
-      IF( ISCL.EQ.1 ) THEN
-         IF( ANRM.GT.BIGNUM )
-     $      CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
-     $                   IERR )
-         IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
-     $      CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, WORK( 2 ),
-     $                   MINMN, IERR )
-         IF( ANRM.LT.SMLNUM )
-     $      CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
-     $                   IERR )
-         IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
-     $      CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, WORK( 2 ),
-     $                   MINMN, IERR )
-      END IF
-*
-*     Return optimal workspace in WORK(1)
-*
-      WORK( 1 ) = MAXWRK
-*
-      RETURN
-*
-*     End of DGESVD
-*
-      END
diff --git a/src/lib/lapack/dgesvx.f b/src/lib/lapack/dgesvx.f
deleted file mode 100644
index 0645a20c..00000000
--- a/src/lib/lapack/dgesvx.f
+++ /dev/null
@@ -1,479 +0,0 @@
-      SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
-     $                   EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR,
-     $                   WORK, IWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          EQUED, FACT, TRANS
-      INTEGER            INFO, LDA, LDAF, LDB, LDX, N, NRHS
-      DOUBLE PRECISION   RCOND
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * ), IWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
-     $                   BERR( * ), C( * ), FERR( * ), R( * ),
-     $                   WORK( * ), X( LDX, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGESVX uses the LU factorization to compute the solution to a real
-*  system of linear equations
-*     A * X = B,
-*  where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
-*
-*  Error bounds on the solution and a condition estimate are also
-*  provided.
-*
-*  Description
-*  ===========
-*
-*  The following steps are performed:
-*
-*  1. If FACT = 'E', real scaling factors are computed to equilibrate
-*     the system:
-*        TRANS = 'N':  diag(R)*A*diag(C)     *inv(diag(C))*X = diag(R)*B
-*        TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
-*        TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
-*     Whether or not the system will be equilibrated depends on the
-*     scaling of the matrix A, but if equilibration is used, A is
-*     overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N')
-*     or diag(C)*B (if TRANS = 'T' or 'C').
-*
-*  2. If FACT = 'N' or 'E', the LU decomposition is used to factor the
-*     matrix A (after equilibration if FACT = 'E') as
-*        A = P * L * U,
-*     where P is a permutation matrix, L is a unit lower triangular
-*     matrix, and U is upper triangular.
-*
-*  3. If some U(i,i)=0, so that U is exactly singular, then the routine
-*     returns with INFO = i. Otherwise, the factored form of A is used
-*     to estimate the condition number of the matrix A.  If the
-*     reciprocal of the condition number is less than machine precision,
-*     INFO = N+1 is returned as a warning, but the routine still goes on
-*     to solve for X and compute error bounds as described below.
-*
-*  4. The system of equations is solved for X using the factored form
-*     of A.
-*
-*  5. Iterative refinement is applied to improve the computed solution
-*     matrix and calculate error bounds and backward error estimates
-*     for it.
-*
-*  6. If equilibration was used, the matrix X is premultiplied by
-*     diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so
-*     that it solves the original system before equilibration.
-*
-*  Arguments
-*  =========
-*
-*  FACT    (input) CHARACTER*1
-*          Specifies whether or not the factored form of the matrix A is
-*          supplied on entry, and if not, whether the matrix A should be
-*          equilibrated before it is factored.
-*          = 'F':  On entry, AF and IPIV contain the factored form of A.
-*                  If EQUED is not 'N', the matrix A has been
-*                  equilibrated with scaling factors given by R and C.
-*                  A, AF, and IPIV are not modified.
-*          = 'N':  The matrix A will be copied to AF and factored.
-*          = 'E':  The matrix A will be equilibrated if necessary, then
-*                  copied to AF and factored.
-*
-*  TRANS   (input) CHARACTER*1
-*          Specifies the form of the system of equations:
-*          = 'N':  A * X = B     (No transpose)
-*          = 'T':  A**T * X = B  (Transpose)
-*          = 'C':  A**H * X = B  (Transpose)
-*
-*  N       (input) INTEGER
-*          The number of linear equations, i.e., the order of the
-*          matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of columns
-*          of the matrices B and X.  NRHS >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the N-by-N matrix A.  If FACT = 'F' and EQUED is
-*          not 'N', then A must have been equilibrated by the scaling
-*          factors in R and/or C.  A is not modified if FACT = 'F' or
-*          'N', or if FACT = 'E' and EQUED = 'N' on exit.
-*
-*          On exit, if EQUED .ne. 'N', A is scaled as follows:
-*          EQUED = 'R':  A := diag(R) * A
-*          EQUED = 'C':  A := A * diag(C)
-*          EQUED = 'B':  A := diag(R) * A * diag(C).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  AF      (input or output) DOUBLE PRECISION array, dimension (LDAF,N)
-*          If FACT = 'F', then AF is an input argument and on entry
-*          contains the factors L and U from the factorization
-*          A = P*L*U as computed by DGETRF.  If EQUED .ne. 'N', then
-*          AF is the factored form of the equilibrated matrix A.
-*
-*          If FACT = 'N', then AF is an output argument and on exit
-*          returns the factors L and U from the factorization A = P*L*U
-*          of the original matrix A.
-*
-*          If FACT = 'E', then AF is an output argument and on exit
-*          returns the factors L and U from the factorization A = P*L*U
-*          of the equilibrated matrix A (see the description of A for
-*          the form of the equilibrated matrix).
-*
-*  LDAF    (input) INTEGER
-*          The leading dimension of the array AF.  LDAF >= max(1,N).
-*
-*  IPIV    (input or output) INTEGER array, dimension (N)
-*          If FACT = 'F', then IPIV is an input argument and on entry
-*          contains the pivot indices from the factorization A = P*L*U
-*          as computed by DGETRF; row i of the matrix was interchanged
-*          with row IPIV(i).
-*
-*          If FACT = 'N', then IPIV is an output argument and on exit
-*          contains the pivot indices from the factorization A = P*L*U
-*          of the original matrix A.
-*
-*          If FACT = 'E', then IPIV is an output argument and on exit
-*          contains the pivot indices from the factorization A = P*L*U
-*          of the equilibrated matrix A.
-*
-*  EQUED   (input or output) CHARACTER*1
-*          Specifies the form of equilibration that was done.
-*          = 'N':  No equilibration (always true if FACT = 'N').
-*          = 'R':  Row equilibration, i.e., A has been premultiplied by
-*                  diag(R).
-*          = 'C':  Column equilibration, i.e., A has been postmultiplied
-*                  by diag(C).
-*          = 'B':  Both row and column equilibration, i.e., A has been
-*                  replaced by diag(R) * A * diag(C).
-*          EQUED is an input argument if FACT = 'F'; otherwise, it is an
-*          output argument.
-*
-*  R       (input or output) DOUBLE PRECISION array, dimension (N)
-*          The row scale factors for A.  If EQUED = 'R' or 'B', A is
-*          multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
-*          is not accessed.  R is an input argument if FACT = 'F';
-*          otherwise, R is an output argument.  If FACT = 'F' and
-*          EQUED = 'R' or 'B', each element of R must be positive.
-*
-*  C       (input or output) DOUBLE PRECISION array, dimension (N)
-*          The column scale factors for A.  If EQUED = 'C' or 'B', A is
-*          multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
-*          is not accessed.  C is an input argument if FACT = 'F';
-*          otherwise, C is an output argument.  If FACT = 'F' and
-*          EQUED = 'C' or 'B', each element of C must be positive.
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the N-by-NRHS right hand side matrix B.
-*          On exit,
-*          if EQUED = 'N', B is not modified;
-*          if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by
-*          diag(R)*B;
-*          if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is
-*          overwritten by diag(C)*B.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  X       (output) DOUBLE PRECISION array, dimension (LDX,NRHS)
-*          If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X
-*          to the original system of equations.  Note that A and B are
-*          modified on exit if EQUED .ne. 'N', and the solution to the
-*          equilibrated system is inv(diag(C))*X if TRANS = 'N' and
-*          EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C'
-*          and EQUED = 'R' or 'B'.
-*
-*  LDX     (input) INTEGER
-*          The leading dimension of the array X.  LDX >= max(1,N).
-*
-*  RCOND   (output) DOUBLE PRECISION
-*          The estimate of the reciprocal condition number of the matrix
-*          A after equilibration (if done).  If RCOND is less than the
-*          machine precision (in particular, if RCOND = 0), the matrix
-*          is singular to working precision.  This condition is
-*          indicated by a return code of INFO > 0.
-*
-*  FERR    (output) DOUBLE PRECISION array, dimension (NRHS)
-*          The estimated forward error bound for each solution vector
-*          X(j) (the j-th column of the solution matrix X).
-*          If XTRUE is the true solution corresponding to X(j), FERR(j)
-*          is an estimated upper bound for the magnitude of the largest
-*          element in (X(j) - XTRUE) divided by the magnitude of the
-*          largest element in X(j).  The estimate is as reliable as
-*          the estimate for RCOND, and is almost always a slight
-*          overestimate of the true error.
-*
-*  BERR    (output) DOUBLE PRECISION array, dimension (NRHS)
-*          The componentwise relative backward error of each solution
-*          vector X(j) (i.e., the smallest relative change in
-*          any element of A or B that makes X(j) an exact solution).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (4*N)
-*          On exit, WORK(1) contains the reciprocal pivot growth
-*          factor norm(A)/norm(U). The "max absolute element" norm is
-*          used. If WORK(1) is much less than 1, then the stability
-*          of the LU factorization of the (equilibrated) matrix A
-*          could be poor. This also means that the solution X, condition
-*          estimator RCOND, and forward error bound FERR could be
-*          unreliable. If factorization fails with 0<INFO<=N, then
-*          WORK(1) contains the reciprocal pivot growth factor for the
-*          leading INFO columns of A.
-*
-*  IWORK   (workspace) INTEGER array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, and i is
-*                <= N:  U(i,i) is exactly zero.  The factorization has
-*                       been completed, but the factor U is exactly
-*                       singular, so the solution and error bounds
-*                       could not be computed. RCOND = 0 is returned.
-*                = N+1: U is nonsingular, but RCOND is less than machine
-*                       precision, meaning that the matrix is singular
-*                       to working precision.  Nevertheless, the
-*                       solution and error bounds are computed because
-*                       there are a number of situations where the
-*                       computed solution can be more accurate than the
-*                       value of RCOND would suggest.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
-      CHARACTER          NORM
-      INTEGER            I, INFEQU, J
-      DOUBLE PRECISION   AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
-     $                   ROWCND, RPVGRW, SMLNUM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH, DLANGE, DLANTR
-      EXTERNAL           LSAME, DLAMCH, DLANGE, DLANTR
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGECON, DGEEQU, DGERFS, DGETRF, DGETRS, DLACPY,
-     $                   DLAQGE, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-      NOFACT = LSAME( FACT, 'N' )
-      EQUIL = LSAME( FACT, 'E' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      IF( NOFACT .OR. EQUIL ) THEN
-         EQUED = 'N'
-         ROWEQU = .FALSE.
-         COLEQU = .FALSE.
-      ELSE
-         ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
-         COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
-         SMLNUM = DLAMCH( 'Safe minimum' )
-         BIGNUM = ONE / SMLNUM
-      END IF
-*
-*     Test the input parameters.
-*
-      IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
-     $     THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
-     $         LSAME( TRANS, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( NRHS.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
-         INFO = -8
-      ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
-     $         ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
-         INFO = -10
-      ELSE
-         IF( ROWEQU ) THEN
-            RCMIN = BIGNUM
-            RCMAX = ZERO
-            DO 10 J = 1, N
-               RCMIN = MIN( RCMIN, R( J ) )
-               RCMAX = MAX( RCMAX, R( J ) )
-   10       CONTINUE
-            IF( RCMIN.LE.ZERO ) THEN
-               INFO = -11
-            ELSE IF( N.GT.0 ) THEN
-               ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
-            ELSE
-               ROWCND = ONE
-            END IF
-         END IF
-         IF( COLEQU .AND. INFO.EQ.0 ) THEN
-            RCMIN = BIGNUM
-            RCMAX = ZERO
-            DO 20 J = 1, N
-               RCMIN = MIN( RCMIN, C( J ) )
-               RCMAX = MAX( RCMAX, C( J ) )
-   20       CONTINUE
-            IF( RCMIN.LE.ZERO ) THEN
-               INFO = -12
-            ELSE IF( N.GT.0 ) THEN
-               COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
-            ELSE
-               COLCND = ONE
-            END IF
-         END IF
-         IF( INFO.EQ.0 ) THEN
-            IF( LDB.LT.MAX( 1, N ) ) THEN
-               INFO = -14
-            ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
-               INFO = -16
-            END IF
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGESVX', -INFO )
-         RETURN
-      END IF
-*
-      IF( EQUIL ) THEN
-*
-*        Compute row and column scalings to equilibrate the matrix A.
-*
-         CALL DGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU )
-         IF( INFEQU.EQ.0 ) THEN
-*
-*           Equilibrate the matrix.
-*
-            CALL DLAQGE( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-     $                   EQUED )
-            ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
-            COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
-         END IF
-      END IF
-*
-*     Scale the right hand side.
-*
-      IF( NOTRAN ) THEN
-         IF( ROWEQU ) THEN
-            DO 40 J = 1, NRHS
-               DO 30 I = 1, N
-                  B( I, J ) = R( I )*B( I, J )
-   30          CONTINUE
-   40       CONTINUE
-         END IF
-      ELSE IF( COLEQU ) THEN
-         DO 60 J = 1, NRHS
-            DO 50 I = 1, N
-               B( I, J ) = C( I )*B( I, J )
-   50       CONTINUE
-   60    CONTINUE
-      END IF
-*
-      IF( NOFACT .OR. EQUIL ) THEN
-*
-*        Compute the LU factorization of A.
-*
-         CALL DLACPY( 'Full', N, N, A, LDA, AF, LDAF )
-         CALL DGETRF( N, N, AF, LDAF, IPIV, INFO )
-*
-*        Return if INFO is non-zero.
-*
-         IF( INFO.GT.0 ) THEN
-*
-*           Compute the reciprocal pivot growth factor of the
-*           leading rank-deficient INFO columns of A.
-*
-            RPVGRW = DLANTR( 'M', 'U', 'N', INFO, INFO, AF, LDAF,
-     $               WORK )
-            IF( RPVGRW.EQ.ZERO ) THEN
-               RPVGRW = ONE
-            ELSE
-               RPVGRW = DLANGE( 'M', N, INFO, A, LDA, WORK ) / RPVGRW
-            END IF
-            WORK( 1 ) = RPVGRW
-            RCOND = ZERO
-            RETURN
-         END IF
-      END IF
-*
-*     Compute the norm of the matrix A and the
-*     reciprocal pivot growth factor RPVGRW.
-*
-      IF( NOTRAN ) THEN
-         NORM = '1'
-      ELSE
-         NORM = 'I'
-      END IF
-      ANORM = DLANGE( NORM, N, N, A, LDA, WORK )
-      RPVGRW = DLANTR( 'M', 'U', 'N', N, N, AF, LDAF, WORK )
-      IF( RPVGRW.EQ.ZERO ) THEN
-         RPVGRW = ONE
-      ELSE
-         RPVGRW = DLANGE( 'M', N, N, A, LDA, WORK ) / RPVGRW
-      END IF
-*
-*     Compute the reciprocal of the condition number of A.
-*
-      CALL DGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO )
-*
-*     Compute the solution matrix X.
-*
-      CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
-      CALL DGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
-*
-*     Use iterative refinement to improve the computed solution and
-*     compute error bounds and backward error estimates for it.
-*
-      CALL DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X,
-     $             LDX, FERR, BERR, WORK, IWORK, INFO )
-*
-*     Transform the solution matrix X to a solution of the original
-*     system.
-*
-      IF( NOTRAN ) THEN
-         IF( COLEQU ) THEN
-            DO 80 J = 1, NRHS
-               DO 70 I = 1, N
-                  X( I, J ) = C( I )*X( I, J )
-   70          CONTINUE
-   80       CONTINUE
-            DO 90 J = 1, NRHS
-               FERR( J ) = FERR( J ) / COLCND
-   90       CONTINUE
-         END IF
-      ELSE IF( ROWEQU ) THEN
-         DO 110 J = 1, NRHS
-            DO 100 I = 1, N
-               X( I, J ) = R( I )*X( I, J )
-  100       CONTINUE
-  110    CONTINUE
-         DO 120 J = 1, NRHS
-            FERR( J ) = FERR( J ) / ROWCND
-  120    CONTINUE
-      END IF
-*
-      WORK( 1 ) = RPVGRW
-*
-*     Set INFO = N+1 if the matrix is singular to working precision.
-*
-      IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
-     $   INFO = N + 1
-      RETURN
-*
-*     End of DGESVX
-*
-      END
diff --git a/src/lib/lapack/dgetc2.f b/src/lib/lapack/dgetc2.f
deleted file mode 100644
index 5842b213..00000000
--- a/src/lib/lapack/dgetc2.f
+++ /dev/null
@@ -1,146 +0,0 @@
-      SUBROUTINE DGETC2( N, A, LDA, IPIV, JPIV, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * ), JPIV( * )
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGETC2 computes an LU factorization with complete pivoting of the
-*  n-by-n matrix A. The factorization has the form A = P * L * U * Q,
-*  where P and Q are permutation matrices, L is lower triangular with
-*  unit diagonal elements and U is upper triangular.
-*
-*  This is the Level 2 BLAS algorithm.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A. N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA, N)
-*          On entry, the n-by-n matrix A to be factored.
-*          On exit, the factors L and U from the factorization
-*          A = P*L*U*Q; the unit diagonal elements of L are not stored.
-*          If U(k, k) appears to be less than SMIN, U(k, k) is given the
-*          value of SMIN, i.e., giving a nonsingular perturbed system.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (output) INTEGER array, dimension(N).
-*          The pivot indices; for 1 <= i <= N, row i of the
-*          matrix has been interchanged with row IPIV(i).
-*
-*  JPIV    (output) INTEGER array, dimension(N).
-*          The pivot indices; for 1 <= j <= N, column j of the
-*          matrix has been interchanged with column JPIV(j).
-*
-*  INFO    (output) INTEGER
-*           = 0: successful exit
-*           > 0: if INFO = k, U(k, k) is likely to produce owerflow if
-*                we try to solve for x in Ax = b. So U is perturbed to
-*                avoid the overflow.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, IP, IPV, J, JP, JPV
-      DOUBLE PRECISION   BIGNUM, EPS, SMIN, SMLNUM, XMAX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGER, DSWAP
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Set constants to control overflow
-*
-      INFO = 0
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' ) / EPS
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Factorize A using complete pivoting.
-*     Set pivots less than SMIN to SMIN.
-*
-      DO 40 I = 1, N - 1
-*
-*        Find max element in matrix A
-*
-         XMAX = ZERO
-         DO 20 IP = I, N
-            DO 10 JP = I, N
-               IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN
-                  XMAX = ABS( A( IP, JP ) )
-                  IPV = IP
-                  JPV = JP
-               END IF
-   10       CONTINUE
-   20    CONTINUE
-         IF( I.EQ.1 )
-     $      SMIN = MAX( EPS*XMAX, SMLNUM )
-*
-*        Swap rows
-*
-         IF( IPV.NE.I )
-     $      CALL DSWAP( N, A( IPV, 1 ), LDA, A( I, 1 ), LDA )
-         IPIV( I ) = IPV
-*
-*        Swap columns
-*
-         IF( JPV.NE.I )
-     $      CALL DSWAP( N, A( 1, JPV ), 1, A( 1, I ), 1 )
-         JPIV( I ) = JPV
-*
-*        Check for singularity
-*
-         IF( ABS( A( I, I ) ).LT.SMIN ) THEN
-            INFO = I
-            A( I, I ) = SMIN
-         END IF
-         DO 30 J = I + 1, N
-            A( J, I ) = A( J, I ) / A( I, I )
-   30    CONTINUE
-         CALL DGER( N-I, N-I, -ONE, A( I+1, I ), 1, A( I, I+1 ), LDA,
-     $              A( I+1, I+1 ), LDA )
-   40 CONTINUE
-*
-      IF( ABS( A( N, N ) ).LT.SMIN ) THEN
-         INFO = N
-         A( N, N ) = SMIN
-      END IF
-*
-      RETURN
-*
-*     End of DGETC2
-*
-      END
diff --git a/src/lib/lapack/dgetf2.f b/src/lib/lapack/dgetf2.f
deleted file mode 100644
index 573b1408..00000000
--- a/src/lib/lapack/dgetf2.f
+++ /dev/null
@@ -1,147 +0,0 @@
-      SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGETF2 computes an LU factorization of a general m-by-n matrix A
-*  using partial pivoting with row interchanges.
-*
-*  The factorization has the form
-*     A = P * L * U
-*  where P is a permutation matrix, L is lower triangular with unit
-*  diagonal elements (lower trapezoidal if m > n), and U is upper
-*  triangular (upper trapezoidal if m < n).
-*
-*  This is the right-looking Level 2 BLAS version of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the m by n matrix to be factored.
-*          On exit, the factors L and U from the factorization
-*          A = P*L*U; the unit diagonal elements of L are not stored.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  IPIV    (output) INTEGER array, dimension (min(M,N))
-*          The pivot indices; for 1 <= i <= min(M,N), row i of the
-*          matrix was interchanged with row IPIV(i).
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -k, the k-th argument had an illegal value
-*          > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*               has been completed, but the factor U is exactly
-*               singular, and division by zero will occur if it is used
-*               to solve a system of equations.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   SFMIN 
-      INTEGER            I, J, JP
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH      
-      INTEGER            IDAMAX
-      EXTERNAL           DLAMCH, IDAMAX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGER, DSCAL, DSWAP, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGETF2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 )
-     $   RETURN
-*
-*     Compute machine safe minimum 
-* 
-      SFMIN = DLAMCH('S')  
-*
-      DO 10 J = 1, MIN( M, N )
-*
-*        Find pivot and test for singularity.
-*
-         JP = J - 1 + IDAMAX( M-J+1, A( J, J ), 1 )
-         IPIV( J ) = JP
-         IF( A( JP, J ).NE.ZERO ) THEN
-*
-*           Apply the interchange to columns 1:N.
-*
-            IF( JP.NE.J )
-     $         CALL DSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA )
-*
-*           Compute elements J+1:M of J-th column.
-*
-            IF( J.LT.M ) THEN 
-               IF( ABS(A( J, J )) .GE. SFMIN ) THEN 
-                  CALL DSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 ) 
-               ELSE 
-                 DO 20 I = 1, M-J 
-                    A( J+I, J ) = A( J+I, J ) / A( J, J ) 
-   20            CONTINUE 
-               END IF 
-            END IF 
-*
-         ELSE IF( INFO.EQ.0 ) THEN
-*
-            INFO = J
-         END IF
-*
-         IF( J.LT.MIN( M, N ) ) THEN
-*
-*           Update trailing submatrix.
-*
-            CALL DGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA,
-     $                 A( J+1, J+1 ), LDA )
-         END IF
-   10 CONTINUE
-      RETURN
-*
-*     End of DGETF2
-*
-      END
diff --git a/src/lib/lapack/dgetrf.f b/src/lib/lapack/dgetrf.f
deleted file mode 100644
index c5b9df33..00000000
--- a/src/lib/lapack/dgetrf.f
+++ /dev/null
@@ -1,159 +0,0 @@
-      SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGETRF computes an LU factorization of a general M-by-N matrix A
-*  using partial pivoting with row interchanges.
-*
-*  The factorization has the form
-*     A = P * L * U
-*  where P is a permutation matrix, L is lower triangular with unit
-*  diagonal elements (lower trapezoidal if m > n), and U is upper
-*  triangular (upper trapezoidal if m < n).
-*
-*  This is the right-looking Level 3 BLAS version of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix to be factored.
-*          On exit, the factors L and U from the factorization
-*          A = P*L*U; the unit diagonal elements of L are not stored.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  IPIV    (output) INTEGER array, dimension (min(M,N))
-*          The pivot indices; for 1 <= i <= min(M,N), row i of the
-*          matrix was interchanged with row IPIV(i).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, U(i,i) is exactly zero. The factorization
-*                has been completed, but the factor U is exactly
-*                singular, and division by zero will occur if it is used
-*                to solve a system of equations.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, IINFO, J, JB, NB
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMM, DGETF2, DLASWP, DTRSM, XERBLA
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGETRF', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 )
-     $   RETURN
-*
-*     Determine the block size for this environment.
-*
-      NB = ILAENV( 1, 'DGETRF', ' ', M, N, -1, -1 )
-      IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-*        Use unblocked code.
-*
-         CALL DGETF2( M, N, A, LDA, IPIV, INFO )
-      ELSE
-*
-*        Use blocked code.
-*
-         DO 20 J = 1, MIN( M, N ), NB
-            JB = MIN( MIN( M, N )-J+1, NB )
-*
-*           Factor diagonal and subdiagonal blocks and test for exact
-*           singularity.
-*
-            CALL DGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-*           Adjust INFO and the pivot indices.
-*
-            IF( INFO.EQ.0 .AND. IINFO.GT.0 )
-     $         INFO = IINFO + J - 1
-            DO 10 I = J, MIN( M, J+JB-1 )
-               IPIV( I ) = J - 1 + IPIV( I )
-   10       CONTINUE
-*
-*           Apply interchanges to columns 1:J-1.
-*
-            CALL DLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
-*
-            IF( J+JB.LE.N ) THEN
-*
-*              Apply interchanges to columns J+JB:N.
-*
-               CALL DLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
-     $                      IPIV, 1 )
-*
-*              Compute block row of U.
-*
-               CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB,
-     $                     N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ),
-     $                     LDA )
-               IF( J+JB.LE.M ) THEN
-*
-*                 Update trailing submatrix.
-*
-                  CALL DGEMM( 'No transpose', 'No transpose', M-J-JB+1,
-     $                        N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA,
-     $                        A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ),
-     $                        LDA )
-               END IF
-            END IF
-   20    CONTINUE
-      END IF
-      RETURN
-*
-*     End of DGETRF
-*
-      END
diff --git a/src/lib/lapack/dgetri.f b/src/lib/lapack/dgetri.f
deleted file mode 100644
index 9f1c1182..00000000
--- a/src/lib/lapack/dgetri.f
+++ /dev/null
@@ -1,192 +0,0 @@
-      SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGETRI computes the inverse of a matrix using the LU factorization
-*  computed by DGETRF.
-*
-*  This method inverts U and then computes inv(A) by solving the system
-*  inv(A)*L = inv(U) for inv(A).
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the factors L and U from the factorization
-*          A = P*L*U as computed by DGETRF.
-*          On exit, if INFO = 0, the inverse of the original matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (input) INTEGER array, dimension (N)
-*          The pivot indices from DGETRF; for 1<=i<=N, row i of the
-*          matrix was interchanged with row IPIV(i).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO=0, then WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,N).
-*          For optimal performance LWORK >= N*NB, where NB is
-*          the optimal blocksize 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, U(i,i) is exactly zero; the matrix is
-*                singular and its inverse could not be computed.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IWS, J, JB, JJ, JP, LDWORK, LWKOPT, NB,
-     $                   NBMIN, NN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMM, DGEMV, DSWAP, DTRSM, DTRTRI, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      NB = ILAENV( 1, 'DGETRI', ' ', N, -1, -1, -1 )
-      LWKOPT = N*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( N.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -3
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -6
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGETRI', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Form inv(U).  If INFO > 0 from DTRTRI, then U is singular,
-*     and the inverse is not computed.
-*
-      CALL DTRTRI( 'Upper', 'Non-unit', N, A, LDA, INFO )
-      IF( INFO.GT.0 )
-     $   RETURN
-*
-      NBMIN = 2
-      LDWORK = N
-      IF( NB.GT.1 .AND. NB.LT.N ) THEN
-         IWS = MAX( LDWORK*NB, 1 )
-         IF( LWORK.LT.IWS ) THEN
-            NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'DGETRI', ' ', N, -1, -1, -1 ) )
-         END IF
-      ELSE
-         IWS = N
-      END IF
-*
-*     Solve the equation inv(A)*L = inv(U) for inv(A).
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.N ) THEN
-*
-*        Use unblocked code.
-*
-         DO 20 J = N, 1, -1
-*
-*           Copy current column of L to WORK and replace with zeros.
-*
-            DO 10 I = J + 1, N
-               WORK( I ) = A( I, J )
-               A( I, J ) = ZERO
-   10       CONTINUE
-*
-*           Compute current column of inv(A).
-*
-            IF( J.LT.N )
-     $         CALL DGEMV( 'No transpose', N, N-J, -ONE, A( 1, J+1 ),
-     $                     LDA, WORK( J+1 ), 1, ONE, A( 1, J ), 1 )
-   20    CONTINUE
-      ELSE
-*
-*        Use blocked code.
-*
-         NN = ( ( N-1 ) / NB )*NB + 1
-         DO 50 J = NN, 1, -NB
-            JB = MIN( NB, N-J+1 )
-*
-*           Copy current block column of L to WORK and replace with
-*           zeros.
-*
-            DO 40 JJ = J, J + JB - 1
-               DO 30 I = JJ + 1, N
-                  WORK( I+( JJ-J )*LDWORK ) = A( I, JJ )
-                  A( I, JJ ) = ZERO
-   30          CONTINUE
-   40       CONTINUE
-*
-*           Compute current block column of inv(A).
-*
-            IF( J+JB.LE.N )
-     $         CALL DGEMM( 'No transpose', 'No transpose', N, JB,
-     $                     N-J-JB+1, -ONE, A( 1, J+JB ), LDA,
-     $                     WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA )
-            CALL DTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB,
-     $                  ONE, WORK( J ), LDWORK, A( 1, J ), LDA )
-   50    CONTINUE
-      END IF
-*
-*     Apply column interchanges.
-*
-      DO 60 J = N - 1, 1, -1
-         JP = IPIV( J )
-         IF( JP.NE.J )
-     $      CALL DSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 )
-   60 CONTINUE
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of DGETRI
-*
-      END
diff --git a/src/lib/lapack/dgetrs.f b/src/lib/lapack/dgetrs.f
deleted file mode 100644
index b7d17b0a..00000000
--- a/src/lib/lapack/dgetrs.f
+++ /dev/null
@@ -1,149 +0,0 @@
-      SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TRANS
-      INTEGER            INFO, LDA, LDB, N, NRHS
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGETRS solves a system of linear equations
-*     A * X = B  or  A' * X = B
-*  with a general N-by-N matrix A using the LU factorization computed
-*  by DGETRF.
-*
-*  Arguments
-*  =========
-*
-*  TRANS   (input) CHARACTER*1
-*          Specifies the form of the system of equations:
-*          = 'N':  A * X = B  (No transpose)
-*          = 'T':  A'* X = B  (Transpose)
-*          = 'C':  A'* X = B  (Conjugate transpose = Transpose)
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of columns
-*          of the matrix B.  NRHS >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The factors L and U from the factorization A = P*L*U
-*          as computed by DGETRF.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (input) INTEGER array, dimension (N)
-*          The pivot indices from DGETRF; for 1<=i<=N, row i of the
-*          matrix was interchanged with row IPIV(i).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the right hand side matrix B.
-*          On exit, the solution matrix X.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOTRAN
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASWP, DTRSM, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      NOTRAN = LSAME( TRANS, 'N' )
-      IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
-     $    LSAME( TRANS, 'C' ) ) 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
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGETRS', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 .OR. NRHS.EQ.0 )
-     $   RETURN
-*
-      IF( NOTRAN ) THEN
-*
-*        Solve A * X = B.
-*
-*        Apply row interchanges to the right hand sides.
-*
-         CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
-*
-*        Solve L*X = B, overwriting B with X.
-*
-         CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
-     $               ONE, A, LDA, B, LDB )
-*
-*        Solve U*X = B, overwriting B with X.
-*
-         CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
-     $               NRHS, ONE, A, LDA, B, LDB )
-      ELSE
-*
-*        Solve A' * X = B.
-*
-*        Solve U'*X = B, overwriting B with X.
-*
-         CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
-     $               ONE, A, LDA, B, LDB )
-*
-*        Solve L'*X = B, overwriting B with X.
-*
-         CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE,
-     $               A, LDA, B, LDB )
-*
-*        Apply row interchanges to the solution vectors.
-*
-         CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
-      END IF
-*
-      RETURN
-*
-*     End of DGETRS
-*
-      END
diff --git a/src/lib/lapack/dggbak.f b/src/lib/lapack/dggbak.f
deleted file mode 100644
index 8ed9fbd4..00000000
--- a/src/lib/lapack/dggbak.f
+++ /dev/null
@@ -1,220 +0,0 @@
-      SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
-     $                   LDV, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOB, SIDE
-      INTEGER            IHI, ILO, INFO, LDV, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   LSCALE( * ), RSCALE( * ), V( LDV, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGGBAK forms the right or left eigenvectors of a real generalized
-*  eigenvalue problem A*x = lambda*B*x, by backward transformation on
-*  the computed eigenvectors of the balanced pair of matrices output by
-*  DGGBAL.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          Specifies the type of backward transformation required:
-*          = 'N':  do nothing, return immediately;
-*          = 'P':  do backward transformation for permutation only;
-*          = 'S':  do backward transformation for scaling only;
-*          = 'B':  do backward transformations for both permutation and
-*                  scaling.
-*          JOB must be the same as the argument JOB supplied to DGGBAL.
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'R':  V contains right eigenvectors;
-*          = 'L':  V contains left eigenvectors.
-*
-*  N       (input) INTEGER
-*          The number of rows of the matrix V.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          The integers ILO and IHI determined by DGGBAL.
-*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-*  LSCALE  (input) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutations and/or scaling factors applied
-*          to the left side of A and B, as returned by DGGBAL.
-*
-*  RSCALE  (input) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutations and/or scaling factors applied
-*          to the right side of A and B, as returned by DGGBAL.
-*
-*  M       (input) INTEGER
-*          The number of columns of the matrix V.  M >= 0.
-*
-*  V       (input/output) DOUBLE PRECISION array, dimension (LDV,M)
-*          On entry, the matrix of right or left eigenvectors to be
-*          transformed, as returned by DTGEVC.
-*          On exit, V is overwritten by the transformed eigenvectors.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the matrix V. LDV >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  See R.C. Ward, Balancing the generalized eigenvalue problem,
-*                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LEFTV, RIGHTV
-      INTEGER            I, K
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSCAL, DSWAP, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      RIGHTV = LSAME( SIDE, 'R' )
-      LEFTV = LSAME( SIDE, 'L' )
-*
-      INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( ILO.LT.1 ) THEN
-         INFO = -4
-      ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
-         INFO = -4
-      ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
-     $   THEN
-         INFO = -5
-      ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
-         INFO = -5
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -8
-      ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGGBAK', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-      IF( M.EQ.0 )
-     $   RETURN
-      IF( LSAME( JOB, 'N' ) )
-     $   RETURN
-*
-      IF( ILO.EQ.IHI )
-     $   GO TO 30
-*
-*     Backward balance
-*
-      IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
-*        Backward transformation on right eigenvectors
-*
-         IF( RIGHTV ) THEN
-            DO 10 I = ILO, IHI
-               CALL DSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
-   10       CONTINUE
-         END IF
-*
-*        Backward transformation on left eigenvectors
-*
-         IF( LEFTV ) THEN
-            DO 20 I = ILO, IHI
-               CALL DSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
-   20       CONTINUE
-         END IF
-      END IF
-*
-*     Backward permutation
-*
-   30 CONTINUE
-      IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
-*        Backward permutation on right eigenvectors
-*
-         IF( RIGHTV ) THEN
-            IF( ILO.EQ.1 )
-     $         GO TO 50
-*
-            DO 40 I = ILO - 1, 1, -1
-               K = RSCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 40
-               CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-   40       CONTINUE
-*
-   50       CONTINUE
-            IF( IHI.EQ.N )
-     $         GO TO 70
-            DO 60 I = IHI + 1, N
-               K = RSCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 60
-               CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-   60       CONTINUE
-         END IF
-*
-*        Backward permutation on left eigenvectors
-*
-   70    CONTINUE
-         IF( LEFTV ) THEN
-            IF( ILO.EQ.1 )
-     $         GO TO 90
-            DO 80 I = ILO - 1, 1, -1
-               K = LSCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 80
-               CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-   80       CONTINUE
-*
-   90       CONTINUE
-            IF( IHI.EQ.N )
-     $         GO TO 110
-            DO 100 I = IHI + 1, N
-               K = LSCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 100
-               CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-  100       CONTINUE
-         END IF
-      END IF
-*
-  110 CONTINUE
-*
-      RETURN
-*
-*     End of DGGBAK
-*
-      END
diff --git a/src/lib/lapack/dggbal.f b/src/lib/lapack/dggbal.f
deleted file mode 100644
index 2034880a..00000000
--- a/src/lib/lapack/dggbal.f
+++ /dev/null
@@ -1,469 +0,0 @@
-      SUBROUTINE DGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE,
-     $                   RSCALE, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOB
-      INTEGER            IHI, ILO, INFO, LDA, LDB, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), LSCALE( * ),
-     $                   RSCALE( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGGBAL balances a pair of general real matrices (A,B).  This
-*  involves, first, permuting A and B by similarity transformations to
-*  isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N
-*  elements on the diagonal; and second, applying a diagonal similarity
-*  transformation to rows and columns ILO to IHI to make the rows
-*  and columns as close in norm as possible. Both steps are optional.
-*
-*  Balancing may reduce the 1-norm of the matrices, and improve the
-*  accuracy of the computed eigenvalues and/or eigenvectors in the
-*  generalized eigenvalue problem A*x = lambda*B*x.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          Specifies the operations to be performed on A and B:
-*          = 'N':  none:  simply set ILO = 1, IHI = N, LSCALE(I) = 1.0
-*                  and RSCALE(I) = 1.0 for i = 1,...,N.
-*          = 'P':  permute only;
-*          = 'S':  scale only;
-*          = 'B':  both permute and scale.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the input matrix A.
-*          On exit,  A is overwritten by the balanced matrix.
-*          If JOB = 'N', A is not referenced.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,N)
-*          On entry, the input matrix B.
-*          On exit,  B is overwritten by the balanced matrix.
-*          If JOB = 'N', B is not referenced.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1,N).
-*
-*  ILO     (output) INTEGER
-*  IHI     (output) INTEGER
-*          ILO and IHI are set to integers such that on exit
-*          A(i,j) = 0 and B(i,j) = 0 if i > j and
-*          j = 1,...,ILO-1 or i = IHI+1,...,N.
-*          If JOB = 'N' or 'S', ILO = 1 and IHI = N.
-*
-*  LSCALE  (output) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutations and scaling factors applied
-*          to the left side of A and B.  If P(j) is the index of the
-*          row interchanged with row j, and D(j)
-*          is the scaling factor applied to row j, then
-*            LSCALE(j) = P(j)    for J = 1,...,ILO-1
-*                      = D(j)    for J = ILO,...,IHI
-*                      = P(j)    for J = IHI+1,...,N.
-*          The order in which the interchanges are made is N to IHI+1,
-*          then 1 to ILO-1.
-*
-*  RSCALE  (output) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutations and scaling factors applied
-*          to the right side of A and B.  If P(j) is the index of the
-*          column interchanged with column j, and D(j)
-*          is the scaling factor applied to column j, then
-*            LSCALE(j) = P(j)    for J = 1,...,ILO-1
-*                      = D(j)    for J = ILO,...,IHI
-*                      = P(j)    for J = IHI+1,...,N.
-*          The order in which the interchanges are made is N to IHI+1,
-*          then 1 to ILO-1.
-*
-*  WORK    (workspace) REAL array, dimension (lwork)
-*          lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and
-*          at least 1 when JOB = 'N' or 'P'.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  See R.C. WARD, Balancing the generalized eigenvalue problem,
-*                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, HALF, ONE
-      PARAMETER          ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
-      DOUBLE PRECISION   THREE, SCLFAC
-      PARAMETER          ( THREE = 3.0D+0, SCLFAC = 1.0D+1 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ICAB, IFLOW, IP1, IR, IRAB, IT, J, JC, JP1,
-     $                   K, KOUNT, L, LCAB, LM1, LRAB, LSFMAX, LSFMIN,
-     $                   M, NR, NRP2
-      DOUBLE PRECISION   ALPHA, BASL, BETA, CAB, CMAX, COEF, COEF2,
-     $                   COEF5, COR, EW, EWC, GAMMA, PGAMMA, RAB, SFMAX,
-     $                   SFMIN, SUM, T, TA, TB, TC
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DDOT, DLAMCH
-      EXTERNAL           LSAME, IDAMAX, DDOT, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DSCAL, DSWAP, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, INT, LOG10, MAX, MIN, SIGN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -4
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGGBAL', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         ILO = 1
-         IHI = N
-         RETURN
-      END IF
-*
-      IF( N.EQ.1 ) THEN
-         ILO = 1
-         IHI = N
-         LSCALE( 1 ) = ONE
-         RSCALE( 1 ) = ONE
-         RETURN
-      END IF
-*
-      IF( LSAME( JOB, 'N' ) ) THEN
-         ILO = 1
-         IHI = N
-         DO 10 I = 1, N
-            LSCALE( I ) = ONE
-            RSCALE( I ) = ONE
-   10    CONTINUE
-         RETURN
-      END IF
-*
-      K = 1
-      L = N
-      IF( LSAME( JOB, 'S' ) )
-     $   GO TO 190
-*
-      GO TO 30
-*
-*     Permute the matrices A and B to isolate the eigenvalues.
-*
-*     Find row with one nonzero in columns 1 through L
-*
-   20 CONTINUE
-      L = LM1
-      IF( L.NE.1 )
-     $   GO TO 30
-*
-      RSCALE( 1 ) = ONE
-      LSCALE( 1 ) = ONE
-      GO TO 190
-*
-   30 CONTINUE
-      LM1 = L - 1
-      DO 80 I = L, 1, -1
-         DO 40 J = 1, LM1
-            JP1 = J + 1
-            IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
-     $         GO TO 50
-   40    CONTINUE
-         J = L
-         GO TO 70
-*
-   50    CONTINUE
-         DO 60 J = JP1, L
-            IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
-     $         GO TO 80
-   60    CONTINUE
-         J = JP1 - 1
-*
-   70    CONTINUE
-         M = L
-         IFLOW = 1
-         GO TO 160
-   80 CONTINUE
-      GO TO 100
-*
-*     Find column with one nonzero in rows K through N
-*
-   90 CONTINUE
-      K = K + 1
-*
-  100 CONTINUE
-      DO 150 J = K, L
-         DO 110 I = K, LM1
-            IP1 = I + 1
-            IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
-     $         GO TO 120
-  110    CONTINUE
-         I = L
-         GO TO 140
-  120    CONTINUE
-         DO 130 I = IP1, L
-            IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
-     $         GO TO 150
-  130    CONTINUE
-         I = IP1 - 1
-  140    CONTINUE
-         M = K
-         IFLOW = 2
-         GO TO 160
-  150 CONTINUE
-      GO TO 190
-*
-*     Permute rows M and I
-*
-  160 CONTINUE
-      LSCALE( M ) = I
-      IF( I.EQ.M )
-     $   GO TO 170
-      CALL DSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA )
-      CALL DSWAP( N-K+1, B( I, K ), LDB, B( M, K ), LDB )
-*
-*     Permute columns M and J
-*
-  170 CONTINUE
-      RSCALE( M ) = J
-      IF( J.EQ.M )
-     $   GO TO 180
-      CALL DSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
-      CALL DSWAP( L, B( 1, J ), 1, B( 1, M ), 1 )
-*
-  180 CONTINUE
-      GO TO ( 20, 90 )IFLOW
-*
-  190 CONTINUE
-      ILO = K
-      IHI = L
-*
-      IF( LSAME( JOB, 'P' ) ) THEN
-         DO 195 I = ILO, IHI
-            LSCALE( I ) = ONE
-            RSCALE( I ) = ONE
-  195    CONTINUE
-         RETURN
-      END IF
-*
-      IF( ILO.EQ.IHI )
-     $   RETURN
-*
-*     Balance the submatrix in rows ILO to IHI.
-*
-      NR = IHI - ILO + 1
-      DO 200 I = ILO, IHI
-         RSCALE( I ) = ZERO
-         LSCALE( I ) = ZERO
-*
-         WORK( I ) = ZERO
-         WORK( I+N ) = ZERO
-         WORK( I+2*N ) = ZERO
-         WORK( I+3*N ) = ZERO
-         WORK( I+4*N ) = ZERO
-         WORK( I+5*N ) = ZERO
-  200 CONTINUE
-*
-*     Compute right side vector in resulting linear equations
-*
-      BASL = LOG10( SCLFAC )
-      DO 240 I = ILO, IHI
-         DO 230 J = ILO, IHI
-            TB = B( I, J )
-            TA = A( I, J )
-            IF( TA.EQ.ZERO )
-     $         GO TO 210
-            TA = LOG10( ABS( TA ) ) / BASL
-  210       CONTINUE
-            IF( TB.EQ.ZERO )
-     $         GO TO 220
-            TB = LOG10( ABS( TB ) ) / BASL
-  220       CONTINUE
-            WORK( I+4*N ) = WORK( I+4*N ) - TA - TB
-            WORK( J+5*N ) = WORK( J+5*N ) - TA - TB
-  230    CONTINUE
-  240 CONTINUE
-*
-      COEF = ONE / DBLE( 2*NR )
-      COEF2 = COEF*COEF
-      COEF5 = HALF*COEF2
-      NRP2 = NR + 2
-      BETA = ZERO
-      IT = 1
-*
-*     Start generalized conjugate gradient iteration
-*
-  250 CONTINUE
-*
-      GAMMA = DDOT( NR, WORK( ILO+4*N ), 1, WORK( ILO+4*N ), 1 ) +
-     $        DDOT( NR, WORK( ILO+5*N ), 1, WORK( ILO+5*N ), 1 )
-*
-      EW = ZERO
-      EWC = ZERO
-      DO 260 I = ILO, IHI
-         EW = EW + WORK( I+4*N )
-         EWC = EWC + WORK( I+5*N )
-  260 CONTINUE
-*
-      GAMMA = COEF*GAMMA - COEF2*( EW**2+EWC**2 ) - COEF5*( EW-EWC )**2
-      IF( GAMMA.EQ.ZERO )
-     $   GO TO 350
-      IF( IT.NE.1 )
-     $   BETA = GAMMA / PGAMMA
-      T = COEF5*( EWC-THREE*EW )
-      TC = COEF5*( EW-THREE*EWC )
-*
-      CALL DSCAL( NR, BETA, WORK( ILO ), 1 )
-      CALL DSCAL( NR, BETA, WORK( ILO+N ), 1 )
-*
-      CALL DAXPY( NR, COEF, WORK( ILO+4*N ), 1, WORK( ILO+N ), 1 )
-      CALL DAXPY( NR, COEF, WORK( ILO+5*N ), 1, WORK( ILO ), 1 )
-*
-      DO 270 I = ILO, IHI
-         WORK( I ) = WORK( I ) + TC
-         WORK( I+N ) = WORK( I+N ) + T
-  270 CONTINUE
-*
-*     Apply matrix to vector
-*
-      DO 300 I = ILO, IHI
-         KOUNT = 0
-         SUM = ZERO
-         DO 290 J = ILO, IHI
-            IF( A( I, J ).EQ.ZERO )
-     $         GO TO 280
-            KOUNT = KOUNT + 1
-            SUM = SUM + WORK( J )
-  280       CONTINUE
-            IF( B( I, J ).EQ.ZERO )
-     $         GO TO 290
-            KOUNT = KOUNT + 1
-            SUM = SUM + WORK( J )
-  290    CONTINUE
-         WORK( I+2*N ) = DBLE( KOUNT )*WORK( I+N ) + SUM
-  300 CONTINUE
-*
-      DO 330 J = ILO, IHI
-         KOUNT = 0
-         SUM = ZERO
-         DO 320 I = ILO, IHI
-            IF( A( I, J ).EQ.ZERO )
-     $         GO TO 310
-            KOUNT = KOUNT + 1
-            SUM = SUM + WORK( I+N )
-  310       CONTINUE
-            IF( B( I, J ).EQ.ZERO )
-     $         GO TO 320
-            KOUNT = KOUNT + 1
-            SUM = SUM + WORK( I+N )
-  320    CONTINUE
-         WORK( J+3*N ) = DBLE( KOUNT )*WORK( J ) + SUM
-  330 CONTINUE
-*
-      SUM = DDOT( NR, WORK( ILO+N ), 1, WORK( ILO+2*N ), 1 ) +
-     $      DDOT( NR, WORK( ILO ), 1, WORK( ILO+3*N ), 1 )
-      ALPHA = GAMMA / SUM
-*
-*     Determine correction to current iteration
-*
-      CMAX = ZERO
-      DO 340 I = ILO, IHI
-         COR = ALPHA*WORK( I+N )
-         IF( ABS( COR ).GT.CMAX )
-     $      CMAX = ABS( COR )
-         LSCALE( I ) = LSCALE( I ) + COR
-         COR = ALPHA*WORK( I )
-         IF( ABS( COR ).GT.CMAX )
-     $      CMAX = ABS( COR )
-         RSCALE( I ) = RSCALE( I ) + COR
-  340 CONTINUE
-      IF( CMAX.LT.HALF )
-     $   GO TO 350
-*
-      CALL DAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), 1 )
-      CALL DAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), 1 )
-*
-      PGAMMA = GAMMA
-      IT = IT + 1
-      IF( IT.LE.NRP2 )
-     $   GO TO 250
-*
-*     End generalized conjugate gradient iteration
-*
-  350 CONTINUE
-      SFMIN = DLAMCH( 'S' )
-      SFMAX = ONE / SFMIN
-      LSFMIN = INT( LOG10( SFMIN ) / BASL+ONE )
-      LSFMAX = INT( LOG10( SFMAX ) / BASL )
-      DO 360 I = ILO, IHI
-         IRAB = IDAMAX( N-ILO+1, A( I, ILO ), LDA )
-         RAB = ABS( A( I, IRAB+ILO-1 ) )
-         IRAB = IDAMAX( N-ILO+1, B( I, ILO ), LDB )
-         RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) )
-         LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE )
-         IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) )
-         IR = MIN( MAX( IR, LSFMIN ), LSFMAX, LSFMAX-LRAB )
-         LSCALE( I ) = SCLFAC**IR
-         ICAB = IDAMAX( IHI, A( 1, I ), 1 )
-         CAB = ABS( A( ICAB, I ) )
-         ICAB = IDAMAX( IHI, B( 1, I ), 1 )
-         CAB = MAX( CAB, ABS( B( ICAB, I ) ) )
-         LCAB = INT( LOG10( CAB+SFMIN ) / BASL+ONE )
-         JC = RSCALE( I ) + SIGN( HALF, RSCALE( I ) )
-         JC = MIN( MAX( JC, LSFMIN ), LSFMAX, LSFMAX-LCAB )
-         RSCALE( I ) = SCLFAC**JC
-  360 CONTINUE
-*
-*     Row scaling of matrices A and B
-*
-      DO 370 I = ILO, IHI
-         CALL DSCAL( N-ILO+1, LSCALE( I ), A( I, ILO ), LDA )
-         CALL DSCAL( N-ILO+1, LSCALE( I ), B( I, ILO ), LDB )
-  370 CONTINUE
-*
-*     Column scaling of matrices A and B
-*
-      DO 380 J = ILO, IHI
-         CALL DSCAL( IHI, RSCALE( J ), A( 1, J ), 1 )
-         CALL DSCAL( IHI, RSCALE( J ), B( 1, J ), 1 )
-  380 CONTINUE
-*
-      RETURN
-*
-*     End of DGGBAL
-*
-      END
diff --git a/src/lib/lapack/dgges.f b/src/lib/lapack/dgges.f
deleted file mode 100644
index ce29aa52..00000000
--- a/src/lib/lapack/dgges.f
+++ /dev/null
@@ -1,550 +0,0 @@
-      SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, DELCTG, N, A, LDA, B, LDB,
-     $                  SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR,
-     $                  LDVSR, WORK, LWORK, BWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     June 30, 1999
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBVSL, JOBVSR, SORT
-      INTEGER            INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            BWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-     $                   B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
-     $                   VSR( LDVSR, * ), WORK( * )
-*     ..
-*     .. Function Arguments ..
-      LOGICAL            DELCTG
-      EXTERNAL           DELCTG
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B),
-*  the generalized eigenvalues, the generalized real Schur form (S,T),
-*  optionally, the left and/or right matrices of Schur vectors (VSL and
-*  VSR). This gives the generalized Schur factorization
-*
-*           (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T )
-*
-*  Optionally, it also orders the eigenvalues so that a selected cluster
-*  of eigenvalues appears in the leading diagonal blocks of the upper
-*  quasi-triangular matrix S and the upper triangular matrix T.The
-*  leading columns of VSL and VSR then form an orthonormal basis for the
-*  corresponding left and right eigenspaces (deflating subspaces).
-*
-*  (If only the generalized eigenvalues are needed, use the driver
-*  DGGEV instead, which is faster.)
-*
-*  A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
-*  or a ratio alpha/beta = w, such that  A - w*B is singular.  It is
-*  usually represented as the pair (alpha,beta), as there is a
-*  reasonable interpretation for beta=0 or both being zero.
-*
-*  A pair of matrices (S,T) is in generalized real Schur form if T is
-*  upper triangular with non-negative diagonal and S is block upper
-*  triangular with 1-by-1 and 2-by-2 blocks.  1-by-1 blocks correspond
-*  to real generalized eigenvalues, while 2-by-2 blocks of S will be
-*  "standardized" by making the corresponding elements of T have the
-*  form:
-*          [  a  0  ]
-*          [  0  b  ]
-*
-*  and the pair of corresponding 2-by-2 blocks in S and T will have a
-*  complex conjugate pair of generalized eigenvalues.
-*
-*
-*  Arguments
-*  =========
-*
-*  JOBVSL  (input) CHARACTER*1
-*          = 'N':  do not compute the left Schur vectors;
-*          = 'V':  compute the left Schur vectors.
-*
-*  JOBVSR  (input) CHARACTER*1
-*          = 'N':  do not compute the right Schur vectors;
-*          = 'V':  compute the right Schur vectors.
-*
-*  SORT    (input) CHARACTER*1
-*          Specifies whether or not to order the eigenvalues on the
-*          diagonal of the generalized Schur form.
-*          = 'N':  Eigenvalues are not ordered;
-*          = 'S':  Eigenvalues are ordered (see DELZTG);
-*
-*  DELZTG  (input) LOGICAL FUNCTION of three DOUBLE PRECISION arguments
-*          DELZTG must be declared EXTERNAL in the calling subroutine.
-*          If SORT = 'N', DELZTG is not referenced.
-*          If SORT = 'S', DELZTG is used to select eigenvalues to sort
-*          to the top left of the Schur form.
-*          An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
-*          DELZTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
-*          one of a complex conjugate pair of eigenvalues is selected,
-*          then both complex eigenvalues are selected.
-*
-*          Note that in the ill-conditioned case, a selected complex
-*          eigenvalue may no longer satisfy DELZTG(ALPHAR(j),ALPHAI(j),
-*          BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2
-*          in this case.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A, B, VSL, and VSR.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA, N)
-*          On entry, the first of the pair of matrices.
-*          On exit, A has been overwritten by its generalized Schur
-*          form S.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of A.  LDA >= max(1,N).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB, N)
-*          On entry, the second of the pair of matrices.
-*          On exit, B has been overwritten by its generalized Schur
-*          form T.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of B.  LDB >= max(1,N).
-*
-*  SDIM    (output) INTEGER
-*          If SORT = 'N', SDIM = 0.
-*          If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*          for which DELZTG is true.  (Complex conjugate pairs for which
-*          DELZTG is true for either eigenvalue count as 2.)
-*
-*  ALPHAR  (output) DOUBLE PRECISION array, dimension (N)
-*  ALPHAI  (output) DOUBLE PRECISION array, dimension (N)
-*  BETA    (output) DOUBLE PRECISION array, dimension (N)
-*          On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*          be the generalized eigenvalues.  ALPHAR(j) + ALPHAI(j)*i,
-*          and  BETA(j),j=1,...,N are the diagonals of the complex Schur
-*          form (S,T) that would result if the 2-by-2 diagonal blocks of
-*          the real Schur form of (A,B) were further reduced to
-*          triangular form using 2-by-2 complex unitary transformations.
-*          If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*          positive, then the j-th and (j+1)-st eigenvalues are a
-*          complex conjugate pair, with ALPHAI(j+1) negative.
-*
-*          Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-*          may easily over- or underflow, and BETA(j) may even be zero.
-*          Thus, the user should avoid naively computing the ratio.
-*          However, ALPHAR and ALPHAI will be always less than and
-*          usually comparable with norm(A) in magnitude, and BETA always
-*          less than and usually comparable with norm(B).
-*
-*  VSL     (output) DOUBLE PRECISION array, dimension (LDVSL,N)
-*          If JOBVSL = 'V', VSL will contain the left Schur vectors.
-*          Not referenced if JOBVSL = 'N'.
-*
-*  LDVSL   (input) INTEGER
-*          The leading dimension of the matrix VSL. LDVSL >=1, and
-*          if JOBVSL = 'V', LDVSL >= N.
-*
-*  VSR     (output) DOUBLE PRECISION array, dimension (LDVSR,N)
-*          If JOBVSR = 'V', VSR will contain the right Schur vectors.
-*          Not referenced if JOBVSR = 'N'.
-*
-*  LDVSR   (input) INTEGER
-*          The leading dimension of the matrix VSR. LDVSR >= 1, and
-*          if JOBVSR = 'V', LDVSR >= N.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= 8*N+16.
-*
-*          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.
-*
-*  BWORK   (workspace) LOGICAL array, dimension (N)
-*          Not referenced if SORT = 'N'.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          = 1,...,N:
-*                The QZ iteration failed.  (A,B) are not in Schur
-*                form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
-*                be correct for j=INFO+1,...,N.
-*          > N:  =N+1: other than QZ iteration failed in DHGEQZ.
-*                =N+2: after reordering, roundoff changed values of
-*                      some complex eigenvalues so that leading
-*                      eigenvalues in the Generalized Schur form no
-*                      longer satisfy DELZTG=.TRUE.  This could also
-*                      be caused due to scaling.
-*                =N+3: reordering failed in DTGSEN.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
-     $                   LQUERY, LST2SL, WANTST
-      INTEGER            I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
-     $                   ILO, IP, IRIGHT, IROWS, ITAU, IWRK, MAXWRK,
-     $                   MINWRK
-      DOUBLE PRECISION   ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL,
-     $                   PVSR, SAFMAX, SAFMIN, SMLNUM
-*     ..
-*     .. Local Arrays ..
-      INTEGER            IDUM( 1 )
-      DOUBLE PRECISION   DIF( 2 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
-     $                   DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN,
-     $                   XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           LSAME, ILAENV, DLAMCH, DLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode the input arguments
-*
-      IF( LSAME( JOBVSL, 'N' ) ) THEN
-         IJOBVL = 1
-         ILVSL = .FALSE.
-      ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
-         IJOBVL = 2
-         ILVSL = .TRUE.
-      ELSE
-         IJOBVL = -1
-         ILVSL = .FALSE.
-      END IF
-*
-      IF( LSAME( JOBVSR, 'N' ) ) THEN
-         IJOBVR = 1
-         ILVSR = .FALSE.
-      ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
-         IJOBVR = 2
-         ILVSR = .TRUE.
-      ELSE
-         IJOBVR = -1
-         ILVSR = .FALSE.
-      END IF
-*
-      WANTST = LSAME( SORT, 'S' )
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( IJOBVL.LE.0 ) THEN
-         INFO = -1
-      ELSE IF( IJOBVR.LE.0 ) THEN
-         INFO = -2
-      ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
-         INFO = -15
-      ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
-         INFO = -17
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       NB refers to the optimal block size for the immediately
-*       following subroutine, as returned by ILAENV.)
-*
-      MINWRK = 1
-      IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
-         MINWRK = 7*( N+1 ) + 16
-         MAXWRK = 7*( N+1 ) + N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 ) +
-     $            16
-         IF( ILVSL ) THEN
-            MAXWRK = MAX( MAXWRK, 7*( N+1 )+N*
-     $               ILAENV( 1, 'DORGQR', ' ', N, 1, N, -1 ) )
-         END IF
-         WORK( 1 ) = MAXWRK
-      END IF
-*
-      IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
-     $   INFO = -19
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGGES ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         SDIM = 0
-         RETURN
-      END IF
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SAFMIN = DLAMCH( 'S' )
-      SAFMAX = ONE / SAFMIN
-      CALL DLABAD( SAFMIN, SAFMAX )
-      SMLNUM = SQRT( SAFMIN ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', N, N, A, LDA, WORK )
-      ILASCL = .FALSE.
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         ANRMTO = SMLNUM
-         ILASCL = .TRUE.
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         ANRMTO = BIGNUM
-         ILASCL = .TRUE.
-      END IF
-      IF( ILASCL )
-     $   CALL DLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-*     Scale B if max element outside range [SMLNUM,BIGNUM]
-*
-      BNRM = DLANGE( 'M', N, N, B, LDB, WORK )
-      ILBSCL = .FALSE.
-      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-         BNRMTO = SMLNUM
-         ILBSCL = .TRUE.
-      ELSE IF( BNRM.GT.BIGNUM ) THEN
-         BNRMTO = BIGNUM
-         ILBSCL = .TRUE.
-      END IF
-      IF( ILBSCL )
-     $   CALL DLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-*     Permute the matrix to make it more nearly triangular
-*     (Workspace: need 6*N + 2*N space for storing balancing factors)
-*
-      ILEFT = 1
-      IRIGHT = N + 1
-      IWRK = IRIGHT + N
-      CALL DGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
-     $             WORK( IRIGHT ), WORK( IWRK ), IERR )
-*
-*     Reduce B to triangular form (QR decomposition of B)
-*     (Workspace: need N, prefer N*NB)
-*
-      IROWS = IHI + 1 - ILO
-      ICOLS = N + 1 - ILO
-      ITAU = IWRK
-      IWRK = ITAU + IROWS
-      CALL DGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
-     $             WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-*     Apply the orthogonal transformation to matrix A
-*     (Workspace: need N, prefer N*NB)
-*
-      CALL DORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
-     $             WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
-     $             LWORK+1-IWRK, IERR )
-*
-*     Initialize VSL
-*     (Workspace: need N, prefer N*NB)
-*
-      IF( ILVSL ) THEN
-         CALL DLASET( 'Full', N, N, ZERO, ONE, VSL, LDVSL )
-         CALL DLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
-     $                VSL( ILO+1, ILO ), LDVSL )
-         CALL DORGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
-     $                WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
-      END IF
-*
-*     Initialize VSR
-*
-      IF( ILVSR )
-     $   CALL DLASET( 'Full', N, N, ZERO, ONE, VSR, LDVSR )
-*
-*     Reduce to generalized Hessenberg form
-*     (Workspace: none needed)
-*
-      CALL DGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
-     $             LDVSL, VSR, LDVSR, IERR )
-*
-*     Perform QZ algorithm, computing Schur vectors if desired
-*     (Workspace: need N)
-*
-      IWRK = ITAU
-      CALL DHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
-     $             ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
-     $             WORK( IWRK ), LWORK+1-IWRK, IERR )
-      IF( IERR.NE.0 ) THEN
-         IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
-            INFO = IERR
-         ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
-            INFO = IERR - N
-         ELSE
-            INFO = N + 1
-         END IF
-         GO TO 50
-      END IF
-*
-*     Sort eigenvalues ALPHA/BETA if desired
-*     (Workspace: need 4*N+16 )
-*
-      SDIM = 0
-      IF( WANTST ) THEN
-*
-*        Undo scaling on eigenvalues before DELZTGing
-*
-         IF( ILASCL ) THEN
-            CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N,
-     $                   IERR )
-            CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N,
-     $                   IERR )
-         END IF
-         IF( ILBSCL )
-     $      CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
-*
-*        Select eigenvalues
-*
-         DO 10 I = 1, N
-            BWORK( I ) = DELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
-   10    CONTINUE
-*
-         CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHAR,
-     $                ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL,
-     $                PVSR, DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1,
-     $                IERR )
-         IF( IERR.EQ.1 )
-     $      INFO = N + 3
-*
-      END IF
-*
-*     Apply back-permutation to VSL and VSR
-*     (Workspace: none needed)
-*
-      IF( ILVSL )
-     $   CALL DGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
-     $                WORK( IRIGHT ), N, VSL, LDVSL, IERR )
-*
-      IF( ILVSR )
-     $   CALL DGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
-     $                WORK( IRIGHT ), N, VSR, LDVSR, IERR )
-*
-*     Check if unscaling would cause over/underflow, if so, rescale
-*     (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of
-*     B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I)
-*
-      IF( ILASCL ) THEN
-         DO 20 I = 1, N
-            IF( ALPHAI( I ).NE.ZERO ) THEN
-               IF( ( ALPHAR( I ) / SAFMAX ).GT.( ANRMTO / ANRM ) .OR.
-     $             ( SAFMIN / ALPHAR( I ) ).GT.( ANRM / ANRMTO ) ) THEN
-                  WORK( 1 ) = ABS( A( I, I ) / ALPHAR( I ) )
-                  BETA( I ) = BETA( I )*WORK( 1 )
-                  ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
-                  ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
-               ELSE IF( ( ALPHAI( I ) / SAFMAX ).GT.
-     $                  ( ANRMTO / ANRM ) .OR.
-     $                  ( SAFMIN / ALPHAI( I ) ).GT.( ANRM / ANRMTO ) )
-     $                   THEN
-                  WORK( 1 ) = ABS( A( I, I+1 ) / ALPHAI( I ) )
-                  BETA( I ) = BETA( I )*WORK( 1 )
-                  ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
-                  ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
-               END IF
-            END IF
-   20    CONTINUE
-      END IF
-*
-      IF( ILBSCL ) THEN
-         DO 30 I = 1, N
-            IF( ALPHAI( I ).NE.ZERO ) THEN
-               IF( ( BETA( I ) / SAFMAX ).GT.( BNRMTO / BNRM ) .OR.
-     $             ( SAFMIN / BETA( I ) ).GT.( BNRM / BNRMTO ) ) THEN
-                  WORK( 1 ) = ABS( B( I, I ) / BETA( I ) )
-                  BETA( I ) = BETA( I )*WORK( 1 )
-                  ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
-                  ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
-               END IF
-            END IF
-   30    CONTINUE
-      END IF
-*
-*     Undo scaling
-*
-      IF( ILASCL ) THEN
-         CALL DLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR )
-         CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
-         CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
-      END IF
-*
-      IF( ILBSCL ) THEN
-         CALL DLASCL( 'U', 0, 0, BNRMTO, BNRM, N, N, B, LDB, IERR )
-         CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
-      END IF
-*
-      IF( WANTST ) THEN
-*
-*        Check if reordering is correct
-*
-         LASTSL = .TRUE.
-         LST2SL = .TRUE.
-         SDIM = 0
-         IP = 0
-         DO 40 I = 1, N
-            CURSL = DELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
-            IF( ALPHAI( I ).EQ.ZERO ) THEN
-               IF( CURSL )
-     $            SDIM = SDIM + 1
-               IP = 0
-               IF( CURSL .AND. .NOT.LASTSL )
-     $            INFO = N + 2
-            ELSE
-               IF( IP.EQ.1 ) THEN
-*
-*                 Last eigenvalue of conjugate pair
-*
-                  CURSL = CURSL .OR. LASTSL
-                  LASTSL = CURSL
-                  IF( CURSL )
-     $               SDIM = SDIM + 2
-                  IP = -1
-                  IF( CURSL .AND. .NOT.LST2SL )
-     $               INFO = N + 2
-               ELSE
-*
-*                 First eigenvalue of conjugate pair
-*
-                  IP = 1
-               END IF
-            END IF
-            LST2SL = LASTSL
-            LASTSL = CURSL
-   40    CONTINUE
-*
-      END IF
-*
-   50 CONTINUE
-*
-      WORK( 1 ) = MAXWRK
-*
-      RETURN
-*
-*     End of DGGES
-*
-      END
diff --git a/src/lib/lapack/dggev.f b/src/lib/lapack/dggev.f
deleted file mode 100644
index 4a204c33..00000000
--- a/src/lib/lapack/dggev.f
+++ /dev/null
@@ -1,489 +0,0 @@
-      SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
-     $                  BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBVL, JOBVR
-      INTEGER            INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-     $                   B( LDB, * ), BETA( * ), VL( LDVL, * ),
-     $                   VR( LDVR, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGGEV computes for a pair of N-by-N real nonsymmetric matrices (A,B)
-*  the generalized eigenvalues, and optionally, the left and/or right
-*  generalized eigenvectors.
-*
-*  A generalized eigenvalue for a pair of matrices (A,B) is a scalar
-*  lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
-*  singular. It is usually represented as the pair (alpha,beta), as
-*  there is a reasonable interpretation for beta=0, and even for both
-*  being zero.
-*
-*  The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
-*  of (A,B) satisfies
-*
-*                   A * v(j) = lambda(j) * B * v(j).
-*
-*  The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
-*  of (A,B) satisfies
-*
-*                   u(j)**H * A  = lambda(j) * u(j)**H * B .
-*
-*  where u(j)**H is the conjugate-transpose of u(j).
-*
-*
-*  Arguments
-*  =========
-*
-*  JOBVL   (input) CHARACTER*1
-*          = 'N':  do not compute the left generalized eigenvectors;
-*          = 'V':  compute the left generalized eigenvectors.
-*
-*  JOBVR   (input) CHARACTER*1
-*          = 'N':  do not compute the right generalized eigenvectors;
-*          = 'V':  compute the right generalized eigenvectors.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A, B, VL, and VR.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA, N)
-*          On entry, the matrix A in the pair (A,B).
-*          On exit, A has been overwritten.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of A.  LDA >= max(1,N).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB, N)
-*          On entry, the matrix B in the pair (A,B).
-*          On exit, B has been overwritten.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of B.  LDB >= max(1,N).
-*
-*  ALPHAR  (output) DOUBLE PRECISION array, dimension (N)
-*  ALPHAI  (output) DOUBLE PRECISION array, dimension (N)
-*  BETA    (output) DOUBLE PRECISION array, dimension (N)
-*          On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*          be the generalized eigenvalues.  If ALPHAI(j) is zero, then
-*          the j-th eigenvalue is real; if positive, then the j-th and
-*          (j+1)-st eigenvalues are a complex conjugate pair, with
-*          ALPHAI(j+1) negative.
-*
-*          Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
-*          may easily over- or underflow, and BETA(j) may even be zero.
-*          Thus, the user should avoid naively computing the ratio
-*          alpha/beta.  However, ALPHAR and ALPHAI will be always less
-*          than and usually comparable with norm(A) in magnitude, and
-*          BETA always less than and usually comparable with norm(B).
-*
-*  VL      (output) DOUBLE PRECISION array, dimension (LDVL,N)
-*          If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*          after another in the columns of VL, in the same order as
-*          their eigenvalues. If the j-th eigenvalue is real, then
-*          u(j) = VL(:,j), the j-th column of VL. If the j-th and
-*          (j+1)-th eigenvalues form a complex conjugate pair, then
-*          u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
-*          Each eigenvector is scaled so the largest component has
-*          abs(real part)+abs(imag. part)=1.
-*          Not referenced if JOBVL = 'N'.
-*
-*  LDVL    (input) INTEGER
-*          The leading dimension of the matrix VL. LDVL >= 1, and
-*          if JOBVL = 'V', LDVL >= N.
-*
-*  VR      (output) DOUBLE PRECISION array, dimension (LDVR,N)
-*          If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*          after another in the columns of VR, in the same order as
-*          their eigenvalues. If the j-th eigenvalue is real, then
-*          v(j) = VR(:,j), the j-th column of VR. If the j-th and
-*          (j+1)-th eigenvalues form a complex conjugate pair, then
-*          v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
-*          Each eigenvector is scaled so the largest component has
-*          abs(real part)+abs(imag. part)=1.
-*          Not referenced if JOBVR = 'N'.
-*
-*  LDVR    (input) INTEGER
-*          The leading dimension of the matrix VR. LDVR >= 1, and
-*          if JOBVR = 'V', LDVR >= N.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,8*N).
-*          For good performance, LWORK must generally be larger.
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          = 1,...,N:
-*                The QZ iteration failed.  No eigenvectors have been
-*                calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
-*                should be correct for j=INFO+1,...,N.
-*          > N:  =N+1: other than QZ iteration failed in DHGEQZ.
-*                =N+2: error return from DTGEVC.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
-      CHARACTER          CHTEMP
-      INTEGER            ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
-     $                   IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, MAXWRK,
-     $                   MINWRK
-      DOUBLE PRECISION   ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
-     $                   SMLNUM, TEMP
-*     ..
-*     .. Local Arrays ..
-      LOGICAL            LDUMMA( 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
-     $                   DLACPY,DLASCL, DLASET, DORGQR, DORMQR, DTGEVC,
-     $                   XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           LSAME, ILAENV, DLAMCH, DLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode the input arguments
-*
-      IF( LSAME( JOBVL, 'N' ) ) THEN
-         IJOBVL = 1
-         ILVL = .FALSE.
-      ELSE IF( LSAME( JOBVL, 'V' ) ) THEN
-         IJOBVL = 2
-         ILVL = .TRUE.
-      ELSE
-         IJOBVL = -1
-         ILVL = .FALSE.
-      END IF
-*
-      IF( LSAME( JOBVR, 'N' ) ) THEN
-         IJOBVR = 1
-         ILVR = .FALSE.
-      ELSE IF( LSAME( JOBVR, 'V' ) ) THEN
-         IJOBVR = 2
-         ILVR = .TRUE.
-      ELSE
-         IJOBVR = -1
-         ILVR = .FALSE.
-      END IF
-      ILV = ILVL .OR. ILVR
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( IJOBVL.LE.0 ) THEN
-         INFO = -1
-      ELSE IF( IJOBVR.LE.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDVL.LT.1 .OR. ( ILVL .AND. LDVL.LT.N ) ) THEN
-         INFO = -12
-      ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
-         INFO = -14
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       NB refers to the optimal block size for the immediately
-*       following subroutine, as returned by ILAENV. The workspace is
-*       computed assuming ILO = 1 and IHI = N, the worst case.)
-*
-      IF( INFO.EQ.0 ) THEN
-         MINWRK = MAX( 1, 8*N )
-         MAXWRK = MAX( 1, N*( 7 +
-     $                 ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 ) ) )
-         MAXWRK = MAX( MAXWRK, N*( 7 +
-     $                 ILAENV( 1, 'DORMQR', ' ', N, 1, N, 0 ) ) )
-         IF( ILVL ) THEN
-            MAXWRK = MAX( MAXWRK, N*( 7 +
-     $                 ILAENV( 1, 'DORGQR', ' ', N, 1, N, -1 ) ) )
-         END IF
-         WORK( 1 ) = MAXWRK
-*
-         IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
-     $      INFO = -16
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGGEV ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SQRT( SMLNUM ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = DLANGE( 'M', N, N, A, LDA, WORK )
-      ILASCL = .FALSE.
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         ANRMTO = SMLNUM
-         ILASCL = .TRUE.
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         ANRMTO = BIGNUM
-         ILASCL = .TRUE.
-      END IF
-      IF( ILASCL )
-     $   CALL DLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-*     Scale B if max element outside range [SMLNUM,BIGNUM]
-*
-      BNRM = DLANGE( 'M', N, N, B, LDB, WORK )
-      ILBSCL = .FALSE.
-      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-         BNRMTO = SMLNUM
-         ILBSCL = .TRUE.
-      ELSE IF( BNRM.GT.BIGNUM ) THEN
-         BNRMTO = BIGNUM
-         ILBSCL = .TRUE.
-      END IF
-      IF( ILBSCL )
-     $   CALL DLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-*     Permute the matrices A, B to isolate eigenvalues if possible
-*     (Workspace: need 6*N)
-*
-      ILEFT = 1
-      IRIGHT = N + 1
-      IWRK = IRIGHT + N
-      CALL DGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
-     $             WORK( IRIGHT ), WORK( IWRK ), IERR )
-*
-*     Reduce B to triangular form (QR decomposition of B)
-*     (Workspace: need N, prefer N*NB)
-*
-      IROWS = IHI + 1 - ILO
-      IF( ILV ) THEN
-         ICOLS = N + 1 - ILO
-      ELSE
-         ICOLS = IROWS
-      END IF
-      ITAU = IWRK
-      IWRK = ITAU + IROWS
-      CALL DGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
-     $             WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-*     Apply the orthogonal transformation to matrix A
-*     (Workspace: need N, prefer N*NB)
-*
-      CALL DORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
-     $             WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
-     $             LWORK+1-IWRK, IERR )
-*
-*     Initialize VL
-*     (Workspace: need N, prefer N*NB)
-*
-      IF( ILVL ) THEN
-         CALL DLASET( 'Full', N, N, ZERO, ONE, VL, LDVL )
-         IF( IROWS.GT.1 ) THEN
-            CALL DLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
-     $                   VL( ILO+1, ILO ), LDVL )
-         END IF
-         CALL DORGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
-     $                WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
-      END IF
-*
-*     Initialize VR
-*
-      IF( ILVR )
-     $   CALL DLASET( 'Full', N, N, ZERO, ONE, VR, LDVR )
-*
-*     Reduce to generalized Hessenberg form
-*     (Workspace: none needed)
-*
-      IF( ILV ) THEN
-*
-*        Eigenvectors requested -- work on whole matrix.
-*
-         CALL DGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
-     $                LDVL, VR, LDVR, IERR )
-      ELSE
-         CALL DGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
-     $                B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
-      END IF
-*
-*     Perform QZ algorithm (Compute eigenvalues, and optionally, the
-*     Schur forms and Schur vectors)
-*     (Workspace: need N)
-*
-      IWRK = ITAU
-      IF( ILV ) THEN
-         CHTEMP = 'S'
-      ELSE
-         CHTEMP = 'E'
-      END IF
-      CALL DHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
-     $             ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
-     $             WORK( IWRK ), LWORK+1-IWRK, IERR )
-      IF( IERR.NE.0 ) THEN
-         IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
-            INFO = IERR
-         ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
-            INFO = IERR - N
-         ELSE
-            INFO = N + 1
-         END IF
-         GO TO 110
-      END IF
-*
-*     Compute Eigenvectors
-*     (Workspace: need 6*N)
-*
-      IF( ILV ) THEN
-         IF( ILVL ) THEN
-            IF( ILVR ) THEN
-               CHTEMP = 'B'
-            ELSE
-               CHTEMP = 'L'
-            END IF
-         ELSE
-            CHTEMP = 'R'
-         END IF
-         CALL DTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL,
-     $                VR, LDVR, N, IN, WORK( IWRK ), IERR )
-         IF( IERR.NE.0 ) THEN
-            INFO = N + 2
-            GO TO 110
-         END IF
-*
-*        Undo balancing on VL and VR and normalization
-*        (Workspace: none needed)
-*
-         IF( ILVL ) THEN
-            CALL DGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
-     $                   WORK( IRIGHT ), N, VL, LDVL, IERR )
-            DO 50 JC = 1, N
-               IF( ALPHAI( JC ).LT.ZERO )
-     $            GO TO 50
-               TEMP = ZERO
-               IF( ALPHAI( JC ).EQ.ZERO ) THEN
-                  DO 10 JR = 1, N
-                     TEMP = MAX( TEMP, ABS( VL( JR, JC ) ) )
-   10             CONTINUE
-               ELSE
-                  DO 20 JR = 1, N
-                     TEMP = MAX( TEMP, ABS( VL( JR, JC ) )+
-     $                      ABS( VL( JR, JC+1 ) ) )
-   20             CONTINUE
-               END IF
-               IF( TEMP.LT.SMLNUM )
-     $            GO TO 50
-               TEMP = ONE / TEMP
-               IF( ALPHAI( JC ).EQ.ZERO ) THEN
-                  DO 30 JR = 1, N
-                     VL( JR, JC ) = VL( JR, JC )*TEMP
-   30             CONTINUE
-               ELSE
-                  DO 40 JR = 1, N
-                     VL( JR, JC ) = VL( JR, JC )*TEMP
-                     VL( JR, JC+1 ) = VL( JR, JC+1 )*TEMP
-   40             CONTINUE
-               END IF
-   50       CONTINUE
-         END IF
-         IF( ILVR ) THEN
-            CALL DGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
-     $                   WORK( IRIGHT ), N, VR, LDVR, IERR )
-            DO 100 JC = 1, N
-               IF( ALPHAI( JC ).LT.ZERO )
-     $            GO TO 100
-               TEMP = ZERO
-               IF( ALPHAI( JC ).EQ.ZERO ) THEN
-                  DO 60 JR = 1, N
-                     TEMP = MAX( TEMP, ABS( VR( JR, JC ) ) )
-   60             CONTINUE
-               ELSE
-                  DO 70 JR = 1, N
-                     TEMP = MAX( TEMP, ABS( VR( JR, JC ) )+
-     $                      ABS( VR( JR, JC+1 ) ) )
-   70             CONTINUE
-               END IF
-               IF( TEMP.LT.SMLNUM )
-     $            GO TO 100
-               TEMP = ONE / TEMP
-               IF( ALPHAI( JC ).EQ.ZERO ) THEN
-                  DO 80 JR = 1, N
-                     VR( JR, JC ) = VR( JR, JC )*TEMP
-   80             CONTINUE
-               ELSE
-                  DO 90 JR = 1, N
-                     VR( JR, JC ) = VR( JR, JC )*TEMP
-                     VR( JR, JC+1 ) = VR( JR, JC+1 )*TEMP
-   90             CONTINUE
-               END IF
-  100       CONTINUE
-         END IF
-*
-*        End of eigenvector calculation
-*
-      END IF
-*
-*     Undo scaling if necessary
-*
-      IF( ILASCL ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
-         CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
-      END IF
-*
-      IF( ILBSCL ) THEN
-         CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
-      END IF
-*
-  110 CONTINUE
-*
-      WORK( 1 ) = MAXWRK
-*
-      RETURN
-*
-*     End of DGGEV
-*
-      END
diff --git a/src/lib/lapack/dgghrd.f b/src/lib/lapack/dgghrd.f
deleted file mode 100644
index 6b8bbb08..00000000
--- a/src/lib/lapack/dgghrd.f
+++ /dev/null
@@ -1,264 +0,0 @@
-      SUBROUTINE DGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
-     $                   LDQ, Z, LDZ, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          COMPQ, COMPZ
-      INTEGER            IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DGGHRD reduces a pair of real matrices (A,B) to generalized upper
-*  Hessenberg form using orthogonal transformations, where A is a
-*  general matrix and B is upper triangular.  The form of the
-*  generalized eigenvalue problem is
-*     A*x = lambda*B*x,
-*  and B is typically made upper triangular by computing its QR
-*  factorization and moving the orthogonal matrix Q to the left side
-*  of the equation.
-*
-*  This subroutine simultaneously reduces A to a Hessenberg matrix H:
-*     Q**T*A*Z = H
-*  and transforms B to another upper triangular matrix T:
-*     Q**T*B*Z = T
-*  in order to reduce the problem to its standard form
-*     H*y = lambda*T*y
-*  where y = Z**T*x.
-*
-*  The orthogonal matrices Q and Z are determined as products of Givens
-*  rotations.  They may either be formed explicitly, or they may be
-*  postmultiplied into input matrices Q1 and Z1, so that
-*
-*       Q1 * A * Z1**T = (Q1*Q) * H * (Z1*Z)**T
-*
-*       Q1 * B * Z1**T = (Q1*Q) * T * (Z1*Z)**T
-*
-*  If Q1 is the orthogonal matrix from the QR factorization of B in the
-*  original equation A*x = lambda*B*x, then DGGHRD reduces the original
-*  problem to generalized Hessenberg form.
-*
-*  Arguments
-*  =========
-*
-*  COMPQ   (input) CHARACTER*1
-*          = 'N': do not compute Q;
-*          = 'I': Q is initialized to the unit matrix, and the
-*                 orthogonal matrix Q is returned;
-*          = 'V': Q must contain an orthogonal matrix Q1 on entry,
-*                 and the product Q1*Q is returned.
-*
-*  COMPZ   (input) CHARACTER*1
-*          = 'N': do not compute Z;
-*          = 'I': Z is initialized to the unit matrix, and the
-*                 orthogonal matrix Z is returned;
-*          = 'V': Z must contain an orthogonal matrix Z1 on entry,
-*                 and the product Z1*Z is returned.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          ILO and IHI mark the rows and columns of A which are to be
-*          reduced.  It is assumed that A is already upper triangular
-*          in rows and columns 1:ILO-1 and IHI+1:N.  ILO and IHI are
-*          normally set by a previous call to SGGBAL; otherwise they
-*          should be set to 1 and N respectively.
-*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA, N)
-*          On entry, the N-by-N general matrix to be reduced.
-*          On exit, the upper triangle and the first subdiagonal of A
-*          are overwritten with the upper Hessenberg matrix H, and the
-*          rest is set to zero.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB, N)
-*          On entry, the N-by-N upper triangular matrix B.
-*          On exit, the upper triangular matrix T = Q**T B Z.  The
-*          elements below the diagonal are set to zero.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  Q       (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
-*          On entry, if COMPQ = 'V', the orthogonal matrix Q1,
-*          typically from the QR factorization of B.
-*          On exit, if COMPQ='I', the orthogonal matrix Q, and if
-*          COMPQ = 'V', the product Q1*Q.
-*          Not referenced if COMPQ='N'.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q.
-*          LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
-*
-*  Z       (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
-*          On entry, if COMPZ = 'V', the orthogonal matrix Z1.
-*          On exit, if COMPZ='I', the orthogonal matrix Z, and if
-*          COMPZ = 'V', the product Z1*Z.
-*          Not referenced if COMPZ='N'.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z.
-*          LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  This routine reduces A to Hessenberg and B to triangular form by
-*  an unblocked reduction, as described in _Matrix_Computations_,
-*  by Golub and Van Loan (Johns Hopkins Press.)
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            ILQ, ILZ
-      INTEGER            ICOMPQ, ICOMPZ, JCOL, JROW
-      DOUBLE PRECISION   C, S, TEMP
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARTG, DLASET, DROT, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode COMPQ
-*
-      IF( LSAME( COMPQ, 'N' ) ) THEN
-         ILQ = .FALSE.
-         ICOMPQ = 1
-      ELSE IF( LSAME( COMPQ, 'V' ) ) THEN
-         ILQ = .TRUE.
-         ICOMPQ = 2
-      ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
-         ILQ = .TRUE.
-         ICOMPQ = 3
-      ELSE
-         ICOMPQ = 0
-      END IF
-*
-*     Decode COMPZ
-*
-      IF( LSAME( COMPZ, 'N' ) ) THEN
-         ILZ = .FALSE.
-         ICOMPZ = 1
-      ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
-         ILZ = .TRUE.
-         ICOMPZ = 2
-      ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
-         ILZ = .TRUE.
-         ICOMPZ = 3
-      ELSE
-         ICOMPZ = 0
-      END IF
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF( ICOMPQ.LE.0 ) THEN
-         INFO = -1
-      ELSE IF( ICOMPZ.LE.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( ILO.LT.1 ) THEN
-         INFO = -4
-      ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      ELSE IF( ( ILQ .AND. LDQ.LT.N ) .OR. LDQ.LT.1 ) THEN
-         INFO = -11
-      ELSE IF( ( ILZ .AND. LDZ.LT.N ) .OR. LDZ.LT.1 ) THEN
-         INFO = -13
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DGGHRD', -INFO )
-         RETURN
-      END IF
-*
-*     Initialize Q and Z if desired.
-*
-      IF( ICOMPQ.EQ.3 )
-     $   CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
-      IF( ICOMPZ.EQ.3 )
-     $   CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-*     Zero out lower triangle of B
-*
-      DO 20 JCOL = 1, N - 1
-         DO 10 JROW = JCOL + 1, N
-            B( JROW, JCOL ) = ZERO
-   10    CONTINUE
-   20 CONTINUE
-*
-*     Reduce A and B
-*
-      DO 40 JCOL = ILO, IHI - 2
-*
-         DO 30 JROW = IHI, JCOL + 2, -1
-*
-*           Step 1: rotate rows JROW-1, JROW to kill A(JROW,JCOL)
-*
-            TEMP = A( JROW-1, JCOL )
-            CALL DLARTG( TEMP, A( JROW, JCOL ), C, S,
-     $                   A( JROW-1, JCOL ) )
-            A( JROW, JCOL ) = ZERO
-            CALL DROT( N-JCOL, A( JROW-1, JCOL+1 ), LDA,
-     $                 A( JROW, JCOL+1 ), LDA, C, S )
-            CALL DROT( N+2-JROW, B( JROW-1, JROW-1 ), LDB,
-     $                 B( JROW, JROW-1 ), LDB, C, S )
-            IF( ILQ )
-     $         CALL DROT( N, Q( 1, JROW-1 ), 1, Q( 1, JROW ), 1, C, S )
-*
-*           Step 2: rotate columns JROW, JROW-1 to kill B(JROW,JROW-1)
-*
-            TEMP = B( JROW, JROW )
-            CALL DLARTG( TEMP, B( JROW, JROW-1 ), C, S,
-     $                   B( JROW, JROW ) )
-            B( JROW, JROW-1 ) = ZERO
-            CALL DROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S )
-            CALL DROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C,
-     $                 S )
-            IF( ILZ )
-     $         CALL DROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S )
-   30    CONTINUE
-   40 CONTINUE
-*
-      RETURN
-*
-*     End of DGGHRD
-*
-      END
diff --git a/src/lib/lapack/dhgeqz.f b/src/lib/lapack/dhgeqz.f
deleted file mode 100644
index de137dc1..00000000
--- a/src/lib/lapack/dhgeqz.f
+++ /dev/null
@@ -1,1243 +0,0 @@
-      SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
-     $                   ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
-     $                   LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          COMPQ, COMPZ, JOB
-      INTEGER            IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   ALPHAI( * ), ALPHAR( * ), BETA( * ),
-     $                   H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
-     $                   WORK( * ), Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DHGEQZ computes the eigenvalues of a real matrix pair (H,T),
-*  where H is an upper Hessenberg matrix and T is upper triangular,
-*  using the double-shift QZ method.
-*  Matrix pairs of this type are produced by the reduction to
-*  generalized upper Hessenberg form of a real matrix pair (A,B):
-*
-*     A = Q1*H*Z1**T,  B = Q1*T*Z1**T,
-*
-*  as computed by DGGHRD.
-*
-*  If JOB='S', then the Hessenberg-triangular pair (H,T) is
-*  also reduced to generalized Schur form,
-*  
-*     H = Q*S*Z**T,  T = Q*P*Z**T,
-*  
-*  where Q and Z are orthogonal matrices, P is an upper triangular
-*  matrix, and S is a quasi-triangular matrix with 1-by-1 and 2-by-2
-*  diagonal blocks.
-*
-*  The 1-by-1 blocks correspond to real eigenvalues of the matrix pair
-*  (H,T) and the 2-by-2 blocks correspond to complex conjugate pairs of
-*  eigenvalues.
-*
-*  Additionally, the 2-by-2 upper triangular diagonal blocks of P
-*  corresponding to 2-by-2 blocks of S are reduced to positive diagonal
-*  form, i.e., if S(j+1,j) is non-zero, then P(j+1,j) = P(j,j+1) = 0,
-*  P(j,j) > 0, and P(j+1,j+1) > 0.
-*
-*  Optionally, the orthogonal matrix Q from the generalized Schur
-*  factorization may be postmultiplied into an input matrix Q1, and the
-*  orthogonal matrix Z may be postmultiplied into an input matrix Z1.
-*  If Q1 and Z1 are the orthogonal matrices from DGGHRD that reduced
-*  the matrix pair (A,B) to generalized upper Hessenberg form, then the
-*  output matrices Q1*Q and Z1*Z are the orthogonal factors from the
-*  generalized Schur factorization of (A,B):
-*
-*     A = (Q1*Q)*S*(Z1*Z)**T,  B = (Q1*Q)*P*(Z1*Z)**T.
-*  
-*  To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently,
-*  of (A,B)) are computed as a pair of values (alpha,beta), where alpha is
-*  complex and beta real.
-*  If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
-*  generalized nonsymmetric eigenvalue problem (GNEP)
-*     A*x = lambda*B*x
-*  and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
-*  alternate form of the GNEP
-*     mu*A*y = B*y.
-*  Real eigenvalues can be read directly from the generalized Schur
-*  form: 
-*    alpha = S(i,i), beta = P(i,i).
-*
-*  Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
-*       Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
-*       pp. 241--256.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          = 'E': Compute eigenvalues only;
-*          = 'S': Compute eigenvalues and the Schur form. 
-*
-*  COMPQ   (input) CHARACTER*1
-*          = 'N': Left Schur vectors (Q) are not computed;
-*          = 'I': Q is initialized to the unit matrix and the matrix Q
-*                 of left Schur vectors of (H,T) is returned;
-*          = 'V': Q must contain an orthogonal matrix Q1 on entry and
-*                 the product Q1*Q is returned.
-*
-*  COMPZ   (input) CHARACTER*1
-*          = 'N': Right Schur vectors (Z) are not computed;
-*          = 'I': Z is initialized to the unit matrix and the matrix Z
-*                 of right Schur vectors of (H,T) is returned;
-*          = 'V': Z must contain an orthogonal matrix Z1 on entry and
-*                 the product Z1*Z is returned.
-*
-*  N       (input) INTEGER
-*          The order of the matrices H, T, Q, and Z.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          ILO and IHI mark the rows and columns of H which are in
-*          Hessenberg form.  It is assumed that A is already upper
-*          triangular in rows and columns 1:ILO-1 and IHI+1:N.
-*          If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
-*
-*  H       (input/output) DOUBLE PRECISION array, dimension (LDH, N)
-*          On entry, the N-by-N upper Hessenberg matrix H.
-*          On exit, if JOB = 'S', H contains the upper quasi-triangular
-*          matrix S from the generalized Schur factorization;
-*          2-by-2 diagonal blocks (corresponding to complex conjugate
-*          pairs of eigenvalues) are returned in standard form, with
-*          H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0.
-*          If JOB = 'E', the diagonal blocks of H match those of S, but
-*          the rest of H is unspecified.
-*
-*  LDH     (input) INTEGER
-*          The leading dimension of the array H.  LDH >= max( 1, N ).
-*
-*  T       (input/output) DOUBLE PRECISION array, dimension (LDT, N)
-*          On entry, the N-by-N upper triangular matrix T.
-*          On exit, if JOB = 'S', T contains the upper triangular
-*          matrix P from the generalized Schur factorization;
-*          2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks of S
-*          are reduced to positive diagonal form, i.e., if H(j+1,j) is
-*          non-zero, then T(j+1,j) = T(j,j+1) = 0, T(j,j) > 0, and
-*          T(j+1,j+1) > 0.
-*          If JOB = 'E', the diagonal blocks of T match those of P, but
-*          the rest of T is unspecified.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T.  LDT >= max( 1, N ).
-*
-*  ALPHAR  (output) DOUBLE PRECISION array, dimension (N)
-*          The real parts of each scalar alpha defining an eigenvalue
-*          of GNEP.
-*
-*  ALPHAI  (output) DOUBLE PRECISION array, dimension (N)
-*          The imaginary parts of each scalar alpha defining an
-*          eigenvalue of GNEP.
-*          If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*          positive, then the j-th and (j+1)-st eigenvalues are a
-*          complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
-*
-*  BETA    (output) DOUBLE PRECISION array, dimension (N)
-*          The scalars beta that define the eigenvalues of GNEP.
-*          Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
-*          beta = BETA(j) represent the j-th eigenvalue of the matrix
-*          pair (A,B), in one of the forms lambda = alpha/beta or
-*          mu = beta/alpha.  Since either lambda or mu may overflow,
-*          they should not, in general, be computed.
-*
-*  Q       (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
-*          On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in
-*          the reduction of (A,B) to generalized Hessenberg form.
-*          On exit, if COMPZ = 'I', the orthogonal matrix of left Schur
-*          vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix
-*          of left Schur vectors of (A,B).
-*          Not referenced if COMPZ = 'N'.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q.  LDQ >= 1.
-*          If COMPQ='V' or 'I', then LDQ >= N.
-*
-*  Z       (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
-*          On entry, if COMPZ = 'V', the orthogonal matrix Z1 used in
-*          the reduction of (A,B) to generalized Hessenberg form.
-*          On exit, if COMPZ = 'I', the orthogonal matrix of
-*          right Schur vectors of (H,T), and if COMPZ = 'V', the
-*          orthogonal matrix of right Schur vectors of (A,B).
-*          Not referenced if COMPZ = 'N'.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z.  LDZ >= 1.
-*          If COMPZ='V' or 'I', then LDZ >= N.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,N).
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*          = 1,...,N: the QZ iteration did not converge.  (H,T) is not
-*                     in Schur form, but ALPHAR(i), ALPHAI(i), and
-*                     BETA(i), i=INFO+1,...,N should be correct.
-*          = N+1,...,2*N: the shift calculation failed.  (H,T) is not
-*                     in Schur form, but ALPHAR(i), ALPHAI(i), and
-*                     BETA(i), i=INFO-N+1,...,N should be correct.
-*
-*  Further Details
-*  ===============
-*
-*  Iteration counters:
-*
-*  JITER  -- counts iterations.
-*  IITER  -- counts iterations run since ILAST was last
-*            changed.  This is therefore reset only when a 1-by-1 or
-*            2-by-2 block deflates off the bottom.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-*    $                     SAFETY = 1.0E+0 )
-      DOUBLE PRECISION   HALF, ZERO, ONE, SAFETY
-      PARAMETER          ( HALF = 0.5D+0, ZERO = 0.0D+0, ONE = 1.0D+0,
-     $                   SAFETY = 1.0D+2 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            ILAZR2, ILAZRO, ILPIVT, ILQ, ILSCHR, ILZ,
-     $                   LQUERY
-      INTEGER            ICOMPQ, ICOMPZ, IFIRST, IFRSTM, IITER, ILAST,
-     $                   ILASTM, IN, ISCHUR, ISTART, J, JC, JCH, JITER,
-     $                   JR, MAXIT
-      DOUBLE PRECISION   A11, A12, A1I, A1R, A21, A22, A2I, A2R, AD11,
-     $                   AD11L, AD12, AD12L, AD21, AD21L, AD22, AD22L,
-     $                   AD32L, AN, ANORM, ASCALE, ATOL, B11, B1A, B1I,
-     $                   B1R, B22, B2A, B2I, B2R, BN, BNORM, BSCALE,
-     $                   BTOL, C, C11I, C11R, C12, C21, C22I, C22R, CL,
-     $                   CQ, CR, CZ, ESHIFT, S, S1, S1INV, S2, SAFMAX,
-     $                   SAFMIN, SCALE, SL, SQI, SQR, SR, SZI, SZR, T1,
-     $                   TAU, TEMP, TEMP2, TEMPI, TEMPR, U1, U12, U12L,
-     $                   U2, ULP, VS, W11, W12, W21, W22, WABS, WI, WR,
-     $                   WR2
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   V( 3 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH, DLANHS, DLAPY2, DLAPY3
-      EXTERNAL           LSAME, DLAMCH, DLANHS, DLAPY2, DLAPY3
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLAG2, DLARFG, DLARTG, DLASET, DLASV2, DROT,
-     $                   XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode JOB, COMPQ, COMPZ
-*
-      IF( LSAME( JOB, 'E' ) ) THEN
-         ILSCHR = .FALSE.
-         ISCHUR = 1
-      ELSE IF( LSAME( JOB, 'S' ) ) THEN
-         ILSCHR = .TRUE.
-         ISCHUR = 2
-      ELSE
-         ISCHUR = 0
-      END IF
-*
-      IF( LSAME( COMPQ, 'N' ) ) THEN
-         ILQ = .FALSE.
-         ICOMPQ = 1
-      ELSE IF( LSAME( COMPQ, 'V' ) ) THEN
-         ILQ = .TRUE.
-         ICOMPQ = 2
-      ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
-         ILQ = .TRUE.
-         ICOMPQ = 3
-      ELSE
-         ICOMPQ = 0
-      END IF
-*
-      IF( LSAME( COMPZ, 'N' ) ) THEN
-         ILZ = .FALSE.
-         ICOMPZ = 1
-      ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
-         ILZ = .TRUE.
-         ICOMPZ = 2
-      ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
-         ILZ = .TRUE.
-         ICOMPZ = 3
-      ELSE
-         ICOMPZ = 0
-      END IF
-*
-*     Check Argument Values
-*
-      INFO = 0
-      WORK( 1 ) = MAX( 1, N )
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( ISCHUR.EQ.0 ) THEN
-         INFO = -1
-      ELSE IF( ICOMPQ.EQ.0 ) THEN
-         INFO = -2
-      ELSE IF( ICOMPZ.EQ.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( ILO.LT.1 ) THEN
-         INFO = -5
-      ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
-         INFO = -6
-      ELSE IF( LDH.LT.N ) THEN
-         INFO = -8
-      ELSE IF( LDT.LT.N ) THEN
-         INFO = -10
-      ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
-         INFO = -15
-      ELSE IF( LDZ.LT.1 .OR. ( ILZ .AND. LDZ.LT.N ) ) THEN
-         INFO = -17
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -19
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DHGEQZ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 ) THEN
-         WORK( 1 ) = DBLE( 1 )
-         RETURN
-      END IF
-*
-*     Initialize Q and Z
-*
-      IF( ICOMPQ.EQ.3 )
-     $   CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
-      IF( ICOMPZ.EQ.3 )
-     $   CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
-*     Machine Constants
-*
-      IN = IHI + 1 - ILO
-      SAFMIN = DLAMCH( 'S' )
-      SAFMAX = ONE / SAFMIN
-      ULP = DLAMCH( 'E' )*DLAMCH( 'B' )
-      ANORM = DLANHS( 'F', IN, H( ILO, ILO ), LDH, WORK )
-      BNORM = DLANHS( 'F', IN, T( ILO, ILO ), LDT, WORK )
-      ATOL = MAX( SAFMIN, ULP*ANORM )
-      BTOL = MAX( SAFMIN, ULP*BNORM )
-      ASCALE = ONE / MAX( SAFMIN, ANORM )
-      BSCALE = ONE / MAX( SAFMIN, BNORM )
-*
-*     Set Eigenvalues IHI+1:N
-*
-      DO 30 J = IHI + 1, N
-         IF( T( J, J ).LT.ZERO ) THEN
-            IF( ILSCHR ) THEN
-               DO 10 JR = 1, J
-                  H( JR, J ) = -H( JR, J )
-                  T( JR, J ) = -T( JR, J )
-   10          CONTINUE
-            ELSE
-               H( J, J ) = -H( J, J )
-               T( J, J ) = -T( J, J )
-            END IF
-            IF( ILZ ) THEN
-               DO 20 JR = 1, N
-                  Z( JR, J ) = -Z( JR, J )
-   20          CONTINUE
-            END IF
-         END IF
-         ALPHAR( J ) = H( J, J )
-         ALPHAI( J ) = ZERO
-         BETA( J ) = T( J, J )
-   30 CONTINUE
-*
-*     If IHI < ILO, skip QZ steps
-*
-      IF( IHI.LT.ILO )
-     $   GO TO 380
-*
-*     MAIN QZ ITERATION LOOP
-*
-*     Initialize dynamic indices
-*
-*     Eigenvalues ILAST+1:N have been found.
-*        Column operations modify rows IFRSTM:whatever.
-*        Row operations modify columns whatever:ILASTM.
-*
-*     If only eigenvalues are being computed, then
-*        IFRSTM is the row of the last splitting row above row ILAST;
-*        this is always at least ILO.
-*     IITER counts iterations since the last eigenvalue was found,
-*        to tell when to use an extraordinary shift.
-*     MAXIT is the maximum number of QZ sweeps allowed.
-*
-      ILAST = IHI
-      IF( ILSCHR ) THEN
-         IFRSTM = 1
-         ILASTM = N
-      ELSE
-         IFRSTM = ILO
-         ILASTM = IHI
-      END IF
-      IITER = 0
-      ESHIFT = ZERO
-      MAXIT = 30*( IHI-ILO+1 )
-*
-      DO 360 JITER = 1, MAXIT
-*
-*        Split the matrix if possible.
-*
-*        Two tests:
-*           1: H(j,j-1)=0  or  j=ILO
-*           2: T(j,j)=0
-*
-         IF( ILAST.EQ.ILO ) THEN
-*
-*           Special case: j=ILAST
-*
-            GO TO 80
-         ELSE
-            IF( ABS( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
-               H( ILAST, ILAST-1 ) = ZERO
-               GO TO 80
-            END IF
-         END IF
-*
-         IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
-            T( ILAST, ILAST ) = ZERO
-            GO TO 70
-         END IF
-*
-*        General case: j<ILAST
-*
-         DO 60 J = ILAST - 1, ILO, -1
-*
-*           Test 1: for H(j,j-1)=0 or j=ILO
-*
-            IF( J.EQ.ILO ) THEN
-               ILAZRO = .TRUE.
-            ELSE
-               IF( ABS( H( J, J-1 ) ).LE.ATOL ) THEN
-                  H( J, J-1 ) = ZERO
-                  ILAZRO = .TRUE.
-               ELSE
-                  ILAZRO = .FALSE.
-               END IF
-            END IF
-*
-*           Test 2: for T(j,j)=0
-*
-            IF( ABS( T( J, J ) ).LT.BTOL ) THEN
-               T( J, J ) = ZERO
-*
-*              Test 1a: Check for 2 consecutive small subdiagonals in A
-*
-               ILAZR2 = .FALSE.
-               IF( .NOT.ILAZRO ) THEN
-                  TEMP = ABS( H( J, J-1 ) )
-                  TEMP2 = ABS( H( J, J ) )
-                  TEMPR = MAX( TEMP, TEMP2 )
-                  IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
-                     TEMP = TEMP / TEMPR
-                     TEMP2 = TEMP2 / TEMPR
-                  END IF
-                  IF( TEMP*( ASCALE*ABS( H( J+1, J ) ) ).LE.TEMP2*
-     $                ( ASCALE*ATOL ) )ILAZR2 = .TRUE.
-               END IF
-*
-*              If both tests pass (1 & 2), i.e., the leading diagonal
-*              element of B in the block is zero, split a 1x1 block off
-*              at the top. (I.e., at the J-th row/column) The leading
-*              diagonal element of the remainder can also be zero, so
-*              this may have to be done repeatedly.
-*
-               IF( ILAZRO .OR. ILAZR2 ) THEN
-                  DO 40 JCH = J, ILAST - 1
-                     TEMP = H( JCH, JCH )
-                     CALL DLARTG( TEMP, H( JCH+1, JCH ), C, S,
-     $                            H( JCH, JCH ) )
-                     H( JCH+1, JCH ) = ZERO
-                     CALL DROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
-     $                          H( JCH+1, JCH+1 ), LDH, C, S )
-                     CALL DROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
-     $                          T( JCH+1, JCH+1 ), LDT, C, S )
-                     IF( ILQ )
-     $                  CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
-     $                             C, S )
-                     IF( ILAZR2 )
-     $                  H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
-                     ILAZR2 = .FALSE.
-                     IF( ABS( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
-                        IF( JCH+1.GE.ILAST ) THEN
-                           GO TO 80
-                        ELSE
-                           IFIRST = JCH + 1
-                           GO TO 110
-                        END IF
-                     END IF
-                     T( JCH+1, JCH+1 ) = ZERO
-   40             CONTINUE
-                  GO TO 70
-               ELSE
-*
-*                 Only test 2 passed -- chase the zero to T(ILAST,ILAST)
-*                 Then process as in the case T(ILAST,ILAST)=0
-*
-                  DO 50 JCH = J, ILAST - 1
-                     TEMP = T( JCH, JCH+1 )
-                     CALL DLARTG( TEMP, T( JCH+1, JCH+1 ), C, S,
-     $                            T( JCH, JCH+1 ) )
-                     T( JCH+1, JCH+1 ) = ZERO
-                     IF( JCH.LT.ILASTM-1 )
-     $                  CALL DROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
-     $                             T( JCH+1, JCH+2 ), LDT, C, S )
-                     CALL DROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
-     $                          H( JCH+1, JCH-1 ), LDH, C, S )
-                     IF( ILQ )
-     $                  CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
-     $                             C, S )
-                     TEMP = H( JCH+1, JCH )
-                     CALL DLARTG( TEMP, H( JCH+1, JCH-1 ), C, S,
-     $                            H( JCH+1, JCH ) )
-                     H( JCH+1, JCH-1 ) = ZERO
-                     CALL DROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
-     $                          H( IFRSTM, JCH-1 ), 1, C, S )
-                     CALL DROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
-     $                          T( IFRSTM, JCH-1 ), 1, C, S )
-                     IF( ILZ )
-     $                  CALL DROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
-     $                             C, S )
-   50             CONTINUE
-                  GO TO 70
-               END IF
-            ELSE IF( ILAZRO ) THEN
-*
-*              Only test 1 passed -- work on J:ILAST
-*
-               IFIRST = J
-               GO TO 110
-            END IF
-*
-*           Neither test passed -- try next J
-*
-   60    CONTINUE
-*
-*        (Drop-through is "impossible")
-*
-         INFO = N + 1
-         GO TO 420
-*
-*        T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
-*        1x1 block.
-*
-   70    CONTINUE
-         TEMP = H( ILAST, ILAST )
-         CALL DLARTG( TEMP, H( ILAST, ILAST-1 ), C, S,
-     $                H( ILAST, ILAST ) )
-         H( ILAST, ILAST-1 ) = ZERO
-         CALL DROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
-     $              H( IFRSTM, ILAST-1 ), 1, C, S )
-         CALL DROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
-     $              T( IFRSTM, ILAST-1 ), 1, C, S )
-         IF( ILZ )
-     $      CALL DROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
-*
-*        H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
-*                              and BETA
-*
-   80    CONTINUE
-         IF( T( ILAST, ILAST ).LT.ZERO ) THEN
-            IF( ILSCHR ) THEN
-               DO 90 J = IFRSTM, ILAST
-                  H( J, ILAST ) = -H( J, ILAST )
-                  T( J, ILAST ) = -T( J, ILAST )
-   90          CONTINUE
-            ELSE
-               H( ILAST, ILAST ) = -H( ILAST, ILAST )
-               T( ILAST, ILAST ) = -T( ILAST, ILAST )
-            END IF
-            IF( ILZ ) THEN
-               DO 100 J = 1, N
-                  Z( J, ILAST ) = -Z( J, ILAST )
-  100          CONTINUE
-            END IF
-         END IF
-         ALPHAR( ILAST ) = H( ILAST, ILAST )
-         ALPHAI( ILAST ) = ZERO
-         BETA( ILAST ) = T( ILAST, ILAST )
-*
-*        Go to next block -- exit if finished.
-*
-         ILAST = ILAST - 1
-         IF( ILAST.LT.ILO )
-     $      GO TO 380
-*
-*        Reset counters
-*
-         IITER = 0
-         ESHIFT = ZERO
-         IF( .NOT.ILSCHR ) THEN
-            ILASTM = ILAST
-            IF( IFRSTM.GT.ILAST )
-     $         IFRSTM = ILO
-         END IF
-         GO TO 350
-*
-*        QZ step
-*
-*        This iteration only involves rows/columns IFIRST:ILAST. We
-*        assume IFIRST < ILAST, and that the diagonal of B is non-zero.
-*
-  110    CONTINUE
-         IITER = IITER + 1
-         IF( .NOT.ILSCHR ) THEN
-            IFRSTM = IFIRST
-         END IF
-*
-*        Compute single shifts.
-*
-*        At this point, IFIRST < ILAST, and the diagonal elements of
-*        T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
-*        magnitude)
-*
-         IF( ( IITER / 10 )*10.EQ.IITER ) THEN
-*
-*           Exceptional shift.  Chosen for no particularly good reason.
-*           (Single shift only.)
-*
-            IF( ( DBLE( MAXIT )*SAFMIN )*ABS( H( ILAST-1, ILAST ) ).LT.
-     $          ABS( T( ILAST-1, ILAST-1 ) ) ) THEN
-               ESHIFT = ESHIFT + H( ILAST-1, ILAST ) /
-     $                  T( ILAST-1, ILAST-1 )
-            ELSE
-               ESHIFT = ESHIFT + ONE / ( SAFMIN*DBLE( MAXIT ) )
-            END IF
-            S1 = ONE
-            WR = ESHIFT
-*
-         ELSE
-*
-*           Shifts based on the generalized eigenvalues of the
-*           bottom-right 2x2 block of A and B. The first eigenvalue
-*           returned by DLAG2 is the Wilkinson shift (AEP p.512),
-*
-            CALL DLAG2( H( ILAST-1, ILAST-1 ), LDH,
-     $                  T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
-     $                  S2, WR, WR2, WI )
-*
-            TEMP = MAX( S1, SAFMIN*MAX( ONE, ABS( WR ), ABS( WI ) ) )
-            IF( WI.NE.ZERO )
-     $         GO TO 200
-         END IF
-*
-*        Fiddle with shift to avoid overflow
-*
-         TEMP = MIN( ASCALE, ONE )*( HALF*SAFMAX )
-         IF( S1.GT.TEMP ) THEN
-            SCALE = TEMP / S1
-         ELSE
-            SCALE = ONE
-         END IF
-*
-         TEMP = MIN( BSCALE, ONE )*( HALF*SAFMAX )
-         IF( ABS( WR ).GT.TEMP )
-     $      SCALE = MIN( SCALE, TEMP / ABS( WR ) )
-         S1 = SCALE*S1
-         WR = SCALE*WR
-*
-*        Now check for two consecutive small subdiagonals.
-*
-         DO 120 J = ILAST - 1, IFIRST + 1, -1
-            ISTART = J
-            TEMP = ABS( S1*H( J, J-1 ) )
-            TEMP2 = ABS( S1*H( J, J )-WR*T( J, J ) )
-            TEMPR = MAX( TEMP, TEMP2 )
-            IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
-               TEMP = TEMP / TEMPR
-               TEMP2 = TEMP2 / TEMPR
-            END IF
-            IF( ABS( ( ASCALE*H( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
-     $          TEMP2 )GO TO 130
-  120    CONTINUE
-*
-         ISTART = IFIRST
-  130    CONTINUE
-*
-*        Do an implicit single-shift QZ sweep.
-*
-*        Initial Q
-*
-         TEMP = S1*H( ISTART, ISTART ) - WR*T( ISTART, ISTART )
-         TEMP2 = S1*H( ISTART+1, ISTART )
-         CALL DLARTG( TEMP, TEMP2, C, S, TEMPR )
-*
-*        Sweep
-*
-         DO 190 J = ISTART, ILAST - 1
-            IF( J.GT.ISTART ) THEN
-               TEMP = H( J, J-1 )
-               CALL DLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
-               H( J+1, J-1 ) = ZERO
-            END IF
-*
-            DO 140 JC = J, ILASTM
-               TEMP = C*H( J, JC ) + S*H( J+1, JC )
-               H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
-               H( J, JC ) = TEMP
-               TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
-               T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
-               T( J, JC ) = TEMP2
-  140       CONTINUE
-            IF( ILQ ) THEN
-               DO 150 JR = 1, N
-                  TEMP = C*Q( JR, J ) + S*Q( JR, J+1 )
-                  Q( JR, J+1 ) = -S*Q( JR, J ) + C*Q( JR, J+1 )
-                  Q( JR, J ) = TEMP
-  150          CONTINUE
-            END IF
-*
-            TEMP = T( J+1, J+1 )
-            CALL DLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
-            T( J+1, J ) = ZERO
-*
-            DO 160 JR = IFRSTM, MIN( J+2, ILAST )
-               TEMP = C*H( JR, J+1 ) + S*H( JR, J )
-               H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
-               H( JR, J+1 ) = TEMP
-  160       CONTINUE
-            DO 170 JR = IFRSTM, J
-               TEMP = C*T( JR, J+1 ) + S*T( JR, J )
-               T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
-               T( JR, J+1 ) = TEMP
-  170       CONTINUE
-            IF( ILZ ) THEN
-               DO 180 JR = 1, N
-                  TEMP = C*Z( JR, J+1 ) + S*Z( JR, J )
-                  Z( JR, J ) = -S*Z( JR, J+1 ) + C*Z( JR, J )
-                  Z( JR, J+1 ) = TEMP
-  180          CONTINUE
-            END IF
-  190    CONTINUE
-*
-         GO TO 350
-*
-*        Use Francis double-shift
-*
-*        Note: the Francis double-shift should work with real shifts,
-*              but only if the block is at least 3x3.
-*              This code may break if this point is reached with
-*              a 2x2 block with real eigenvalues.
-*
-  200    CONTINUE
-         IF( IFIRST+1.EQ.ILAST ) THEN
-*
-*           Special case -- 2x2 block with complex eigenvectors
-*
-*           Step 1: Standardize, that is, rotate so that
-*
-*                       ( B11  0  )
-*                   B = (         )  with B11 non-negative.
-*                       (  0  B22 )
-*
-            CALL DLASV2( T( ILAST-1, ILAST-1 ), T( ILAST-1, ILAST ),
-     $                   T( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
-*
-            IF( B11.LT.ZERO ) THEN
-               CR = -CR
-               SR = -SR
-               B11 = -B11
-               B22 = -B22
-            END IF
-*
-            CALL DROT( ILASTM+1-IFIRST, H( ILAST-1, ILAST-1 ), LDH,
-     $                 H( ILAST, ILAST-1 ), LDH, CL, SL )
-            CALL DROT( ILAST+1-IFRSTM, H( IFRSTM, ILAST-1 ), 1,
-     $                 H( IFRSTM, ILAST ), 1, CR, SR )
-*
-            IF( ILAST.LT.ILASTM )
-     $         CALL DROT( ILASTM-ILAST, T( ILAST-1, ILAST+1 ), LDT,
-     $                    T( ILAST, ILAST+1 ), LDH, CL, SL )
-            IF( IFRSTM.LT.ILAST-1 )
-     $         CALL DROT( IFIRST-IFRSTM, T( IFRSTM, ILAST-1 ), 1,
-     $                    T( IFRSTM, ILAST ), 1, CR, SR )
-*
-            IF( ILQ )
-     $         CALL DROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, CL,
-     $                    SL )
-            IF( ILZ )
-     $         CALL DROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, CR,
-     $                    SR )
-*
-            T( ILAST-1, ILAST-1 ) = B11
-            T( ILAST-1, ILAST ) = ZERO
-            T( ILAST, ILAST-1 ) = ZERO
-            T( ILAST, ILAST ) = B22
-*
-*           If B22 is negative, negate column ILAST
-*
-            IF( B22.LT.ZERO ) THEN
-               DO 210 J = IFRSTM, ILAST
-                  H( J, ILAST ) = -H( J, ILAST )
-                  T( J, ILAST ) = -T( J, ILAST )
-  210          CONTINUE
-*
-               IF( ILZ ) THEN
-                  DO 220 J = 1, N
-                     Z( J, ILAST ) = -Z( J, ILAST )
-  220             CONTINUE
-               END IF
-            END IF
-*
-*           Step 2: Compute ALPHAR, ALPHAI, and BETA (see refs.)
-*
-*           Recompute shift
-*
-            CALL DLAG2( H( ILAST-1, ILAST-1 ), LDH,
-     $                  T( ILAST-1, ILAST-1 ), LDT, SAFMIN*SAFETY, S1,
-     $                  TEMP, WR, TEMP2, WI )
-*
-*           If standardization has perturbed the shift onto real line,
-*           do another (real single-shift) QR step.
-*
-            IF( WI.EQ.ZERO )
-     $         GO TO 350
-            S1INV = ONE / S1
-*
-*           Do EISPACK (QZVAL) computation of alpha and beta
-*
-            A11 = H( ILAST-1, ILAST-1 )
-            A21 = H( ILAST, ILAST-1 )
-            A12 = H( ILAST-1, ILAST )
-            A22 = H( ILAST, ILAST )
-*
-*           Compute complex Givens rotation on right
-*           (Assume some element of C = (sA - wB) > unfl )
-*                            __
-*           (sA - wB) ( CZ   -SZ )
-*                     ( SZ    CZ )
-*
-            C11R = S1*A11 - WR*B11
-            C11I = -WI*B11
-            C12 = S1*A12
-            C21 = S1*A21
-            C22R = S1*A22 - WR*B22
-            C22I = -WI*B22
-*
-            IF( ABS( C11R )+ABS( C11I )+ABS( C12 ).GT.ABS( C21 )+
-     $          ABS( C22R )+ABS( C22I ) ) THEN
-               T1 = DLAPY3( C12, C11R, C11I )
-               CZ = C12 / T1
-               SZR = -C11R / T1
-               SZI = -C11I / T1
-            ELSE
-               CZ = DLAPY2( C22R, C22I )
-               IF( CZ.LE.SAFMIN ) THEN
-                  CZ = ZERO
-                  SZR = ONE
-                  SZI = ZERO
-               ELSE
-                  TEMPR = C22R / CZ
-                  TEMPI = C22I / CZ
-                  T1 = DLAPY2( CZ, C21 )
-                  CZ = CZ / T1
-                  SZR = -C21*TEMPR / T1
-                  SZI = C21*TEMPI / T1
-               END IF
-            END IF
-*
-*           Compute Givens rotation on left
-*
-*           (  CQ   SQ )
-*           (  __      )  A or B
-*           ( -SQ   CQ )
-*
-            AN = ABS( A11 ) + ABS( A12 ) + ABS( A21 ) + ABS( A22 )
-            BN = ABS( B11 ) + ABS( B22 )
-            WABS = ABS( WR ) + ABS( WI )
-            IF( S1*AN.GT.WABS*BN ) THEN
-               CQ = CZ*B11
-               SQR = SZR*B22
-               SQI = -SZI*B22
-            ELSE
-               A1R = CZ*A11 + SZR*A12
-               A1I = SZI*A12
-               A2R = CZ*A21 + SZR*A22
-               A2I = SZI*A22
-               CQ = DLAPY2( A1R, A1I )
-               IF( CQ.LE.SAFMIN ) THEN
-                  CQ = ZERO
-                  SQR = ONE
-                  SQI = ZERO
-               ELSE
-                  TEMPR = A1R / CQ
-                  TEMPI = A1I / CQ
-                  SQR = TEMPR*A2R + TEMPI*A2I
-                  SQI = TEMPI*A2R - TEMPR*A2I
-               END IF
-            END IF
-            T1 = DLAPY3( CQ, SQR, SQI )
-            CQ = CQ / T1
-            SQR = SQR / T1
-            SQI = SQI / T1
-*
-*           Compute diagonal elements of QBZ
-*
-            TEMPR = SQR*SZR - SQI*SZI
-            TEMPI = SQR*SZI + SQI*SZR
-            B1R = CQ*CZ*B11 + TEMPR*B22
-            B1I = TEMPI*B22
-            B1A = DLAPY2( B1R, B1I )
-            B2R = CQ*CZ*B22 + TEMPR*B11
-            B2I = -TEMPI*B11
-            B2A = DLAPY2( B2R, B2I )
-*
-*           Normalize so beta > 0, and Im( alpha1 ) > 0
-*
-            BETA( ILAST-1 ) = B1A
-            BETA( ILAST ) = B2A
-            ALPHAR( ILAST-1 ) = ( WR*B1A )*S1INV
-            ALPHAI( ILAST-1 ) = ( WI*B1A )*S1INV
-            ALPHAR( ILAST ) = ( WR*B2A )*S1INV
-            ALPHAI( ILAST ) = -( WI*B2A )*S1INV
-*
-*           Step 3: Go to next block -- exit if finished.
-*
-            ILAST = IFIRST - 1
-            IF( ILAST.LT.ILO )
-     $         GO TO 380
-*
-*           Reset counters
-*
-            IITER = 0
-            ESHIFT = ZERO
-            IF( .NOT.ILSCHR ) THEN
-               ILASTM = ILAST
-               IF( IFRSTM.GT.ILAST )
-     $            IFRSTM = ILO
-            END IF
-            GO TO 350
-         ELSE
-*
-*           Usual case: 3x3 or larger block, using Francis implicit
-*                       double-shift
-*
-*                                    2
-*           Eigenvalue equation is  w  - c w + d = 0,
-*
-*                                         -1 2        -1
-*           so compute 1st column of  (A B  )  - c A B   + d
-*           using the formula in QZIT (from EISPACK)
-*
-*           We assume that the block is at least 3x3
-*
-            AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
-     $             ( BSCALE*T( ILAST-1, ILAST-1 ) )
-            AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
-     $             ( BSCALE*T( ILAST-1, ILAST-1 ) )
-            AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
-     $             ( BSCALE*T( ILAST, ILAST ) )
-            AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
-     $             ( BSCALE*T( ILAST, ILAST ) )
-            U12 = T( ILAST-1, ILAST ) / T( ILAST, ILAST )
-            AD11L = ( ASCALE*H( IFIRST, IFIRST ) ) /
-     $              ( BSCALE*T( IFIRST, IFIRST ) )
-            AD21L = ( ASCALE*H( IFIRST+1, IFIRST ) ) /
-     $              ( BSCALE*T( IFIRST, IFIRST ) )
-            AD12L = ( ASCALE*H( IFIRST, IFIRST+1 ) ) /
-     $              ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
-            AD22L = ( ASCALE*H( IFIRST+1, IFIRST+1 ) ) /
-     $              ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
-            AD32L = ( ASCALE*H( IFIRST+2, IFIRST+1 ) ) /
-     $              ( BSCALE*T( IFIRST+1, IFIRST+1 ) )
-            U12L = T( IFIRST, IFIRST+1 ) / T( IFIRST+1, IFIRST+1 )
-*
-            V( 1 ) = ( AD11-AD11L )*( AD22-AD11L ) - AD12*AD21 +
-     $               AD21*U12*AD11L + ( AD12L-AD11L*U12L )*AD21L
-            V( 2 ) = ( ( AD22L-AD11L )-AD21L*U12L-( AD11-AD11L )-
-     $               ( AD22-AD11L )+AD21*U12 )*AD21L
-            V( 3 ) = AD32L*AD21L
-*
-            ISTART = IFIRST
-*
-            CALL DLARFG( 3, V( 1 ), V( 2 ), 1, TAU )
-            V( 1 ) = ONE
-*
-*           Sweep
-*
-            DO 290 J = ISTART, ILAST - 2
-*
-*              All but last elements: use 3x3 Householder transforms.
-*
-*              Zero (j-1)st column of A
-*
-               IF( J.GT.ISTART ) THEN
-                  V( 1 ) = H( J, J-1 )
-                  V( 2 ) = H( J+1, J-1 )
-                  V( 3 ) = H( J+2, J-1 )
-*
-                  CALL DLARFG( 3, H( J, J-1 ), V( 2 ), 1, TAU )
-                  V( 1 ) = ONE
-                  H( J+1, J-1 ) = ZERO
-                  H( J+2, J-1 ) = ZERO
-               END IF
-*
-               DO 230 JC = J, ILASTM
-                  TEMP = TAU*( H( J, JC )+V( 2 )*H( J+1, JC )+V( 3 )*
-     $                   H( J+2, JC ) )
-                  H( J, JC ) = H( J, JC ) - TEMP
-                  H( J+1, JC ) = H( J+1, JC ) - TEMP*V( 2 )
-                  H( J+2, JC ) = H( J+2, JC ) - TEMP*V( 3 )
-                  TEMP2 = TAU*( T( J, JC )+V( 2 )*T( J+1, JC )+V( 3 )*
-     $                    T( J+2, JC ) )
-                  T( J, JC ) = T( J, JC ) - TEMP2
-                  T( J+1, JC ) = T( J+1, JC ) - TEMP2*V( 2 )
-                  T( J+2, JC ) = T( J+2, JC ) - TEMP2*V( 3 )
-  230          CONTINUE
-               IF( ILQ ) THEN
-                  DO 240 JR = 1, N
-                     TEMP = TAU*( Q( JR, J )+V( 2 )*Q( JR, J+1 )+V( 3 )*
-     $                      Q( JR, J+2 ) )
-                     Q( JR, J ) = Q( JR, J ) - TEMP
-                     Q( JR, J+1 ) = Q( JR, J+1 ) - TEMP*V( 2 )
-                     Q( JR, J+2 ) = Q( JR, J+2 ) - TEMP*V( 3 )
-  240             CONTINUE
-               END IF
-*
-*              Zero j-th column of B (see DLAGBC for details)
-*
-*              Swap rows to pivot
-*
-               ILPIVT = .FALSE.
-               TEMP = MAX( ABS( T( J+1, J+1 ) ), ABS( T( J+1, J+2 ) ) )
-               TEMP2 = MAX( ABS( T( J+2, J+1 ) ), ABS( T( J+2, J+2 ) ) )
-               IF( MAX( TEMP, TEMP2 ).LT.SAFMIN ) THEN
-                  SCALE = ZERO
-                  U1 = ONE
-                  U2 = ZERO
-                  GO TO 250
-               ELSE IF( TEMP.GE.TEMP2 ) THEN
-                  W11 = T( J+1, J+1 )
-                  W21 = T( J+2, J+1 )
-                  W12 = T( J+1, J+2 )
-                  W22 = T( J+2, J+2 )
-                  U1 = T( J+1, J )
-                  U2 = T( J+2, J )
-               ELSE
-                  W21 = T( J+1, J+1 )
-                  W11 = T( J+2, J+1 )
-                  W22 = T( J+1, J+2 )
-                  W12 = T( J+2, J+2 )
-                  U2 = T( J+1, J )
-                  U1 = T( J+2, J )
-               END IF
-*
-*              Swap columns if nec.
-*
-               IF( ABS( W12 ).GT.ABS( W11 ) ) THEN
-                  ILPIVT = .TRUE.
-                  TEMP = W12
-                  TEMP2 = W22
-                  W12 = W11
-                  W22 = W21
-                  W11 = TEMP
-                  W21 = TEMP2
-               END IF
-*
-*              LU-factor
-*
-               TEMP = W21 / W11
-               U2 = U2 - TEMP*U1
-               W22 = W22 - TEMP*W12
-               W21 = ZERO
-*
-*              Compute SCALE
-*
-               SCALE = ONE
-               IF( ABS( W22 ).LT.SAFMIN ) THEN
-                  SCALE = ZERO
-                  U2 = ONE
-                  U1 = -W12 / W11
-                  GO TO 250
-               END IF
-               IF( ABS( W22 ).LT.ABS( U2 ) )
-     $            SCALE = ABS( W22 / U2 )
-               IF( ABS( W11 ).LT.ABS( U1 ) )
-     $            SCALE = MIN( SCALE, ABS( W11 / U1 ) )
-*
-*              Solve
-*
-               U2 = ( SCALE*U2 ) / W22
-               U1 = ( SCALE*U1-W12*U2 ) / W11
-*
-  250          CONTINUE
-               IF( ILPIVT ) THEN
-                  TEMP = U2
-                  U2 = U1
-                  U1 = TEMP
-               END IF
-*
-*              Compute Householder Vector
-*
-               T1 = SQRT( SCALE**2+U1**2+U2**2 )
-               TAU = ONE + SCALE / T1
-               VS = -ONE / ( SCALE+T1 )
-               V( 1 ) = ONE
-               V( 2 ) = VS*U1
-               V( 3 ) = VS*U2
-*
-*              Apply transformations from the right.
-*
-               DO 260 JR = IFRSTM, MIN( J+3, ILAST )
-                  TEMP = TAU*( H( JR, J )+V( 2 )*H( JR, J+1 )+V( 3 )*
-     $                   H( JR, J+2 ) )
-                  H( JR, J ) = H( JR, J ) - TEMP
-                  H( JR, J+1 ) = H( JR, J+1 ) - TEMP*V( 2 )
-                  H( JR, J+2 ) = H( JR, J+2 ) - TEMP*V( 3 )
-  260          CONTINUE
-               DO 270 JR = IFRSTM, J + 2
-                  TEMP = TAU*( T( JR, J )+V( 2 )*T( JR, J+1 )+V( 3 )*
-     $                   T( JR, J+2 ) )
-                  T( JR, J ) = T( JR, J ) - TEMP
-                  T( JR, J+1 ) = T( JR, J+1 ) - TEMP*V( 2 )
-                  T( JR, J+2 ) = T( JR, J+2 ) - TEMP*V( 3 )
-  270          CONTINUE
-               IF( ILZ ) THEN
-                  DO 280 JR = 1, N
-                     TEMP = TAU*( Z( JR, J )+V( 2 )*Z( JR, J+1 )+V( 3 )*
-     $                      Z( JR, J+2 ) )
-                     Z( JR, J ) = Z( JR, J ) - TEMP
-                     Z( JR, J+1 ) = Z( JR, J+1 ) - TEMP*V( 2 )
-                     Z( JR, J+2 ) = Z( JR, J+2 ) - TEMP*V( 3 )
-  280             CONTINUE
-               END IF
-               T( J+1, J ) = ZERO
-               T( J+2, J ) = ZERO
-  290       CONTINUE
-*
-*           Last elements: Use Givens rotations
-*
-*           Rotations from the left
-*
-            J = ILAST - 1
-            TEMP = H( J, J-1 )
-            CALL DLARTG( TEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
-            H( J+1, J-1 ) = ZERO
-*
-            DO 300 JC = J, ILASTM
-               TEMP = C*H( J, JC ) + S*H( J+1, JC )
-               H( J+1, JC ) = -S*H( J, JC ) + C*H( J+1, JC )
-               H( J, JC ) = TEMP
-               TEMP2 = C*T( J, JC ) + S*T( J+1, JC )
-               T( J+1, JC ) = -S*T( J, JC ) + C*T( J+1, JC )
-               T( J, JC ) = TEMP2
-  300       CONTINUE
-            IF( ILQ ) THEN
-               DO 310 JR = 1, N
-                  TEMP = C*Q( JR, J ) + S*Q( JR, J+1 )
-                  Q( JR, J+1 ) = -S*Q( JR, J ) + C*Q( JR, J+1 )
-                  Q( JR, J ) = TEMP
-  310          CONTINUE
-            END IF
-*
-*           Rotations from the right.
-*
-            TEMP = T( J+1, J+1 )
-            CALL DLARTG( TEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
-            T( J+1, J ) = ZERO
-*
-            DO 320 JR = IFRSTM, ILAST
-               TEMP = C*H( JR, J+1 ) + S*H( JR, J )
-               H( JR, J ) = -S*H( JR, J+1 ) + C*H( JR, J )
-               H( JR, J+1 ) = TEMP
-  320       CONTINUE
-            DO 330 JR = IFRSTM, ILAST - 1
-               TEMP = C*T( JR, J+1 ) + S*T( JR, J )
-               T( JR, J ) = -S*T( JR, J+1 ) + C*T( JR, J )
-               T( JR, J+1 ) = TEMP
-  330       CONTINUE
-            IF( ILZ ) THEN
-               DO 340 JR = 1, N
-                  TEMP = C*Z( JR, J+1 ) + S*Z( JR, J )
-                  Z( JR, J ) = -S*Z( JR, J+1 ) + C*Z( JR, J )
-                  Z( JR, J+1 ) = TEMP
-  340          CONTINUE
-            END IF
-*
-*           End of Double-Shift code
-*
-         END IF
-*
-         GO TO 350
-*
-*        End of iteration loop
-*
-  350    CONTINUE
-  360 CONTINUE
-*
-*     Drop-through = non-convergence
-*
-      INFO = ILAST
-      GO TO 420
-*
-*     Successful completion of all QZ steps
-*
-  380 CONTINUE
-*
-*     Set Eigenvalues 1:ILO-1
-*
-      DO 410 J = 1, ILO - 1
-         IF( T( J, J ).LT.ZERO ) THEN
-            IF( ILSCHR ) THEN
-               DO 390 JR = 1, J
-                  H( JR, J ) = -H( JR, J )
-                  T( JR, J ) = -T( JR, J )
-  390          CONTINUE
-            ELSE
-               H( J, J ) = -H( J, J )
-               T( J, J ) = -T( J, J )
-            END IF
-            IF( ILZ ) THEN
-               DO 400 JR = 1, N
-                  Z( JR, J ) = -Z( JR, J )
-  400          CONTINUE
-            END IF
-         END IF
-         ALPHAR( J ) = H( J, J )
-         ALPHAI( J ) = ZERO
-         BETA( J ) = T( J, J )
-  410 CONTINUE
-*
-*     Normal Termination
-*
-      INFO = 0
-*
-*     Exit (other than argument error) -- return optimal workspace size
-*
-  420 CONTINUE
-      WORK( 1 ) = DBLE( N )
-      RETURN
-*
-*     End of DHGEQZ
-*
-      END
diff --git a/src/lib/lapack/dhseqr.f b/src/lib/lapack/dhseqr.f
deleted file mode 100644
index 5b307fa8..00000000
--- a/src/lib/lapack/dhseqr.f
+++ /dev/null
@@ -1,407 +0,0 @@
-      SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z,
-     $                   LDZ, WORK, LWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, ILO, INFO, LDH, LDZ, LWORK, N
-      CHARACTER          COMPZ, JOB
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-     $                   Z( LDZ, * )
-*     ..
-*     Purpose
-*     =======
-*
-*     DHSEQR computes the eigenvalues of a Hessenberg matrix H
-*     and, optionally, the matrices T and Z from the Schur decomposition
-*     H = Z T Z**T, where T is an upper quasi-triangular matrix (the
-*     Schur form), and Z is the orthogonal matrix of Schur vectors.
-*
-*     Optionally Z may be postmultiplied into an input orthogonal
-*     matrix Q so that this routine can give the Schur factorization
-*     of a matrix A which has been reduced to the Hessenberg form H
-*     by the orthogonal matrix Q:  A = Q*H*Q**T = (QZ)*T*(QZ)**T.
-*
-*     Arguments
-*     =========
-*
-*     JOB   (input) CHARACTER*1
-*           = 'E':  compute eigenvalues only;
-*           = 'S':  compute eigenvalues and the Schur form T.
-*
-*     COMPZ (input) CHARACTER*1
-*           = 'N':  no Schur vectors are computed;
-*           = 'I':  Z is initialized to the unit matrix and the matrix Z
-*                   of Schur vectors of H is returned;
-*           = 'V':  Z must contain an orthogonal matrix Q on entry, and
-*                   the product Q*Z is returned.
-*
-*     N     (input) INTEGER
-*           The order of the matrix H.  N .GE. 0.
-*
-*     ILO   (input) INTEGER
-*     IHI   (input) INTEGER
-*           It is assumed that H is already upper triangular in rows
-*           and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*           set by a previous call to DGEBAL, and then passed to DGEHRD
-*           when the matrix output by DGEBAL is reduced to Hessenberg
-*           form. Otherwise ILO and IHI should be set to 1 and N
-*           respectively.  If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*           If N = 0, then ILO = 1 and IHI = 0.
-*
-*     H     (input/output) DOUBLE PRECISION array, dimension (LDH,N)
-*           On entry, the upper Hessenberg matrix H.
-*           On exit, if INFO = 0 and JOB = 'S', then H contains the
-*           upper quasi-triangular matrix T from the Schur decomposition
-*           (the Schur form); 2-by-2 diagonal blocks (corresponding to
-*           complex conjugate pairs of eigenvalues) are returned in
-*           standard form, with H(i,i) = H(i+1,i+1) and
-*           H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the
-*           contents of H are unspecified on exit.  (The output value of
-*           H when INFO.GT.0 is given under the description of INFO
-*           below.)
-*
-*           Unlike earlier versions of DHSEQR, this subroutine may
-*           explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
-*           or j = IHI+1, IHI+2, ... N.
-*
-*     LDH   (input) INTEGER
-*           The leading dimension of the array H. LDH .GE. max(1,N).
-*
-*     WR    (output) DOUBLE PRECISION array, dimension (N)
-*     WI    (output) DOUBLE PRECISION array, dimension (N)
-*           The real and imaginary parts, respectively, of the computed
-*           eigenvalues. If two eigenvalues are computed as a complex
-*           conjugate pair, they are stored in consecutive elements of
-*           WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and
-*           WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in
-*           the same order as on the diagonal of the Schur form returned
-*           in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
-*           diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*           WI(i+1) = -WI(i).
-*
-*     Z     (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
-*           If COMPZ = 'N', Z is not referenced.
-*           If COMPZ = 'I', on entry Z need not be set and on exit,
-*           if INFO = 0, Z contains the orthogonal matrix Z of the Schur
-*           vectors of H.  If COMPZ = 'V', on entry Z must contain an
-*           N-by-N matrix Q, which is assumed to be equal to the unit
-*           matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
-*           if INFO = 0, Z contains Q*Z.
-*           Normally Q is the orthogonal matrix generated by DORGHR
-*           after the call to DGEHRD which formed the Hessenberg matrix
-*           H. (The output value of Z when INFO.GT.0 is given under
-*           the description of INFO below.)
-*
-*     LDZ   (input) INTEGER
-*           The leading dimension of the array Z.  if COMPZ = 'I' or
-*           COMPZ = 'V', then LDZ.GE.MAX(1,N).  Otherwize, LDZ.GE.1.
-*
-*     WORK  (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
-*           On exit, if INFO = 0, WORK(1) returns an estimate of
-*           the optimal value for LWORK.
-*
-*     LWORK (input) INTEGER
-*           The dimension of the array WORK.  LWORK .GE. max(1,N)
-*           is sufficient, but LWORK typically as large as 6*N may
-*           be required for optimal performance.  A workspace query
-*           to determine the optimal workspace size is recommended.
-*
-*           If LWORK = -1, then DHSEQR does a workspace query.
-*           In this case, DHSEQR checks the input parameters and
-*           estimates the optimal workspace size for the given
-*           values of N, ILO and IHI.  The estimate is returned
-*           in WORK(1).  No error message related to LWORK is
-*           issued by XERBLA.  Neither H nor Z are accessed.
-*
-*
-*     INFO  (output) INTEGER
-*             =  0:  successful exit
-*           .LT. 0:  if INFO = -i, the i-th argument had an illegal
-*                    value
-*           .GT. 0:  if INFO = i, DHSEQR failed to compute all of
-*                the eigenvalues.  Elements 1:ilo-1 and i+1:n of WR
-*                and WI contain those eigenvalues which have been
-*                successfully computed.  (Failures are rare.)
-*
-*                If INFO .GT. 0 and JOB = 'E', then on exit, the
-*                remaining unconverged eigenvalues are the eigen-
-*                values of the upper Hessenberg matrix rows and
-*                columns ILO through INFO of the final, output
-*                value of H.
-*
-*                If INFO .GT. 0 and JOB   = 'S', then on exit
-*
-*           (*)  (initial value of H)*U  = U*(final value of H)
-*
-*                where U is an orthogonal matrix.  The final
-*                value of H is upper Hessenberg and quasi-triangular
-*                in rows and columns INFO+1 through IHI.
-*
-*                If INFO .GT. 0 and COMPZ = 'V', then on exit
-*
-*                  (final value of Z)  =  (initial value of Z)*U
-*
-*                where U is the orthogonal matrix in (*) (regard-
-*                less of the value of JOB.)
-*
-*                If INFO .GT. 0 and COMPZ = 'I', then on exit
-*                      (final value of Z)  = U
-*                where U is the orthogonal matrix in (*) (regard-
-*                less of the value of JOB.)
-*
-*                If INFO .GT. 0 and COMPZ = 'N', then Z is not
-*                accessed.
-*
-*     ================================================================
-*             Default values supplied by
-*             ILAENV(ISPEC,'DHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
-*             It is suggested that these defaults be adjusted in order
-*             to attain best performance in each particular
-*             computational environment.
-*
-*            ISPEC=1:  The DLAHQR vs DLAQR0 crossover point.
-*                      Default: 75. (Must be at least 11.)
-*
-*            ISPEC=2:  Recommended deflation window size.
-*                      This depends on ILO, IHI and NS.  NS is the
-*                      number of simultaneous shifts returned
-*                      by ILAENV(ISPEC=4).  (See ISPEC=4 below.)
-*                      The default for (IHI-ILO+1).LE.500 is NS.
-*                      The default for (IHI-ILO+1).GT.500 is 3*NS/2.
-*
-*            ISPEC=3:  Nibble crossover point. (See ILAENV for
-*                      details.)  Default: 14% of deflation window
-*                      size.
-*
-*            ISPEC=4:  Number of simultaneous shifts, NS, in
-*                      a multi-shift QR iteration.
-*
-*                      If IHI-ILO+1 is ...
-*
-*                      greater than      ...but less    ... the
-*                      or equal to ...      than        default is
-*
-*                           1               30          NS -   2(+)
-*                          30               60          NS -   4(+)
-*                          60              150          NS =  10(+)
-*                         150              590          NS =  **
-*                         590             3000          NS =  64
-*                        3000             6000          NS = 128
-*                        6000             infinity      NS = 256
-*
-*                  (+)  By default some or all matrices of this order 
-*                       are passed to the implicit double shift routine
-*                       DLAHQR and NS is ignored.  See ISPEC=1 above 
-*                       and comments in IPARM for details.
-*
-*                       The asterisks (**) indicate an ad-hoc
-*                       function of N increasing from 10 to 64.
-*
-*            ISPEC=5:  Select structured matrix multiply.
-*                      (See ILAENV for details.) Default: 3.
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ================================================================
-*     References:
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*       Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*       929--947, 2002.
-*
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*       of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-*     ================================================================
-*     .. Parameters ..
-*
-*     ==== Matrices of order NTINY or smaller must be processed by
-*     .    DLAHQR because of insufficient subdiagonal scratch space.
-*     .    (This is a hard limit.) ====
-*
-*     ==== NL allocates some local workspace to help small matrices
-*     .    through a rare DLAHQR failure.  NL .GT. NTINY = 11 is
-*     .    required and NL .LE. NMIN = ILAENV(ISPEC=1,...) is recom-
-*     .    mended.  (The default value of NMIN is 75.)  Using NL = 49
-*     .    allows up to six simultaneous shifts and a 16-by-16
-*     .    deflation window.  ====
-*
-      INTEGER            NTINY
-      PARAMETER          ( NTINY = 11 )
-      INTEGER            NL
-      PARAMETER          ( NL = 49 )
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0d0, ONE = 1.0d0 )
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   HL( NL, NL ), WORKL( NL )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, KBOT, NMIN
-      LOGICAL            INITZ, LQUERY, WANTT, WANTZ
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      LOGICAL            LSAME
-      EXTERNAL           ILAENV, LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLACPY, DLAHQR, DLAQR0, DLASET, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     ==== Decode and check the input parameters. ====
-*
-      WANTT = LSAME( JOB, 'S' )
-      INITZ = LSAME( COMPZ, 'I' )
-      WANTZ = INITZ .OR. LSAME( COMPZ, 'V' )
-      WORK( 1 ) = DBLE( MAX( 1, N ) )
-      LQUERY = LWORK.EQ.-1
-*
-      INFO = 0
-      IF( .NOT.LSAME( JOB, 'E' ) .AND. .NOT.WANTT ) THEN
-         INFO = -1
-      ELSE IF( .NOT.LSAME( COMPZ, 'N' ) .AND. .NOT.WANTZ ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
-         INFO = -4
-      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
-         INFO = -5
-      ELSE IF( LDH.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.MAX( 1, N ) ) ) THEN
-         INFO = -11
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -13
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-*
-*        ==== Quick return in case of invalid argument. ====
-*
-         CALL XERBLA( 'DHSEQR', -INFO )
-         RETURN
-*
-      ELSE IF( N.EQ.0 ) THEN
-*
-*        ==== Quick return in case N = 0; nothing to do. ====
-*
-         RETURN
-*
-      ELSE IF( LQUERY ) THEN
-*
-*        ==== Quick return in case of a workspace query ====
-*
-         CALL DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
-     $                IHI, Z, LDZ, WORK, LWORK, INFO )
-*        ==== Ensure reported workspace size is backward-compatible with
-*        .    previous LAPACK versions. ====
-         WORK( 1 ) = MAX( DBLE( MAX( 1, N ) ), WORK( 1 ) )
-         RETURN
-*
-      ELSE
-*
-*        ==== copy eigenvalues isolated by DGEBAL ====
-*
-         DO 10 I = 1, ILO - 1
-            WR( I ) = H( I, I )
-            WI( I ) = ZERO
-   10    CONTINUE
-         DO 20 I = IHI + 1, N
-            WR( I ) = H( I, I )
-            WI( I ) = ZERO
-   20    CONTINUE
-*
-*        ==== Initialize Z, if requested ====
-*
-         IF( INITZ )
-     $      CALL DLASET( 'A', N, N, ZERO, ONE, Z, LDZ )
-*
-*        ==== Quick return if possible ====
-*
-         IF( ILO.EQ.IHI ) THEN
-            WR( ILO ) = H( ILO, ILO )
-            WI( ILO ) = ZERO
-            RETURN
-         END IF
-*
-*        ==== DLAHQR/DLAQR0 crossover point ====
-*
-         NMIN = ILAENV( 12, 'DHSEQR', JOB( : 1 ) // COMPZ( : 1 ), N,
-     $          ILO, IHI, LWORK )
-         NMIN = MAX( NTINY, NMIN )
-*
-*        ==== DLAQR0 for big matrices; DLAHQR for small ones ====
-*
-         IF( N.GT.NMIN ) THEN
-            CALL DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
-     $                   IHI, Z, LDZ, WORK, LWORK, INFO )
-         ELSE
-*
-*           ==== Small matrix ====
-*
-            CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO,
-     $                   IHI, Z, LDZ, INFO )
-*
-            IF( INFO.GT.0 ) THEN
-*
-*              ==== A rare DLAHQR failure!  DLAQR0 sometimes succeeds
-*              .    when DLAHQR fails. ====
-*
-               KBOT = INFO
-*
-               IF( N.GE.NL ) THEN
-*
-*                 ==== Larger matrices have enough subdiagonal scratch
-*                 .    space to call DLAQR0 directly. ====
-*
-                  CALL DLAQR0( WANTT, WANTZ, N, ILO, KBOT, H, LDH, WR,
-     $                         WI, ILO, IHI, Z, LDZ, WORK, LWORK, INFO )
-*
-               ELSE
-*
-*                 ==== Tiny matrices don't have enough subdiagonal
-*                 .    scratch space to benefit from DLAQR0.  Hence,
-*                 .    tiny matrices must be copied into a larger
-*                 .    array before calling DLAQR0. ====
-*
-                  CALL DLACPY( 'A', N, N, H, LDH, HL, NL )
-                  HL( N+1, N ) = ZERO
-                  CALL DLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ),
-     $                         NL )
-                  CALL DLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, WR,
-     $                         WI, ILO, IHI, Z, LDZ, WORKL, NL, INFO )
-                  IF( WANTT .OR. INFO.NE.0 )
-     $               CALL DLACPY( 'A', N, N, HL, NL, H, LDH )
-               END IF
-            END IF
-         END IF
-*
-*        ==== Clear out the trash, if necessary. ====
-*
-         IF( ( WANTT .OR. INFO.NE.0 ) .AND. N.GT.2 )
-     $      CALL DLASET( 'L', N-2, N-2, ZERO, ZERO, H( 3, 1 ), LDH )
-*
-*        ==== Ensure reported workspace size is backward-compatible with
-*        .    previous LAPACK versions. ====
-*
-         WORK( 1 ) = MAX( DBLE( MAX( 1, N ) ), WORK( 1 ) )
-      END IF
-*
-*     ==== End of DHSEQR ====
-*
-      END
diff --git a/src/lib/lapack/disnan.f b/src/lib/lapack/disnan.f
deleted file mode 100644
index 52003561..00000000
--- a/src/lib/lapack/disnan.f
+++ /dev/null
@@ -1,33 +0,0 @@
-      LOGICAL FUNCTION DISNAN(DIN)
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION DIN
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DISNAN returns .TRUE. if its argument is NaN, and .FALSE.
-*  otherwise.  To be replaced by the Fortran 2003 intrinsic in the
-*  future.
-*
-*  Arguments
-*  =========
-*
-*  DIN      (input) DOUBLE PRECISION
-*          Input to test for NaN.
-*
-*  =====================================================================
-*
-*  .. External Functions ..
-      LOGICAL DLAISNAN
-      EXTERNAL DLAISNAN
-*  ..
-*  .. Executable Statements ..
-      DISNAN = DLAISNAN(DIN,DIN)
-      RETURN
-      END
diff --git a/src/lib/lapack/dlabad.f b/src/lib/lapack/dlabad.f
deleted file mode 100644
index 05ff5d44..00000000
--- a/src/lib/lapack/dlabad.f
+++ /dev/null
@@ -1,55 +0,0 @@
-      SUBROUTINE DLABAD( SMALL, LARGE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   LARGE, SMALL
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLABAD takes as input the values computed by DLAMCH for underflow and
-*  overflow, and returns the square root of each of these values if the
-*  log of LARGE is sufficiently large.  This subroutine is intended to
-*  identify machines with a large exponent range, such as the Crays, and
-*  redefine the underflow and overflow limits to be the square roots of
-*  the values computed by DLAMCH.  This subroutine is needed because
-*  DLAMCH does not compensate for poor arithmetic in the upper half of
-*  the exponent range, as is found on a Cray.
-*
-*  Arguments
-*  =========
-*
-*  SMALL   (input/output) DOUBLE PRECISION
-*          On entry, the underflow threshold as computed by DLAMCH.
-*          On exit, if LOG10(LARGE) is sufficiently large, the square
-*          root of SMALL, otherwise unchanged.
-*
-*  LARGE   (input/output) DOUBLE PRECISION
-*          On entry, the overflow threshold as computed by DLAMCH.
-*          On exit, if LOG10(LARGE) is sufficiently large, the square
-*          root of LARGE, otherwise unchanged.
-*
-*  =====================================================================
-*
-*     .. Intrinsic Functions ..
-      INTRINSIC          LOG10, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     If it looks like we're on a Cray, take the square root of
-*     SMALL and LARGE to avoid overflow and underflow problems.
-*
-      IF( LOG10( LARGE ).GT.2000.D0 ) THEN
-         SMALL = SQRT( SMALL )
-         LARGE = SQRT( LARGE )
-      END IF
-*
-      RETURN
-*
-*     End of DLABAD
-*
-      END
diff --git a/src/lib/lapack/dlabrd.f b/src/lib/lapack/dlabrd.f
deleted file mode 100644
index 196b130c..00000000
--- a/src/lib/lapack/dlabrd.f
+++ /dev/null
@@ -1,290 +0,0 @@
-      SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
-     $                   LDY )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            LDA, LDX, LDY, M, N, NB
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), D( * ), E( * ), TAUP( * ),
-     $                   TAUQ( * ), X( LDX, * ), Y( LDY, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLABRD reduces the first NB rows and columns of a real general
-*  m by n matrix A to upper or lower bidiagonal form by an orthogonal
-*  transformation Q' * A * P, and returns the matrices X and Y which
-*  are needed to apply the transformation to the unreduced part of A.
-*
-*  If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
-*  bidiagonal form.
-*
-*  This is an auxiliary routine called by DGEBRD
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows in the matrix A.
-*
-*  N       (input) INTEGER
-*          The number of columns in the matrix A.
-*
-*  NB      (input) INTEGER
-*          The number of leading rows and columns of A to be reduced.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the m by n general matrix to be reduced.
-*          On exit, the first NB rows and columns of the matrix are
-*          overwritten; the rest of the array is unchanged.
-*          If m >= n, elements on and below the diagonal in the first NB
-*            columns, with the array TAUQ, represent the orthogonal
-*            matrix Q as a product of elementary reflectors; and
-*            elements above the diagonal in the first NB rows, with the
-*            array TAUP, represent the orthogonal matrix P as a product
-*            of elementary reflectors.
-*          If m < n, elements below the diagonal in the first NB
-*            columns, with the array TAUQ, represent the orthogonal
-*            matrix Q as a product of elementary reflectors, and
-*            elements on and above the diagonal in the first NB rows,
-*            with the array TAUP, represent the orthogonal matrix P as
-*            a product of elementary reflectors.
-*          See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  D       (output) DOUBLE PRECISION array, dimension (NB)
-*          The diagonal elements of the first NB rows and columns of
-*          the reduced matrix.  D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (NB)
-*          The off-diagonal elements of the first NB rows and columns of
-*          the reduced matrix.
-*
-*  TAUQ    (output) DOUBLE PRECISION array dimension (NB)
-*          The scalar factors of the elementary reflectors which
-*          represent the orthogonal matrix Q. See Further Details.
-*
-*  TAUP    (output) DOUBLE PRECISION array, dimension (NB)
-*          The scalar factors of the elementary reflectors which
-*          represent the orthogonal matrix P. See Further Details.
-*
-*  X       (output) DOUBLE PRECISION array, dimension (LDX,NB)
-*          The m-by-nb matrix X required to update the unreduced part
-*          of A.
-*
-*  LDX     (input) INTEGER
-*          The leading dimension of the array X. LDX >= M.
-*
-*  Y       (output) DOUBLE PRECISION array, dimension (LDY,NB)
-*          The n-by-nb matrix Y required to update the unreduced part
-*          of A.
-*
-*  LDY     (input) INTEGER
-*          The leading dimension of the array Y. LDY >= N.
-*
-*  Further Details
-*  ===============
-*
-*  The matrices Q and P are represented as products of elementary
-*  reflectors:
-*
-*     Q = H(1) H(2) . . . H(nb)  and  P = G(1) G(2) . . . G(nb)
-*
-*  Each H(i) and G(i) has the form:
-*
-*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'
-*
-*  where tauq and taup are real scalars, and v and u are real vectors.
-*
-*  If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
-*  A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
-*  A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
-*  A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
-*  A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  The elements of the vectors v and u together form the m-by-nb matrix
-*  V and the nb-by-n matrix U' which are needed, with X and Y, to apply
-*  the transformation to the unreduced part of the matrix, using a block
-*  update of the form:  A := A - V*Y' - X*U'.
-*
-*  The contents of A on exit are illustrated by the following examples
-*  with nb = 2:
-*
-*  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):
-*
-*    (  1   1   u1  u1  u1 )           (  1   u1  u1  u1  u1  u1 )
-*    (  v1  1   1   u2  u2 )           (  1   1   u2  u2  u2  u2 )
-*    (  v1  v2  a   a   a  )           (  v1  1   a   a   a   a  )
-*    (  v1  v2  a   a   a  )           (  v1  v2  a   a   a   a  )
-*    (  v1  v2  a   a   a  )           (  v1  v2  a   a   a   a  )
-*    (  v1  v2  a   a   a  )
-*
-*  where a denotes an element of the original matrix which is unchanged,
-*  vi denotes an element of the vector defining H(i), and ui an element
-*  of the vector defining G(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMV, DLARFG, DSCAL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 .OR. N.LE.0 )
-     $   RETURN
-*
-      IF( M.GE.N ) THEN
-*
-*        Reduce to upper bidiagonal form
-*
-         DO 10 I = 1, NB
-*
-*           Update A(i:m,i)
-*
-            CALL DGEMV( 'No transpose', M-I+1, I-1, -ONE, A( I, 1 ),
-     $                  LDA, Y( I, 1 ), LDY, ONE, A( I, I ), 1 )
-            CALL DGEMV( 'No transpose', M-I+1, I-1, -ONE, X( I, 1 ),
-     $                  LDX, A( 1, I ), 1, ONE, A( I, I ), 1 )
-*
-*           Generate reflection Q(i) to annihilate A(i+1:m,i)
-*
-            CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
-     $                   TAUQ( I ) )
-            D( I ) = A( I, I )
-            IF( I.LT.N ) THEN
-               A( I, I ) = ONE
-*
-*              Compute Y(i+1:n,i)
-*
-               CALL DGEMV( 'Transpose', M-I+1, N-I, ONE, A( I, I+1 ),
-     $                     LDA, A( I, I ), 1, ZERO, Y( I+1, I ), 1 )
-               CALL DGEMV( 'Transpose', M-I+1, I-1, ONE, A( I, 1 ), LDA,
-     $                     A( I, I ), 1, ZERO, Y( 1, I ), 1 )
-               CALL DGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
-     $                     LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
-               CALL DGEMV( 'Transpose', M-I+1, I-1, ONE, X( I, 1 ), LDX,
-     $                     A( I, I ), 1, ZERO, Y( 1, I ), 1 )
-               CALL DGEMV( 'Transpose', I-1, N-I, -ONE, A( 1, I+1 ),
-     $                     LDA, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
-               CALL DSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
-*
-*              Update A(i,i+1:n)
-*
-               CALL DGEMV( 'No transpose', N-I, I, -ONE, Y( I+1, 1 ),
-     $                     LDY, A( I, 1 ), LDA, ONE, A( I, I+1 ), LDA )
-               CALL DGEMV( 'Transpose', I-1, N-I, -ONE, A( 1, I+1 ),
-     $                     LDA, X( I, 1 ), LDX, ONE, A( I, I+1 ), LDA )
-*
-*              Generate reflection P(i) to annihilate A(i,i+2:n)
-*
-               CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
-     $                      LDA, TAUP( I ) )
-               E( I ) = A( I, I+1 )
-               A( I, I+1 ) = ONE
-*
-*              Compute X(i+1:m,i)
-*
-               CALL DGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, I+1 ),
-     $                     LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 )
-               CALL DGEMV( 'Transpose', N-I, I, ONE, Y( I+1, 1 ), LDY,
-     $                     A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
-               CALL DGEMV( 'No transpose', M-I, I, -ONE, A( I+1, 1 ),
-     $                     LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
-               CALL DGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
-     $                     LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
-               CALL DGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
-     $                     LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
-               CALL DSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
-            END IF
-   10    CONTINUE
-      ELSE
-*
-*        Reduce to lower bidiagonal form
-*
-         DO 20 I = 1, NB
-*
-*           Update A(i,i:n)
-*
-            CALL DGEMV( 'No transpose', N-I+1, I-1, -ONE, Y( I, 1 ),
-     $                  LDY, A( I, 1 ), LDA, ONE, A( I, I ), LDA )
-            CALL DGEMV( 'Transpose', I-1, N-I+1, -ONE, A( 1, I ), LDA,
-     $                  X( I, 1 ), LDX, ONE, A( I, I ), LDA )
-*
-*           Generate reflection P(i) to annihilate A(i,i+1:n)
-*
-            CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
-     $                   TAUP( I ) )
-            D( I ) = A( I, I )
-            IF( I.LT.M ) THEN
-               A( I, I ) = ONE
-*
-*              Compute X(i+1:m,i)
-*
-               CALL DGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, I ),
-     $                     LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 )
-               CALL DGEMV( 'Transpose', N-I+1, I-1, ONE, Y( I, 1 ), LDY,
-     $                     A( I, I ), LDA, ZERO, X( 1, I ), 1 )
-               CALL DGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
-     $                     LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
-               CALL DGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, I ),
-     $                     LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 )
-               CALL DGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
-     $                     LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
-               CALL DSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
-*
-*              Update A(i+1:m,i)
-*
-               CALL DGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
-     $                     LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 )
-               CALL DGEMV( 'No transpose', M-I, I, -ONE, X( I+1, 1 ),
-     $                     LDX, A( 1, I ), 1, ONE, A( I+1, I ), 1 )
-*
-*              Generate reflection Q(i) to annihilate A(i+2:m,i)
-*
-               CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
-     $                      TAUQ( I ) )
-               E( I ) = A( I+1, I )
-               A( I+1, I ) = ONE
-*
-*              Compute Y(i+1:n,i)
-*
-               CALL DGEMV( 'Transpose', M-I, N-I, ONE, A( I+1, I+1 ),
-     $                     LDA, A( I+1, I ), 1, ZERO, Y( I+1, I ), 1 )
-               CALL DGEMV( 'Transpose', M-I, I-1, ONE, A( I+1, 1 ), LDA,
-     $                     A( I+1, I ), 1, ZERO, Y( 1, I ), 1 )
-               CALL DGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
-     $                     LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
-               CALL DGEMV( 'Transpose', M-I, I, ONE, X( I+1, 1 ), LDX,
-     $                     A( I+1, I ), 1, ZERO, Y( 1, I ), 1 )
-               CALL DGEMV( 'Transpose', I, N-I, -ONE, A( 1, I+1 ), LDA,
-     $                     Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
-               CALL DSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
-            END IF
-   20    CONTINUE
-      END IF
-      RETURN
-*
-*     End of DLABRD
-*
-      END
diff --git a/src/lib/lapack/dlacn2.f b/src/lib/lapack/dlacn2.f
deleted file mode 100644
index 6705d256..00000000
--- a/src/lib/lapack/dlacn2.f
+++ /dev/null
@@ -1,214 +0,0 @@
-      SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            KASE, N
-      DOUBLE PRECISION   EST
-*     ..
-*     .. Array Arguments ..
-      INTEGER            ISGN( * ), ISAVE( 3 )
-      DOUBLE PRECISION   V( * ), X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLACN2 estimates the 1-norm of a square, real matrix A.
-*  Reverse communication is used for evaluating matrix-vector products.
-*
-*  Arguments
-*  =========
-*
-*  N      (input) INTEGER
-*         The order of the matrix.  N >= 1.
-*
-*  V      (workspace) DOUBLE PRECISION array, dimension (N)
-*         On the final return, V = A*W,  where  EST = norm(V)/norm(W)
-*         (W is not returned).
-*
-*  X      (input/output) DOUBLE PRECISION array, dimension (N)
-*         On an intermediate return, X should be overwritten by
-*               A * X,   if KASE=1,
-*               A' * X,  if KASE=2,
-*         and DLACN2 must be re-called with all the other parameters
-*         unchanged.
-*
-*  ISGN   (workspace) INTEGER array, dimension (N)
-*
-*  EST    (input/output) DOUBLE PRECISION
-*         On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
-*         unchanged from the previous call to DLACN2.
-*         On exit, EST is an estimate (a lower bound) for norm(A). 
-*
-*  KASE   (input/output) INTEGER
-*         On the initial call to DLACN2, KASE should be 0.
-*         On an intermediate return, KASE will be 1 or 2, indicating
-*         whether X should be overwritten by A * X  or A' * X.
-*         On the final return from DLACN2, KASE will again be 0.
-*
-*  ISAVE  (input/output) INTEGER array, dimension (3)
-*         ISAVE is used to save variables between calls to DLACN2
-*
-*  Further Details
-*  ======= =======
-*
-*  Contributed by Nick Higham, University of Manchester.
-*  Originally named SONEST, dated March 16, 1988.
-*
-*  Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
-*  a real or complex matrix, with applications to condition estimation",
-*  ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
-*
-*  This is a thread safe version of DLACON, which uses the array ISAVE
-*  in place of a SAVE statement, as follows:
-*
-*     DLACON     DLACN2
-*      JUMP     ISAVE(1)
-*      J        ISAVE(2)
-*      ITER     ISAVE(3)
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            ITMAX
-      PARAMETER          ( ITMAX = 5 )
-      DOUBLE PRECISION   ZERO, ONE, TWO
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, JLAST
-      DOUBLE PRECISION   ALTSGN, ESTOLD, TEMP
-*     ..
-*     .. External Functions ..
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DASUM
-      EXTERNAL           IDAMAX, DASUM
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, NINT, SIGN
-*     ..
-*     .. Executable Statements ..
-*
-      IF( KASE.EQ.0 ) THEN
-         DO 10 I = 1, N
-            X( I ) = ONE / DBLE( N )
-   10    CONTINUE
-         KASE = 1
-         ISAVE( 1 ) = 1
-         RETURN
-      END IF
-*
-      GO TO ( 20, 40, 70, 110, 140 )ISAVE( 1 )
-*
-*     ................ ENTRY   (ISAVE( 1 ) = 1)
-*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
-*
-   20 CONTINUE
-      IF( N.EQ.1 ) THEN
-         V( 1 ) = X( 1 )
-         EST = ABS( V( 1 ) )
-*        ... QUIT
-         GO TO 150
-      END IF
-      EST = DASUM( N, X, 1 )
-*
-      DO 30 I = 1, N
-         X( I ) = SIGN( ONE, X( I ) )
-         ISGN( I ) = NINT( X( I ) )
-   30 CONTINUE
-      KASE = 2
-      ISAVE( 1 ) = 2
-      RETURN
-*
-*     ................ ENTRY   (ISAVE( 1 ) = 2)
-*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
-   40 CONTINUE
-      ISAVE( 2 ) = IDAMAX( N, X, 1 )
-      ISAVE( 3 ) = 2
-*
-*     MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
-*
-   50 CONTINUE
-      DO 60 I = 1, N
-         X( I ) = ZERO
-   60 CONTINUE
-      X( ISAVE( 2 ) ) = ONE
-      KASE = 1
-      ISAVE( 1 ) = 3
-      RETURN
-*
-*     ................ ENTRY   (ISAVE( 1 ) = 3)
-*     X HAS BEEN OVERWRITTEN BY A*X.
-*
-   70 CONTINUE
-      CALL DCOPY( N, X, 1, V, 1 )
-      ESTOLD = EST
-      EST = DASUM( N, V, 1 )
-      DO 80 I = 1, N
-         IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
-     $      GO TO 90
-   80 CONTINUE
-*     REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
-      GO TO 120
-*
-   90 CONTINUE
-*     TEST FOR CYCLING.
-      IF( EST.LE.ESTOLD )
-     $   GO TO 120
-*
-      DO 100 I = 1, N
-         X( I ) = SIGN( ONE, X( I ) )
-         ISGN( I ) = NINT( X( I ) )
-  100 CONTINUE
-      KASE = 2
-      ISAVE( 1 ) = 4
-      RETURN
-*
-*     ................ ENTRY   (ISAVE( 1 ) = 4)
-*     X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
-  110 CONTINUE
-      JLAST = ISAVE( 2 )
-      ISAVE( 2 ) = IDAMAX( N, X, 1 )
-      IF( ( X( JLAST ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND.
-     $    ( ISAVE( 3 ).LT.ITMAX ) ) THEN
-         ISAVE( 3 ) = ISAVE( 3 ) + 1
-         GO TO 50
-      END IF
-*
-*     ITERATION COMPLETE.  FINAL STAGE.
-*
-  120 CONTINUE
-      ALTSGN = ONE
-      DO 130 I = 1, N
-         X( I ) = ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) )
-         ALTSGN = -ALTSGN
-  130 CONTINUE
-      KASE = 1
-      ISAVE( 1 ) = 5
-      RETURN
-*
-*     ................ ENTRY   (ISAVE( 1 ) = 5)
-*     X HAS BEEN OVERWRITTEN BY A*X.
-*
-  140 CONTINUE
-      TEMP = TWO*( DASUM( N, X, 1 ) / DBLE( 3*N ) )
-      IF( TEMP.GT.EST ) THEN
-         CALL DCOPY( N, X, 1, V, 1 )
-         EST = TEMP
-      END IF
-*
-  150 CONTINUE
-      KASE = 0
-      RETURN
-*
-*     End of DLACN2
-*
-      END
diff --git a/src/lib/lapack/dlacon.f b/src/lib/lapack/dlacon.f
deleted file mode 100644
index f113b03a..00000000
--- a/src/lib/lapack/dlacon.f
+++ /dev/null
@@ -1,205 +0,0 @@
-      SUBROUTINE DLACON( N, V, X, ISGN, EST, KASE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            KASE, N
-      DOUBLE PRECISION   EST
-*     ..
-*     .. Array Arguments ..
-      INTEGER            ISGN( * )
-      DOUBLE PRECISION   V( * ), X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLACON estimates the 1-norm of a square, real matrix A.
-*  Reverse communication is used for evaluating matrix-vector products.
-*
-*  Arguments
-*  =========
-*
-*  N      (input) INTEGER
-*         The order of the matrix.  N >= 1.
-*
-*  V      (workspace) DOUBLE PRECISION array, dimension (N)
-*         On the final return, V = A*W,  where  EST = norm(V)/norm(W)
-*         (W is not returned).
-*
-*  X      (input/output) DOUBLE PRECISION array, dimension (N)
-*         On an intermediate return, X should be overwritten by
-*               A * X,   if KASE=1,
-*               A' * X,  if KASE=2,
-*         and DLACON must be re-called with all the other parameters
-*         unchanged.
-*
-*  ISGN   (workspace) INTEGER array, dimension (N)
-*
-*  EST    (input/output) DOUBLE PRECISION
-*         On entry with KASE = 1 or 2 and JUMP = 3, EST should be
-*         unchanged from the previous call to DLACON.
-*         On exit, EST is an estimate (a lower bound) for norm(A). 
-*
-*  KASE   (input/output) INTEGER
-*         On the initial call to DLACON, KASE should be 0.
-*         On an intermediate return, KASE will be 1 or 2, indicating
-*         whether X should be overwritten by A * X  or A' * X.
-*         On the final return from DLACON, KASE will again be 0.
-*
-*  Further Details
-*  ======= =======
-*
-*  Contributed by Nick Higham, University of Manchester.
-*  Originally named SONEST, dated March 16, 1988.
-*
-*  Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
-*  a real or complex matrix, with applications to condition estimation",
-*  ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            ITMAX
-      PARAMETER          ( ITMAX = 5 )
-      DOUBLE PRECISION   ZERO, ONE, TWO
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ITER, J, JLAST, JUMP
-      DOUBLE PRECISION   ALTSGN, ESTOLD, TEMP
-*     ..
-*     .. External Functions ..
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DASUM
-      EXTERNAL           IDAMAX, DASUM
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, NINT, SIGN
-*     ..
-*     .. Save statement ..
-      SAVE
-*     ..
-*     .. Executable Statements ..
-*
-      IF( KASE.EQ.0 ) THEN
-         DO 10 I = 1, N
-            X( I ) = ONE / DBLE( N )
-   10    CONTINUE
-         KASE = 1
-         JUMP = 1
-         RETURN
-      END IF
-*
-      GO TO ( 20, 40, 70, 110, 140 )JUMP
-*
-*     ................ ENTRY   (JUMP = 1)
-*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
-*
-   20 CONTINUE
-      IF( N.EQ.1 ) THEN
-         V( 1 ) = X( 1 )
-         EST = ABS( V( 1 ) )
-*        ... QUIT
-         GO TO 150
-      END IF
-      EST = DASUM( N, X, 1 )
-*
-      DO 30 I = 1, N
-         X( I ) = SIGN( ONE, X( I ) )
-         ISGN( I ) = NINT( X( I ) )
-   30 CONTINUE
-      KASE = 2
-      JUMP = 2
-      RETURN
-*
-*     ................ ENTRY   (JUMP = 2)
-*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
-   40 CONTINUE
-      J = IDAMAX( N, X, 1 )
-      ITER = 2
-*
-*     MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
-*
-   50 CONTINUE
-      DO 60 I = 1, N
-         X( I ) = ZERO
-   60 CONTINUE
-      X( J ) = ONE
-      KASE = 1
-      JUMP = 3
-      RETURN
-*
-*     ................ ENTRY   (JUMP = 3)
-*     X HAS BEEN OVERWRITTEN BY A*X.
-*
-   70 CONTINUE
-      CALL DCOPY( N, X, 1, V, 1 )
-      ESTOLD = EST
-      EST = DASUM( N, V, 1 )
-      DO 80 I = 1, N
-         IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
-     $      GO TO 90
-   80 CONTINUE
-*     REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
-      GO TO 120
-*
-   90 CONTINUE
-*     TEST FOR CYCLING.
-      IF( EST.LE.ESTOLD )
-     $   GO TO 120
-*
-      DO 100 I = 1, N
-         X( I ) = SIGN( ONE, X( I ) )
-         ISGN( I ) = NINT( X( I ) )
-  100 CONTINUE
-      KASE = 2
-      JUMP = 4
-      RETURN
-*
-*     ................ ENTRY   (JUMP = 4)
-*     X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
-*
-  110 CONTINUE
-      JLAST = J
-      J = IDAMAX( N, X, 1 )
-      IF( ( X( JLAST ).NE.ABS( X( J ) ) ) .AND. ( ITER.LT.ITMAX ) ) THEN
-         ITER = ITER + 1
-         GO TO 50
-      END IF
-*
-*     ITERATION COMPLETE.  FINAL STAGE.
-*
-  120 CONTINUE
-      ALTSGN = ONE
-      DO 130 I = 1, N
-         X( I ) = ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) )
-         ALTSGN = -ALTSGN
-  130 CONTINUE
-      KASE = 1
-      JUMP = 5
-      RETURN
-*
-*     ................ ENTRY   (JUMP = 5)
-*     X HAS BEEN OVERWRITTEN BY A*X.
-*
-  140 CONTINUE
-      TEMP = TWO*( DASUM( N, X, 1 ) / DBLE( 3*N ) )
-      IF( TEMP.GT.EST ) THEN
-         CALL DCOPY( N, X, 1, V, 1 )
-         EST = TEMP
-      END IF
-*
-  150 CONTINUE
-      KASE = 0
-      RETURN
-*
-*     End of DLACON
-*
-      END
diff --git a/src/lib/lapack/dlacpy.f b/src/lib/lapack/dlacpy.f
deleted file mode 100644
index d72603a5..00000000
--- a/src/lib/lapack/dlacpy.f
+++ /dev/null
@@ -1,87 +0,0 @@
-      SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            LDA, LDB, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLACPY copies all or part of a two-dimensional matrix A to another
-*  matrix B.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies the part of the matrix A to be copied to B.
-*          = 'U':      Upper triangular part
-*          = 'L':      Lower triangular part
-*          Otherwise:  All of the matrix A
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The m by n matrix A.  If UPLO = 'U', only the upper triangle
-*          or trapezoid is accessed; if UPLO = 'L', only the lower
-*          triangle or trapezoid is accessed.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  B       (output) DOUBLE PRECISION array, dimension (LDB,N)
-*          On exit, B = A in the locations specified by UPLO.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,M).
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, J
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-      IF( LSAME( UPLO, 'U' ) ) THEN
-         DO 20 J = 1, N
-            DO 10 I = 1, MIN( J, M )
-               B( I, J ) = A( I, J )
-   10       CONTINUE
-   20    CONTINUE
-      ELSE IF( LSAME( UPLO, 'L' ) ) THEN
-         DO 40 J = 1, N
-            DO 30 I = J, M
-               B( I, J ) = A( I, J )
-   30       CONTINUE
-   40    CONTINUE
-      ELSE
-         DO 60 J = 1, N
-            DO 50 I = 1, M
-               B( I, J ) = A( I, J )
-   50       CONTINUE
-   60    CONTINUE
-      END IF
-      RETURN
-*
-*     End of DLACPY
-*
-      END
diff --git a/src/lib/lapack/dladiv.f b/src/lib/lapack/dladiv.f
deleted file mode 100644
index b6a74d1b..00000000
--- a/src/lib/lapack/dladiv.f
+++ /dev/null
@@ -1,62 +0,0 @@
-      SUBROUTINE DLADIV( A, B, C, D, P, Q )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   A, B, C, D, P, Q
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLADIV performs complex division in  real arithmetic
-*
-*                        a + i*b
-*             p + i*q = ---------
-*                        c + i*d
-*
-*  The algorithm is due to Robert L. Smith and can be found
-*  in D. Knuth, The art of Computer Programming, Vol.2, p.195
-*
-*  Arguments
-*  =========
-*
-*  A       (input) DOUBLE PRECISION
-*  B       (input) DOUBLE PRECISION
-*  C       (input) DOUBLE PRECISION
-*  D       (input) DOUBLE PRECISION
-*          The scalars a, b, c, and d in the above expression.
-*
-*  P       (output) DOUBLE PRECISION
-*  Q       (output) DOUBLE PRECISION
-*          The scalars p and q in the above expression.
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      DOUBLE PRECISION   E, F
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS
-*     ..
-*     .. Executable Statements ..
-*
-      IF( ABS( D ).LT.ABS( C ) ) THEN
-         E = D / C
-         F = C + D*E
-         P = ( A+B*E ) / F
-         Q = ( B-A*E ) / F
-      ELSE
-         E = C / D
-         F = D + C*E
-         P = ( B+A*E ) / F
-         Q = ( -A+B*E ) / F
-      END IF
-*
-      RETURN
-*
-*     End of DLADIV
-*
-      END
diff --git a/src/lib/lapack/dlae2.f b/src/lib/lapack/dlae2.f
deleted file mode 100644
index 8e81c608..00000000
--- a/src/lib/lapack/dlae2.f
+++ /dev/null
@@ -1,123 +0,0 @@
-      SUBROUTINE DLAE2( A, B, C, RT1, RT2 )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   A, B, C, RT1, RT2
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAE2  computes the eigenvalues of a 2-by-2 symmetric matrix
-*     [  A   B  ]
-*     [  B   C  ].
-*  On return, RT1 is the eigenvalue of larger absolute value, and RT2
-*  is the eigenvalue of smaller absolute value.
-*
-*  Arguments
-*  =========
-*
-*  A       (input) DOUBLE PRECISION
-*          The (1,1) element of the 2-by-2 matrix.
-*
-*  B       (input) DOUBLE PRECISION
-*          The (1,2) and (2,1) elements of the 2-by-2 matrix.
-*
-*  C       (input) DOUBLE PRECISION
-*          The (2,2) element of the 2-by-2 matrix.
-*
-*  RT1     (output) DOUBLE PRECISION
-*          The eigenvalue of larger absolute value.
-*
-*  RT2     (output) DOUBLE PRECISION
-*          The eigenvalue of smaller absolute value.
-*
-*  Further Details
-*  ===============
-*
-*  RT1 is accurate to a few ulps barring over/underflow.
-*
-*  RT2 may be inaccurate if there is massive cancellation in the
-*  determinant A*C-B*B; higher precision or correctly rounded or
-*  correctly truncated arithmetic would be needed to compute RT2
-*  accurately in all cases.
-*
-*  Overflow is possible only if RT1 is within a factor of 5 of overflow.
-*  Underflow is harmless if the input data is 0 or exceeds
-*     underflow_threshold / macheps.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D0 )
-      DOUBLE PRECISION   TWO
-      PARAMETER          ( TWO = 2.0D0 )
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-      DOUBLE PRECISION   HALF
-      PARAMETER          ( HALF = 0.5D0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   AB, ACMN, ACMX, ADF, DF, RT, SM, TB
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Compute the eigenvalues
-*
-      SM = A + C
-      DF = A - C
-      ADF = ABS( DF )
-      TB = B + B
-      AB = ABS( TB )
-      IF( ABS( A ).GT.ABS( C ) ) THEN
-         ACMX = A
-         ACMN = C
-      ELSE
-         ACMX = C
-         ACMN = A
-      END IF
-      IF( ADF.GT.AB ) THEN
-         RT = ADF*SQRT( ONE+( AB / ADF )**2 )
-      ELSE IF( ADF.LT.AB ) THEN
-         RT = AB*SQRT( ONE+( ADF / AB )**2 )
-      ELSE
-*
-*        Includes case AB=ADF=0
-*
-         RT = AB*SQRT( TWO )
-      END IF
-      IF( SM.LT.ZERO ) THEN
-         RT1 = HALF*( SM-RT )
-*
-*        Order of execution important.
-*        To get fully accurate smaller eigenvalue,
-*        next line needs to be executed in higher precision.
-*
-         RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
-      ELSE IF( SM.GT.ZERO ) THEN
-         RT1 = HALF*( SM+RT )
-*
-*        Order of execution important.
-*        To get fully accurate smaller eigenvalue,
-*        next line needs to be executed in higher precision.
-*
-         RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
-      ELSE
-*
-*        Includes case RT1 = RT2 = 0
-*
-         RT1 = HALF*RT
-         RT2 = -HALF*RT
-      END IF
-      RETURN
-*
-*     End of DLAE2
-*
-      END
diff --git a/src/lib/lapack/dlaev2.f b/src/lib/lapack/dlaev2.f
deleted file mode 100644
index 49402faa..00000000
--- a/src/lib/lapack/dlaev2.f
+++ /dev/null
@@ -1,169 +0,0 @@
-      SUBROUTINE DLAEV2( A, B, C, RT1, RT2, CS1, SN1 )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   A, B, C, CS1, RT1, RT2, SN1
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix
-*     [  A   B  ]
-*     [  B   C  ].
-*  On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
-*  eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
-*  eigenvector for RT1, giving the decomposition
-*
-*     [ CS1  SN1 ] [  A   B  ] [ CS1 -SN1 ]  =  [ RT1  0  ]
-*     [-SN1  CS1 ] [  B   C  ] [ SN1  CS1 ]     [  0  RT2 ].
-*
-*  Arguments
-*  =========
-*
-*  A       (input) DOUBLE PRECISION
-*          The (1,1) element of the 2-by-2 matrix.
-*
-*  B       (input) DOUBLE PRECISION
-*          The (1,2) element and the conjugate of the (2,1) element of
-*          the 2-by-2 matrix.
-*
-*  C       (input) DOUBLE PRECISION
-*          The (2,2) element of the 2-by-2 matrix.
-*
-*  RT1     (output) DOUBLE PRECISION
-*          The eigenvalue of larger absolute value.
-*
-*  RT2     (output) DOUBLE PRECISION
-*          The eigenvalue of smaller absolute value.
-*
-*  CS1     (output) DOUBLE PRECISION
-*  SN1     (output) DOUBLE PRECISION
-*          The vector (CS1, SN1) is a unit right eigenvector for RT1.
-*
-*  Further Details
-*  ===============
-*
-*  RT1 is accurate to a few ulps barring over/underflow.
-*
-*  RT2 may be inaccurate if there is massive cancellation in the
-*  determinant A*C-B*B; higher precision or correctly rounded or
-*  correctly truncated arithmetic would be needed to compute RT2
-*  accurately in all cases.
-*
-*  CS1 and SN1 are accurate to a few ulps barring over/underflow.
-*
-*  Overflow is possible only if RT1 is within a factor of 5 of overflow.
-*  Underflow is harmless if the input data is 0 or exceeds
-*     underflow_threshold / macheps.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D0 )
-      DOUBLE PRECISION   TWO
-      PARAMETER          ( TWO = 2.0D0 )
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-      DOUBLE PRECISION   HALF
-      PARAMETER          ( HALF = 0.5D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            SGN1, SGN2
-      DOUBLE PRECISION   AB, ACMN, ACMX, ACS, ADF, CS, CT, DF, RT, SM,
-     $                   TB, TN
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Compute the eigenvalues
-*
-      SM = A + C
-      DF = A - C
-      ADF = ABS( DF )
-      TB = B + B
-      AB = ABS( TB )
-      IF( ABS( A ).GT.ABS( C ) ) THEN
-         ACMX = A
-         ACMN = C
-      ELSE
-         ACMX = C
-         ACMN = A
-      END IF
-      IF( ADF.GT.AB ) THEN
-         RT = ADF*SQRT( ONE+( AB / ADF )**2 )
-      ELSE IF( ADF.LT.AB ) THEN
-         RT = AB*SQRT( ONE+( ADF / AB )**2 )
-      ELSE
-*
-*        Includes case AB=ADF=0
-*
-         RT = AB*SQRT( TWO )
-      END IF
-      IF( SM.LT.ZERO ) THEN
-         RT1 = HALF*( SM-RT )
-         SGN1 = -1
-*
-*        Order of execution important.
-*        To get fully accurate smaller eigenvalue,
-*        next line needs to be executed in higher precision.
-*
-         RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
-      ELSE IF( SM.GT.ZERO ) THEN
-         RT1 = HALF*( SM+RT )
-         SGN1 = 1
-*
-*        Order of execution important.
-*        To get fully accurate smaller eigenvalue,
-*        next line needs to be executed in higher precision.
-*
-         RT2 = ( ACMX / RT1 )*ACMN - ( B / RT1 )*B
-      ELSE
-*
-*        Includes case RT1 = RT2 = 0
-*
-         RT1 = HALF*RT
-         RT2 = -HALF*RT
-         SGN1 = 1
-      END IF
-*
-*     Compute the eigenvector
-*
-      IF( DF.GE.ZERO ) THEN
-         CS = DF + RT
-         SGN2 = 1
-      ELSE
-         CS = DF - RT
-         SGN2 = -1
-      END IF
-      ACS = ABS( CS )
-      IF( ACS.GT.AB ) THEN
-         CT = -TB / CS
-         SN1 = ONE / SQRT( ONE+CT*CT )
-         CS1 = CT*SN1
-      ELSE
-         IF( AB.EQ.ZERO ) THEN
-            CS1 = ONE
-            SN1 = ZERO
-         ELSE
-            TN = -CS / TB
-            CS1 = ONE / SQRT( ONE+TN*TN )
-            SN1 = TN*CS1
-         END IF
-      END IF
-      IF( SGN1.EQ.SGN2 ) THEN
-         TN = CS1
-         CS1 = -SN1
-         SN1 = TN
-      END IF
-      RETURN
-*
-*     End of DLAEV2
-*
-      END
diff --git a/src/lib/lapack/dlaexc.f b/src/lib/lapack/dlaexc.f
deleted file mode 100644
index 18e7d247..00000000
--- a/src/lib/lapack/dlaexc.f
+++ /dev/null
@@ -1,354 +0,0 @@
-      SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK,
-     $                   INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            WANTQ
-      INTEGER            INFO, J1, LDQ, LDT, N, N1, N2
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   Q( LDQ, * ), T( LDT, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
-*  an upper quasi-triangular matrix T by an orthogonal similarity
-*  transformation.
-*
-*  T must be in Schur canonical form, that is, block upper triangular
-*  with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
-*  has its diagonal elemnts equal and its off-diagonal elements of
-*  opposite sign.
-*
-*  Arguments
-*  =========
-*
-*  WANTQ   (input) LOGICAL
-*          = .TRUE. : accumulate the transformation in the matrix Q;
-*          = .FALSE.: do not accumulate the transformation.
-*
-*  N       (input) INTEGER
-*          The order of the matrix T. N >= 0.
-*
-*  T       (input/output) DOUBLE PRECISION array, dimension (LDT,N)
-*          On entry, the upper quasi-triangular matrix T, in Schur
-*          canonical form.
-*          On exit, the updated matrix T, again in Schur canonical form.
-*
-*  LDT     (input)  INTEGER
-*          The leading dimension of the array T. LDT >= max(1,N).
-*
-*  Q       (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
-*          On entry, if WANTQ is .TRUE., the orthogonal matrix Q.
-*          On exit, if WANTQ is .TRUE., the updated matrix Q.
-*          If WANTQ is .FALSE., Q is not referenced.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q.
-*          LDQ >= 1; and if WANTQ is .TRUE., LDQ >= N.
-*
-*  J1      (input) INTEGER
-*          The index of the first row of the first block T11.
-*
-*  N1      (input) INTEGER
-*          The order of the first block T11. N1 = 0, 1 or 2.
-*
-*  N2      (input) INTEGER
-*          The order of the second block T22. N2 = 0, 1 or 2.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          = 1: the transformed matrix T would be too far from Schur
-*               form; the blocks are not swapped and T and Q are
-*               unchanged.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-      DOUBLE PRECISION   TEN
-      PARAMETER          ( TEN = 1.0D+1 )
-      INTEGER            LDD, LDX
-      PARAMETER          ( LDD = 4, LDX = 2 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            IERR, J2, J3, J4, K, ND
-      DOUBLE PRECISION   CS, DNORM, EPS, SCALE, SMLNUM, SN, T11, T22,
-     $                   T33, TAU, TAU1, TAU2, TEMP, THRESH, WI1, WI2,
-     $                   WR1, WR2, XNORM
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   D( LDD, 4 ), U( 3 ), U1( 3 ), U2( 3 ),
-     $                   X( LDX, 2 )
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH, DLANGE
-      EXTERNAL           DLAMCH, DLANGE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLACPY, DLANV2, DLARFG, DLARFX, DLARTG, DLASY2,
-     $                   DROT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 .OR. N1.EQ.0 .OR. N2.EQ.0 )
-     $   RETURN
-      IF( J1+N1.GT.N )
-     $   RETURN
-*
-      J2 = J1 + 1
-      J3 = J1 + 2
-      J4 = J1 + 3
-*
-      IF( N1.EQ.1 .AND. N2.EQ.1 ) THEN
-*
-*        Swap two 1-by-1 blocks.
-*
-         T11 = T( J1, J1 )
-         T22 = T( J2, J2 )
-*
-*        Determine the transformation to perform the interchange.
-*
-         CALL DLARTG( T( J1, J2 ), T22-T11, CS, SN, TEMP )
-*
-*        Apply transformation to the matrix T.
-*
-         IF( J3.LE.N )
-     $      CALL DROT( N-J1-1, T( J1, J3 ), LDT, T( J2, J3 ), LDT, CS,
-     $                 SN )
-         CALL DROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN )
-*
-         T( J1, J1 ) = T22
-         T( J2, J2 ) = T11
-*
-         IF( WANTQ ) THEN
-*
-*           Accumulate transformation in the matrix Q.
-*
-            CALL DROT( N, Q( 1, J1 ), 1, Q( 1, J2 ), 1, CS, SN )
-         END IF
-*
-      ELSE
-*
-*        Swapping involves at least one 2-by-2 block.
-*
-*        Copy the diagonal block of order N1+N2 to the local array D
-*        and compute its norm.
-*
-         ND = N1 + N2
-         CALL DLACPY( 'Full', ND, ND, T( J1, J1 ), LDT, D, LDD )
-         DNORM = DLANGE( 'Max', ND, ND, D, LDD, WORK )
-*
-*        Compute machine-dependent threshold for test for accepting
-*        swap.
-*
-         EPS = DLAMCH( 'P' )
-         SMLNUM = DLAMCH( 'S' ) / EPS
-         THRESH = MAX( TEN*EPS*DNORM, SMLNUM )
-*
-*        Solve T11*X - X*T22 = scale*T12 for X.
-*
-         CALL DLASY2( .FALSE., .FALSE., -1, N1, N2, D, LDD,
-     $                D( N1+1, N1+1 ), LDD, D( 1, N1+1 ), LDD, SCALE, X,
-     $                LDX, XNORM, IERR )
-*
-*        Swap the adjacent diagonal blocks.
-*
-         K = N1 + N1 + N2 - 3
-         GO TO ( 10, 20, 30 )K
-*
-   10    CONTINUE
-*
-*        N1 = 1, N2 = 2: generate elementary reflector H so that:
-*
-*        ( scale, X11, X12 ) H = ( 0, 0, * )
-*
-         U( 1 ) = SCALE
-         U( 2 ) = X( 1, 1 )
-         U( 3 ) = X( 1, 2 )
-         CALL DLARFG( 3, U( 3 ), U, 1, TAU )
-         U( 3 ) = ONE
-         T11 = T( J1, J1 )
-*
-*        Perform swap provisionally on diagonal block in D.
-*
-         CALL DLARFX( 'L', 3, 3, U, TAU, D, LDD, WORK )
-         CALL DLARFX( 'R', 3, 3, U, TAU, D, LDD, WORK )
-*
-*        Test whether to reject swap.
-*
-         IF( MAX( ABS( D( 3, 1 ) ), ABS( D( 3, 2 ) ), ABS( D( 3,
-     $       3 )-T11 ) ).GT.THRESH )GO TO 50
-*
-*        Accept swap: apply transformation to the entire matrix T.
-*
-         CALL DLARFX( 'L', 3, N-J1+1, U, TAU, T( J1, J1 ), LDT, WORK )
-         CALL DLARFX( 'R', J2, 3, U, TAU, T( 1, J1 ), LDT, WORK )
-*
-         T( J3, J1 ) = ZERO
-         T( J3, J2 ) = ZERO
-         T( J3, J3 ) = T11
-*
-         IF( WANTQ ) THEN
-*
-*           Accumulate transformation in the matrix Q.
-*
-            CALL DLARFX( 'R', N, 3, U, TAU, Q( 1, J1 ), LDQ, WORK )
-         END IF
-         GO TO 40
-*
-   20    CONTINUE
-*
-*        N1 = 2, N2 = 1: generate elementary reflector H so that:
-*
-*        H (  -X11 ) = ( * )
-*          (  -X21 ) = ( 0 )
-*          ( scale ) = ( 0 )
-*
-         U( 1 ) = -X( 1, 1 )
-         U( 2 ) = -X( 2, 1 )
-         U( 3 ) = SCALE
-         CALL DLARFG( 3, U( 1 ), U( 2 ), 1, TAU )
-         U( 1 ) = ONE
-         T33 = T( J3, J3 )
-*
-*        Perform swap provisionally on diagonal block in D.
-*
-         CALL DLARFX( 'L', 3, 3, U, TAU, D, LDD, WORK )
-         CALL DLARFX( 'R', 3, 3, U, TAU, D, LDD, WORK )
-*
-*        Test whether to reject swap.
-*
-         IF( MAX( ABS( D( 2, 1 ) ), ABS( D( 3, 1 ) ), ABS( D( 1,
-     $       1 )-T33 ) ).GT.THRESH )GO TO 50
-*
-*        Accept swap: apply transformation to the entire matrix T.
-*
-         CALL DLARFX( 'R', J3, 3, U, TAU, T( 1, J1 ), LDT, WORK )
-         CALL DLARFX( 'L', 3, N-J1, U, TAU, T( J1, J2 ), LDT, WORK )
-*
-         T( J1, J1 ) = T33
-         T( J2, J1 ) = ZERO
-         T( J3, J1 ) = ZERO
-*
-         IF( WANTQ ) THEN
-*
-*           Accumulate transformation in the matrix Q.
-*
-            CALL DLARFX( 'R', N, 3, U, TAU, Q( 1, J1 ), LDQ, WORK )
-         END IF
-         GO TO 40
-*
-   30    CONTINUE
-*
-*        N1 = 2, N2 = 2: generate elementary reflectors H(1) and H(2) so
-*        that:
-*
-*        H(2) H(1) (  -X11  -X12 ) = (  *  * )
-*                  (  -X21  -X22 )   (  0  * )
-*                  ( scale    0  )   (  0  0 )
-*                  (    0  scale )   (  0  0 )
-*
-         U1( 1 ) = -X( 1, 1 )
-         U1( 2 ) = -X( 2, 1 )
-         U1( 3 ) = SCALE
-         CALL DLARFG( 3, U1( 1 ), U1( 2 ), 1, TAU1 )
-         U1( 1 ) = ONE
-*
-         TEMP = -TAU1*( X( 1, 2 )+U1( 2 )*X( 2, 2 ) )
-         U2( 1 ) = -TEMP*U1( 2 ) - X( 2, 2 )
-         U2( 2 ) = -TEMP*U1( 3 )
-         U2( 3 ) = SCALE
-         CALL DLARFG( 3, U2( 1 ), U2( 2 ), 1, TAU2 )
-         U2( 1 ) = ONE
-*
-*        Perform swap provisionally on diagonal block in D.
-*
-         CALL DLARFX( 'L', 3, 4, U1, TAU1, D, LDD, WORK )
-         CALL DLARFX( 'R', 4, 3, U1, TAU1, D, LDD, WORK )
-         CALL DLARFX( 'L', 3, 4, U2, TAU2, D( 2, 1 ), LDD, WORK )
-         CALL DLARFX( 'R', 4, 3, U2, TAU2, D( 1, 2 ), LDD, WORK )
-*
-*        Test whether to reject swap.
-*
-         IF( MAX( ABS( D( 3, 1 ) ), ABS( D( 3, 2 ) ), ABS( D( 4, 1 ) ),
-     $       ABS( D( 4, 2 ) ) ).GT.THRESH )GO TO 50
-*
-*        Accept swap: apply transformation to the entire matrix T.
-*
-         CALL DLARFX( 'L', 3, N-J1+1, U1, TAU1, T( J1, J1 ), LDT, WORK )
-         CALL DLARFX( 'R', J4, 3, U1, TAU1, T( 1, J1 ), LDT, WORK )
-         CALL DLARFX( 'L', 3, N-J1+1, U2, TAU2, T( J2, J1 ), LDT, WORK )
-         CALL DLARFX( 'R', J4, 3, U2, TAU2, T( 1, J2 ), LDT, WORK )
-*
-         T( J3, J1 ) = ZERO
-         T( J3, J2 ) = ZERO
-         T( J4, J1 ) = ZERO
-         T( J4, J2 ) = ZERO
-*
-         IF( WANTQ ) THEN
-*
-*           Accumulate transformation in the matrix Q.
-*
-            CALL DLARFX( 'R', N, 3, U1, TAU1, Q( 1, J1 ), LDQ, WORK )
-            CALL DLARFX( 'R', N, 3, U2, TAU2, Q( 1, J2 ), LDQ, WORK )
-         END IF
-*
-   40    CONTINUE
-*
-         IF( N2.EQ.2 ) THEN
-*
-*           Standardize new 2-by-2 block T11
-*
-            CALL DLANV2( T( J1, J1 ), T( J1, J2 ), T( J2, J1 ),
-     $                   T( J2, J2 ), WR1, WI1, WR2, WI2, CS, SN )
-            CALL DROT( N-J1-1, T( J1, J1+2 ), LDT, T( J2, J1+2 ), LDT,
-     $                 CS, SN )
-            CALL DROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN )
-            IF( WANTQ )
-     $         CALL DROT( N, Q( 1, J1 ), 1, Q( 1, J2 ), 1, CS, SN )
-         END IF
-*
-         IF( N1.EQ.2 ) THEN
-*
-*           Standardize new 2-by-2 block T22
-*
-            J3 = J1 + N2
-            J4 = J3 + 1
-            CALL DLANV2( T( J3, J3 ), T( J3, J4 ), T( J4, J3 ),
-     $                   T( J4, J4 ), WR1, WI1, WR2, WI2, CS, SN )
-            IF( J3+2.LE.N )
-     $         CALL DROT( N-J3-1, T( J3, J3+2 ), LDT, T( J4, J3+2 ),
-     $                    LDT, CS, SN )
-            CALL DROT( J3-1, T( 1, J3 ), 1, T( 1, J4 ), 1, CS, SN )
-            IF( WANTQ )
-     $         CALL DROT( N, Q( 1, J3 ), 1, Q( 1, J4 ), 1, CS, SN )
-         END IF
-*
-      END IF
-      RETURN
-*
-*     Exit with INFO = 1 if swap was rejected.
-*
-   50 CONTINUE
-      INFO = 1
-      RETURN
-*
-*     End of DLAEXC
-*
-      END
diff --git a/src/lib/lapack/dlag2.f b/src/lib/lapack/dlag2.f
deleted file mode 100644
index e754203b..00000000
--- a/src/lib/lapack/dlag2.f
+++ /dev/null
@@ -1,300 +0,0 @@
-      SUBROUTINE DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1,
-     $                  WR2, WI )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            LDA, LDB
-      DOUBLE PRECISION   SAFMIN, SCALE1, SCALE2, WI, WR1, WR2
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue
-*  problem  A - w B, with scaling as necessary to avoid over-/underflow.
-*
-*  The scaling factor "s" results in a modified eigenvalue equation
-*
-*      s A - w B
-*
-*  where  s  is a non-negative scaling factor chosen so that  w,  w B,
-*  and  s A  do not overflow and, if possible, do not underflow, either.
-*
-*  Arguments
-*  =========
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA, 2)
-*          On entry, the 2 x 2 matrix A.  It is assumed that its 1-norm
-*          is less than 1/SAFMIN.  Entries less than
-*          sqrt(SAFMIN)*norm(A) are subject to being treated as zero.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= 2.
-*
-*  B       (input) DOUBLE PRECISION array, dimension (LDB, 2)
-*          On entry, the 2 x 2 upper triangular matrix B.  It is
-*          assumed that the one-norm of B is less than 1/SAFMIN.  The
-*          diagonals should be at least sqrt(SAFMIN) times the largest
-*          element of B (in absolute value); if a diagonal is smaller
-*          than that, then  +/- sqrt(SAFMIN) will be used instead of
-*          that diagonal.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= 2.
-*
-*  SAFMIN  (input) DOUBLE PRECISION
-*          The smallest positive number s.t. 1/SAFMIN does not
-*          overflow.  (This should always be DLAMCH('S') -- it is an
-*          argument in order to avoid having to call DLAMCH frequently.)
-*
-*  SCALE1  (output) DOUBLE PRECISION
-*          A scaling factor used to avoid over-/underflow in the
-*          eigenvalue equation which defines the first eigenvalue.  If
-*          the eigenvalues are complex, then the eigenvalues are
-*          ( WR1  +/-  WI i ) / SCALE1  (which may lie outside the
-*          exponent range of the machine), SCALE1=SCALE2, and SCALE1
-*          will always be positive.  If the eigenvalues are real, then
-*          the first (real) eigenvalue is  WR1 / SCALE1 , but this may
-*          overflow or underflow, and in fact, SCALE1 may be zero or
-*          less than the underflow threshhold if the exact eigenvalue
-*          is sufficiently large.
-*
-*  SCALE2  (output) DOUBLE PRECISION
-*          A scaling factor used to avoid over-/underflow in the
-*          eigenvalue equation which defines the second eigenvalue.  If
-*          the eigenvalues are complex, then SCALE2=SCALE1.  If the
-*          eigenvalues are real, then the second (real) eigenvalue is
-*          WR2 / SCALE2 , but this may overflow or underflow, and in
-*          fact, SCALE2 may be zero or less than the underflow
-*          threshhold if the exact eigenvalue is sufficiently large.
-*
-*  WR1     (output) DOUBLE PRECISION
-*          If the eigenvalue is real, then WR1 is SCALE1 times the
-*          eigenvalue closest to the (2,2) element of A B**(-1).  If the
-*          eigenvalue is complex, then WR1=WR2 is SCALE1 times the real
-*          part of the eigenvalues.
-*
-*  WR2     (output) DOUBLE PRECISION
-*          If the eigenvalue is real, then WR2 is SCALE2 times the
-*          other eigenvalue.  If the eigenvalue is complex, then
-*          WR1=WR2 is SCALE1 times the real part of the eigenvalues.
-*
-*  WI      (output) DOUBLE PRECISION
-*          If the eigenvalue is real, then WI is zero.  If the
-*          eigenvalue is complex, then WI is SCALE1 times the imaginary
-*          part of the eigenvalues.  WI will always be non-negative.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE, TWO
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-      DOUBLE PRECISION   HALF
-      PARAMETER          ( HALF = ONE / TWO )
-      DOUBLE PRECISION   FUZZY1
-      PARAMETER          ( FUZZY1 = ONE+1.0D-5 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   A11, A12, A21, A22, ABI22, ANORM, AS11, AS12,
-     $                   AS22, ASCALE, B11, B12, B22, BINV11, BINV22,
-     $                   BMIN, BNORM, BSCALE, BSIZE, C1, C2, C3, C4, C5,
-     $                   DIFF, DISCR, PP, QQ, R, RTMAX, RTMIN, S1, S2,
-     $                   SAFMAX, SHIFT, SS, SUM, WABS, WBIG, WDET,
-     $                   WSCALE, WSIZE, WSMALL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SIGN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      RTMIN = SQRT( SAFMIN )
-      RTMAX = ONE / RTMIN
-      SAFMAX = ONE / SAFMIN
-*
-*     Scale A
-*
-      ANORM = MAX( ABS( A( 1, 1 ) )+ABS( A( 2, 1 ) ),
-     $        ABS( A( 1, 2 ) )+ABS( A( 2, 2 ) ), SAFMIN )
-      ASCALE = ONE / ANORM
-      A11 = ASCALE*A( 1, 1 )
-      A21 = ASCALE*A( 2, 1 )
-      A12 = ASCALE*A( 1, 2 )
-      A22 = ASCALE*A( 2, 2 )
-*
-*     Perturb B if necessary to insure non-singularity
-*
-      B11 = B( 1, 1 )
-      B12 = B( 1, 2 )
-      B22 = B( 2, 2 )
-      BMIN = RTMIN*MAX( ABS( B11 ), ABS( B12 ), ABS( B22 ), RTMIN )
-      IF( ABS( B11 ).LT.BMIN )
-     $   B11 = SIGN( BMIN, B11 )
-      IF( ABS( B22 ).LT.BMIN )
-     $   B22 = SIGN( BMIN, B22 )
-*
-*     Scale B
-*
-      BNORM = MAX( ABS( B11 ), ABS( B12 )+ABS( B22 ), SAFMIN )
-      BSIZE = MAX( ABS( B11 ), ABS( B22 ) )
-      BSCALE = ONE / BSIZE
-      B11 = B11*BSCALE
-      B12 = B12*BSCALE
-      B22 = B22*BSCALE
-*
-*     Compute larger eigenvalue by method described by C. van Loan
-*
-*     ( AS is A shifted by -SHIFT*B )
-*
-      BINV11 = ONE / B11
-      BINV22 = ONE / B22
-      S1 = A11*BINV11
-      S2 = A22*BINV22
-      IF( ABS( S1 ).LE.ABS( S2 ) ) THEN
-         AS12 = A12 - S1*B12
-         AS22 = A22 - S1*B22
-         SS = A21*( BINV11*BINV22 )
-         ABI22 = AS22*BINV22 - SS*B12
-         PP = HALF*ABI22
-         SHIFT = S1
-      ELSE
-         AS12 = A12 - S2*B12
-         AS11 = A11 - S2*B11
-         SS = A21*( BINV11*BINV22 )
-         ABI22 = -SS*B12
-         PP = HALF*( AS11*BINV11+ABI22 )
-         SHIFT = S2
-      END IF
-      QQ = SS*AS12
-      IF( ABS( PP*RTMIN ).GE.ONE ) THEN
-         DISCR = ( RTMIN*PP )**2 + QQ*SAFMIN
-         R = SQRT( ABS( DISCR ) )*RTMAX
-      ELSE
-         IF( PP**2+ABS( QQ ).LE.SAFMIN ) THEN
-            DISCR = ( RTMAX*PP )**2 + QQ*SAFMAX
-            R = SQRT( ABS( DISCR ) )*RTMIN
-         ELSE
-            DISCR = PP**2 + QQ
-            R = SQRT( ABS( DISCR ) )
-         END IF
-      END IF
-*
-*     Note: the test of R in the following IF is to cover the case when
-*           DISCR is small and negative and is flushed to zero during
-*           the calculation of R.  On machines which have a consistent
-*           flush-to-zero threshhold and handle numbers above that
-*           threshhold correctly, it would not be necessary.
-*
-      IF( DISCR.GE.ZERO .OR. R.EQ.ZERO ) THEN
-         SUM = PP + SIGN( R, PP )
-         DIFF = PP - SIGN( R, PP )
-         WBIG = SHIFT + SUM
-*
-*        Compute smaller eigenvalue
-*
-         WSMALL = SHIFT + DIFF
-         IF( HALF*ABS( WBIG ).GT.MAX( ABS( WSMALL ), SAFMIN ) ) THEN
-            WDET = ( A11*A22-A12*A21 )*( BINV11*BINV22 )
-            WSMALL = WDET / WBIG
-         END IF
-*
-*        Choose (real) eigenvalue closest to 2,2 element of A*B**(-1)
-*        for WR1.
-*
-         IF( PP.GT.ABI22 ) THEN
-            WR1 = MIN( WBIG, WSMALL )
-            WR2 = MAX( WBIG, WSMALL )
-         ELSE
-            WR1 = MAX( WBIG, WSMALL )
-            WR2 = MIN( WBIG, WSMALL )
-         END IF
-         WI = ZERO
-      ELSE
-*
-*        Complex eigenvalues
-*
-         WR1 = SHIFT + PP
-         WR2 = WR1
-         WI = R
-      END IF
-*
-*     Further scaling to avoid underflow and overflow in computing
-*     SCALE1 and overflow in computing w*B.
-*
-*     This scale factor (WSCALE) is bounded from above using C1 and C2,
-*     and from below using C3 and C4.
-*        C1 implements the condition  s A  must never overflow.
-*        C2 implements the condition  w B  must never overflow.
-*        C3, with C2,
-*           implement the condition that s A - w B must never overflow.
-*        C4 implements the condition  s    should not underflow.
-*        C5 implements the condition  max(s,|w|) should be at least 2.
-*
-      C1 = BSIZE*( SAFMIN*MAX( ONE, ASCALE ) )
-      C2 = SAFMIN*MAX( ONE, BNORM )
-      C3 = BSIZE*SAFMIN
-      IF( ASCALE.LE.ONE .AND. BSIZE.LE.ONE ) THEN
-         C4 = MIN( ONE, ( ASCALE / SAFMIN )*BSIZE )
-      ELSE
-         C4 = ONE
-      END IF
-      IF( ASCALE.LE.ONE .OR. BSIZE.LE.ONE ) THEN
-         C5 = MIN( ONE, ASCALE*BSIZE )
-      ELSE
-         C5 = ONE
-      END IF
-*
-*     Scale first eigenvalue
-*
-      WABS = ABS( WR1 ) + ABS( WI )
-      WSIZE = MAX( SAFMIN, C1, FUZZY1*( WABS*C2+C3 ),
-     $        MIN( C4, HALF*MAX( WABS, C5 ) ) )
-      IF( WSIZE.NE.ONE ) THEN
-         WSCALE = ONE / WSIZE
-         IF( WSIZE.GT.ONE ) THEN
-            SCALE1 = ( MAX( ASCALE, BSIZE )*WSCALE )*
-     $               MIN( ASCALE, BSIZE )
-         ELSE
-            SCALE1 = ( MIN( ASCALE, BSIZE )*WSCALE )*
-     $               MAX( ASCALE, BSIZE )
-         END IF
-         WR1 = WR1*WSCALE
-         IF( WI.NE.ZERO ) THEN
-            WI = WI*WSCALE
-            WR2 = WR1
-            SCALE2 = SCALE1
-         END IF
-      ELSE
-         SCALE1 = ASCALE*BSIZE
-         SCALE2 = SCALE1
-      END IF
-*
-*     Scale second eigenvalue (if real)
-*
-      IF( WI.EQ.ZERO ) THEN
-         WSIZE = MAX( SAFMIN, C1, FUZZY1*( ABS( WR2 )*C2+C3 ),
-     $           MIN( C4, HALF*MAX( ABS( WR2 ), C5 ) ) )
-         IF( WSIZE.NE.ONE ) THEN
-            WSCALE = ONE / WSIZE
-            IF( WSIZE.GT.ONE ) THEN
-               SCALE2 = ( MAX( ASCALE, BSIZE )*WSCALE )*
-     $                  MIN( ASCALE, BSIZE )
-            ELSE
-               SCALE2 = ( MIN( ASCALE, BSIZE )*WSCALE )*
-     $                  MAX( ASCALE, BSIZE )
-            END IF
-            WR2 = WR2*WSCALE
-         ELSE
-            SCALE2 = ASCALE*BSIZE
-         END IF
-      END IF
-*
-*     End of DLAG2
-*
-      RETURN
-      END
diff --git a/src/lib/lapack/dlagv2.f b/src/lib/lapack/dlagv2.f
deleted file mode 100644
index 15bcb0b9..00000000
--- a/src/lib/lapack/dlagv2.f
+++ /dev/null
@@ -1,287 +0,0 @@
-      SUBROUTINE DLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL,
-     $                   CSR, SNR )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            LDA, LDB
-      DOUBLE PRECISION   CSL, CSR, SNL, SNR
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), ALPHAI( 2 ), ALPHAR( 2 ),
-     $                   B( LDB, * ), BETA( 2 )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAGV2 computes the Generalized Schur factorization of a real 2-by-2
-*  matrix pencil (A,B) where B is upper triangular. This routine
-*  computes orthogonal (rotation) matrices given by CSL, SNL and CSR,
-*  SNR such that
-*
-*  1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0
-*     types), then
-*
-*     [ a11 a12 ] := [  CSL  SNL ] [ a11 a12 ] [  CSR -SNR ]
-*     [  0  a22 ]    [ -SNL  CSL ] [ a21 a22 ] [  SNR  CSR ]
-*
-*     [ b11 b12 ] := [  CSL  SNL ] [ b11 b12 ] [  CSR -SNR ]
-*     [  0  b22 ]    [ -SNL  CSL ] [  0  b22 ] [  SNR  CSR ],
-*
-*  2) if the pencil (A,B) has a pair of complex conjugate eigenvalues,
-*     then
-*
-*     [ a11 a12 ] := [  CSL  SNL ] [ a11 a12 ] [  CSR -SNR ]
-*     [ a21 a22 ]    [ -SNL  CSL ] [ a21 a22 ] [  SNR  CSR ]
-*
-*     [ b11  0  ] := [  CSL  SNL ] [ b11 b12 ] [  CSR -SNR ]
-*     [  0  b22 ]    [ -SNL  CSL ] [  0  b22 ] [  SNR  CSR ]
-*
-*     where b11 >= b22 > 0.
-*
-*
-*  Arguments
-*  =========
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA, 2)
-*          On entry, the 2 x 2 matrix A.
-*          On exit, A is overwritten by the ``A-part'' of the
-*          generalized Schur form.
-*
-*  LDA     (input) INTEGER
-*          THe leading dimension of the array A.  LDA >= 2.
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB, 2)
-*          On entry, the upper triangular 2 x 2 matrix B.
-*          On exit, B is overwritten by the ``B-part'' of the
-*          generalized Schur form.
-*
-*  LDB     (input) INTEGER
-*          THe leading dimension of the array B.  LDB >= 2.
-*
-*  ALPHAR  (output) DOUBLE PRECISION array, dimension (2)
-*  ALPHAI  (output) DOUBLE PRECISION array, dimension (2)
-*  BETA    (output) DOUBLE PRECISION array, dimension (2)
-*          (ALPHAR(k)+i*ALPHAI(k))/BETA(k) are the eigenvalues of the
-*          pencil (A,B), k=1,2, i = sqrt(-1).  Note that BETA(k) may
-*          be zero.
-*
-*  CSL     (output) DOUBLE PRECISION
-*          The cosine of the left rotation matrix.
-*
-*  SNL     (output) DOUBLE PRECISION
-*          The sine of the left rotation matrix.
-*
-*  CSR     (output) DOUBLE PRECISION
-*          The cosine of the right rotation matrix.
-*
-*  SNR     (output) DOUBLE PRECISION
-*          The sine of the right rotation matrix.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   ANORM, ASCALE, BNORM, BSCALE, H1, H2, H3, QQ,
-     $                   R, RR, SAFMIN, SCALE1, SCALE2, T, ULP, WI, WR1,
-     $                   WR2
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLAG2, DLARTG, DLASV2, DROT
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH, DLAPY2
-      EXTERNAL           DLAMCH, DLAPY2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX
-*     ..
-*     .. Executable Statements ..
-*
-      SAFMIN = DLAMCH( 'S' )
-      ULP = DLAMCH( 'P' )
-*
-*     Scale A
-*
-      ANORM = MAX( ABS( A( 1, 1 ) )+ABS( A( 2, 1 ) ),
-     $        ABS( A( 1, 2 ) )+ABS( A( 2, 2 ) ), SAFMIN )
-      ASCALE = ONE / ANORM
-      A( 1, 1 ) = ASCALE*A( 1, 1 )
-      A( 1, 2 ) = ASCALE*A( 1, 2 )
-      A( 2, 1 ) = ASCALE*A( 2, 1 )
-      A( 2, 2 ) = ASCALE*A( 2, 2 )
-*
-*     Scale B
-*
-      BNORM = MAX( ABS( B( 1, 1 ) ), ABS( B( 1, 2 ) )+ABS( B( 2, 2 ) ),
-     $        SAFMIN )
-      BSCALE = ONE / BNORM
-      B( 1, 1 ) = BSCALE*B( 1, 1 )
-      B( 1, 2 ) = BSCALE*B( 1, 2 )
-      B( 2, 2 ) = BSCALE*B( 2, 2 )
-*
-*     Check if A can be deflated
-*
-      IF( ABS( A( 2, 1 ) ).LE.ULP ) THEN
-         CSL = ONE
-         SNL = ZERO
-         CSR = ONE
-         SNR = ZERO
-         A( 2, 1 ) = ZERO
-         B( 2, 1 ) = ZERO
-*
-*     Check if B is singular
-*
-      ELSE IF( ABS( B( 1, 1 ) ).LE.ULP ) THEN
-         CALL DLARTG( A( 1, 1 ), A( 2, 1 ), CSL, SNL, R )
-         CSR = ONE
-         SNR = ZERO
-         CALL DROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
-         CALL DROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
-         A( 2, 1 ) = ZERO
-         B( 1, 1 ) = ZERO
-         B( 2, 1 ) = ZERO
-*
-      ELSE IF( ABS( B( 2, 2 ) ).LE.ULP ) THEN
-         CALL DLARTG( A( 2, 2 ), A( 2, 1 ), CSR, SNR, T )
-         SNR = -SNR
-         CALL DROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
-         CALL DROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
-         CSL = ONE
-         SNL = ZERO
-         A( 2, 1 ) = ZERO
-         B( 2, 1 ) = ZERO
-         B( 2, 2 ) = ZERO
-*
-      ELSE
-*
-*        B is nonsingular, first compute the eigenvalues of (A,B)
-*
-         CALL DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, WR2,
-     $               WI )
-*
-         IF( WI.EQ.ZERO ) THEN
-*
-*           two real eigenvalues, compute s*A-w*B
-*
-            H1 = SCALE1*A( 1, 1 ) - WR1*B( 1, 1 )
-            H2 = SCALE1*A( 1, 2 ) - WR1*B( 1, 2 )
-            H3 = SCALE1*A( 2, 2 ) - WR1*B( 2, 2 )
-*
-            RR = DLAPY2( H1, H2 )
-            QQ = DLAPY2( SCALE1*A( 2, 1 ), H3 )
-*
-            IF( RR.GT.QQ ) THEN
-*
-*              find right rotation matrix to zero 1,1 element of
-*              (sA - wB)
-*
-               CALL DLARTG( H2, H1, CSR, SNR, T )
-*
-            ELSE
-*
-*              find right rotation matrix to zero 2,1 element of
-*              (sA - wB)
-*
-               CALL DLARTG( H3, SCALE1*A( 2, 1 ), CSR, SNR, T )
-*
-            END IF
-*
-            SNR = -SNR
-            CALL DROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
-            CALL DROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
-*
-*           compute inf norms of A and B
-*
-            H1 = MAX( ABS( A( 1, 1 ) )+ABS( A( 1, 2 ) ),
-     $           ABS( A( 2, 1 ) )+ABS( A( 2, 2 ) ) )
-            H2 = MAX( ABS( B( 1, 1 ) )+ABS( B( 1, 2 ) ),
-     $           ABS( B( 2, 1 ) )+ABS( B( 2, 2 ) ) )
-*
-            IF( ( SCALE1*H1 ).GE.ABS( WR1 )*H2 ) THEN
-*
-*              find left rotation matrix Q to zero out B(2,1)
-*
-               CALL DLARTG( B( 1, 1 ), B( 2, 1 ), CSL, SNL, R )
-*
-            ELSE
-*
-*              find left rotation matrix Q to zero out A(2,1)
-*
-               CALL DLARTG( A( 1, 1 ), A( 2, 1 ), CSL, SNL, R )
-*
-            END IF
-*
-            CALL DROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
-            CALL DROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
-*
-            A( 2, 1 ) = ZERO
-            B( 2, 1 ) = ZERO
-*
-         ELSE
-*
-*           a pair of complex conjugate eigenvalues
-*           first compute the SVD of the matrix B
-*
-            CALL DLASV2( B( 1, 1 ), B( 1, 2 ), B( 2, 2 ), R, T, SNR,
-     $                   CSR, SNL, CSL )
-*
-*           Form (A,B) := Q(A,B)Z' where Q is left rotation matrix and
-*           Z is right rotation matrix computed from DLASV2
-*
-            CALL DROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
-            CALL DROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
-            CALL DROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
-            CALL DROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
-*
-            B( 2, 1 ) = ZERO
-            B( 1, 2 ) = ZERO
-*
-         END IF
-*
-      END IF
-*
-*     Unscaling
-*
-      A( 1, 1 ) = ANORM*A( 1, 1 )
-      A( 2, 1 ) = ANORM*A( 2, 1 )
-      A( 1, 2 ) = ANORM*A( 1, 2 )
-      A( 2, 2 ) = ANORM*A( 2, 2 )
-      B( 1, 1 ) = BNORM*B( 1, 1 )
-      B( 2, 1 ) = BNORM*B( 2, 1 )
-      B( 1, 2 ) = BNORM*B( 1, 2 )
-      B( 2, 2 ) = BNORM*B( 2, 2 )
-*
-      IF( WI.EQ.ZERO ) THEN
-         ALPHAR( 1 ) = A( 1, 1 )
-         ALPHAR( 2 ) = A( 2, 2 )
-         ALPHAI( 1 ) = ZERO
-         ALPHAI( 2 ) = ZERO
-         BETA( 1 ) = B( 1, 1 )
-         BETA( 2 ) = B( 2, 2 )
-      ELSE
-         ALPHAR( 1 ) = ANORM*WR1 / SCALE1 / BNORM
-         ALPHAI( 1 ) = ANORM*WI / SCALE1 / BNORM
-         ALPHAR( 2 ) = ALPHAR( 1 )
-         ALPHAI( 2 ) = -ALPHAI( 1 )
-         BETA( 1 ) = ONE
-         BETA( 2 ) = ONE
-      END IF
-*
-      RETURN
-*
-*     End of DLAGV2
-*
-      END
diff --git a/src/lib/lapack/dlahqr.f b/src/lib/lapack/dlahqr.f
deleted file mode 100644
index 449a3770..00000000
--- a/src/lib/lapack/dlahqr.f
+++ /dev/null
@@ -1,501 +0,0 @@
-      SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-     $                   ILOZ, IHIZ, Z, LDZ, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * )
-*     ..
-*
-*     Purpose
-*     =======
-*
-*     DLAHQR is an auxiliary routine called by DHSEQR to update the
-*     eigenvalues and Schur decomposition already computed by DHSEQR, by
-*     dealing with the Hessenberg submatrix in rows and columns ILO to
-*     IHI.
-*
-*     Arguments
-*     =========
-*
-*     WANTT   (input) LOGICAL
-*          = .TRUE. : the full Schur form T is required;
-*          = .FALSE.: only eigenvalues are required.
-*
-*     WANTZ   (input) LOGICAL
-*          = .TRUE. : the matrix of Schur vectors Z is required;
-*          = .FALSE.: Schur vectors are not required.
-*
-*     N       (input) INTEGER
-*          The order of the matrix H.  N >= 0.
-*
-*     ILO     (input) INTEGER
-*     IHI     (input) INTEGER
-*          It is assumed that H is already upper quasi-triangular in
-*          rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
-*          ILO = 1). DLAHQR works primarily with the Hessenberg
-*          submatrix in rows and columns ILO to IHI, but applies
-*          transformations to all of H if WANTT is .TRUE..
-*          1 <= ILO <= max(1,IHI); IHI <= N.
-*
-*     H       (input/output) DOUBLE PRECISION array, dimension (LDH,N)
-*          On entry, the upper Hessenberg matrix H.
-*          On exit, if INFO is zero and if WANTT is .TRUE., H is upper
-*          quasi-triangular in rows and columns ILO:IHI, with any
-*          2-by-2 diagonal blocks in standard form. If INFO is zero
-*          and WANTT is .FALSE., the contents of H are unspecified on
-*          exit.  The output state of H if INFO is nonzero is given
-*          below under the description of INFO.
-*
-*     LDH     (input) INTEGER
-*          The leading dimension of the array H. LDH >= max(1,N).
-*
-*     WR      (output) DOUBLE PRECISION array, dimension (N)
-*     WI      (output) DOUBLE PRECISION array, dimension (N)
-*          The real and imaginary parts, respectively, of the computed
-*          eigenvalues ILO to IHI are stored in the corresponding
-*          elements of WR and WI. If two eigenvalues are computed as a
-*          complex conjugate pair, they are stored in consecutive
-*          elements of WR and WI, say the i-th and (i+1)th, with
-*          WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
-*          eigenvalues are stored in the same order as on the diagonal
-*          of the Schur form returned in H, with WR(i) = H(i,i), and, if
-*          H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
-*          WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
-*
-*     ILOZ    (input) INTEGER
-*     IHIZ    (input) INTEGER
-*          Specify the rows of Z to which transformations must be
-*          applied if WANTZ is .TRUE..
-*          1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
-*
-*     Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
-*          If WANTZ is .TRUE., on entry Z must contain the current
-*          matrix Z of transformations accumulated by DHSEQR, and on
-*          exit Z has been updated; transformations are applied only to
-*          the submatrix Z(ILOZ:IHIZ,ILO:IHI).
-*          If WANTZ is .FALSE., Z is not referenced.
-*
-*     LDZ     (input) INTEGER
-*          The leading dimension of the array Z. LDZ >= max(1,N).
-*
-*     INFO    (output) INTEGER
-*           =   0: successful exit
-*          .GT. 0: If INFO = i, DLAHQR failed to compute all the
-*                  eigenvalues ILO to IHI in a total of 30 iterations
-*                  per eigenvalue; elements i+1:ihi of WR and WI
-*                  contain those eigenvalues which have been
-*                  successfully computed.
-*
-*                  If INFO .GT. 0 and WANTT is .FALSE., then on exit,
-*                  the remaining unconverged eigenvalues are the
-*                  eigenvalues of the upper Hessenberg matrix rows
-*                  and columns ILO thorugh INFO of the final, output
-*                  value of H.
-*
-*                  If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*          (*)       (initial value of H)*U  = U*(final value of H)
-*                  where U is an orthognal matrix.    The final
-*                  value of H is upper Hessenberg and triangular in
-*                  rows and columns INFO+1 through IHI.
-*
-*                  If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*                      (final value of Z)  = (initial value of Z)*U
-*                  where U is the orthogonal matrix in (*)
-*                  (regardless of the value of WANTT.)
-*
-*     Further Details
-*     ===============
-*
-*     02-96 Based on modifications by
-*     David Day, Sandia National Laboratory, USA
-*
-*     12-04 Further modifications by
-*     Ralph Byers, University of Kansas, USA
-*
-*       This is a modified version of DLAHQR from LAPACK version 3.0.
-*       It is (1) more robust against overflow and underflow and
-*       (2) adopts the more conservative Ahues & Tisseur stopping
-*       criterion (LAWN 122, 1997).
-*
-*     =========================================================
-*
-*     .. Parameters ..
-      INTEGER            ITMAX
-      PARAMETER          ( ITMAX = 30 )
-      DOUBLE PRECISION   ZERO, ONE, TWO
-      PARAMETER          ( ZERO = 0.0d0, ONE = 1.0d0, TWO = 2.0d0 )
-      DOUBLE PRECISION   DAT1, DAT2
-      PARAMETER          ( DAT1 = 3.0d0 / 4.0d0, DAT2 = -0.4375d0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   AA, AB, BA, BB, CS, DET, H11, H12, H21, H21S,
-     $                   H22, RT1I, RT1R, RT2I, RT2R, RTDISC, S, SAFMAX,
-     $                   SAFMIN, SMLNUM, SN, SUM, T1, T2, T3, TR, TST,
-     $                   ULP, V2, V3
-      INTEGER            I, I1, I2, ITS, J, K, L, M, NH, NR, NZ
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   V( 3 )
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DLABAD, DLANV2, DLARFG, DROT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-      IF( ILO.EQ.IHI ) THEN
-         WR( ILO ) = H( ILO, ILO )
-         WI( ILO ) = ZERO
-         RETURN
-      END IF
-*
-*     ==== clear out the trash ====
-      DO 10 J = ILO, IHI - 3
-         H( J+2, J ) = ZERO
-         H( J+3, J ) = ZERO
-   10 CONTINUE
-      IF( ILO.LE.IHI-2 )
-     $   H( IHI, IHI-2 ) = ZERO
-*
-      NH = IHI - ILO + 1
-      NZ = IHIZ - ILOZ + 1
-*
-*     Set machine-dependent constants for the stopping criterion.
-*
-      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
-      SAFMAX = ONE / SAFMIN
-      CALL DLABAD( SAFMIN, SAFMAX )
-      ULP = DLAMCH( 'PRECISION' )
-      SMLNUM = SAFMIN*( DBLE( NH ) / ULP )
-*
-*     I1 and I2 are the indices of the first row and last column of H
-*     to which transformations must be applied. If eigenvalues only are
-*     being computed, I1 and I2 are set inside the main loop.
-*
-      IF( WANTT ) THEN
-         I1 = 1
-         I2 = N
-      END IF
-*
-*     The main loop begins here. I is the loop index and decreases from
-*     IHI to ILO in steps of 1 or 2. Each iteration of the loop works
-*     with the active submatrix in rows and columns L to I.
-*     Eigenvalues I+1 to IHI have already converged. Either L = ILO or
-*     H(L,L-1) is negligible so that the matrix splits.
-*
-      I = IHI
-   20 CONTINUE
-      L = ILO
-      IF( I.LT.ILO )
-     $   GO TO 160
-*
-*     Perform QR iterations on rows and columns ILO to I until a
-*     submatrix of order 1 or 2 splits off at the bottom because a
-*     subdiagonal element has become negligible.
-*
-      DO 140 ITS = 0, ITMAX
-*
-*        Look for a single small subdiagonal element.
-*
-         DO 30 K = I, L + 1, -1
-            IF( ABS( H( K, K-1 ) ).LE.SMLNUM )
-     $         GO TO 40
-            TST = ABS( H( K-1, K-1 ) ) + ABS( H( K, K ) )
-            IF( TST.EQ.ZERO ) THEN
-               IF( K-2.GE.ILO )
-     $            TST = TST + ABS( H( K-1, K-2 ) )
-               IF( K+1.LE.IHI )
-     $            TST = TST + ABS( H( K+1, K ) )
-            END IF
-*           ==== The following is a conservative small subdiagonal
-*           .    deflation  criterion due to Ahues & Tisseur (LAWN 122,
-*           .    1997). It has better mathematical foundation and
-*           .    improves accuracy in some cases.  ====
-            IF( ABS( H( K, K-1 ) ).LE.ULP*TST ) THEN
-               AB = MAX( ABS( H( K, K-1 ) ), ABS( H( K-1, K ) ) )
-               BA = MIN( ABS( H( K, K-1 ) ), ABS( H( K-1, K ) ) )
-               AA = MAX( ABS( H( K, K ) ),
-     $              ABS( H( K-1, K-1 )-H( K, K ) ) )
-               BB = MIN( ABS( H( K, K ) ),
-     $              ABS( H( K-1, K-1 )-H( K, K ) ) )
-               S = AA + AB
-               IF( BA*( AB / S ).LE.MAX( SMLNUM,
-     $             ULP*( BB*( AA / S ) ) ) )GO TO 40
-            END IF
-   30    CONTINUE
-   40    CONTINUE
-         L = K
-         IF( L.GT.ILO ) THEN
-*
-*           H(L,L-1) is negligible
-*
-            H( L, L-1 ) = ZERO
-         END IF
-*
-*        Exit from loop if a submatrix of order 1 or 2 has split off.
-*
-         IF( L.GE.I-1 )
-     $      GO TO 150
-*
-*        Now the active submatrix is in rows and columns L to I. If
-*        eigenvalues only are being computed, only the active submatrix
-*        need be transformed.
-*
-         IF( .NOT.WANTT ) THEN
-            I1 = L
-            I2 = I
-         END IF
-*
-         IF( ITS.EQ.10 .OR. ITS.EQ.20 ) THEN
-*
-*           Exceptional shift.
-*
-            H11 = DAT1*S + H( I, I )
-            H12 = DAT2*S
-            H21 = S
-            H22 = H11
-         ELSE
-*
-*           Prepare to use Francis' double shift
-*           (i.e. 2nd degree generalized Rayleigh quotient)
-*
-            H11 = H( I-1, I-1 )
-            H21 = H( I, I-1 )
-            H12 = H( I-1, I )
-            H22 = H( I, I )
-         END IF
-         S = ABS( H11 ) + ABS( H12 ) + ABS( H21 ) + ABS( H22 )
-         IF( S.EQ.ZERO ) THEN
-            RT1R = ZERO
-            RT1I = ZERO
-            RT2R = ZERO
-            RT2I = ZERO
-         ELSE
-            H11 = H11 / S
-            H21 = H21 / S
-            H12 = H12 / S
-            H22 = H22 / S
-            TR = ( H11+H22 ) / TWO
-            DET = ( H11-TR )*( H22-TR ) - H12*H21
-            RTDISC = SQRT( ABS( DET ) )
-            IF( DET.GE.ZERO ) THEN
-*
-*              ==== complex conjugate shifts ====
-*
-               RT1R = TR*S
-               RT2R = RT1R
-               RT1I = RTDISC*S
-               RT2I = -RT1I
-            ELSE
-*
-*              ==== real shifts (use only one of them)  ====
-*
-               RT1R = TR + RTDISC
-               RT2R = TR - RTDISC
-               IF( ABS( RT1R-H22 ).LE.ABS( RT2R-H22 ) ) THEN
-                  RT1R = RT1R*S
-                  RT2R = RT1R
-               ELSE
-                  RT2R = RT2R*S
-                  RT1R = RT2R
-               END IF
-               RT1I = ZERO
-               RT2I = ZERO
-            END IF
-         END IF
-*
-*        Look for two consecutive small subdiagonal elements.
-*
-         DO 50 M = I - 2, L, -1
-*           Determine the effect of starting the double-shift QR
-*           iteration at row M, and see if this would make H(M,M-1)
-*           negligible.  (The following uses scaling to avoid
-*           overflows and most underflows.)
-*
-            H21S = H( M+1, M )
-            S = ABS( H( M, M )-RT2R ) + ABS( RT2I ) + ABS( H21S )
-            H21S = H( M+1, M ) / S
-            V( 1 ) = H21S*H( M, M+1 ) + ( H( M, M )-RT1R )*
-     $               ( ( H( M, M )-RT2R ) / S ) - RT1I*( RT2I / S )
-            V( 2 ) = H21S*( H( M, M )+H( M+1, M+1 )-RT1R-RT2R )
-            V( 3 ) = H21S*H( M+2, M+1 )
-            S = ABS( V( 1 ) ) + ABS( V( 2 ) ) + ABS( V( 3 ) )
-            V( 1 ) = V( 1 ) / S
-            V( 2 ) = V( 2 ) / S
-            V( 3 ) = V( 3 ) / S
-            IF( M.EQ.L )
-     $         GO TO 60
-            IF( ABS( H( M, M-1 ) )*( ABS( V( 2 ) )+ABS( V( 3 ) ) ).LE.
-     $          ULP*ABS( V( 1 ) )*( ABS( H( M-1, M-1 ) )+ABS( H( M,
-     $          M ) )+ABS( H( M+1, M+1 ) ) ) )GO TO 60
-   50    CONTINUE
-   60    CONTINUE
-*
-*        Double-shift QR step
-*
-         DO 130 K = M, I - 1
-*
-*           The first iteration of this loop determines a reflection G
-*           from the vector V and applies it from left and right to H,
-*           thus creating a nonzero bulge below the subdiagonal.
-*
-*           Each subsequent iteration determines a reflection G to
-*           restore the Hessenberg form in the (K-1)th column, and thus
-*           chases the bulge one step toward the bottom of the active
-*           submatrix. NR is the order of G.
-*
-            NR = MIN( 3, I-K+1 )
-            IF( K.GT.M )
-     $         CALL DCOPY( NR, H( K, K-1 ), 1, V, 1 )
-            CALL DLARFG( NR, V( 1 ), V( 2 ), 1, T1 )
-            IF( K.GT.M ) THEN
-               H( K, K-1 ) = V( 1 )
-               H( K+1, K-1 ) = ZERO
-               IF( K.LT.I-1 )
-     $            H( K+2, K-1 ) = ZERO
-            ELSE IF( M.GT.L ) THEN
-               H( K, K-1 ) = -H( K, K-1 )
-            END IF
-            V2 = V( 2 )
-            T2 = T1*V2
-            IF( NR.EQ.3 ) THEN
-               V3 = V( 3 )
-               T3 = T1*V3
-*
-*              Apply G from the left to transform the rows of the matrix
-*              in columns K to I2.
-*
-               DO 70 J = K, I2
-                  SUM = H( K, J ) + V2*H( K+1, J ) + V3*H( K+2, J )
-                  H( K, J ) = H( K, J ) - SUM*T1
-                  H( K+1, J ) = H( K+1, J ) - SUM*T2
-                  H( K+2, J ) = H( K+2, J ) - SUM*T3
-   70          CONTINUE
-*
-*              Apply G from the right to transform the columns of the
-*              matrix in rows I1 to min(K+3,I).
-*
-               DO 80 J = I1, MIN( K+3, I )
-                  SUM = H( J, K ) + V2*H( J, K+1 ) + V3*H( J, K+2 )
-                  H( J, K ) = H( J, K ) - SUM*T1
-                  H( J, K+1 ) = H( J, K+1 ) - SUM*T2
-                  H( J, K+2 ) = H( J, K+2 ) - SUM*T3
-   80          CONTINUE
-*
-               IF( WANTZ ) THEN
-*
-*                 Accumulate transformations in the matrix Z
-*
-                  DO 90 J = ILOZ, IHIZ
-                     SUM = Z( J, K ) + V2*Z( J, K+1 ) + V3*Z( J, K+2 )
-                     Z( J, K ) = Z( J, K ) - SUM*T1
-                     Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2
-                     Z( J, K+2 ) = Z( J, K+2 ) - SUM*T3
-   90             CONTINUE
-               END IF
-            ELSE IF( NR.EQ.2 ) THEN
-*
-*              Apply G from the left to transform the rows of the matrix
-*              in columns K to I2.
-*
-               DO 100 J = K, I2
-                  SUM = H( K, J ) + V2*H( K+1, J )
-                  H( K, J ) = H( K, J ) - SUM*T1
-                  H( K+1, J ) = H( K+1, J ) - SUM*T2
-  100          CONTINUE
-*
-*              Apply G from the right to transform the columns of the
-*              matrix in rows I1 to min(K+3,I).
-*
-               DO 110 J = I1, I
-                  SUM = H( J, K ) + V2*H( J, K+1 )
-                  H( J, K ) = H( J, K ) - SUM*T1
-                  H( J, K+1 ) = H( J, K+1 ) - SUM*T2
-  110          CONTINUE
-*
-               IF( WANTZ ) THEN
-*
-*                 Accumulate transformations in the matrix Z
-*
-                  DO 120 J = ILOZ, IHIZ
-                     SUM = Z( J, K ) + V2*Z( J, K+1 )
-                     Z( J, K ) = Z( J, K ) - SUM*T1
-                     Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2
-  120             CONTINUE
-               END IF
-            END IF
-  130    CONTINUE
-*
-  140 CONTINUE
-*
-*     Failure to converge in remaining number of iterations
-*
-      INFO = I
-      RETURN
-*
-  150 CONTINUE
-*
-      IF( L.EQ.I ) THEN
-*
-*        H(I,I-1) is negligible: one eigenvalue has converged.
-*
-         WR( I ) = H( I, I )
-         WI( I ) = ZERO
-      ELSE IF( L.EQ.I-1 ) THEN
-*
-*        H(I-1,I-2) is negligible: a pair of eigenvalues have converged.
-*
-*        Transform the 2-by-2 submatrix to standard Schur form,
-*        and compute and store the eigenvalues.
-*
-         CALL DLANV2( H( I-1, I-1 ), H( I-1, I ), H( I, I-1 ),
-     $                H( I, I ), WR( I-1 ), WI( I-1 ), WR( I ), WI( I ),
-     $                CS, SN )
-*
-         IF( WANTT ) THEN
-*
-*           Apply the transformation to the rest of H.
-*
-            IF( I2.GT.I )
-     $         CALL DROT( I2-I, H( I-1, I+1 ), LDH, H( I, I+1 ), LDH,
-     $                    CS, SN )
-            CALL DROT( I-I1-1, H( I1, I-1 ), 1, H( I1, I ), 1, CS, SN )
-         END IF
-         IF( WANTZ ) THEN
-*
-*           Apply the transformation to Z.
-*
-            CALL DROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, SN )
-         END IF
-      END IF
-*
-*     return to start of the main loop with new value of I.
-*
-      I = L - 1
-      GO TO 20
-*
-  160 CONTINUE
-      RETURN
-*
-*     End of DLAHQR
-*
-      END
diff --git a/src/lib/lapack/dlahr2.f b/src/lib/lapack/dlahr2.f
deleted file mode 100644
index 6af74977..00000000
--- a/src/lib/lapack/dlahr2.f
+++ /dev/null
@@ -1,238 +0,0 @@
-      SUBROUTINE DLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            K, LDA, LDT, LDY, N, NB
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION  A( LDA, * ), T( LDT, NB ), TAU( NB ),
-     $                   Y( LDY, NB )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAHR2 reduces the first NB columns of A real general n-BY-(n-k+1)
-*  matrix A so that elements below the k-th subdiagonal are zero. The
-*  reduction is performed by an orthogonal similarity transformation
-*  Q' * A * Q. The routine returns the matrices V and T which determine
-*  Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
-*
-*  This is an auxiliary routine called by DGEHRD.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.
-*
-*  K       (input) INTEGER
-*          The offset for the reduction. Elements below the k-th
-*          subdiagonal in the first NB columns are reduced to zero.
-*          K < N.
-*
-*  NB      (input) INTEGER
-*          The number of columns to be reduced.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N-K+1)
-*          On entry, the n-by-(n-k+1) general matrix A.
-*          On exit, the elements on and above the k-th subdiagonal in
-*          the first NB columns are overwritten with the corresponding
-*          elements of the reduced matrix; the elements below the k-th
-*          subdiagonal, with the array TAU, represent the matrix Q as a
-*          product of elementary reflectors. The other columns of A are
-*          unchanged. See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (NB)
-*          The scalar factors of the elementary reflectors. See Further
-*          Details.
-*
-*  T       (output) DOUBLE PRECISION array, dimension (LDT,NB)
-*          The upper triangular matrix T.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T.  LDT >= NB.
-*
-*  Y       (output) DOUBLE PRECISION array, dimension (LDY,NB)
-*          The n-by-nb matrix Y.
-*
-*  LDY     (input) INTEGER
-*          The leading dimension of the array Y. LDY >= N.
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of nb elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(nb).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
-*  A(i+k+1:n,i), and tau in TAU(i).
-*
-*  The elements of the vectors v together form the (n-k+1)-by-nb matrix
-*  V which is needed, with T and Y, to apply the transformation to the
-*  unreduced part of the matrix, using an update of the form:
-*  A := (I - V*T*V') * (A - Y*V').
-*
-*  The contents of A on exit are illustrated by the following example
-*  with n = 7, k = 3 and nb = 2:
-*
-*     ( a   a   a   a   a )
-*     ( a   a   a   a   a )
-*     ( a   a   a   a   a )
-*     ( h   h   a   a   a )
-*     ( v1  h   a   a   a )
-*     ( v1  v2  a   a   a )
-*     ( v1  v2  a   a   a )
-*
-*  where a denotes an element of the original matrix A, h denotes a
-*  modified element of the upper Hessenberg matrix H, and vi denotes an
-*  element of the vector defining H(i).
-*
-*  This file is a slight modification of LAPACK-3.0's DLAHRD
-*  incorporating improvements proposed by Quintana-Orti and Van de
-*  Gejin. Note that the entries of A(1:K,2:NB) differ from those
-*  returned by the original LAPACK routine. This function is
-*  not backward compatible with LAPACK3.0.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION  ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, 
-     $                     ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-      DOUBLE PRECISION  EI
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DCOPY, DGEMM, DGEMV, DLACPY,
-     $                   DLARFG, DSCAL, DTRMM, DTRMV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-      DO 10 I = 1, NB
-         IF( I.GT.1 ) THEN
-*
-*           Update A(K+1:N,I)
-*
-*           Update I-th column of A - Y * V'
-*
-            CALL DGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY,
-     $                  A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 )
-*
-*           Apply I - V * T' * V' to this column (call it b) from the
-*           left, using the last column of T as workspace
-*
-*           Let  V = ( V1 )   and   b = ( b1 )   (first I-1 rows)
-*                    ( V2 )             ( b2 )
-*
-*           where V1 is unit lower triangular
-*
-*           w := V1' * b1
-*
-            CALL DCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 )
-            CALL DTRMV( 'Lower', 'Transpose', 'UNIT', 
-     $                  I-1, A( K+1, 1 ),
-     $                  LDA, T( 1, NB ), 1 )
-*
-*           w := w + V2'*b2
-*
-            CALL DGEMV( 'Transpose', N-K-I+1, I-1, 
-     $                  ONE, A( K+I, 1 ),
-     $                  LDA, A( K+I, I ), 1, ONE, T( 1, NB ), 1 )
-*
-*           w := T'*w
-*
-            CALL DTRMV( 'Upper', 'Transpose', 'NON-UNIT', 
-     $                  I-1, T, LDT,
-     $                  T( 1, NB ), 1 )
-*
-*           b2 := b2 - V2*w
-*
-            CALL DGEMV( 'NO TRANSPOSE', N-K-I+1, I-1, -ONE, 
-     $                  A( K+I, 1 ),
-     $                  LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 )
-*
-*           b1 := b1 - V1*w
-*
-            CALL DTRMV( 'Lower', 'NO TRANSPOSE', 
-     $                  'UNIT', I-1,
-     $                  A( K+1, 1 ), LDA, T( 1, NB ), 1 )
-            CALL DAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 )
-*
-            A( K+I-1, I-1 ) = EI
-         END IF
-*
-*        Generate the elementary reflector H(I) to annihilate
-*        A(K+I+1:N,I)
-*
-         CALL DLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1,
-     $                TAU( I ) )
-         EI = A( K+I, I )
-         A( K+I, I ) = ONE
-*
-*        Compute  Y(K+1:N,I)
-*
-         CALL DGEMV( 'NO TRANSPOSE', N-K, N-K-I+1, 
-     $               ONE, A( K+1, I+1 ),
-     $               LDA, A( K+I, I ), 1, ZERO, Y( K+1, I ), 1 )
-         CALL DGEMV( 'Transpose', N-K-I+1, I-1, 
-     $               ONE, A( K+I, 1 ), LDA,
-     $               A( K+I, I ), 1, ZERO, T( 1, I ), 1 )
-         CALL DGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, 
-     $               Y( K+1, 1 ), LDY,
-     $               T( 1, I ), 1, ONE, Y( K+1, I ), 1 )
-         CALL DSCAL( N-K, TAU( I ), Y( K+1, I ), 1 )
-*
-*        Compute T(1:I,I)
-*
-         CALL DSCAL( I-1, -TAU( I ), T( 1, I ), 1 )
-         CALL DTRMV( 'Upper', 'No Transpose', 'NON-UNIT', 
-     $               I-1, T, LDT,
-     $               T( 1, I ), 1 )
-         T( I, I ) = TAU( I )
-*
-   10 CONTINUE
-      A( K+NB, NB ) = EI
-*
-*     Compute Y(1:K,1:NB)
-*
-      CALL DLACPY( 'ALL', K, NB, A( 1, 2 ), LDA, Y, LDY )
-      CALL DTRMM( 'RIGHT', 'Lower', 'NO TRANSPOSE', 
-     $            'UNIT', K, NB,
-     $            ONE, A( K+1, 1 ), LDA, Y, LDY )
-      IF( N.GT.K+NB )
-     $   CALL DGEMM( 'NO TRANSPOSE', 'NO TRANSPOSE', K, 
-     $               NB, N-K-NB, ONE,
-     $               A( 1, 2+NB ), LDA, A( K+1+NB, 1 ), LDA, ONE, Y,
-     $               LDY )
-      CALL DTRMM( 'RIGHT', 'Upper', 'NO TRANSPOSE', 
-     $            'NON-UNIT', K, NB,
-     $            ONE, T, LDT, Y, LDY )
-*
-      RETURN
-*
-*     End of DLAHR2
-*
-      END
diff --git a/src/lib/lapack/dlahrd.f b/src/lib/lapack/dlahrd.f
deleted file mode 100644
index a04133d1..00000000
--- a/src/lib/lapack/dlahrd.f
+++ /dev/null
@@ -1,207 +0,0 @@
-      SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            K, LDA, LDT, LDY, N, NB
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), T( LDT, NB ), TAU( NB ),
-     $                   Y( LDY, NB )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAHRD reduces the first NB columns of a real general n-by-(n-k+1)
-*  matrix A so that elements below the k-th subdiagonal are zero. The
-*  reduction is performed by an orthogonal similarity transformation
-*  Q' * A * Q. The routine returns the matrices V and T which determine
-*  Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
-*
-*  This is an OBSOLETE auxiliary routine. 
-*  This routine will be 'deprecated' in a  future release.
-*  Please use the new routine DLAHR2 instead.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.
-*
-*  K       (input) INTEGER
-*          The offset for the reduction. Elements below the k-th
-*          subdiagonal in the first NB columns are reduced to zero.
-*
-*  NB      (input) INTEGER
-*          The number of columns to be reduced.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N-K+1)
-*          On entry, the n-by-(n-k+1) general matrix A.
-*          On exit, the elements on and above the k-th subdiagonal in
-*          the first NB columns are overwritten with the corresponding
-*          elements of the reduced matrix; the elements below the k-th
-*          subdiagonal, with the array TAU, represent the matrix Q as a
-*          product of elementary reflectors. The other columns of A are
-*          unchanged. See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (NB)
-*          The scalar factors of the elementary reflectors. See Further
-*          Details.
-*
-*  T       (output) DOUBLE PRECISION array, dimension (LDT,NB)
-*          The upper triangular matrix T.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T.  LDT >= NB.
-*
-*  Y       (output) DOUBLE PRECISION array, dimension (LDY,NB)
-*          The n-by-nb matrix Y.
-*
-*  LDY     (input) INTEGER
-*          The leading dimension of the array Y. LDY >= N.
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of nb elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(nb).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
-*  A(i+k+1:n,i), and tau in TAU(i).
-*
-*  The elements of the vectors v together form the (n-k+1)-by-nb matrix
-*  V which is needed, with T and Y, to apply the transformation to the
-*  unreduced part of the matrix, using an update of the form:
-*  A := (I - V*T*V') * (A - Y*V').
-*
-*  The contents of A on exit are illustrated by the following example
-*  with n = 7, k = 3 and nb = 2:
-*
-*     ( a   h   a   a   a )
-*     ( a   h   a   a   a )
-*     ( a   h   a   a   a )
-*     ( h   h   a   a   a )
-*     ( v1  h   a   a   a )
-*     ( v1  v2  a   a   a )
-*     ( v1  v2  a   a   a )
-*
-*  where a denotes an element of the original matrix A, h denotes a
-*  modified element of the upper Hessenberg matrix H, and vi denotes an
-*  element of the vector defining H(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-      DOUBLE PRECISION   EI
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DCOPY, DGEMV, DLARFG, DSCAL, DTRMV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-      DO 10 I = 1, NB
-         IF( I.GT.1 ) THEN
-*
-*           Update A(1:n,i)
-*
-*           Compute i-th column of A - Y * V'
-*
-            CALL DGEMV( 'No transpose', N, I-1, -ONE, Y, LDY,
-     $                  A( K+I-1, 1 ), LDA, ONE, A( 1, I ), 1 )
-*
-*           Apply I - V * T' * V' to this column (call it b) from the
-*           left, using the last column of T as workspace
-*
-*           Let  V = ( V1 )   and   b = ( b1 )   (first I-1 rows)
-*                    ( V2 )             ( b2 )
-*
-*           where V1 is unit lower triangular
-*
-*           w := V1' * b1
-*
-            CALL DCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 )
-            CALL DTRMV( 'Lower', 'Transpose', 'Unit', I-1, A( K+1, 1 ),
-     $                  LDA, T( 1, NB ), 1 )
-*
-*           w := w + V2'*b2
-*
-            CALL DGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ),
-     $                  LDA, A( K+I, I ), 1, ONE, T( 1, NB ), 1 )
-*
-*           w := T'*w
-*
-            CALL DTRMV( 'Upper', 'Transpose', 'Non-unit', I-1, T, LDT,
-     $                  T( 1, NB ), 1 )
-*
-*           b2 := b2 - V2*w
-*
-            CALL DGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ),
-     $                  LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 )
-*
-*           b1 := b1 - V1*w
-*
-            CALL DTRMV( 'Lower', 'No transpose', 'Unit', I-1,
-     $                  A( K+1, 1 ), LDA, T( 1, NB ), 1 )
-            CALL DAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 )
-*
-            A( K+I-1, I-1 ) = EI
-         END IF
-*
-*        Generate the elementary reflector H(i) to annihilate
-*        A(k+i+1:n,i)
-*
-         CALL DLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1,
-     $                TAU( I ) )
-         EI = A( K+I, I )
-         A( K+I, I ) = ONE
-*
-*        Compute  Y(1:n,i)
-*
-         CALL DGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA,
-     $               A( K+I, I ), 1, ZERO, Y( 1, I ), 1 )
-         CALL DGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), LDA,
-     $               A( K+I, I ), 1, ZERO, T( 1, I ), 1 )
-         CALL DGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1,
-     $               ONE, Y( 1, I ), 1 )
-         CALL DSCAL( N, TAU( I ), Y( 1, I ), 1 )
-*
-*        Compute T(1:i,i)
-*
-         CALL DSCAL( I-1, -TAU( I ), T( 1, I ), 1 )
-         CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT,
-     $               T( 1, I ), 1 )
-         T( I, I ) = TAU( I )
-*
-   10 CONTINUE
-      A( K+NB, NB ) = EI
-*
-      RETURN
-*
-*     End of DLAHRD
-*
-      END
diff --git a/src/lib/lapack/dlaic1.f b/src/lib/lapack/dlaic1.f
deleted file mode 100644
index 44baece1..00000000
--- a/src/lib/lapack/dlaic1.f
+++ /dev/null
@@ -1,292 +0,0 @@
-      SUBROUTINE DLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            J, JOB
-      DOUBLE PRECISION   C, GAMMA, S, SEST, SESTPR
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   W( J ), X( J )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAIC1 applies one step of incremental condition estimation in
-*  its simplest version:
-*
-*  Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j
-*  lower triangular matrix L, such that
-*           twonorm(L*x) = sest
-*  Then DLAIC1 computes sestpr, s, c such that
-*  the vector
-*                  [ s*x ]
-*           xhat = [  c  ]
-*  is an approximate singular vector of
-*                  [ L     0  ]
-*           Lhat = [ w' gamma ]
-*  in the sense that
-*           twonorm(Lhat*xhat) = sestpr.
-*
-*  Depending on JOB, an estimate for the largest or smallest singular
-*  value is computed.
-*
-*  Note that [s c]' and sestpr**2 is an eigenpair of the system
-*
-*      diag(sest*sest, 0) + [alpha  gamma] * [ alpha ]
-*                                            [ gamma ]
-*
-*  where  alpha =  x'*w.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) INTEGER
-*          = 1: an estimate for the largest singular value is computed.
-*          = 2: an estimate for the smallest singular value is computed.
-*
-*  J       (input) INTEGER
-*          Length of X and W
-*
-*  X       (input) DOUBLE PRECISION array, dimension (J)
-*          The j-vector x.
-*
-*  SEST    (input) DOUBLE PRECISION
-*          Estimated singular value of j by j matrix L
-*
-*  W       (input) DOUBLE PRECISION array, dimension (J)
-*          The j-vector w.
-*
-*  GAMMA   (input) DOUBLE PRECISION
-*          The diagonal element gamma.
-*
-*  SESTPR  (output) DOUBLE PRECISION
-*          Estimated singular value of (j+1) by (j+1) matrix Lhat.
-*
-*  S       (output) DOUBLE PRECISION
-*          Sine needed in forming xhat.
-*
-*  C       (output) DOUBLE PRECISION
-*          Cosine needed in forming xhat.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE, TWO
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 )
-      DOUBLE PRECISION   HALF, FOUR
-      PARAMETER          ( HALF = 0.5D0, FOUR = 4.0D0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   ABSALP, ABSEST, ABSGAM, ALPHA, B, COSINE, EPS,
-     $                   NORMA, S1, S2, SINE, T, TEST, TMP, ZETA1, ZETA2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SIGN, SQRT
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DDOT, DLAMCH
-      EXTERNAL           DDOT, DLAMCH
-*     ..
-*     .. Executable Statements ..
-*
-      EPS = DLAMCH( 'Epsilon' )
-      ALPHA = DDOT( J, X, 1, W, 1 )
-*
-      ABSALP = ABS( ALPHA )
-      ABSGAM = ABS( GAMMA )
-      ABSEST = ABS( SEST )
-*
-      IF( JOB.EQ.1 ) THEN
-*
-*        Estimating largest singular value
-*
-*        special cases
-*
-         IF( SEST.EQ.ZERO ) THEN
-            S1 = MAX( ABSGAM, ABSALP )
-            IF( S1.EQ.ZERO ) THEN
-               S = ZERO
-               C = ONE
-               SESTPR = ZERO
-            ELSE
-               S = ALPHA / S1
-               C = GAMMA / S1
-               TMP = SQRT( S*S+C*C )
-               S = S / TMP
-               C = C / TMP
-               SESTPR = S1*TMP
-            END IF
-            RETURN
-         ELSE IF( ABSGAM.LE.EPS*ABSEST ) THEN
-            S = ONE
-            C = ZERO
-            TMP = MAX( ABSEST, ABSALP )
-            S1 = ABSEST / TMP
-            S2 = ABSALP / TMP
-            SESTPR = TMP*SQRT( S1*S1+S2*S2 )
-            RETURN
-         ELSE IF( ABSALP.LE.EPS*ABSEST ) THEN
-            S1 = ABSGAM
-            S2 = ABSEST
-            IF( S1.LE.S2 ) THEN
-               S = ONE
-               C = ZERO
-               SESTPR = S2
-            ELSE
-               S = ZERO
-               C = ONE
-               SESTPR = S1
-            END IF
-            RETURN
-         ELSE IF( ABSEST.LE.EPS*ABSALP .OR. ABSEST.LE.EPS*ABSGAM ) THEN
-            S1 = ABSGAM
-            S2 = ABSALP
-            IF( S1.LE.S2 ) THEN
-               TMP = S1 / S2
-               S = SQRT( ONE+TMP*TMP )
-               SESTPR = S2*S
-               C = ( GAMMA / S2 ) / S
-               S = SIGN( ONE, ALPHA ) / S
-            ELSE
-               TMP = S2 / S1
-               C = SQRT( ONE+TMP*TMP )
-               SESTPR = S1*C
-               S = ( ALPHA / S1 ) / C
-               C = SIGN( ONE, GAMMA ) / C
-            END IF
-            RETURN
-         ELSE
-*
-*           normal case
-*
-            ZETA1 = ALPHA / ABSEST
-            ZETA2 = GAMMA / ABSEST
-*
-            B = ( ONE-ZETA1*ZETA1-ZETA2*ZETA2 )*HALF
-            C = ZETA1*ZETA1
-            IF( B.GT.ZERO ) THEN
-               T = C / ( B+SQRT( B*B+C ) )
-            ELSE
-               T = SQRT( B*B+C ) - B
-            END IF
-*
-            SINE = -ZETA1 / T
-            COSINE = -ZETA2 / ( ONE+T )
-            TMP = SQRT( SINE*SINE+COSINE*COSINE )
-            S = SINE / TMP
-            C = COSINE / TMP
-            SESTPR = SQRT( T+ONE )*ABSEST
-            RETURN
-         END IF
-*
-      ELSE IF( JOB.EQ.2 ) THEN
-*
-*        Estimating smallest singular value
-*
-*        special cases
-*
-         IF( SEST.EQ.ZERO ) THEN
-            SESTPR = ZERO
-            IF( MAX( ABSGAM, ABSALP ).EQ.ZERO ) THEN
-               SINE = ONE
-               COSINE = ZERO
-            ELSE
-               SINE = -GAMMA
-               COSINE = ALPHA
-            END IF
-            S1 = MAX( ABS( SINE ), ABS( COSINE ) )
-            S = SINE / S1
-            C = COSINE / S1
-            TMP = SQRT( S*S+C*C )
-            S = S / TMP
-            C = C / TMP
-            RETURN
-         ELSE IF( ABSGAM.LE.EPS*ABSEST ) THEN
-            S = ZERO
-            C = ONE
-            SESTPR = ABSGAM
-            RETURN
-         ELSE IF( ABSALP.LE.EPS*ABSEST ) THEN
-            S1 = ABSGAM
-            S2 = ABSEST
-            IF( S1.LE.S2 ) THEN
-               S = ZERO
-               C = ONE
-               SESTPR = S1
-            ELSE
-               S = ONE
-               C = ZERO
-               SESTPR = S2
-            END IF
-            RETURN
-         ELSE IF( ABSEST.LE.EPS*ABSALP .OR. ABSEST.LE.EPS*ABSGAM ) THEN
-            S1 = ABSGAM
-            S2 = ABSALP
-            IF( S1.LE.S2 ) THEN
-               TMP = S1 / S2
-               C = SQRT( ONE+TMP*TMP )
-               SESTPR = ABSEST*( TMP / C )
-               S = -( GAMMA / S2 ) / C
-               C = SIGN( ONE, ALPHA ) / C
-            ELSE
-               TMP = S2 / S1
-               S = SQRT( ONE+TMP*TMP )
-               SESTPR = ABSEST / S
-               C = ( ALPHA / S1 ) / S
-               S = -SIGN( ONE, GAMMA ) / S
-            END IF
-            RETURN
-         ELSE
-*
-*           normal case
-*
-            ZETA1 = ALPHA / ABSEST
-            ZETA2 = GAMMA / ABSEST
-*
-            NORMA = MAX( ONE+ZETA1*ZETA1+ABS( ZETA1*ZETA2 ),
-     $              ABS( ZETA1*ZETA2 )+ZETA2*ZETA2 )
-*
-*           See if root is closer to zero or to ONE
-*
-            TEST = ONE + TWO*( ZETA1-ZETA2 )*( ZETA1+ZETA2 )
-            IF( TEST.GE.ZERO ) THEN
-*
-*              root is close to zero, compute directly
-*
-               B = ( ZETA1*ZETA1+ZETA2*ZETA2+ONE )*HALF
-               C = ZETA2*ZETA2
-               T = C / ( B+SQRT( ABS( B*B-C ) ) )
-               SINE = ZETA1 / ( ONE-T )
-               COSINE = -ZETA2 / T
-               SESTPR = SQRT( T+FOUR*EPS*EPS*NORMA )*ABSEST
-            ELSE
-*
-*              root is closer to ONE, shift by that amount
-*
-               B = ( ZETA2*ZETA2+ZETA1*ZETA1-ONE )*HALF
-               C = ZETA1*ZETA1
-               IF( B.GE.ZERO ) THEN
-                  T = -C / ( B+SQRT( B*B+C ) )
-               ELSE
-                  T = B - SQRT( B*B+C )
-               END IF
-               SINE = -ZETA1 / T
-               COSINE = -ZETA2 / ( ONE+T )
-               SESTPR = SQRT( ONE+T+FOUR*EPS*EPS*NORMA )*ABSEST
-            END IF
-            TMP = SQRT( SINE*SINE+COSINE*COSINE )
-            S = SINE / TMP
-            C = COSINE / TMP
-            RETURN
-*
-         END IF
-      END IF
-      RETURN
-*
-*     End of DLAIC1
-*
-      END
diff --git a/src/lib/lapack/dlaisnan.f b/src/lib/lapack/dlaisnan.f
deleted file mode 100644
index 96350a27..00000000
--- a/src/lib/lapack/dlaisnan.f
+++ /dev/null
@@ -1,41 +0,0 @@
-      LOGICAL FUNCTION DLAISNAN(DIN1,DIN2)
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION DIN1,DIN2
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  This routine is not for general use.  It exists solely to avoid
-*  over-optimization in DISNAN.
-*
-*  DLAISNAN checks for NaNs by comparing its two arguments for
-*  inequality.  NaN is the only floating-point value where NaN != NaN
-*  returns .TRUE.  To check for NaNs, pass the same variable as both
-*  arguments.
-*
-*  Strictly speaking, Fortran does not allow aliasing of function
-*  arguments. So a compiler must assume that the two arguments are
-*  not the same variable, and the test will not be optimized away.
-*  Interprocedural or whole-program optimization may delete this
-*  test.  The ISNAN functions will be replaced by the correct
-*  Fortran 03 intrinsic once the intrinsic is widely available.
-*
-*  Arguments
-*  =========
-*
-*  DIN1     (input) DOUBLE PRECISION
-*  DIN2     (input) DOUBLE PRECISION
-*          Two numbers to compare for inequality.
-*
-*  =====================================================================
-*
-*  .. Executable Statements ..
-      DLAISNAN = (DIN1.NE.DIN2)
-      RETURN
-      END
diff --git a/src/lib/lapack/dlaln2.f b/src/lib/lapack/dlaln2.f
deleted file mode 100644
index 7c99bdbe..00000000
--- a/src/lib/lapack/dlaln2.f
+++ /dev/null
@@ -1,507 +0,0 @@
-      SUBROUTINE DLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B,
-     $                   LDB, WR, WI, X, LDX, SCALE, XNORM, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            LTRANS
-      INTEGER            INFO, LDA, LDB, LDX, NA, NW
-      DOUBLE PRECISION   CA, D1, D2, SCALE, SMIN, WI, WR, XNORM
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), X( LDX, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLALN2 solves a system of the form  (ca A - w D ) X = s B
-*  or (ca A' - w D) X = s B   with possible scaling ("s") and
-*  perturbation of A.  (A' means A-transpose.)
-*
-*  A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA
-*  real diagonal matrix, w is a real or complex value, and X and B are
-*  NA x 1 matrices -- real if w is real, complex if w is complex.  NA
-*  may be 1 or 2.
-*
-*  If w is complex, X and B are represented as NA x 2 matrices,
-*  the first column of each being the real part and the second
-*  being the imaginary part.
-*
-*  "s" is a scaling factor (.LE. 1), computed by DLALN2, which is
-*  so chosen that X can be computed without overflow.  X is further
-*  scaled if necessary to assure that norm(ca A - w D)*norm(X) is less
-*  than overflow.
-*
-*  If both singular values of (ca A - w D) are less than SMIN,
-*  SMIN*identity will be used instead of (ca A - w D).  If only one
-*  singular value is less than SMIN, one element of (ca A - w D) will be
-*  perturbed enough to make the smallest singular value roughly SMIN.
-*  If both singular values are at least SMIN, (ca A - w D) will not be
-*  perturbed.  In any case, the perturbation will be at most some small
-*  multiple of max( SMIN, ulp*norm(ca A - w D) ).  The singular values
-*  are computed by infinity-norm approximations, and thus will only be
-*  correct to a factor of 2 or so.
-*
-*  Note: all input quantities are assumed to be smaller than overflow
-*  by a reasonable factor.  (See BIGNUM.)
-*
-*  Arguments
-*  ==========
-*
-*  LTRANS  (input) LOGICAL
-*          =.TRUE.:  A-transpose will be used.
-*          =.FALSE.: A will be used (not transposed.)
-*
-*  NA      (input) INTEGER
-*          The size of the matrix A.  It may (only) be 1 or 2.
-*
-*  NW      (input) INTEGER
-*          1 if "w" is real, 2 if "w" is complex.  It may only be 1
-*          or 2.
-*
-*  SMIN    (input) DOUBLE PRECISION
-*          The desired lower bound on the singular values of A.  This
-*          should be a safe distance away from underflow or overflow,
-*          say, between (underflow/machine precision) and  (machine
-*          precision * overflow ).  (See BIGNUM and ULP.)
-*
-*  CA      (input) DOUBLE PRECISION
-*          The coefficient c, which A is multiplied by.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,NA)
-*          The NA x NA matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of A.  It must be at least NA.
-*
-*  D1      (input) DOUBLE PRECISION
-*          The 1,1 element in the diagonal matrix D.
-*
-*  D2      (input) DOUBLE PRECISION
-*          The 2,2 element in the diagonal matrix D.  Not used if NW=1.
-*
-*  B       (input) DOUBLE PRECISION array, dimension (LDB,NW)
-*          The NA x NW matrix B (right-hand side).  If NW=2 ("w" is
-*          complex), column 1 contains the real part of B and column 2
-*          contains the imaginary part.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of B.  It must be at least NA.
-*
-*  WR      (input) DOUBLE PRECISION
-*          The real part of the scalar "w".
-*
-*  WI      (input) DOUBLE PRECISION
-*          The imaginary part of the scalar "w".  Not used if NW=1.
-*
-*  X       (output) DOUBLE PRECISION array, dimension (LDX,NW)
-*          The NA x NW matrix X (unknowns), as computed by DLALN2.
-*          If NW=2 ("w" is complex), on exit, column 1 will contain
-*          the real part of X and column 2 will contain the imaginary
-*          part.
-*
-*  LDX     (input) INTEGER
-*          The leading dimension of X.  It must be at least NA.
-*
-*  SCALE   (output) DOUBLE PRECISION
-*          The scale factor that B must be multiplied by to insure
-*          that overflow does not occur when computing X.  Thus,
-*          (ca A - w D) X  will be SCALE*B, not B (ignoring
-*          perturbations of A.)  It will be at most 1.
-*
-*  XNORM   (output) DOUBLE PRECISION
-*          The infinity-norm of X, when X is regarded as an NA x NW
-*          real matrix.
-*
-*  INFO    (output) INTEGER
-*          An error flag.  It will be set to zero if no error occurs,
-*          a negative number if an argument is in error, or a positive
-*          number if  ca A - w D  had to be perturbed.
-*          The possible values are:
-*          = 0: No error occurred, and (ca A - w D) did not have to be
-*                 perturbed.
-*          = 1: (ca A - w D) had to be perturbed to make its smallest
-*               (or only) singular value greater than SMIN.
-*          NOTE: In the interests of speed, this routine does not
-*                check the inputs for errors.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-      DOUBLE PRECISION   TWO
-      PARAMETER          ( TWO = 2.0D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            ICMAX, J
-      DOUBLE PRECISION   BBND, BI1, BI2, BIGNUM, BNORM, BR1, BR2, CI21,
-     $                   CI22, CMAX, CNORM, CR21, CR22, CSI, CSR, LI21,
-     $                   LR21, SMINI, SMLNUM, TEMP, U22ABS, UI11, UI11R,
-     $                   UI12, UI12S, UI22, UR11, UR11R, UR12, UR12S,
-     $                   UR22, XI1, XI2, XR1, XR2
-*     ..
-*     .. Local Arrays ..
-      LOGICAL            RSWAP( 4 ), ZSWAP( 4 )
-      INTEGER            IPIVOT( 4, 4 )
-      DOUBLE PRECISION   CI( 2, 2 ), CIV( 4 ), CR( 2, 2 ), CRV( 4 )
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLADIV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX
-*     ..
-*     .. Equivalences ..
-      EQUIVALENCE        ( CI( 1, 1 ), CIV( 1 ) ),
-     $                   ( CR( 1, 1 ), CRV( 1 ) )
-*     ..
-*     .. Data statements ..
-      DATA               ZSWAP / .FALSE., .FALSE., .TRUE., .TRUE. /
-      DATA               RSWAP / .FALSE., .TRUE., .FALSE., .TRUE. /
-      DATA               IPIVOT / 1, 2, 3, 4, 2, 1, 4, 3, 3, 4, 1, 2, 4,
-     $                   3, 2, 1 /
-*     ..
-*     .. Executable Statements ..
-*
-*     Compute BIGNUM
-*
-      SMLNUM = TWO*DLAMCH( 'Safe minimum' )
-      BIGNUM = ONE / SMLNUM
-      SMINI = MAX( SMIN, SMLNUM )
-*
-*     Don't check for input errors
-*
-      INFO = 0
-*
-*     Standard Initializations
-*
-      SCALE = ONE
-*
-      IF( NA.EQ.1 ) THEN
-*
-*        1 x 1  (i.e., scalar) system   C X = B
-*
-         IF( NW.EQ.1 ) THEN
-*
-*           Real 1x1 system.
-*
-*           C = ca A - w D
-*
-            CSR = CA*A( 1, 1 ) - WR*D1
-            CNORM = ABS( CSR )
-*
-*           If | C | < SMINI, use C = SMINI
-*
-            IF( CNORM.LT.SMINI ) THEN
-               CSR = SMINI
-               CNORM = SMINI
-               INFO = 1
-            END IF
-*
-*           Check scaling for  X = B / C
-*
-            BNORM = ABS( B( 1, 1 ) )
-            IF( CNORM.LT.ONE .AND. BNORM.GT.ONE ) THEN
-               IF( BNORM.GT.BIGNUM*CNORM )
-     $            SCALE = ONE / BNORM
-            END IF
-*
-*           Compute X
-*
-            X( 1, 1 ) = ( B( 1, 1 )*SCALE ) / CSR
-            XNORM = ABS( X( 1, 1 ) )
-         ELSE
-*
-*           Complex 1x1 system (w is complex)
-*
-*           C = ca A - w D
-*
-            CSR = CA*A( 1, 1 ) - WR*D1
-            CSI = -WI*D1
-            CNORM = ABS( CSR ) + ABS( CSI )
-*
-*           If | C | < SMINI, use C = SMINI
-*
-            IF( CNORM.LT.SMINI ) THEN
-               CSR = SMINI
-               CSI = ZERO
-               CNORM = SMINI
-               INFO = 1
-            END IF
-*
-*           Check scaling for  X = B / C
-*
-            BNORM = ABS( B( 1, 1 ) ) + ABS( B( 1, 2 ) )
-            IF( CNORM.LT.ONE .AND. BNORM.GT.ONE ) THEN
-               IF( BNORM.GT.BIGNUM*CNORM )
-     $            SCALE = ONE / BNORM
-            END IF
-*
-*           Compute X
-*
-            CALL DLADIV( SCALE*B( 1, 1 ), SCALE*B( 1, 2 ), CSR, CSI,
-     $                   X( 1, 1 ), X( 1, 2 ) )
-            XNORM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
-         END IF
-*
-      ELSE
-*
-*        2x2 System
-*
-*        Compute the real part of  C = ca A - w D  (or  ca A' - w D )
-*
-         CR( 1, 1 ) = CA*A( 1, 1 ) - WR*D1
-         CR( 2, 2 ) = CA*A( 2, 2 ) - WR*D2
-         IF( LTRANS ) THEN
-            CR( 1, 2 ) = CA*A( 2, 1 )
-            CR( 2, 1 ) = CA*A( 1, 2 )
-         ELSE
-            CR( 2, 1 ) = CA*A( 2, 1 )
-            CR( 1, 2 ) = CA*A( 1, 2 )
-         END IF
-*
-         IF( NW.EQ.1 ) THEN
-*
-*           Real 2x2 system  (w is real)
-*
-*           Find the largest element in C
-*
-            CMAX = ZERO
-            ICMAX = 0
-*
-            DO 10 J = 1, 4
-               IF( ABS( CRV( J ) ).GT.CMAX ) THEN
-                  CMAX = ABS( CRV( J ) )
-                  ICMAX = J
-               END IF
-   10       CONTINUE
-*
-*           If norm(C) < SMINI, use SMINI*identity.
-*
-            IF( CMAX.LT.SMINI ) THEN
-               BNORM = MAX( ABS( B( 1, 1 ) ), ABS( B( 2, 1 ) ) )
-               IF( SMINI.LT.ONE .AND. BNORM.GT.ONE ) THEN
-                  IF( BNORM.GT.BIGNUM*SMINI )
-     $               SCALE = ONE / BNORM
-               END IF
-               TEMP = SCALE / SMINI
-               X( 1, 1 ) = TEMP*B( 1, 1 )
-               X( 2, 1 ) = TEMP*B( 2, 1 )
-               XNORM = TEMP*BNORM
-               INFO = 1
-               RETURN
-            END IF
-*
-*           Gaussian elimination with complete pivoting.
-*
-            UR11 = CRV( ICMAX )
-            CR21 = CRV( IPIVOT( 2, ICMAX ) )
-            UR12 = CRV( IPIVOT( 3, ICMAX ) )
-            CR22 = CRV( IPIVOT( 4, ICMAX ) )
-            UR11R = ONE / UR11
-            LR21 = UR11R*CR21
-            UR22 = CR22 - UR12*LR21
-*
-*           If smaller pivot < SMINI, use SMINI
-*
-            IF( ABS( UR22 ).LT.SMINI ) THEN
-               UR22 = SMINI
-               INFO = 1
-            END IF
-            IF( RSWAP( ICMAX ) ) THEN
-               BR1 = B( 2, 1 )
-               BR2 = B( 1, 1 )
-            ELSE
-               BR1 = B( 1, 1 )
-               BR2 = B( 2, 1 )
-            END IF
-            BR2 = BR2 - LR21*BR1
-            BBND = MAX( ABS( BR1*( UR22*UR11R ) ), ABS( BR2 ) )
-            IF( BBND.GT.ONE .AND. ABS( UR22 ).LT.ONE ) THEN
-               IF( BBND.GE.BIGNUM*ABS( UR22 ) )
-     $            SCALE = ONE / BBND
-            END IF
-*
-            XR2 = ( BR2*SCALE ) / UR22
-            XR1 = ( SCALE*BR1 )*UR11R - XR2*( UR11R*UR12 )
-            IF( ZSWAP( ICMAX ) ) THEN
-               X( 1, 1 ) = XR2
-               X( 2, 1 ) = XR1
-            ELSE
-               X( 1, 1 ) = XR1
-               X( 2, 1 ) = XR2
-            END IF
-            XNORM = MAX( ABS( XR1 ), ABS( XR2 ) )
-*
-*           Further scaling if  norm(A) norm(X) > overflow
-*
-            IF( XNORM.GT.ONE .AND. CMAX.GT.ONE ) THEN
-               IF( XNORM.GT.BIGNUM / CMAX ) THEN
-                  TEMP = CMAX / BIGNUM
-                  X( 1, 1 ) = TEMP*X( 1, 1 )
-                  X( 2, 1 ) = TEMP*X( 2, 1 )
-                  XNORM = TEMP*XNORM
-                  SCALE = TEMP*SCALE
-               END IF
-            END IF
-         ELSE
-*
-*           Complex 2x2 system  (w is complex)
-*
-*           Find the largest element in C
-*
-            CI( 1, 1 ) = -WI*D1
-            CI( 2, 1 ) = ZERO
-            CI( 1, 2 ) = ZERO
-            CI( 2, 2 ) = -WI*D2
-            CMAX = ZERO
-            ICMAX = 0
-*
-            DO 20 J = 1, 4
-               IF( ABS( CRV( J ) )+ABS( CIV( J ) ).GT.CMAX ) THEN
-                  CMAX = ABS( CRV( J ) ) + ABS( CIV( J ) )
-                  ICMAX = J
-               END IF
-   20       CONTINUE
-*
-*           If norm(C) < SMINI, use SMINI*identity.
-*
-            IF( CMAX.LT.SMINI ) THEN
-               BNORM = MAX( ABS( B( 1, 1 ) )+ABS( B( 1, 2 ) ),
-     $                 ABS( B( 2, 1 ) )+ABS( B( 2, 2 ) ) )
-               IF( SMINI.LT.ONE .AND. BNORM.GT.ONE ) THEN
-                  IF( BNORM.GT.BIGNUM*SMINI )
-     $               SCALE = ONE / BNORM
-               END IF
-               TEMP = SCALE / SMINI
-               X( 1, 1 ) = TEMP*B( 1, 1 )
-               X( 2, 1 ) = TEMP*B( 2, 1 )
-               X( 1, 2 ) = TEMP*B( 1, 2 )
-               X( 2, 2 ) = TEMP*B( 2, 2 )
-               XNORM = TEMP*BNORM
-               INFO = 1
-               RETURN
-            END IF
-*
-*           Gaussian elimination with complete pivoting.
-*
-            UR11 = CRV( ICMAX )
-            UI11 = CIV( ICMAX )
-            CR21 = CRV( IPIVOT( 2, ICMAX ) )
-            CI21 = CIV( IPIVOT( 2, ICMAX ) )
-            UR12 = CRV( IPIVOT( 3, ICMAX ) )
-            UI12 = CIV( IPIVOT( 3, ICMAX ) )
-            CR22 = CRV( IPIVOT( 4, ICMAX ) )
-            CI22 = CIV( IPIVOT( 4, ICMAX ) )
-            IF( ICMAX.EQ.1 .OR. ICMAX.EQ.4 ) THEN
-*
-*              Code when off-diagonals of pivoted C are real
-*
-               IF( ABS( UR11 ).GT.ABS( UI11 ) ) THEN
-                  TEMP = UI11 / UR11
-                  UR11R = ONE / ( UR11*( ONE+TEMP**2 ) )
-                  UI11R = -TEMP*UR11R
-               ELSE
-                  TEMP = UR11 / UI11
-                  UI11R = -ONE / ( UI11*( ONE+TEMP**2 ) )
-                  UR11R = -TEMP*UI11R
-               END IF
-               LR21 = CR21*UR11R
-               LI21 = CR21*UI11R
-               UR12S = UR12*UR11R
-               UI12S = UR12*UI11R
-               UR22 = CR22 - UR12*LR21
-               UI22 = CI22 - UR12*LI21
-            ELSE
-*
-*              Code when diagonals of pivoted C are real
-*
-               UR11R = ONE / UR11
-               UI11R = ZERO
-               LR21 = CR21*UR11R
-               LI21 = CI21*UR11R
-               UR12S = UR12*UR11R
-               UI12S = UI12*UR11R
-               UR22 = CR22 - UR12*LR21 + UI12*LI21
-               UI22 = -UR12*LI21 - UI12*LR21
-            END IF
-            U22ABS = ABS( UR22 ) + ABS( UI22 )
-*
-*           If smaller pivot < SMINI, use SMINI
-*
-            IF( U22ABS.LT.SMINI ) THEN
-               UR22 = SMINI
-               UI22 = ZERO
-               INFO = 1
-            END IF
-            IF( RSWAP( ICMAX ) ) THEN
-               BR2 = B( 1, 1 )
-               BR1 = B( 2, 1 )
-               BI2 = B( 1, 2 )
-               BI1 = B( 2, 2 )
-            ELSE
-               BR1 = B( 1, 1 )
-               BR2 = B( 2, 1 )
-               BI1 = B( 1, 2 )
-               BI2 = B( 2, 2 )
-            END IF
-            BR2 = BR2 - LR21*BR1 + LI21*BI1
-            BI2 = BI2 - LI21*BR1 - LR21*BI1
-            BBND = MAX( ( ABS( BR1 )+ABS( BI1 ) )*
-     $             ( U22ABS*( ABS( UR11R )+ABS( UI11R ) ) ),
-     $             ABS( BR2 )+ABS( BI2 ) )
-            IF( BBND.GT.ONE .AND. U22ABS.LT.ONE ) THEN
-               IF( BBND.GE.BIGNUM*U22ABS ) THEN
-                  SCALE = ONE / BBND
-                  BR1 = SCALE*BR1
-                  BI1 = SCALE*BI1
-                  BR2 = SCALE*BR2
-                  BI2 = SCALE*BI2
-               END IF
-            END IF
-*
-            CALL DLADIV( BR2, BI2, UR22, UI22, XR2, XI2 )
-            XR1 = UR11R*BR1 - UI11R*BI1 - UR12S*XR2 + UI12S*XI2
-            XI1 = UI11R*BR1 + UR11R*BI1 - UI12S*XR2 - UR12S*XI2
-            IF( ZSWAP( ICMAX ) ) THEN
-               X( 1, 1 ) = XR2
-               X( 2, 1 ) = XR1
-               X( 1, 2 ) = XI2
-               X( 2, 2 ) = XI1
-            ELSE
-               X( 1, 1 ) = XR1
-               X( 2, 1 ) = XR2
-               X( 1, 2 ) = XI1
-               X( 2, 2 ) = XI2
-            END IF
-            XNORM = MAX( ABS( XR1 )+ABS( XI1 ), ABS( XR2 )+ABS( XI2 ) )
-*
-*           Further scaling if  norm(A) norm(X) > overflow
-*
-            IF( XNORM.GT.ONE .AND. CMAX.GT.ONE ) THEN
-               IF( XNORM.GT.BIGNUM / CMAX ) THEN
-                  TEMP = CMAX / BIGNUM
-                  X( 1, 1 ) = TEMP*X( 1, 1 )
-                  X( 2, 1 ) = TEMP*X( 2, 1 )
-                  X( 1, 2 ) = TEMP*X( 1, 2 )
-                  X( 2, 2 ) = TEMP*X( 2, 2 )
-                  XNORM = TEMP*XNORM
-                  SCALE = TEMP*SCALE
-               END IF
-            END IF
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DLALN2
-*
-      END
diff --git a/src/lib/lapack/dlamch.f b/src/lib/lapack/dlamch.f
deleted file mode 100644
index 64ac3bec..00000000
--- a/src/lib/lapack/dlamch.f
+++ /dev/null
@@ -1,857 +0,0 @@
-      DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      CHARACTER          CMACH
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAMCH determines double precision machine parameters.
-*
-*  Arguments
-*  =========
-*
-*  CMACH   (input) CHARACTER*1
-*          Specifies the value to be returned by DLAMCH:
-*          = 'E' or 'e',   DLAMCH := eps
-*          = 'S' or 's ,   DLAMCH := sfmin
-*          = 'B' or 'b',   DLAMCH := base
-*          = 'P' or 'p',   DLAMCH := eps*base
-*          = 'N' or 'n',   DLAMCH := t
-*          = 'R' or 'r',   DLAMCH := rnd
-*          = 'M' or 'm',   DLAMCH := emin
-*          = 'U' or 'u',   DLAMCH := rmin
-*          = 'L' or 'l',   DLAMCH := emax
-*          = 'O' or 'o',   DLAMCH := rmax
-*
-*          where
-*
-*          eps   = relative machine precision
-*          sfmin = safe minimum, such that 1/sfmin does not overflow
-*          base  = base of the machine
-*          prec  = eps*base
-*          t     = number of (base) digits in the mantissa
-*          rnd   = 1.0 when rounding occurs in addition, 0.0 otherwise
-*          emin  = minimum exponent before (gradual) underflow
-*          rmin  = underflow threshold - base**(emin-1)
-*          emax  = largest exponent before overflow
-*          rmax  = overflow threshold  - (base**emax)*(1-eps)
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            FIRST, LRND
-      INTEGER            BETA, IMAX, IMIN, IT
-      DOUBLE PRECISION   BASE, EMAX, EMIN, EPS, PREC, RMACH, RMAX, RMIN,
-     $                   RND, SFMIN, SMALL, T
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLAMC2
-*     ..
-*     .. Save statement ..
-      SAVE               FIRST, EPS, SFMIN, BASE, T, RND, EMIN, RMIN,
-     $                   EMAX, RMAX, PREC
-*     ..
-*     .. Data statements ..
-      DATA               FIRST / .TRUE. /
-*     ..
-*     .. Executable Statements ..
-*
-      IF( FIRST ) THEN
-         FIRST = .FALSE.
-         CALL DLAMC2( BETA, IT, LRND, EPS, IMIN, RMIN, IMAX, RMAX )
-         BASE = BETA
-         T = IT
-         IF( LRND ) THEN
-            RND = ONE
-            EPS = ( BASE**( 1-IT ) ) / 2
-         ELSE
-            RND = ZERO
-            EPS = BASE**( 1-IT )
-         END IF
-         PREC = EPS*BASE
-         EMIN = IMIN
-         EMAX = IMAX
-         SFMIN = RMIN
-         SMALL = ONE / RMAX
-         IF( SMALL.GE.SFMIN ) THEN
-*
-*           Use SMALL plus a bit, to avoid the possibility of rounding
-*           causing overflow when computing  1/sfmin.
-*
-            SFMIN = SMALL*( ONE+EPS )
-         END IF
-      END IF
-*
-      IF( LSAME( CMACH, 'E' ) ) THEN
-         RMACH = EPS
-      ELSE IF( LSAME( CMACH, 'S' ) ) THEN
-         RMACH = SFMIN
-      ELSE IF( LSAME( CMACH, 'B' ) ) THEN
-         RMACH = BASE
-      ELSE IF( LSAME( CMACH, 'P' ) ) THEN
-         RMACH = PREC
-      ELSE IF( LSAME( CMACH, 'N' ) ) THEN
-         RMACH = T
-      ELSE IF( LSAME( CMACH, 'R' ) ) THEN
-         RMACH = RND
-      ELSE IF( LSAME( CMACH, 'M' ) ) THEN
-         RMACH = EMIN
-      ELSE IF( LSAME( CMACH, 'U' ) ) THEN
-         RMACH = RMIN
-      ELSE IF( LSAME( CMACH, 'L' ) ) THEN
-         RMACH = EMAX
-      ELSE IF( LSAME( CMACH, 'O' ) ) THEN
-         RMACH = RMAX
-      END IF
-*
-      DLAMCH = RMACH
-      RETURN
-*
-*     End of DLAMCH
-*
-      END
-*
-************************************************************************
-*
-      SUBROUTINE DLAMC1( BETA, T, RND, IEEE1 )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      LOGICAL            IEEE1, RND
-      INTEGER            BETA, T
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAMC1 determines the machine parameters given by BETA, T, RND, and
-*  IEEE1.
-*
-*  Arguments
-*  =========
-*
-*  BETA    (output) INTEGER
-*          The base of the machine.
-*
-*  T       (output) INTEGER
-*          The number of ( BETA ) digits in the mantissa.
-*
-*  RND     (output) LOGICAL
-*          Specifies whether proper rounding  ( RND = .TRUE. )  or
-*          chopping  ( RND = .FALSE. )  occurs in addition. This may not
-*          be a reliable guide to the way in which the machine performs
-*          its arithmetic.
-*
-*  IEEE1   (output) LOGICAL
-*          Specifies whether rounding appears to be done in the IEEE
-*          'round to nearest' style.
-*
-*  Further Details
-*  ===============
-*
-*  The routine is based on the routine  ENVRON  by Malcolm and
-*  incorporates suggestions by Gentleman and Marovich. See
-*
-*     Malcolm M. A. (1972) Algorithms to reveal properties of
-*        floating-point arithmetic. Comms. of the ACM, 15, 949-951.
-*
-*     Gentleman W. M. and Marovich S. B. (1974) More on algorithms
-*        that reveal properties of floating point arithmetic units.
-*        Comms. of the ACM, 17, 276-277.
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            FIRST, LIEEE1, LRND
-      INTEGER            LBETA, LT
-      DOUBLE PRECISION   A, B, C, F, ONE, QTR, SAVEC, T1, T2
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMC3
-      EXTERNAL           DLAMC3
-*     ..
-*     .. Save statement ..
-      SAVE               FIRST, LIEEE1, LBETA, LRND, LT
-*     ..
-*     .. Data statements ..
-      DATA               FIRST / .TRUE. /
-*     ..
-*     .. Executable Statements ..
-*
-      IF( FIRST ) THEN
-         FIRST = .FALSE.
-         ONE = 1
-*
-*        LBETA,  LIEEE1,  LT and  LRND  are the  local values  of  BETA,
-*        IEEE1, T and RND.
-*
-*        Throughout this routine  we use the function  DLAMC3  to ensure
-*        that relevant values are  stored and not held in registers,  or
-*        are not affected by optimizers.
-*
-*        Compute  a = 2.0**m  with the  smallest positive integer m such
-*        that
-*
-*           fl( a + 1.0 ) = a.
-*
-         A = 1
-         C = 1
-*
-*+       WHILE( C.EQ.ONE )LOOP
-   10    CONTINUE
-         IF( C.EQ.ONE ) THEN
-            A = 2*A
-            C = DLAMC3( A, ONE )
-            C = DLAMC3( C, -A )
-            GO TO 10
-         END IF
-*+       END WHILE
-*
-*        Now compute  b = 2.0**m  with the smallest positive integer m
-*        such that
-*
-*           fl( a + b ) .gt. a.
-*
-         B = 1
-         C = DLAMC3( A, B )
-*
-*+       WHILE( C.EQ.A )LOOP
-   20    CONTINUE
-         IF( C.EQ.A ) THEN
-            B = 2*B
-            C = DLAMC3( A, B )
-            GO TO 20
-         END IF
-*+       END WHILE
-*
-*        Now compute the base.  a and c  are neighbouring floating point
-*        numbers  in the  interval  ( beta**t, beta**( t + 1 ) )  and so
-*        their difference is beta. Adding 0.25 to c is to ensure that it
-*        is truncated to beta and not ( beta - 1 ).
-*
-         QTR = ONE / 4
-         SAVEC = C
-         C = DLAMC3( C, -A )
-         LBETA = C + QTR
-*
-*        Now determine whether rounding or chopping occurs,  by adding a
-*        bit  less  than  beta/2  and a  bit  more  than  beta/2  to  a.
-*
-         B = LBETA
-         F = DLAMC3( B / 2, -B / 100 )
-         C = DLAMC3( F, A )
-         IF( C.EQ.A ) THEN
-            LRND = .TRUE.
-         ELSE
-            LRND = .FALSE.
-         END IF
-         F = DLAMC3( B / 2, B / 100 )
-         C = DLAMC3( F, A )
-         IF( ( LRND ) .AND. ( C.EQ.A ) )
-     $      LRND = .FALSE.
-*
-*        Try and decide whether rounding is done in the  IEEE  'round to
-*        nearest' style. B/2 is half a unit in the last place of the two
-*        numbers A and SAVEC. Furthermore, A is even, i.e. has last  bit
-*        zero, and SAVEC is odd. Thus adding B/2 to A should not  change
-*        A, but adding B/2 to SAVEC should change SAVEC.
-*
-         T1 = DLAMC3( B / 2, A )
-         T2 = DLAMC3( B / 2, SAVEC )
-         LIEEE1 = ( T1.EQ.A ) .AND. ( T2.GT.SAVEC ) .AND. LRND
-*
-*        Now find  the  mantissa, t.  It should  be the  integer part of
-*        log to the base beta of a,  however it is safer to determine  t
-*        by powering.  So we find t as the smallest positive integer for
-*        which
-*
-*           fl( beta**t + 1.0 ) = 1.0.
-*
-         LT = 0
-         A = 1
-         C = 1
-*
-*+       WHILE( C.EQ.ONE )LOOP
-   30    CONTINUE
-         IF( C.EQ.ONE ) THEN
-            LT = LT + 1
-            A = A*LBETA
-            C = DLAMC3( A, ONE )
-            C = DLAMC3( C, -A )
-            GO TO 30
-         END IF
-*+       END WHILE
-*
-      END IF
-*
-      BETA = LBETA
-      T = LT
-      RND = LRND
-      IEEE1 = LIEEE1
-      RETURN
-*
-*     End of DLAMC1
-*
-      END
-*
-************************************************************************
-*
-      SUBROUTINE DLAMC2( BETA, T, RND, EPS, EMIN, RMIN, EMAX, RMAX )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      LOGICAL            RND
-      INTEGER            BETA, EMAX, EMIN, T
-      DOUBLE PRECISION   EPS, RMAX, RMIN
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAMC2 determines the machine parameters specified in its argument
-*  list.
-*
-*  Arguments
-*  =========
-*
-*  BETA    (output) INTEGER
-*          The base of the machine.
-*
-*  T       (output) INTEGER
-*          The number of ( BETA ) digits in the mantissa.
-*
-*  RND     (output) LOGICAL
-*          Specifies whether proper rounding  ( RND = .TRUE. )  or
-*          chopping  ( RND = .FALSE. )  occurs in addition. This may not
-*          be a reliable guide to the way in which the machine performs
-*          its arithmetic.
-*
-*  EPS     (output) DOUBLE PRECISION
-*          The smallest positive number such that
-*
-*             fl( 1.0 - EPS ) .LT. 1.0,
-*
-*          where fl denotes the computed value.
-*
-*  EMIN    (output) INTEGER
-*          The minimum exponent before (gradual) underflow occurs.
-*
-*  RMIN    (output) DOUBLE PRECISION
-*          The smallest normalized number for the machine, given by
-*          BASE**( EMIN - 1 ), where  BASE  is the floating point value
-*          of BETA.
-*
-*  EMAX    (output) INTEGER
-*          The maximum exponent before overflow occurs.
-*
-*  RMAX    (output) DOUBLE PRECISION
-*          The largest positive number for the machine, given by
-*          BASE**EMAX * ( 1 - EPS ), where  BASE  is the floating point
-*          value of BETA.
-*
-*  Further Details
-*  ===============
-*
-*  The computation of  EPS  is based on a routine PARANOIA by
-*  W. Kahan of the University of California at Berkeley.
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            FIRST, IEEE, IWARN, LIEEE1, LRND
-      INTEGER            GNMIN, GPMIN, I, LBETA, LEMAX, LEMIN, LT,
-     $                   NGNMIN, NGPMIN
-      DOUBLE PRECISION   A, B, C, HALF, LEPS, LRMAX, LRMIN, ONE, RBASE,
-     $                   SIXTH, SMALL, THIRD, TWO, ZERO
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMC3
-      EXTERNAL           DLAMC3
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLAMC1, DLAMC4, DLAMC5
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
-*     ..
-*     .. Save statement ..
-      SAVE               FIRST, IWARN, LBETA, LEMAX, LEMIN, LEPS, LRMAX,
-     $                   LRMIN, LT
-*     ..
-*     .. Data statements ..
-      DATA               FIRST / .TRUE. / , IWARN / .FALSE. /
-*     ..
-*     .. Executable Statements ..
-*
-      IF( FIRST ) THEN
-         FIRST = .FALSE.
-         ZERO = 0
-         ONE = 1
-         TWO = 2
-*
-*        LBETA, LT, LRND, LEPS, LEMIN and LRMIN  are the local values of
-*        BETA, T, RND, EPS, EMIN and RMIN.
-*
-*        Throughout this routine  we use the function  DLAMC3  to ensure
-*        that relevant values are stored  and not held in registers,  or
-*        are not affected by optimizers.
-*
-*        DLAMC1 returns the parameters  LBETA, LT, LRND and LIEEE1.
-*
-         CALL DLAMC1( LBETA, LT, LRND, LIEEE1 )
-*
-*        Start to find EPS.
-*
-         B = LBETA
-         A = B**( -LT )
-         LEPS = A
-*
-*        Try some tricks to see whether or not this is the correct  EPS.
-*
-         B = TWO / 3
-         HALF = ONE / 2
-         SIXTH = DLAMC3( B, -HALF )
-         THIRD = DLAMC3( SIXTH, SIXTH )
-         B = DLAMC3( THIRD, -HALF )
-         B = DLAMC3( B, SIXTH )
-         B = ABS( B )
-         IF( B.LT.LEPS )
-     $      B = LEPS
-*
-         LEPS = 1
-*
-*+       WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP
-   10    CONTINUE
-         IF( ( LEPS.GT.B ) .AND. ( B.GT.ZERO ) ) THEN
-            LEPS = B
-            C = DLAMC3( HALF*LEPS, ( TWO**5 )*( LEPS**2 ) )
-            C = DLAMC3( HALF, -C )
-            B = DLAMC3( HALF, C )
-            C = DLAMC3( HALF, -B )
-            B = DLAMC3( HALF, C )
-            GO TO 10
-         END IF
-*+       END WHILE
-*
-         IF( A.LT.LEPS )
-     $      LEPS = A
-*
-*        Computation of EPS complete.
-*
-*        Now find  EMIN.  Let A = + or - 1, and + or - (1 + BASE**(-3)).
-*        Keep dividing  A by BETA until (gradual) underflow occurs. This
-*        is detected when we cannot recover the previous A.
-*
-         RBASE = ONE / LBETA
-         SMALL = ONE
-         DO 20 I = 1, 3
-            SMALL = DLAMC3( SMALL*RBASE, ZERO )
-   20    CONTINUE
-         A = DLAMC3( ONE, SMALL )
-         CALL DLAMC4( NGPMIN, ONE, LBETA )
-         CALL DLAMC4( NGNMIN, -ONE, LBETA )
-         CALL DLAMC4( GPMIN, A, LBETA )
-         CALL DLAMC4( GNMIN, -A, LBETA )
-         IEEE = .FALSE.
-*
-         IF( ( NGPMIN.EQ.NGNMIN ) .AND. ( GPMIN.EQ.GNMIN ) ) THEN
-            IF( NGPMIN.EQ.GPMIN ) THEN
-               LEMIN = NGPMIN
-*            ( Non twos-complement machines, no gradual underflow;
-*              e.g.,  VAX )
-            ELSE IF( ( GPMIN-NGPMIN ).EQ.3 ) THEN
-               LEMIN = NGPMIN - 1 + LT
-               IEEE = .TRUE.
-*            ( Non twos-complement machines, with gradual underflow;
-*              e.g., IEEE standard followers )
-            ELSE
-               LEMIN = MIN( NGPMIN, GPMIN )
-*            ( A guess; no known machine )
-               IWARN = .TRUE.
-            END IF
-*
-         ELSE IF( ( NGPMIN.EQ.GPMIN ) .AND. ( NGNMIN.EQ.GNMIN ) ) THEN
-            IF( ABS( NGPMIN-NGNMIN ).EQ.1 ) THEN
-               LEMIN = MAX( NGPMIN, NGNMIN )
-*            ( Twos-complement machines, no gradual underflow;
-*              e.g., CYBER 205 )
-            ELSE
-               LEMIN = MIN( NGPMIN, NGNMIN )
-*            ( A guess; no known machine )
-               IWARN = .TRUE.
-            END IF
-*
-         ELSE IF( ( ABS( NGPMIN-NGNMIN ).EQ.1 ) .AND.
-     $            ( GPMIN.EQ.GNMIN ) ) THEN
-            IF( ( GPMIN-MIN( NGPMIN, NGNMIN ) ).EQ.3 ) THEN
-               LEMIN = MAX( NGPMIN, NGNMIN ) - 1 + LT
-*            ( Twos-complement machines with gradual underflow;
-*              no known machine )
-            ELSE
-               LEMIN = MIN( NGPMIN, NGNMIN )
-*            ( A guess; no known machine )
-               IWARN = .TRUE.
-            END IF
-*
-         ELSE
-            LEMIN = MIN( NGPMIN, NGNMIN, GPMIN, GNMIN )
-*         ( A guess; no known machine )
-            IWARN = .TRUE.
-         END IF
-***
-* Comment out this if block if EMIN is ok
-         IF( IWARN ) THEN
-            FIRST = .TRUE.
-            WRITE( 6, FMT = 9999 )LEMIN
-         END IF
-***
-*
-*        Assume IEEE arithmetic if we found denormalised  numbers above,
-*        or if arithmetic seems to round in the  IEEE style,  determined
-*        in routine DLAMC1. A true IEEE machine should have both  things
-*        true; however, faulty machines may have one or the other.
-*
-         IEEE = IEEE .OR. LIEEE1
-*
-*        Compute  RMIN by successive division by  BETA. We could compute
-*        RMIN as BASE**( EMIN - 1 ),  but some machines underflow during
-*        this computation.
-*
-         LRMIN = 1
-         DO 30 I = 1, 1 - LEMIN
-            LRMIN = DLAMC3( LRMIN*RBASE, ZERO )
-   30    CONTINUE
-*
-*        Finally, call DLAMC5 to compute EMAX and RMAX.
-*
-         CALL DLAMC5( LBETA, LT, LEMIN, IEEE, LEMAX, LRMAX )
-      END IF
-*
-      BETA = LBETA
-      T = LT
-      RND = LRND
-      EPS = LEPS
-      EMIN = LEMIN
-      RMIN = LRMIN
-      EMAX = LEMAX
-      RMAX = LRMAX
-*
-      RETURN
-*
- 9999 FORMAT( / / ' WARNING. The value EMIN may be incorrect:-',
-     $      '  EMIN = ', I8, /
-     $      ' If, after inspection, the value EMIN looks',
-     $      ' acceptable please comment out ',
-     $      / ' the IF block as marked within the code of routine',
-     $      ' DLAMC2,', / ' otherwise supply EMIN explicitly.', / )
-*
-*     End of DLAMC2
-*
-      END
-*
-************************************************************************
-*
-      DOUBLE PRECISION FUNCTION DLAMC3( A, B )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   A, B
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAMC3  is intended to force  A  and  B  to be stored prior to doing
-*  the addition of  A  and  B ,  for use in situations where optimizers
-*  might hold one of these in a register.
-*
-*  Arguments
-*  =========
-*
-*  A, B    (input) DOUBLE PRECISION
-*          The values A and B.
-*
-* =====================================================================
-*
-*     .. Executable Statements ..
-*
-      DLAMC3 = A + B
-*
-      RETURN
-*
-*     End of DLAMC3
-*
-      END
-*
-************************************************************************
-*
-      SUBROUTINE DLAMC4( EMIN, START, BASE )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      INTEGER            BASE, EMIN
-      DOUBLE PRECISION   START
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAMC4 is a service routine for DLAMC2.
-*
-*  Arguments
-*  =========
-*
-*  EMIN    (output) EMIN
-*          The minimum exponent before (gradual) underflow, computed by
-*          setting A = START and dividing by BASE until the previous A
-*          can not be recovered.
-*
-*  START   (input) DOUBLE PRECISION
-*          The starting point for determining EMIN.
-*
-*  BASE    (input) INTEGER
-*          The base of the machine.
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I
-      DOUBLE PRECISION   A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMC3
-      EXTERNAL           DLAMC3
-*     ..
-*     .. Executable Statements ..
-*
-      A = START
-      ONE = 1
-      RBASE = ONE / BASE
-      ZERO = 0
-      EMIN = 1
-      B1 = DLAMC3( A*RBASE, ZERO )
-      C1 = A
-      C2 = A
-      D1 = A
-      D2 = A
-*+    WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
-*    $       ( D1.EQ.A ).AND.( D2.EQ.A )      )LOOP
-   10 CONTINUE
-      IF( ( C1.EQ.A ) .AND. ( C2.EQ.A ) .AND. ( D1.EQ.A ) .AND.
-     $    ( D2.EQ.A ) ) THEN
-         EMIN = EMIN - 1
-         A = B1
-         B1 = DLAMC3( A / BASE, ZERO )
-         C1 = DLAMC3( B1*BASE, ZERO )
-         D1 = ZERO
-         DO 20 I = 1, BASE
-            D1 = D1 + B1
-   20    CONTINUE
-         B2 = DLAMC3( A*RBASE, ZERO )
-         C2 = DLAMC3( B2 / RBASE, ZERO )
-         D2 = ZERO
-         DO 30 I = 1, BASE
-            D2 = D2 + B2
-   30    CONTINUE
-         GO TO 10
-      END IF
-*+    END WHILE
-*
-      RETURN
-*
-*     End of DLAMC4
-*
-      END
-*
-************************************************************************
-*
-      SUBROUTINE DLAMC5( BETA, P, EMIN, IEEE, EMAX, RMAX )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      LOGICAL            IEEE
-      INTEGER            BETA, EMAX, EMIN, P
-      DOUBLE PRECISION   RMAX
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAMC5 attempts to compute RMAX, the largest machine floating-point
-*  number, without overflow.  It assumes that EMAX + abs(EMIN) sum
-*  approximately to a power of 2.  It will fail on machines where this
-*  assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
-*  EMAX = 28718).  It will also fail if the value supplied for EMIN is
-*  too large (i.e. too close to zero), probably with overflow.
-*
-*  Arguments
-*  =========
-*
-*  BETA    (input) INTEGER
-*          The base of floating-point arithmetic.
-*
-*  P       (input) INTEGER
-*          The number of base BETA digits in the mantissa of a
-*          floating-point value.
-*
-*  EMIN    (input) INTEGER
-*          The minimum exponent before (gradual) underflow.
-*
-*  IEEE    (input) LOGICAL
-*          A logical flag specifying whether or not the arithmetic
-*          system is thought to comply with the IEEE standard.
-*
-*  EMAX    (output) INTEGER
-*          The largest exponent before overflow
-*
-*  RMAX    (output) DOUBLE PRECISION
-*          The largest machine floating-point number.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            EXBITS, EXPSUM, I, LEXP, NBITS, TRY, UEXP
-      DOUBLE PRECISION   OLDY, RECBAS, Y, Z
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMC3
-      EXTERNAL           DLAMC3
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MOD
-*     ..
-*     .. Executable Statements ..
-*
-*     First compute LEXP and UEXP, two powers of 2 that bound
-*     abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
-*     approximately to the bound that is closest to abs(EMIN).
-*     (EMAX is the exponent of the required number RMAX).
-*
-      LEXP = 1
-      EXBITS = 1
-   10 CONTINUE
-      TRY = LEXP*2
-      IF( TRY.LE.( -EMIN ) ) THEN
-         LEXP = TRY
-         EXBITS = EXBITS + 1
-         GO TO 10
-      END IF
-      IF( LEXP.EQ.-EMIN ) THEN
-         UEXP = LEXP
-      ELSE
-         UEXP = TRY
-         EXBITS = EXBITS + 1
-      END IF
-*
-*     Now -LEXP is less than or equal to EMIN, and -UEXP is greater
-*     than or equal to EMIN. EXBITS is the number of bits needed to
-*     store the exponent.
-*
-      IF( ( UEXP+EMIN ).GT.( -LEXP-EMIN ) ) THEN
-         EXPSUM = 2*LEXP
-      ELSE
-         EXPSUM = 2*UEXP
-      END IF
-*
-*     EXPSUM is the exponent range, approximately equal to
-*     EMAX - EMIN + 1 .
-*
-      EMAX = EXPSUM + EMIN - 1
-      NBITS = 1 + EXBITS + P
-*
-*     NBITS is the total number of bits needed to store a
-*     floating-point number.
-*
-      IF( ( MOD( NBITS, 2 ).EQ.1 ) .AND. ( BETA.EQ.2 ) ) THEN
-*
-*        Either there are an odd number of bits used to store a
-*        floating-point number, which is unlikely, or some bits are
-*        not used in the representation of numbers, which is possible,
-*        (e.g. Cray machines) or the mantissa has an implicit bit,
-*        (e.g. IEEE machines, Dec Vax machines), which is perhaps the
-*        most likely. We have to assume the last alternative.
-*        If this is true, then we need to reduce EMAX by one because
-*        there must be some way of representing zero in an implicit-bit
-*        system. On machines like Cray, we are reducing EMAX by one
-*        unnecessarily.
-*
-         EMAX = EMAX - 1
-      END IF
-*
-      IF( IEEE ) THEN
-*
-*        Assume we are on an IEEE machine which reserves one exponent
-*        for infinity and NaN.
-*
-         EMAX = EMAX - 1
-      END IF
-*
-*     Now create RMAX, the largest machine number, which should
-*     be equal to (1.0 - BETA**(-P)) * BETA**EMAX .
-*
-*     First compute 1.0 - BETA**(-P), being careful that the
-*     result is less than 1.0 .
-*
-      RECBAS = ONE / BETA
-      Z = BETA - ONE
-      Y = ZERO
-      DO 20 I = 1, P
-         Z = Z*RECBAS
-         IF( Y.LT.ONE )
-     $      OLDY = Y
-         Y = DLAMC3( Y, Z )
-   20 CONTINUE
-      IF( Y.GE.ONE )
-     $   Y = OLDY
-*
-*     Now multiply by BETA**EMAX to get RMAX.
-*
-      DO 30 I = 1, EMAX
-         Y = DLAMC3( Y*BETA, ZERO )
-   30 CONTINUE
-*
-      RMAX = Y
-      RETURN
-*
-*     End of DLAMC5
-*
-      END
diff --git a/src/lib/lapack/dlange.f b/src/lib/lapack/dlange.f
deleted file mode 100644
index fec96ac7..00000000
--- a/src/lib/lapack/dlange.f
+++ /dev/null
@@ -1,144 +0,0 @@
-      DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          NORM
-      INTEGER            LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLANGE  returns the value of the one norm,  or the Frobenius norm, or
-*  the  infinity norm,  or the  element of  largest absolute value  of a
-*  real matrix A.
-*
-*  Description
-*  ===========
-*
-*  DLANGE returns the value
-*
-*     DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*              (
-*              ( norm1(A),         NORM = '1', 'O' or 'o'
-*              (
-*              ( normI(A),         NORM = 'I' or 'i'
-*              (
-*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
-*
-*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
-*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
-*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
-*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies the value to be returned in DLANGE as described
-*          above.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.  When M = 0,
-*          DLANGE is set to zero.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.  When N = 0,
-*          DLANGE is set to zero.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The m by n matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(M,1).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*          where LWORK >= M when NORM = 'I'; otherwise, WORK is not
-*          referenced.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   SCALE, SUM, VALUE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASSQ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( MIN( M, N ).EQ.0 ) THEN
-         VALUE = ZERO
-      ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-*        Find max(abs(A(i,j))).
-*
-         VALUE = ZERO
-         DO 20 J = 1, N
-            DO 10 I = 1, M
-               VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   10       CONTINUE
-   20    CONTINUE
-      ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-*        Find norm1(A).
-*
-         VALUE = ZERO
-         DO 40 J = 1, N
-            SUM = ZERO
-            DO 30 I = 1, M
-               SUM = SUM + ABS( A( I, J ) )
-   30       CONTINUE
-            VALUE = MAX( VALUE, SUM )
-   40    CONTINUE
-      ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-*        Find normI(A).
-*
-         DO 50 I = 1, M
-            WORK( I ) = ZERO
-   50    CONTINUE
-         DO 70 J = 1, N
-            DO 60 I = 1, M
-               WORK( I ) = WORK( I ) + ABS( A( I, J ) )
-   60       CONTINUE
-   70    CONTINUE
-         VALUE = ZERO
-         DO 80 I = 1, M
-            VALUE = MAX( VALUE, WORK( I ) )
-   80    CONTINUE
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-*        Find normF(A).
-*
-         SCALE = ZERO
-         SUM = ONE
-         DO 90 J = 1, N
-            CALL DLASSQ( M, A( 1, J ), 1, SCALE, SUM )
-   90    CONTINUE
-         VALUE = SCALE*SQRT( SUM )
-      END IF
-*
-      DLANGE = VALUE
-      RETURN
-*
-*     End of DLANGE
-*
-      END
diff --git a/src/lib/lapack/dlanhs.f b/src/lib/lapack/dlanhs.f
deleted file mode 100644
index 76b87eeb..00000000
--- a/src/lib/lapack/dlanhs.f
+++ /dev/null
@@ -1,141 +0,0 @@
-      DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          NORM
-      INTEGER            LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLANHS  returns the value of the one norm,  or the Frobenius norm, or
-*  the  infinity norm,  or the  element of  largest absolute value  of a
-*  Hessenberg matrix A.
-*
-*  Description
-*  ===========
-*
-*  DLANHS returns the value
-*
-*     DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*              (
-*              ( norm1(A),         NORM = '1', 'O' or 'o'
-*              (
-*              ( normI(A),         NORM = 'I' or 'i'
-*              (
-*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
-*
-*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
-*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
-*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
-*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies the value to be returned in DLANHS as described
-*          above.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.  When N = 0, DLANHS is
-*          set to zero.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The n by n upper Hessenberg matrix A; the part of A below the
-*          first sub-diagonal is not referenced.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(N,1).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*          where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*          referenced.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   SCALE, SUM, VALUE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASSQ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.EQ.0 ) THEN
-         VALUE = ZERO
-      ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-*        Find max(abs(A(i,j))).
-*
-         VALUE = ZERO
-         DO 20 J = 1, N
-            DO 10 I = 1, MIN( N, J+1 )
-               VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   10       CONTINUE
-   20    CONTINUE
-      ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-*        Find norm1(A).
-*
-         VALUE = ZERO
-         DO 40 J = 1, N
-            SUM = ZERO
-            DO 30 I = 1, MIN( N, J+1 )
-               SUM = SUM + ABS( A( I, J ) )
-   30       CONTINUE
-            VALUE = MAX( VALUE, SUM )
-   40    CONTINUE
-      ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-*        Find normI(A).
-*
-         DO 50 I = 1, N
-            WORK( I ) = ZERO
-   50    CONTINUE
-         DO 70 J = 1, N
-            DO 60 I = 1, MIN( N, J+1 )
-               WORK( I ) = WORK( I ) + ABS( A( I, J ) )
-   60       CONTINUE
-   70    CONTINUE
-         VALUE = ZERO
-         DO 80 I = 1, N
-            VALUE = MAX( VALUE, WORK( I ) )
-   80    CONTINUE
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-*        Find normF(A).
-*
-         SCALE = ZERO
-         SUM = ONE
-         DO 90 J = 1, N
-            CALL DLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM )
-   90    CONTINUE
-         VALUE = SCALE*SQRT( SUM )
-      END IF
-*
-      DLANHS = VALUE
-      RETURN
-*
-*     End of DLANHS
-*
-      END
diff --git a/src/lib/lapack/dlansp.f b/src/lib/lapack/dlansp.f
deleted file mode 100644
index ab221006..00000000
--- a/src/lib/lapack/dlansp.f
+++ /dev/null
@@ -1,196 +0,0 @@
-      DOUBLE PRECISION FUNCTION DLANSP( NORM, UPLO, N, AP, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          NORM, UPLO
-      INTEGER            N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   AP( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLANSP  returns the value of the one norm,  or the Frobenius norm, or
-*  the  infinity norm,  or the  element of  largest absolute value  of a
-*  real symmetric matrix A,  supplied in packed form.
-*
-*  Description
-*  ===========
-*
-*  DLANSP returns the value
-*
-*     DLANSP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*              (
-*              ( norm1(A),         NORM = '1', 'O' or 'o'
-*              (
-*              ( normI(A),         NORM = 'I' or 'i'
-*              (
-*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
-*
-*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
-*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
-*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
-*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies the value to be returned in DLANSP as described
-*          above.
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          symmetric matrix A is supplied.
-*          = 'U':  Upper triangular part of A is supplied
-*          = 'L':  Lower triangular part of A is supplied
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.  When N = 0, DLANSP is
-*          set to zero.
-*
-*  AP      (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*          The upper or lower triangle of the symmetric matrix A, packed
-*          columnwise in a linear array.  The j-th column of A is stored
-*          in the array AP as follows:
-*          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*          WORK is not referenced.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J, K
-      DOUBLE PRECISION   ABSA, SCALE, SUM, VALUE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASSQ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.EQ.0 ) THEN
-         VALUE = ZERO
-      ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-*        Find max(abs(A(i,j))).
-*
-         VALUE = ZERO
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            K = 1
-            DO 20 J = 1, N
-               DO 10 I = K, K + J - 1
-                  VALUE = MAX( VALUE, ABS( AP( I ) ) )
-   10          CONTINUE
-               K = K + J
-   20       CONTINUE
-         ELSE
-            K = 1
-            DO 40 J = 1, N
-               DO 30 I = K, K + N - J
-                  VALUE = MAX( VALUE, ABS( AP( I ) ) )
-   30          CONTINUE
-               K = K + N - J + 1
-   40       CONTINUE
-         END IF
-      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
-     $         ( NORM.EQ.'1' ) ) THEN
-*
-*        Find normI(A) ( = norm1(A), since A is symmetric).
-*
-         VALUE = ZERO
-         K = 1
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            DO 60 J = 1, N
-               SUM = ZERO
-               DO 50 I = 1, J - 1
-                  ABSA = ABS( AP( K ) )
-                  SUM = SUM + ABSA
-                  WORK( I ) = WORK( I ) + ABSA
-                  K = K + 1
-   50          CONTINUE
-               WORK( J ) = SUM + ABS( AP( K ) )
-               K = K + 1
-   60       CONTINUE
-            DO 70 I = 1, N
-               VALUE = MAX( VALUE, WORK( I ) )
-   70       CONTINUE
-         ELSE
-            DO 80 I = 1, N
-               WORK( I ) = ZERO
-   80       CONTINUE
-            DO 100 J = 1, N
-               SUM = WORK( J ) + ABS( AP( K ) )
-               K = K + 1
-               DO 90 I = J + 1, N
-                  ABSA = ABS( AP( K ) )
-                  SUM = SUM + ABSA
-                  WORK( I ) = WORK( I ) + ABSA
-                  K = K + 1
-   90          CONTINUE
-               VALUE = MAX( VALUE, SUM )
-  100       CONTINUE
-         END IF
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-*        Find normF(A).
-*
-         SCALE = ZERO
-         SUM = ONE
-         K = 2
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            DO 110 J = 2, N
-               CALL DLASSQ( J-1, AP( K ), 1, SCALE, SUM )
-               K = K + J
-  110       CONTINUE
-         ELSE
-            DO 120 J = 1, N - 1
-               CALL DLASSQ( N-J, AP( K ), 1, SCALE, SUM )
-               K = K + N - J + 1
-  120       CONTINUE
-         END IF
-         SUM = 2*SUM
-         K = 1
-         DO 130 I = 1, N
-            IF( AP( K ).NE.ZERO ) THEN
-               ABSA = ABS( AP( K ) )
-               IF( SCALE.LT.ABSA ) THEN
-                  SUM = ONE + SUM*( SCALE / ABSA )**2
-                  SCALE = ABSA
-               ELSE
-                  SUM = SUM + ( ABSA / SCALE )**2
-               END IF
-            END IF
-            IF( LSAME( UPLO, 'U' ) ) THEN
-               K = K + I + 1
-            ELSE
-               K = K + N - I + 1
-            END IF
-  130    CONTINUE
-         VALUE = SCALE*SQRT( SUM )
-      END IF
-*
-      DLANSP = VALUE
-      RETURN
-*
-*     End of DLANSP
-*
-      END
diff --git a/src/lib/lapack/dlanst.f b/src/lib/lapack/dlanst.f
deleted file mode 100644
index 2b12091a..00000000
--- a/src/lib/lapack/dlanst.f
+++ /dev/null
@@ -1,124 +0,0 @@
-      DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          NORM
-      INTEGER            N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLANST  returns the value of the one norm,  or the Frobenius norm, or
-*  the  infinity norm,  or the  element of  largest absolute value  of a
-*  real symmetric tridiagonal matrix A.
-*
-*  Description
-*  ===========
-*
-*  DLANST returns the value
-*
-*     DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*              (
-*              ( norm1(A),         NORM = '1', 'O' or 'o'
-*              (
-*              ( normI(A),         NORM = 'I' or 'i'
-*              (
-*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
-*
-*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
-*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
-*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
-*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies the value to be returned in DLANST as described
-*          above.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.  When N = 0, DLANST is
-*          set to zero.
-*
-*  D       (input) DOUBLE PRECISION array, dimension (N)
-*          The diagonal elements of A.
-*
-*  E       (input) DOUBLE PRECISION array, dimension (N-1)
-*          The (n-1) sub-diagonal or super-diagonal elements of A.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-      DOUBLE PRECISION   ANORM, SCALE, SUM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASSQ
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.LE.0 ) THEN
-         ANORM = ZERO
-      ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-*        Find max(abs(A(i,j))).
-*
-         ANORM = ABS( D( N ) )
-         DO 10 I = 1, N - 1
-            ANORM = MAX( ANORM, ABS( D( I ) ) )
-            ANORM = MAX( ANORM, ABS( E( I ) ) )
-   10    CONTINUE
-      ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' .OR.
-     $         LSAME( NORM, 'I' ) ) THEN
-*
-*        Find norm1(A).
-*
-         IF( N.EQ.1 ) THEN
-            ANORM = ABS( D( 1 ) )
-         ELSE
-            ANORM = MAX( ABS( D( 1 ) )+ABS( E( 1 ) ),
-     $              ABS( E( N-1 ) )+ABS( D( N ) ) )
-            DO 20 I = 2, N - 1
-               ANORM = MAX( ANORM, ABS( D( I ) )+ABS( E( I ) )+
-     $                 ABS( E( I-1 ) ) )
-   20       CONTINUE
-         END IF
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-*        Find normF(A).
-*
-         SCALE = ZERO
-         SUM = ONE
-         IF( N.GT.1 ) THEN
-            CALL DLASSQ( N-1, E, 1, SCALE, SUM )
-            SUM = 2*SUM
-         END IF
-         CALL DLASSQ( N, D, 1, SCALE, SUM )
-         ANORM = SCALE*SQRT( SUM )
-      END IF
-*
-      DLANST = ANORM
-      RETURN
-*
-*     End of DLANST
-*
-      END
diff --git a/src/lib/lapack/dlansy.f b/src/lib/lapack/dlansy.f
deleted file mode 100644
index b6c727c0..00000000
--- a/src/lib/lapack/dlansy.f
+++ /dev/null
@@ -1,173 +0,0 @@
-      DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          NORM, UPLO
-      INTEGER            LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLANSY  returns the value of the one norm,  or the Frobenius norm, or
-*  the  infinity norm,  or the  element of  largest absolute value  of a
-*  real symmetric matrix A.
-*
-*  Description
-*  ===========
-*
-*  DLANSY returns the value
-*
-*     DLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*              (
-*              ( norm1(A),         NORM = '1', 'O' or 'o'
-*              (
-*              ( normI(A),         NORM = 'I' or 'i'
-*              (
-*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
-*
-*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
-*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
-*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
-*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies the value to be returned in DLANSY as described
-*          above.
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          symmetric matrix A is to be referenced.
-*          = 'U':  Upper triangular part of A is referenced
-*          = 'L':  Lower triangular part of A is referenced
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.  When N = 0, DLANSY is
-*          set to zero.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(N,1).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*          WORK is not referenced.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   ABSA, SCALE, SUM, VALUE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASSQ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.EQ.0 ) THEN
-         VALUE = ZERO
-      ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-*        Find max(abs(A(i,j))).
-*
-         VALUE = ZERO
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            DO 20 J = 1, N
-               DO 10 I = 1, J
-                  VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   10          CONTINUE
-   20       CONTINUE
-         ELSE
-            DO 40 J = 1, N
-               DO 30 I = J, N
-                  VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   30          CONTINUE
-   40       CONTINUE
-         END IF
-      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
-     $         ( NORM.EQ.'1' ) ) THEN
-*
-*        Find normI(A) ( = norm1(A), since A is symmetric).
-*
-         VALUE = ZERO
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            DO 60 J = 1, N
-               SUM = ZERO
-               DO 50 I = 1, J - 1
-                  ABSA = ABS( A( I, J ) )
-                  SUM = SUM + ABSA
-                  WORK( I ) = WORK( I ) + ABSA
-   50          CONTINUE
-               WORK( J ) = SUM + ABS( A( J, J ) )
-   60       CONTINUE
-            DO 70 I = 1, N
-               VALUE = MAX( VALUE, WORK( I ) )
-   70       CONTINUE
-         ELSE
-            DO 80 I = 1, N
-               WORK( I ) = ZERO
-   80       CONTINUE
-            DO 100 J = 1, N
-               SUM = WORK( J ) + ABS( A( J, J ) )
-               DO 90 I = J + 1, N
-                  ABSA = ABS( A( I, J ) )
-                  SUM = SUM + ABSA
-                  WORK( I ) = WORK( I ) + ABSA
-   90          CONTINUE
-               VALUE = MAX( VALUE, SUM )
-  100       CONTINUE
-         END IF
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-*        Find normF(A).
-*
-         SCALE = ZERO
-         SUM = ONE
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            DO 110 J = 2, N
-               CALL DLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
-  110       CONTINUE
-         ELSE
-            DO 120 J = 1, N - 1
-               CALL DLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
-  120       CONTINUE
-         END IF
-         SUM = 2*SUM
-         CALL DLASSQ( N, A, LDA+1, SCALE, SUM )
-         VALUE = SCALE*SQRT( SUM )
-      END IF
-*
-      DLANSY = VALUE
-      RETURN
-*
-*     End of DLANSY
-*
-      END
diff --git a/src/lib/lapack/dlantr.f b/src/lib/lapack/dlantr.f
deleted file mode 100644
index 92debd3d..00000000
--- a/src/lib/lapack/dlantr.f
+++ /dev/null
@@ -1,276 +0,0 @@
-      DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
-     $                 WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIAG, NORM, UPLO
-      INTEGER            LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLANTR  returns the value of the one norm,  or the Frobenius norm, or
-*  the  infinity norm,  or the  element of  largest absolute value  of a
-*  trapezoidal or triangular matrix A.
-*
-*  Description
-*  ===========
-*
-*  DLANTR returns the value
-*
-*     DLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*              (
-*              ( norm1(A),         NORM = '1', 'O' or 'o'
-*              (
-*              ( normI(A),         NORM = 'I' or 'i'
-*              (
-*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
-*
-*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
-*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
-*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
-*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies the value to be returned in DLANTR as described
-*          above.
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the matrix A is upper or lower trapezoidal.
-*          = 'U':  Upper trapezoidal
-*          = 'L':  Lower trapezoidal
-*          Note that A is triangular instead of trapezoidal if M = N.
-*
-*  DIAG    (input) CHARACTER*1
-*          Specifies whether or not the matrix A has unit diagonal.
-*          = 'N':  Non-unit diagonal
-*          = 'U':  Unit diagonal
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0, and if
-*          UPLO = 'U', M <= N.  When M = 0, DLANTR is set to zero.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0, and if
-*          UPLO = 'L', N <= M.  When N = 0, DLANTR is set to zero.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The trapezoidal matrix A (A is triangular if M = N).
-*          If UPLO = 'U', the leading m by n upper trapezoidal part of
-*          the array A contains the upper trapezoidal matrix, and the
-*          strictly lower triangular part of A is not referenced.
-*          If UPLO = 'L', the leading m by n lower trapezoidal part of
-*          the array A contains the lower trapezoidal matrix, and the
-*          strictly upper triangular part of A is not referenced.  Note
-*          that when DIAG = 'U', the diagonal elements of A are not
-*          referenced and are assumed to be one.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(M,1).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*          where LWORK >= M when NORM = 'I'; otherwise, WORK is not
-*          referenced.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UDIAG
-      INTEGER            I, J
-      DOUBLE PRECISION   SCALE, SUM, VALUE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASSQ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( MIN( M, N ).EQ.0 ) THEN
-         VALUE = ZERO
-      ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-*        Find max(abs(A(i,j))).
-*
-         IF( LSAME( DIAG, 'U' ) ) THEN
-            VALUE = ONE
-            IF( LSAME( UPLO, 'U' ) ) THEN
-               DO 20 J = 1, N
-                  DO 10 I = 1, MIN( M, J-1 )
-                     VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   10             CONTINUE
-   20          CONTINUE
-            ELSE
-               DO 40 J = 1, N
-                  DO 30 I = J + 1, M
-                     VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   30             CONTINUE
-   40          CONTINUE
-            END IF
-         ELSE
-            VALUE = ZERO
-            IF( LSAME( UPLO, 'U' ) ) THEN
-               DO 60 J = 1, N
-                  DO 50 I = 1, MIN( M, J )
-                     VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   50             CONTINUE
-   60          CONTINUE
-            ELSE
-               DO 80 J = 1, N
-                  DO 70 I = J, M
-                     VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   70             CONTINUE
-   80          CONTINUE
-            END IF
-         END IF
-      ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-*        Find norm1(A).
-*
-         VALUE = ZERO
-         UDIAG = LSAME( DIAG, 'U' )
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            DO 110 J = 1, N
-               IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
-                  SUM = ONE
-                  DO 90 I = 1, J - 1
-                     SUM = SUM + ABS( A( I, J ) )
-   90             CONTINUE
-               ELSE
-                  SUM = ZERO
-                  DO 100 I = 1, MIN( M, J )
-                     SUM = SUM + ABS( A( I, J ) )
-  100             CONTINUE
-               END IF
-               VALUE = MAX( VALUE, SUM )
-  110       CONTINUE
-         ELSE
-            DO 140 J = 1, N
-               IF( UDIAG ) THEN
-                  SUM = ONE
-                  DO 120 I = J + 1, M
-                     SUM = SUM + ABS( A( I, J ) )
-  120             CONTINUE
-               ELSE
-                  SUM = ZERO
-                  DO 130 I = J, M
-                     SUM = SUM + ABS( A( I, J ) )
-  130             CONTINUE
-               END IF
-               VALUE = MAX( VALUE, SUM )
-  140       CONTINUE
-         END IF
-      ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-*        Find normI(A).
-*
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            IF( LSAME( DIAG, 'U' ) ) THEN
-               DO 150 I = 1, M
-                  WORK( I ) = ONE
-  150          CONTINUE
-               DO 170 J = 1, N
-                  DO 160 I = 1, MIN( M, J-1 )
-                     WORK( I ) = WORK( I ) + ABS( A( I, J ) )
-  160             CONTINUE
-  170          CONTINUE
-            ELSE
-               DO 180 I = 1, M
-                  WORK( I ) = ZERO
-  180          CONTINUE
-               DO 200 J = 1, N
-                  DO 190 I = 1, MIN( M, J )
-                     WORK( I ) = WORK( I ) + ABS( A( I, J ) )
-  190             CONTINUE
-  200          CONTINUE
-            END IF
-         ELSE
-            IF( LSAME( DIAG, 'U' ) ) THEN
-               DO 210 I = 1, N
-                  WORK( I ) = ONE
-  210          CONTINUE
-               DO 220 I = N + 1, M
-                  WORK( I ) = ZERO
-  220          CONTINUE
-               DO 240 J = 1, N
-                  DO 230 I = J + 1, M
-                     WORK( I ) = WORK( I ) + ABS( A( I, J ) )
-  230             CONTINUE
-  240          CONTINUE
-            ELSE
-               DO 250 I = 1, M
-                  WORK( I ) = ZERO
-  250          CONTINUE
-               DO 270 J = 1, N
-                  DO 260 I = J, M
-                     WORK( I ) = WORK( I ) + ABS( A( I, J ) )
-  260             CONTINUE
-  270          CONTINUE
-            END IF
-         END IF
-         VALUE = ZERO
-         DO 280 I = 1, M
-            VALUE = MAX( VALUE, WORK( I ) )
-  280    CONTINUE
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-*        Find normF(A).
-*
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            IF( LSAME( DIAG, 'U' ) ) THEN
-               SCALE = ONE
-               SUM = MIN( M, N )
-               DO 290 J = 2, N
-                  CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
-  290          CONTINUE
-            ELSE
-               SCALE = ZERO
-               SUM = ONE
-               DO 300 J = 1, N
-                  CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
-  300          CONTINUE
-            END IF
-         ELSE
-            IF( LSAME( DIAG, 'U' ) ) THEN
-               SCALE = ONE
-               SUM = MIN( M, N )
-               DO 310 J = 1, N
-                  CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
-     $                         SUM )
-  310          CONTINUE
-            ELSE
-               SCALE = ZERO
-               SUM = ONE
-               DO 320 J = 1, N
-                  CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
-  320          CONTINUE
-            END IF
-         END IF
-         VALUE = SCALE*SQRT( SUM )
-      END IF
-*
-      DLANTR = VALUE
-      RETURN
-*
-*     End of DLANTR
-*
-      END
diff --git a/src/lib/lapack/dlanv2.f b/src/lib/lapack/dlanv2.f
deleted file mode 100644
index cef3f472..00000000
--- a/src/lib/lapack/dlanv2.f
+++ /dev/null
@@ -1,205 +0,0 @@
-      SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric
-*  matrix in standard form:
-*
-*       [ A  B ] = [ CS -SN ] [ AA  BB ] [ CS  SN ]
-*       [ C  D ]   [ SN  CS ] [ CC  DD ] [-SN  CS ]
-*
-*  where either
-*  1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or
-*  2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex
-*  conjugate eigenvalues.
-*
-*  Arguments
-*  =========
-*
-*  A       (input/output) DOUBLE PRECISION
-*  B       (input/output) DOUBLE PRECISION
-*  C       (input/output) DOUBLE PRECISION
-*  D       (input/output) DOUBLE PRECISION
-*          On entry, the elements of the input matrix.
-*          On exit, they are overwritten by the elements of the
-*          standardised Schur form.
-*
-*  RT1R    (output) DOUBLE PRECISION
-*  RT1I    (output) DOUBLE PRECISION
-*  RT2R    (output) DOUBLE PRECISION
-*  RT2I    (output) DOUBLE PRECISION
-*          The real and imaginary parts of the eigenvalues. If the
-*          eigenvalues are a complex conjugate pair, RT1I > 0.
-*
-*  CS      (output) DOUBLE PRECISION
-*  SN      (output) DOUBLE PRECISION
-*          Parameters of the rotation matrix.
-*
-*  Further Details
-*  ===============
-*
-*  Modified by V. Sima, Research Institute for Informatics, Bucharest,
-*  Romania, to reduce the risk of cancellation errors,
-*  when computing real eigenvalues, and to ensure, if possible, that
-*  abs(RT1R) >= abs(RT2R).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, HALF, ONE
-      PARAMETER          ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
-      DOUBLE PRECISION   MULTPL
-      PARAMETER          ( MULTPL = 4.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB,
-     $                   SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH, DLAPY2
-      EXTERNAL           DLAMCH, DLAPY2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SIGN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      EPS = DLAMCH( 'P' )
-      IF( C.EQ.ZERO ) THEN
-         CS = ONE
-         SN = ZERO
-         GO TO 10
-*
-      ELSE IF( B.EQ.ZERO ) THEN
-*
-*        Swap rows and columns
-*
-         CS = ZERO
-         SN = ONE
-         TEMP = D
-         D = A
-         A = TEMP
-         B = -C
-         C = ZERO
-         GO TO 10
-      ELSE IF( ( A-D ).EQ.ZERO .AND. SIGN( ONE, B ).NE.SIGN( ONE, C ) )
-     $          THEN
-         CS = ONE
-         SN = ZERO
-         GO TO 10
-      ELSE
-*
-         TEMP = A - D
-         P = HALF*TEMP
-         BCMAX = MAX( ABS( B ), ABS( C ) )
-         BCMIS = MIN( ABS( B ), ABS( C ) )*SIGN( ONE, B )*SIGN( ONE, C )
-         SCALE = MAX( ABS( P ), BCMAX )
-         Z = ( P / SCALE )*P + ( BCMAX / SCALE )*BCMIS
-*
-*        If Z is of the order of the machine accuracy, postpone the
-*        decision on the nature of eigenvalues
-*
-         IF( Z.GE.MULTPL*EPS ) THEN
-*
-*           Real eigenvalues. Compute A and D.
-*
-            Z = P + SIGN( SQRT( SCALE )*SQRT( Z ), P )
-            A = D + Z
-            D = D - ( BCMAX / Z )*BCMIS
-*
-*           Compute B and the rotation matrix
-*
-            TAU = DLAPY2( C, Z )
-            CS = Z / TAU
-            SN = C / TAU
-            B = B - C
-            C = ZERO
-         ELSE
-*
-*           Complex eigenvalues, or real (almost) equal eigenvalues.
-*           Make diagonal elements equal.
-*
-            SIGMA = B + C
-            TAU = DLAPY2( SIGMA, TEMP )
-            CS = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) )
-            SN = -( P / ( TAU*CS ) )*SIGN( ONE, SIGMA )
-*
-*           Compute [ AA  BB ] = [ A  B ] [ CS -SN ]
-*                   [ CC  DD ]   [ C  D ] [ SN  CS ]
-*
-            AA = A*CS + B*SN
-            BB = -A*SN + B*CS
-            CC = C*CS + D*SN
-            DD = -C*SN + D*CS
-*
-*           Compute [ A  B ] = [ CS  SN ] [ AA  BB ]
-*                   [ C  D ]   [-SN  CS ] [ CC  DD ]
-*
-            A = AA*CS + CC*SN
-            B = BB*CS + DD*SN
-            C = -AA*SN + CC*CS
-            D = -BB*SN + DD*CS
-*
-            TEMP = HALF*( A+D )
-            A = TEMP
-            D = TEMP
-*
-            IF( C.NE.ZERO ) THEN
-               IF( B.NE.ZERO ) THEN
-                  IF( SIGN( ONE, B ).EQ.SIGN( ONE, C ) ) THEN
-*
-*                    Real eigenvalues: reduce to upper triangular form
-*
-                     SAB = SQRT( ABS( B ) )
-                     SAC = SQRT( ABS( C ) )
-                     P = SIGN( SAB*SAC, C )
-                     TAU = ONE / SQRT( ABS( B+C ) )
-                     A = TEMP + P
-                     D = TEMP - P
-                     B = B - C
-                     C = ZERO
-                     CS1 = SAB*TAU
-                     SN1 = SAC*TAU
-                     TEMP = CS*CS1 - SN*SN1
-                     SN = CS*SN1 + SN*CS1
-                     CS = TEMP
-                  END IF
-               ELSE
-                  B = -C
-                  C = ZERO
-                  TEMP = CS
-                  CS = -SN
-                  SN = TEMP
-               END IF
-            END IF
-         END IF
-*
-      END IF
-*
-   10 CONTINUE
-*
-*     Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I).
-*
-      RT1R = A
-      RT2R = D
-      IF( C.EQ.ZERO ) THEN
-         RT1I = ZERO
-         RT2I = ZERO
-      ELSE
-         RT1I = SQRT( ABS( B ) )*SQRT( ABS( C ) )
-         RT2I = -RT1I
-      END IF
-      RETURN
-*
-*     End of DLANV2
-*
-      END
diff --git a/src/lib/lapack/dlapmt.f b/src/lib/lapack/dlapmt.f
deleted file mode 100644
index 325774c0..00000000
--- a/src/lib/lapack/dlapmt.f
+++ /dev/null
@@ -1,136 +0,0 @@
-      SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            FORWRD
-      INTEGER            LDX, M, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            K( * )
-      DOUBLE PRECISION   X( LDX, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAPMT rearranges the columns of the M by N matrix X as specified
-*  by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
-*  If FORWRD = .TRUE.,  forward permutation:
-*
-*       X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
-*
-*  If FORWRD = .FALSE., backward permutation:
-*
-*       X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
-*
-*  Arguments
-*  =========
-*
-*  FORWRD  (input) LOGICAL
-*          = .TRUE., forward permutation
-*          = .FALSE., backward permutation
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix X. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix X. N >= 0.
-*
-*  X       (input/output) DOUBLE PRECISION array, dimension (LDX,N)
-*          On entry, the M by N matrix X.
-*          On exit, X contains the permuted matrix X.
-*
-*  LDX     (input) INTEGER
-*          The leading dimension of the array X, LDX >= MAX(1,M).
-*
-*  K       (input/output) INTEGER array, dimension (N)
-*          On entry, K contains the permutation vector. K is used as
-*          internal workspace, but reset to its original value on
-*          output.
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, II, IN, J
-      DOUBLE PRECISION   TEMP
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-      DO 10 I = 1, N
-         K( I ) = -K( I )
-   10 CONTINUE
-*
-      IF( FORWRD ) THEN
-*
-*        Forward permutation
-*
-         DO 50 I = 1, N
-*
-            IF( K( I ).GT.0 )
-     $         GO TO 40
-*
-            J = I
-            K( J ) = -K( J )
-            IN = K( J )
-*
-   20       CONTINUE
-            IF( K( IN ).GT.0 )
-     $         GO TO 40
-*
-            DO 30 II = 1, M
-               TEMP = X( II, J )
-               X( II, J ) = X( II, IN )
-               X( II, IN ) = TEMP
-   30       CONTINUE
-*
-            K( IN ) = -K( IN )
-            J = IN
-            IN = K( IN )
-            GO TO 20
-*
-   40       CONTINUE
-*
-   50    CONTINUE
-*
-      ELSE
-*
-*        Backward permutation
-*
-         DO 90 I = 1, N
-*
-            IF( K( I ).GT.0 )
-     $         GO TO 80
-*
-            K( I ) = -K( I )
-            J = K( I )
-   60       CONTINUE
-            IF( J.EQ.I )
-     $         GO TO 80
-*
-            DO 70 II = 1, M
-               TEMP = X( II, I )
-               X( II, I ) = X( II, J )
-               X( II, J ) = TEMP
-   70       CONTINUE
-*
-            K( J ) = -K( J )
-            J = K( J )
-            GO TO 60
-*
-   80       CONTINUE
-*
-   90    CONTINUE
-*
-      END IF
-*
-      RETURN
-*
-*     End of DLAPMT
-*
-      END
diff --git a/src/lib/lapack/dlapy2.f b/src/lib/lapack/dlapy2.f
deleted file mode 100644
index 98ef81b6..00000000
--- a/src/lib/lapack/dlapy2.f
+++ /dev/null
@@ -1,53 +0,0 @@
-      DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   X, Y
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
-*  overflow.
-*
-*  Arguments
-*  =========
-*
-*  X       (input) DOUBLE PRECISION
-*  Y       (input) DOUBLE PRECISION
-*          X and Y specify the values x and y.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   W, XABS, YABS, Z
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      XABS = ABS( X )
-      YABS = ABS( Y )
-      W = MAX( XABS, YABS )
-      Z = MIN( XABS, YABS )
-      IF( Z.EQ.ZERO ) THEN
-         DLAPY2 = W
-      ELSE
-         DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
-      END IF
-      RETURN
-*
-*     End of DLAPY2
-*
-      END
diff --git a/src/lib/lapack/dlapy3.f b/src/lib/lapack/dlapy3.f
deleted file mode 100644
index 2b47bb47..00000000
--- a/src/lib/lapack/dlapy3.f
+++ /dev/null
@@ -1,56 +0,0 @@
-      DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   X, Y, Z
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
-*  unnecessary overflow.
-*
-*  Arguments
-*  =========
-*
-*  X       (input) DOUBLE PRECISION
-*  Y       (input) DOUBLE PRECISION
-*  Z       (input) DOUBLE PRECISION
-*          X, Y and Z specify the values x, y and z.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   W, XABS, YABS, ZABS
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      XABS = ABS( X )
-      YABS = ABS( Y )
-      ZABS = ABS( Z )
-      W = MAX( XABS, YABS, ZABS )
-      IF( W.EQ.ZERO ) THEN
-*     W can be zero for max(0,nan,0)
-*     adding all three entries together will make sure
-*     NaN will not disappear.
-         DLAPY3 =  XABS + YABS + ZABS
-      ELSE
-         DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
-     $            ( ZABS / W )**2 )
-      END IF
-      RETURN
-*
-*     End of DLAPY3
-*
-      END
diff --git a/src/lib/lapack/dlaqge.f b/src/lib/lapack/dlaqge.f
deleted file mode 100644
index 9feb927c..00000000
--- a/src/lib/lapack/dlaqge.f
+++ /dev/null
@@ -1,154 +0,0 @@
-      SUBROUTINE DLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
-     $                   EQUED )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          EQUED
-      INTEGER            LDA, M, N
-      DOUBLE PRECISION   AMAX, COLCND, ROWCND
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( * ), R( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAQGE equilibrates a general M by N matrix A using the row and
-*  column scaling factors in the vectors R and C.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M by N matrix A.
-*          On exit, the equilibrated matrix.  See EQUED for the form of
-*          the equilibrated matrix.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(M,1).
-*
-*  R       (input) DOUBLE PRECISION array, dimension (M)
-*          The row scale factors for A.
-*
-*  C       (input) DOUBLE PRECISION array, dimension (N)
-*          The column scale factors for A.
-*
-*  ROWCND  (input) DOUBLE PRECISION
-*          Ratio of the smallest R(i) to the largest R(i).
-*
-*  COLCND  (input) DOUBLE PRECISION
-*          Ratio of the smallest C(i) to the largest C(i).
-*
-*  AMAX    (input) DOUBLE PRECISION
-*          Absolute value of largest matrix entry.
-*
-*  EQUED   (output) CHARACTER*1
-*          Specifies the form of equilibration that was done.
-*          = 'N':  No equilibration
-*          = 'R':  Row equilibration, i.e., A has been premultiplied by
-*                  diag(R).
-*          = 'C':  Column equilibration, i.e., A has been postmultiplied
-*                  by diag(C).
-*          = 'B':  Both row and column equilibration, i.e., A has been
-*                  replaced by diag(R) * A * diag(C).
-*
-*  Internal Parameters
-*  ===================
-*
-*  THRESH is a threshold value used to decide if row or column scaling
-*  should be done based on the ratio of the row or column scaling
-*  factors.  If ROWCND < THRESH, row scaling is done, and if
-*  COLCND < THRESH, column scaling is done.
-*
-*  LARGE and SMALL are threshold values used to decide if row scaling
-*  should be done based on the absolute size of the largest matrix
-*  element.  If AMAX > LARGE or AMAX < SMALL, row scaling is done.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, THRESH
-      PARAMETER          ( ONE = 1.0D+0, THRESH = 0.1D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   CJ, LARGE, SMALL
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 .OR. N.LE.0 ) THEN
-         EQUED = 'N'
-         RETURN
-      END IF
-*
-*     Initialize LARGE and SMALL.
-*
-      SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
-      LARGE = ONE / SMALL
-*
-      IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
-     $     THEN
-*
-*        No row scaling
-*
-         IF( COLCND.GE.THRESH ) THEN
-*
-*           No column scaling
-*
-            EQUED = 'N'
-         ELSE
-*
-*           Column scaling
-*
-            DO 20 J = 1, N
-               CJ = C( J )
-               DO 10 I = 1, M
-                  A( I, J ) = CJ*A( I, J )
-   10          CONTINUE
-   20       CONTINUE
-            EQUED = 'C'
-         END IF
-      ELSE IF( COLCND.GE.THRESH ) THEN
-*
-*        Row scaling, no column scaling
-*
-         DO 40 J = 1, N
-            DO 30 I = 1, M
-               A( I, J ) = R( I )*A( I, J )
-   30       CONTINUE
-   40    CONTINUE
-         EQUED = 'R'
-      ELSE
-*
-*        Row and column scaling
-*
-         DO 60 J = 1, N
-            CJ = C( J )
-            DO 50 I = 1, M
-               A( I, J ) = CJ*R( I )*A( I, J )
-   50       CONTINUE
-   60    CONTINUE
-         EQUED = 'B'
-      END IF
-*
-      RETURN
-*
-*     End of DLAQGE
-*
-      END
diff --git a/src/lib/lapack/dlaqp2.f b/src/lib/lapack/dlaqp2.f
deleted file mode 100644
index 5ce3b162..00000000
--- a/src/lib/lapack/dlaqp2.f
+++ /dev/null
@@ -1,175 +0,0 @@
-      SUBROUTINE DLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
-     $                   WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            LDA, M, N, OFFSET
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
-     $                   WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAQP2 computes a QR factorization with column pivoting of
-*  the block A(OFFSET+1:M,1:N).
-*  The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A. N >= 0.
-*
-*  OFFSET  (input) INTEGER
-*          The number of rows of the matrix A that must be pivoted
-*          but no factorized. OFFSET >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the upper triangle of block A(OFFSET+1:M,1:N) is 
-*          the triangular factor obtained; the elements in block
-*          A(OFFSET+1:M,1:N) below the diagonal, together with the
-*          array TAU, represent the orthogonal matrix Q as a product of
-*          elementary reflectors. Block A(1:OFFSET,1:N) has been
-*          accordingly pivoted, but no factorized.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*          to the front of A*P (a leading column); if JPVT(i) = 0,
-*          the i-th column of A is a free column.
-*          On exit, if JPVT(i) = k, then the i-th column of A*P
-*          was the k-th column of A.
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors.
-*
-*  VN1     (input/output) DOUBLE PRECISION array, dimension (N)
-*          The vector with the partial column norms.
-*
-*  VN2     (input/output) DOUBLE PRECISION array, dimension (N)
-*          The vector with the exact column norms.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*    X. Sun, Computer Science Dept., Duke University, USA
-*
-*  Partial column norm updating strategy modified by
-*    Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*    University of Zagreb, Croatia.
-*    June 2006.
-*  For more details see LAPACK Working Note 176.
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ITEMP, J, MN, OFFPI, PVT
-      DOUBLE PRECISION   AII, TEMP, TEMP2, TOL3Z
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DLARFG, DSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
-*     ..
-*     .. External Functions ..
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH, DNRM2
-      EXTERNAL           IDAMAX, DLAMCH, DNRM2
-*     ..
-*     .. Executable Statements ..
-*
-      MN = MIN( M-OFFSET, N )
-      TOL3Z = SQRT(DLAMCH('Epsilon'))
-*
-*     Compute factorization.
-*
-      DO 20 I = 1, MN
-*
-         OFFPI = OFFSET + I
-*
-*        Determine ith pivot column and swap if necessary.
-*
-         PVT = ( I-1 ) + IDAMAX( N-I+1, VN1( I ), 1 )
-*
-         IF( PVT.NE.I ) THEN
-            CALL DSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
-            ITEMP = JPVT( PVT )
-            JPVT( PVT ) = JPVT( I )
-            JPVT( I ) = ITEMP
-            VN1( PVT ) = VN1( I )
-            VN2( PVT ) = VN2( I )
-         END IF
-*
-*        Generate elementary reflector H(i).
-*
-         IF( OFFPI.LT.M ) THEN
-            CALL DLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1,
-     $                   TAU( I ) )
-         ELSE
-            CALL DLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) )
-         END IF
-*
-         IF( I.LT.N ) THEN
-*
-*           Apply H(i)' to A(offset+i:m,i+1:n) from the left.
-*
-            AII = A( OFFPI, I )
-            A( OFFPI, I ) = ONE
-            CALL DLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
-     $                  TAU( I ), A( OFFPI, I+1 ), LDA, WORK( 1 ) )
-            A( OFFPI, I ) = AII
-         END IF
-*
-*        Update partial column norms.
-*
-         DO 10 J = I + 1, N
-            IF( VN1( J ).NE.ZERO ) THEN
-*
-*              NOTE: The following 4 lines follow from the analysis in
-*              Lapack Working Note 176.
-*
-               TEMP = ONE - ( ABS( A( OFFPI, J ) ) / VN1( J ) )**2
-               TEMP = MAX( TEMP, ZERO )
-               TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
-               IF( TEMP2 .LE. TOL3Z ) THEN
-                  IF( OFFPI.LT.M ) THEN
-                     VN1( J ) = DNRM2( M-OFFPI, A( OFFPI+1, J ), 1 )
-                     VN2( J ) = VN1( J )
-                  ELSE
-                     VN1( J ) = ZERO
-                     VN2( J ) = ZERO
-                  END IF
-               ELSE
-                  VN1( J ) = VN1( J )*SQRT( TEMP )
-               END IF
-            END IF
-   10    CONTINUE
-*
-   20 CONTINUE
-*
-      RETURN
-*
-*     End of DLAQP2
-*
-      END
diff --git a/src/lib/lapack/dlaqps.f b/src/lib/lapack/dlaqps.f
deleted file mode 100644
index 94658d27..00000000
--- a/src/lib/lapack/dlaqps.f
+++ /dev/null
@@ -1,259 +0,0 @@
-      SUBROUTINE DLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1,
-     $                   VN2, AUXV, F, LDF )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            KB, LDA, LDF, M, N, NB, OFFSET
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
-     $                   VN1( * ), VN2( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAQPS computes a step of QR factorization with column pivoting
-*  of a real M-by-N matrix A by using Blas-3.  It tries to factorize
-*  NB columns from A starting from the row OFFSET+1, and updates all
-*  of the matrix with Blas-3 xGEMM.
-*
-*  In some cases, due to catastrophic cancellations, it cannot
-*  factorize NB columns.  Hence, the actual number of factorized
-*  columns is returned in KB.
-*
-*  Block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A. N >= 0
-*
-*  OFFSET  (input) INTEGER
-*          The number of rows of A that have been factorized in
-*          previous steps.
-*
-*  NB      (input) INTEGER
-*          The number of columns to factorize.
-*
-*  KB      (output) INTEGER
-*          The number of columns actually factorized.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, block A(OFFSET+1:M,1:KB) is the triangular
-*          factor obtained and block A(1:OFFSET,1:N) has been
-*          accordingly pivoted, but no factorized.
-*          The rest of the matrix, block A(OFFSET+1:M,KB+1:N) has
-*          been updated.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          JPVT(I) = K <==> Column K of the full matrix A has been
-*          permuted into position I in AP.
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (KB)
-*          The scalar factors of the elementary reflectors.
-*
-*  VN1     (input/output) DOUBLE PRECISION array, dimension (N)
-*          The vector with the partial column norms.
-*
-*  VN2     (input/output) DOUBLE PRECISION array, dimension (N)
-*          The vector with the exact column norms.
-*
-*  AUXV    (input/output) DOUBLE PRECISION array, dimension (NB)
-*          Auxiliar vector.
-*
-*  F       (input/output) DOUBLE PRECISION array, dimension (LDF,NB)
-*          Matrix F' = L*Y'*A.
-*
-*  LDF     (input) INTEGER
-*          The leading dimension of the array F. LDF >= max(1,N).
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*    X. Sun, Computer Science Dept., Duke University, USA
-*
-*  Partial column norm updating strategy modified by
-*    Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*    University of Zagreb, Croatia.
-*    June 2006.
-*  For more details see LAPACK Working Note 176.
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            ITEMP, J, K, LASTRK, LSTICC, PVT, RK
-      DOUBLE PRECISION   AKK, TEMP, TEMP2, TOL3Z
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMM, DGEMV, DLARFG, DSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX, MIN, NINT, SQRT
-*     ..
-*     .. External Functions ..
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH, DNRM2
-      EXTERNAL           IDAMAX, DLAMCH, DNRM2
-*     ..
-*     .. Executable Statements ..
-*
-      LASTRK = MIN( M, N+OFFSET )
-      LSTICC = 0
-      K = 0
-      TOL3Z = SQRT(DLAMCH('Epsilon'))
-*
-*     Beginning of while loop.
-*
-   10 CONTINUE
-      IF( ( K.LT.NB ) .AND. ( LSTICC.EQ.0 ) ) THEN
-         K = K + 1
-         RK = OFFSET + K
-*
-*        Determine ith pivot column and swap if necessary
-*
-         PVT = ( K-1 ) + IDAMAX( N-K+1, VN1( K ), 1 )
-         IF( PVT.NE.K ) THEN
-            CALL DSWAP( M, A( 1, PVT ), 1, A( 1, K ), 1 )
-            CALL DSWAP( K-1, F( PVT, 1 ), LDF, F( K, 1 ), LDF )
-            ITEMP = JPVT( PVT )
-            JPVT( PVT ) = JPVT( K )
-            JPVT( K ) = ITEMP
-            VN1( PVT ) = VN1( K )
-            VN2( PVT ) = VN2( K )
-         END IF
-*
-*        Apply previous Householder reflectors to column K:
-*        A(RK:M,K) := A(RK:M,K) - A(RK:M,1:K-1)*F(K,1:K-1)'.
-*
-         IF( K.GT.1 ) THEN
-            CALL DGEMV( 'No transpose', M-RK+1, K-1, -ONE, A( RK, 1 ),
-     $                  LDA, F( K, 1 ), LDF, ONE, A( RK, K ), 1 )
-         END IF
-*
-*        Generate elementary reflector H(k).
-*
-         IF( RK.LT.M ) THEN
-            CALL DLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, TAU( K ) )
-         ELSE
-            CALL DLARFG( 1, A( RK, K ), A( RK, K ), 1, TAU( K ) )
-         END IF
-*
-         AKK = A( RK, K )
-         A( RK, K ) = ONE
-*
-*        Compute Kth column of F:
-*
-*        Compute  F(K+1:N,K) := tau(K)*A(RK:M,K+1:N)'*A(RK:M,K).
-*
-         IF( K.LT.N ) THEN
-            CALL DGEMV( 'Transpose', M-RK+1, N-K, TAU( K ),
-     $                  A( RK, K+1 ), LDA, A( RK, K ), 1, ZERO,
-     $                  F( K+1, K ), 1 )
-         END IF
-*
-*        Padding F(1:K,K) with zeros.
-*
-         DO 20 J = 1, K
-            F( J, K ) = ZERO
-   20    CONTINUE
-*
-*        Incremental updating of F:
-*        F(1:N,K) := F(1:N,K) - tau(K)*F(1:N,1:K-1)*A(RK:M,1:K-1)'
-*                    *A(RK:M,K).
-*
-         IF( K.GT.1 ) THEN
-            CALL DGEMV( 'Transpose', M-RK+1, K-1, -TAU( K ), A( RK, 1 ),
-     $                  LDA, A( RK, K ), 1, ZERO, AUXV( 1 ), 1 )
-*
-            CALL DGEMV( 'No transpose', N, K-1, ONE, F( 1, 1 ), LDF,
-     $                  AUXV( 1 ), 1, ONE, F( 1, K ), 1 )
-         END IF
-*
-*        Update the current row of A:
-*        A(RK,K+1:N) := A(RK,K+1:N) - A(RK,1:K)*F(K+1:N,1:K)'.
-*
-         IF( K.LT.N ) THEN
-            CALL DGEMV( 'No transpose', N-K, K, -ONE, F( K+1, 1 ), LDF,
-     $                  A( RK, 1 ), LDA, ONE, A( RK, K+1 ), LDA )
-         END IF
-*
-*        Update partial column norms.
-*
-         IF( RK.LT.LASTRK ) THEN
-            DO 30 J = K + 1, N
-               IF( VN1( J ).NE.ZERO ) THEN
-*
-*                 NOTE: The following 4 lines follow from the analysis in
-*                 Lapack Working Note 176.
-*
-                  TEMP = ABS( A( RK, J ) ) / VN1( J )
-                  TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
-                  TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
-                  IF( TEMP2 .LE. TOL3Z ) THEN
-                     VN2( J ) = DBLE( LSTICC )
-                     LSTICC = J
-                  ELSE
-                     VN1( J ) = VN1( J )*SQRT( TEMP )
-                  END IF
-               END IF
-   30       CONTINUE
-         END IF
-*
-         A( RK, K ) = AKK
-*
-*        End of while loop.
-*
-         GO TO 10
-      END IF
-      KB = K
-      RK = OFFSET + KB
-*
-*     Apply the block reflector to the rest of the matrix:
-*     A(OFFSET+KB+1:M,KB+1:N) := A(OFFSET+KB+1:M,KB+1:N) -
-*                         A(OFFSET+KB+1:M,1:KB)*F(KB+1:N,1:KB)'.
-*
-      IF( KB.LT.MIN( N, M-OFFSET ) ) THEN
-         CALL DGEMM( 'No transpose', 'Transpose', M-RK, N-KB, KB, -ONE,
-     $               A( RK+1, 1 ), LDA, F( KB+1, 1 ), LDF, ONE,
-     $               A( RK+1, KB+1 ), LDA )
-      END IF
-*
-*     Recomputation of difficult columns.
-*
-   40 CONTINUE
-      IF( LSTICC.GT.0 ) THEN
-         ITEMP = NINT( VN2( LSTICC ) )
-         VN1( LSTICC ) = DNRM2( M-RK, A( RK+1, LSTICC ), 1 )
-*
-*        NOTE: The computation of VN1( LSTICC ) relies on the fact that 
-*        SNRM2 does not fail on vectors with norm below the value of
-*        SQRT(DLAMCH('S')) 
-*
-         VN2( LSTICC ) = VN1( LSTICC )
-         LSTICC = ITEMP
-         GO TO 40
-      END IF
-*
-      RETURN
-*
-*     End of DLAQPS
-*
-      END
diff --git a/src/lib/lapack/dlaqr0.f b/src/lib/lapack/dlaqr0.f
deleted file mode 100644
index 479da53d..00000000
--- a/src/lib/lapack/dlaqr0.f
+++ /dev/null
@@ -1,642 +0,0 @@
-      SUBROUTINE DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-     $                   ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*     Purpose
-*     =======
-*
-*     DLAQR0 computes the eigenvalues of a Hessenberg matrix H
-*     and, optionally, the matrices T and Z from the Schur decomposition
-*     H = Z T Z**T, where T is an upper quasi-triangular matrix (the
-*     Schur form), and Z is the orthogonal matrix of Schur vectors.
-*
-*     Optionally Z may be postmultiplied into an input orthogonal
-*     matrix Q so that this routine can give the Schur factorization
-*     of a matrix A which has been reduced to the Hessenberg form H
-*     by the orthogonal matrix Q:  A = Q*H*Q**T = (QZ)*T*(QZ)**T.
-*
-*     Arguments
-*     =========
-*
-*     WANTT   (input) LOGICAL
-*          = .TRUE. : the full Schur form T is required;
-*          = .FALSE.: only eigenvalues are required.
-*
-*     WANTZ   (input) LOGICAL
-*          = .TRUE. : the matrix of Schur vectors Z is required;
-*          = .FALSE.: Schur vectors are not required.
-*
-*     N     (input) INTEGER
-*           The order of the matrix H.  N .GE. 0.
-*
-*     ILO   (input) INTEGER
-*     IHI   (input) INTEGER
-*           It is assumed that H is already upper triangular in rows
-*           and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
-*           H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
-*           previous call to DGEBAL, and then passed to DGEHRD when the
-*           matrix output by DGEBAL is reduced to Hessenberg form.
-*           Otherwise, ILO and IHI should be set to 1 and N,
-*           respectively.  If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*           If N = 0, then ILO = 1 and IHI = 0.
-*
-*     H     (input/output) DOUBLE PRECISION array, dimension (LDH,N)
-*           On entry, the upper Hessenberg matrix H.
-*           On exit, if INFO = 0 and WANTT is .TRUE., then H contains
-*           the upper quasi-triangular matrix T from the Schur
-*           decomposition (the Schur form); 2-by-2 diagonal blocks
-*           (corresponding to complex conjugate pairs of eigenvalues)
-*           are returned in standard form, with H(i,i) = H(i+1,i+1)
-*           and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
-*           .FALSE., then the contents of H are unspecified on exit.
-*           (The output value of H when INFO.GT.0 is given under the
-*           description of INFO below.)
-*
-*           This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
-*           j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
-*
-*     LDH   (input) INTEGER
-*           The leading dimension of the array H. LDH .GE. max(1,N).
-*
-*     WR    (output) DOUBLE PRECISION array, dimension (IHI)
-*     WI    (output) DOUBLE PRECISION array, dimension (IHI)
-*           The real and imaginary parts, respectively, of the computed
-*           eigenvalues of H(ILO:IHI,ILO:IHI) are stored WR(ILO:IHI)
-*           and WI(ILO:IHI). If two eigenvalues are computed as a
-*           complex conjugate pair, they are stored in consecutive
-*           elements of WR and WI, say the i-th and (i+1)th, with
-*           WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
-*           the eigenvalues are stored in the same order as on the
-*           diagonal of the Schur form returned in H, with
-*           WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
-*           block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*           WI(i+1) = -WI(i).
-*
-*     ILOZ     (input) INTEGER
-*     IHIZ     (input) INTEGER
-*           Specify the rows of Z to which transformations must be
-*           applied if WANTZ is .TRUE..
-*           1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
-*
-*     Z     (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
-*           If WANTZ is .FALSE., then Z is not referenced.
-*           If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
-*           replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
-*           orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
-*           (The output value of Z when INFO.GT.0 is given under
-*           the description of INFO below.)
-*
-*     LDZ   (input) INTEGER
-*           The leading dimension of the array Z.  if WANTZ is .TRUE.
-*           then LDZ.GE.MAX(1,IHIZ).  Otherwize, LDZ.GE.1.
-*
-*     WORK  (workspace/output) DOUBLE PRECISION array, dimension LWORK
-*           On exit, if LWORK = -1, WORK(1) returns an estimate of
-*           the optimal value for LWORK.
-*
-*     LWORK (input) INTEGER
-*           The dimension of the array WORK.  LWORK .GE. max(1,N)
-*           is sufficient, but LWORK typically as large as 6*N may
-*           be required for optimal performance.  A workspace query
-*           to determine the optimal workspace size is recommended.
-*
-*           If LWORK = -1, then DLAQR0 does a workspace query.
-*           In this case, DLAQR0 checks the input parameters and
-*           estimates the optimal workspace size for the given
-*           values of N, ILO and IHI.  The estimate is returned
-*           in WORK(1).  No error message related to LWORK is
-*           issued by XERBLA.  Neither H nor Z are accessed.
-*
-*
-*     INFO  (output) INTEGER
-*             =  0:  successful exit
-*           .GT. 0:  if INFO = i, DLAQR0 failed to compute all of
-*                the eigenvalues.  Elements 1:ilo-1 and i+1:n of WR
-*                and WI contain those eigenvalues which have been
-*                successfully computed.  (Failures are rare.)
-*
-*                If INFO .GT. 0 and WANT is .FALSE., then on exit,
-*                the remaining unconverged eigenvalues are the eigen-
-*                values of the upper Hessenberg matrix rows and
-*                columns ILO through INFO of the final, output
-*                value of H.
-*
-*                If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*
-*           (*)  (initial value of H)*U  = U*(final value of H)
-*
-*                where U is an orthogonal matrix.  The final
-*                value of H is upper Hessenberg and quasi-triangular
-*                in rows and columns INFO+1 through IHI.
-*
-*                If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*
-*                  (final value of Z(ILO:IHI,ILOZ:IHIZ)
-*                   =  (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
-*
-*                where U is the orthogonal matrix in (*) (regard-
-*                less of the value of WANTT.)
-*
-*                If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
-*                accessed.
-*
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ================================================================
-*
-*     References:
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*       Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*       929--947, 2002.
-*
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*       of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-*     ================================================================
-*     .. Parameters ..
-*
-*     ==== Matrices of order NTINY or smaller must be processed by
-*     .    DLAHQR because of insufficient subdiagonal scratch space.
-*     .    (This is a hard limit.) ====
-*
-*     ==== Exceptional deflation windows:  try to cure rare
-*     .    slow convergence by increasing the size of the
-*     .    deflation window after KEXNW iterations. =====
-*
-*     ==== Exceptional shifts: try to cure rare slow convergence
-*     .    with ad-hoc exceptional shifts every KEXSH iterations.
-*     .    The constants WILK1 and WILK2 are used to form the
-*     .    exceptional shifts. ====
-*
-      INTEGER            NTINY
-      PARAMETER          ( NTINY = 11 )
-      INTEGER            KEXNW, KEXSH
-      PARAMETER          ( KEXNW = 5, KEXSH = 6 )
-      DOUBLE PRECISION   WILK1, WILK2
-      PARAMETER          ( WILK1 = 0.75d0, WILK2 = -0.4375d0 )
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0d0, ONE = 1.0d0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   AA, BB, CC, CS, DD, SN, SS, SWAP
-      INTEGER            I, INF, IT, ITMAX, K, KACC22, KBOT, KDU, KS,
-     $                   KT, KTOP, KU, KV, KWH, KWTOP, KWV, LD, LS,
-     $                   LWKOPT, NDFL, NH, NHO, NIBBLE, NMIN, NS, NSMAX,
-     $                   NSR, NVE, NW, NWMAX, NWR
-      LOGICAL            NWINC, SORTED
-      CHARACTER          JBCMPZ*2
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   ZDUM( 1, 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLACPY, DLAHQR, DLANV2, DLAQR3, DLAQR4, DLAQR5
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, INT, MAX, MIN, MOD
-*     ..
-*     .. Executable Statements ..
-      INFO = 0
-*
-*     ==== Quick return for N = 0: nothing to do. ====
-*
-      IF( N.EQ.0 ) THEN
-         WORK( 1 ) = ONE
-         RETURN
-      END IF
-*
-*     ==== Set up job flags for ILAENV. ====
-*
-      IF( WANTT ) THEN
-         JBCMPZ( 1: 1 ) = 'S'
-      ELSE
-         JBCMPZ( 1: 1 ) = 'E'
-      END IF
-      IF( WANTZ ) THEN
-         JBCMPZ( 2: 2 ) = 'V'
-      ELSE
-         JBCMPZ( 2: 2 ) = 'N'
-      END IF
-*
-*     ==== Tiny matrices must use DLAHQR. ====
-*
-      IF( N.LE.NTINY ) THEN
-*
-*        ==== Estimate optimal workspace. ====
-*
-         LWKOPT = 1
-         IF( LWORK.NE.-1 )
-     $      CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-     $                   ILOZ, IHIZ, Z, LDZ, INFO )
-      ELSE
-*
-*        ==== Use small bulge multi-shift QR with aggressive early
-*        .    deflation on larger-than-tiny matrices. ====
-*
-*        ==== Hope for the best. ====
-*
-         INFO = 0
-*
-*        ==== NWR = recommended deflation window size.  At this
-*        .    point,  N .GT. NTINY = 11, so there is enough
-*        .    subdiagonal workspace for NWR.GE.2 as required.
-*        .    (In fact, there is enough subdiagonal space for
-*        .    NWR.GE.3.) ====
-*
-         NWR = ILAENV( 13, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
-         NWR = MAX( 2, NWR )
-         NWR = MIN( IHI-ILO+1, ( N-1 ) / 3, NWR )
-         NW = NWR
-*
-*        ==== NSR = recommended number of simultaneous shifts.
-*        .    At this point N .GT. NTINY = 11, so there is at
-*        .    enough subdiagonal workspace for NSR to be even
-*        .    and greater than or equal to two as required. ====
-*
-         NSR = ILAENV( 15, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
-         NSR = MIN( NSR, ( N+6 ) / 9, IHI-ILO )
-         NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
-*
-*        ==== Estimate optimal workspace ====
-*
-*        ==== Workspace query call to DLAQR3 ====
-*
-         CALL DLAQR3( WANTT, WANTZ, N, ILO, IHI, NWR+1, H, LDH, ILOZ,
-     $                IHIZ, Z, LDZ, LS, LD, WR, WI, H, LDH, N, H, LDH,
-     $                N, H, LDH, WORK, -1 )
-*
-*        ==== Optimal workspace = MAX(DLAQR5, DLAQR3) ====
-*
-         LWKOPT = MAX( 3*NSR / 2, INT( WORK( 1 ) ) )
-*
-*        ==== Quick return in case of workspace query. ====
-*
-         IF( LWORK.EQ.-1 ) THEN
-            WORK( 1 ) = DBLE( LWKOPT )
-            RETURN
-         END IF
-*
-*        ==== DLAHQR/DLAQR0 crossover point ====
-*
-         NMIN = ILAENV( 12, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
-         NMIN = MAX( NTINY, NMIN )
-*
-*        ==== Nibble crossover point ====
-*
-         NIBBLE = ILAENV( 14, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
-         NIBBLE = MAX( 0, NIBBLE )
-*
-*        ==== Accumulate reflections during ttswp?  Use block
-*        .    2-by-2 structure during matrix-matrix multiply? ====
-*
-         KACC22 = ILAENV( 16, 'DLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
-         KACC22 = MAX( 0, KACC22 )
-         KACC22 = MIN( 2, KACC22 )
-*
-*        ==== NWMAX = the largest possible deflation window for
-*        .    which there is sufficient workspace. ====
-*
-         NWMAX = MIN( ( N-1 ) / 3, LWORK / 2 )
-*
-*        ==== NSMAX = the Largest number of simultaneous shifts
-*        .    for which there is sufficient workspace. ====
-*
-         NSMAX = MIN( ( N+6 ) / 9, 2*LWORK / 3 )
-         NSMAX = NSMAX - MOD( NSMAX, 2 )
-*
-*        ==== NDFL: an iteration count restarted at deflation. ====
-*
-         NDFL = 1
-*
-*        ==== ITMAX = iteration limit ====
-*
-         ITMAX = MAX( 30, 2*KEXSH )*MAX( 10, ( IHI-ILO+1 ) )
-*
-*        ==== Last row and column in the active block ====
-*
-         KBOT = IHI
-*
-*        ==== Main Loop ====
-*
-         DO 80 IT = 1, ITMAX
-*
-*           ==== Done when KBOT falls below ILO ====
-*
-            IF( KBOT.LT.ILO )
-     $         GO TO 90
-*
-*           ==== Locate active block ====
-*
-            DO 10 K = KBOT, ILO + 1, -1
-               IF( H( K, K-1 ).EQ.ZERO )
-     $            GO TO 20
-   10       CONTINUE
-            K = ILO
-   20       CONTINUE
-            KTOP = K
-*
-*           ==== Select deflation window size ====
-*
-            NH = KBOT - KTOP + 1
-            IF( NDFL.LT.KEXNW .OR. NH.LT.NW ) THEN
-*
-*              ==== Typical deflation window.  If possible and
-*              .    advisable, nibble the entire active block.
-*              .    If not, use size NWR or NWR+1 depending upon
-*              .    which has the smaller corresponding subdiagonal
-*              .    entry (a heuristic). ====
-*
-               NWINC = .TRUE.
-               IF( NH.LE.MIN( NMIN, NWMAX ) ) THEN
-                  NW = NH
-               ELSE
-                  NW = MIN( NWR, NH, NWMAX )
-                  IF( NW.LT.NWMAX ) THEN
-                     IF( NW.GE.NH-1 ) THEN
-                        NW = NH
-                     ELSE
-                        KWTOP = KBOT - NW + 1
-                        IF( ABS( H( KWTOP, KWTOP-1 ) ).GT.
-     $                      ABS( H( KWTOP-1, KWTOP-2 ) ) )NW = NW + 1
-                     END IF
-                  END IF
-               END IF
-            ELSE
-*
-*              ==== Exceptional deflation window.  If there have
-*              .    been no deflations in KEXNW or more iterations,
-*              .    then vary the deflation window size.   At first,
-*              .    because, larger windows are, in general, more
-*              .    powerful than smaller ones, rapidly increase the
-*              .    window up to the maximum reasonable and possible.
-*              .    Then maybe try a slightly smaller window.  ====
-*
-               IF( NWINC .AND. NW.LT.MIN( NWMAX, NH ) ) THEN
-                  NW = MIN( NWMAX, NH, 2*NW )
-               ELSE
-                  NWINC = .FALSE.
-                  IF( NW.EQ.NH .AND. NH.GT.2 )
-     $               NW = NH - 1
-               END IF
-            END IF
-*
-*           ==== Aggressive early deflation:
-*           .    split workspace under the subdiagonal into
-*           .      - an nw-by-nw work array V in the lower
-*           .        left-hand-corner,
-*           .      - an NW-by-at-least-NW-but-more-is-better
-*           .        (NW-by-NHO) horizontal work array along
-*           .        the bottom edge,
-*           .      - an at-least-NW-but-more-is-better (NHV-by-NW)
-*           .        vertical work array along the left-hand-edge.
-*           .        ====
-*
-            KV = N - NW + 1
-            KT = NW + 1
-            NHO = ( N-NW-1 ) - KT + 1
-            KWV = NW + 2
-            NVE = ( N-NW ) - KWV + 1
-*
-*           ==== Aggressive early deflation ====
-*
-            CALL DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-     $                   IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH,
-     $                   NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH,
-     $                   WORK, LWORK )
-*
-*           ==== Adjust KBOT accounting for new deflations. ====
-*
-            KBOT = KBOT - LD
-*
-*           ==== KS points to the shifts. ====
-*
-            KS = KBOT - LS + 1
-*
-*           ==== Skip an expensive QR sweep if there is a (partly
-*           .    heuristic) reason to expect that many eigenvalues
-*           .    will deflate without it.  Here, the QR sweep is
-*           .    skipped if many eigenvalues have just been deflated
-*           .    or if the remaining active block is small.
-*
-            IF( ( LD.EQ.0 ) .OR. ( ( 100*LD.LE.NW*NIBBLE ) .AND. ( KBOT-
-     $          KTOP+1.GT.MIN( NMIN, NWMAX ) ) ) ) THEN
-*
-*              ==== NS = nominal number of simultaneous shifts.
-*              .    This may be lowered (slightly) if DLAQR3
-*              .    did not provide that many shifts. ====
-*
-               NS = MIN( NSMAX, NSR, MAX( 2, KBOT-KTOP ) )
-               NS = NS - MOD( NS, 2 )
-*
-*              ==== If there have been no deflations
-*              .    in a multiple of KEXSH iterations,
-*              .    then try exceptional shifts.
-*              .    Otherwise use shifts provided by
-*              .    DLAQR3 above or from the eigenvalues
-*              .    of a trailing principal submatrix. ====
-*
-               IF( MOD( NDFL, KEXSH ).EQ.0 ) THEN
-                  KS = KBOT - NS + 1
-                  DO 30 I = KBOT, MAX( KS+1, KTOP+2 ), -2
-                     SS = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
-                     AA = WILK1*SS + H( I, I )
-                     BB = SS
-                     CC = WILK2*SS
-                     DD = AA
-                     CALL DLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ),
-     $                            WR( I ), WI( I ), CS, SN )
-   30             CONTINUE
-                  IF( KS.EQ.KTOP ) THEN
-                     WR( KS+1 ) = H( KS+1, KS+1 )
-                     WI( KS+1 ) = ZERO
-                     WR( KS ) = WR( KS+1 )
-                     WI( KS ) = WI( KS+1 )
-                  END IF
-               ELSE
-*
-*                 ==== Got NS/2 or fewer shifts? Use DLAQR4 or
-*                 .    DLAHQR on a trailing principal submatrix to
-*                 .    get more. (Since NS.LE.NSMAX.LE.(N+6)/9,
-*                 .    there is enough space below the subdiagonal
-*                 .    to fit an NS-by-NS scratch array.) ====
-*
-                  IF( KBOT-KS+1.LE.NS / 2 ) THEN
-                     KS = KBOT - NS + 1
-                     KT = N - NS + 1
-                     CALL DLACPY( 'A', NS, NS, H( KS, KS ), LDH,
-     $                            H( KT, 1 ), LDH )
-                     IF( NS.GT.NMIN ) THEN
-                        CALL DLAQR4( .false., .false., NS, 1, NS,
-     $                               H( KT, 1 ), LDH, WR( KS ),
-     $                               WI( KS ), 1, 1, ZDUM, 1, WORK,
-     $                               LWORK, INF )
-                     ELSE
-                        CALL DLAHQR( .false., .false., NS, 1, NS,
-     $                               H( KT, 1 ), LDH, WR( KS ),
-     $                               WI( KS ), 1, 1, ZDUM, 1, INF )
-                     END IF
-                     KS = KS + INF
-*
-*                    ==== In case of a rare QR failure use
-*                    .    eigenvalues of the trailing 2-by-2
-*                    .    principal submatrix.  ====
-*
-                     IF( KS.GE.KBOT ) THEN
-                        AA = H( KBOT-1, KBOT-1 )
-                        CC = H( KBOT, KBOT-1 )
-                        BB = H( KBOT-1, KBOT )
-                        DD = H( KBOT, KBOT )
-                        CALL DLANV2( AA, BB, CC, DD, WR( KBOT-1 ),
-     $                               WI( KBOT-1 ), WR( KBOT ),
-     $                               WI( KBOT ), CS, SN )
-                        KS = KBOT - 1
-                     END IF
-                  END IF
-*
-                  IF( KBOT-KS+1.GT.NS ) THEN
-*
-*                    ==== Sort the shifts (Helps a little)
-*                    .    Bubble sort keeps complex conjugate
-*                    .    pairs together. ====
-*
-                     SORTED = .false.
-                     DO 50 K = KBOT, KS + 1, -1
-                        IF( SORTED )
-     $                     GO TO 60
-                        SORTED = .true.
-                        DO 40 I = KS, K - 1
-                           IF( ABS( WR( I ) )+ABS( WI( I ) ).LT.
-     $                         ABS( WR( I+1 ) )+ABS( WI( I+1 ) ) ) THEN
-                              SORTED = .false.
-*
-                              SWAP = WR( I )
-                              WR( I ) = WR( I+1 )
-                              WR( I+1 ) = SWAP
-*
-                              SWAP = WI( I )
-                              WI( I ) = WI( I+1 )
-                              WI( I+1 ) = SWAP
-                           END IF
-   40                   CONTINUE
-   50                CONTINUE
-   60                CONTINUE
-                  END IF
-*
-*                 ==== Shuffle shifts into pairs of real shifts
-*                 .    and pairs of complex conjugate shifts
-*                 .    assuming complex conjugate shifts are
-*                 .    already adjacent to one another. (Yes,
-*                 .    they are.)  ====
-*
-                  DO 70 I = KBOT, KS + 2, -2
-                     IF( WI( I ).NE.-WI( I-1 ) ) THEN
-*
-                        SWAP = WR( I )
-                        WR( I ) = WR( I-1 )
-                        WR( I-1 ) = WR( I-2 )
-                        WR( I-2 ) = SWAP
-*
-                        SWAP = WI( I )
-                        WI( I ) = WI( I-1 )
-                        WI( I-1 ) = WI( I-2 )
-                        WI( I-2 ) = SWAP
-                     END IF
-   70             CONTINUE
-               END IF
-*
-*              ==== If there are only two shifts and both are
-*              .    real, then use only one.  ====
-*
-               IF( KBOT-KS+1.EQ.2 ) THEN
-                  IF( WI( KBOT ).EQ.ZERO ) THEN
-                     IF( ABS( WR( KBOT )-H( KBOT, KBOT ) ).LT.
-     $                   ABS( WR( KBOT-1 )-H( KBOT, KBOT ) ) ) THEN
-                        WR( KBOT-1 ) = WR( KBOT )
-                     ELSE
-                        WR( KBOT ) = WR( KBOT-1 )
-                     END IF
-                  END IF
-               END IF
-*
-*              ==== Use up to NS of the the smallest magnatiude
-*              .    shifts.  If there aren't NS shifts available,
-*              .    then use them all, possibly dropping one to
-*              .    make the number of shifts even. ====
-*
-               NS = MIN( NS, KBOT-KS+1 )
-               NS = NS - MOD( NS, 2 )
-               KS = KBOT - NS + 1
-*
-*              ==== Small-bulge multi-shift QR sweep:
-*              .    split workspace under the subdiagonal into
-*              .    - a KDU-by-KDU work array U in the lower
-*              .      left-hand-corner,
-*              .    - a KDU-by-at-least-KDU-but-more-is-better
-*              .      (KDU-by-NHo) horizontal work array WH along
-*              .      the bottom edge,
-*              .    - and an at-least-KDU-but-more-is-better-by-KDU
-*              .      (NVE-by-KDU) vertical work WV arrow along
-*              .      the left-hand-edge. ====
-*
-               KDU = 3*NS - 3
-               KU = N - KDU + 1
-               KWH = KDU + 1
-               NHO = ( N-KDU+1-4 ) - ( KDU+1 ) + 1
-               KWV = KDU + 4
-               NVE = N - KDU - KWV + 1
-*
-*              ==== Small-bulge multi-shift QR sweep ====
-*
-               CALL DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NS,
-     $                      WR( KS ), WI( KS ), H, LDH, ILOZ, IHIZ, Z,
-     $                      LDZ, WORK, 3, H( KU, 1 ), LDH, NVE,
-     $                      H( KWV, 1 ), LDH, NHO, H( KU, KWH ), LDH )
-            END IF
-*
-*           ==== Note progress (or the lack of it). ====
-*
-            IF( LD.GT.0 ) THEN
-               NDFL = 1
-            ELSE
-               NDFL = NDFL + 1
-            END IF
-*
-*           ==== End of main loop ====
-   80    CONTINUE
-*
-*        ==== Iteration limit exceeded.  Set INFO to show where
-*        .    the problem occurred and exit. ====
-*
-         INFO = KBOT
-   90    CONTINUE
-      END IF
-*
-*     ==== Return the optimal value of LWORK. ====
-*
-      WORK( 1 ) = DBLE( LWKOPT )
-*
-*     ==== End of DLAQR0 ====
-*
-      END
diff --git a/src/lib/lapack/dlaqr1.f b/src/lib/lapack/dlaqr1.f
deleted file mode 100644
index c80fe668..00000000
--- a/src/lib/lapack/dlaqr1.f
+++ /dev/null
@@ -1,97 +0,0 @@
-      SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   SI1, SI2, SR1, SR2
-      INTEGER            LDH, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   H( LDH, * ), V( * )
-*     ..
-*
-*       Given a 2-by-2 or 3-by-3 matrix H, DLAQR1 sets v to a
-*       scalar multiple of the first column of the product
-*
-*       (*)  K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I)
-*
-*       scaling to avoid overflows and most underflows. It
-*       is assumed that either
-*
-*               1) sr1 = sr2 and si1 = -si2
-*           or
-*               2) si1 = si2 = 0.
-*
-*       This is useful for starting double implicit shift bulges
-*       in the QR algorithm.
-*
-*
-*       N      (input) integer
-*              Order of the matrix H. N must be either 2 or 3.
-*
-*       H      (input) DOUBLE PRECISION array of dimension (LDH,N)
-*              The 2-by-2 or 3-by-3 matrix H in (*).
-*
-*       LDH    (input) integer
-*              The leading dimension of H as declared in
-*              the calling procedure.  LDH.GE.N
-*
-*       SR1    (input) DOUBLE PRECISION
-*       SI1    The shifts in (*).
-*       SR2
-*       SI2
-*
-*       V      (output) DOUBLE PRECISION array of dimension N
-*              A scalar multiple of the first column of the
-*              matrix K in (*).
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0d0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   H21S, H31S, S
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS
-*     ..
-*     .. Executable Statements ..
-      IF( N.EQ.2 ) THEN
-         S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) )
-         IF( S.EQ.ZERO ) THEN
-            V( 1 ) = ZERO
-            V( 2 ) = ZERO
-         ELSE
-            H21S = H( 2, 1 ) / S
-            V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-SR1 )*
-     $               ( ( H( 1, 1 )-SR2 ) / S ) - SI1*( SI2 / S )
-            V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 )
-         END IF
-      ELSE
-         S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) +
-     $       ABS( H( 3, 1 ) )
-         IF( S.EQ.ZERO ) THEN
-            V( 1 ) = ZERO
-            V( 2 ) = ZERO
-            V( 3 ) = ZERO
-         ELSE
-            H21S = H( 2, 1 ) / S
-            H31S = H( 3, 1 ) / S
-            V( 1 ) = ( H( 1, 1 )-SR1 )*( ( H( 1, 1 )-SR2 ) / S ) -
-     $               SI1*( SI2 / S ) + H( 1, 2 )*H21S + H( 1, 3 )*H31S
-            V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) +
-     $               H( 2, 3 )*H31S
-            V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-SR1-SR2 ) +
-     $               H21S*H( 3, 2 )
-         END IF
-      END IF
-      END
diff --git a/src/lib/lapack/dlaqr2.f b/src/lib/lapack/dlaqr2.f
deleted file mode 100644
index 6ddb3309..00000000
--- a/src/lib/lapack/dlaqr2.f
+++ /dev/null
@@ -1,551 +0,0 @@
-      SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-     $                   IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
-     $                   LDT, NV, WV, LDWV, WORK, LWORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
-     $                   LDZ, LWORK, N, ND, NH, NS, NV, NW
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
-     $                   V( LDV, * ), WORK( * ), WV( LDWV, * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*     This subroutine is identical to DLAQR3 except that it avoids
-*     recursion by calling DLAHQR instead of DLAQR4.
-*
-*
-*     ******************************************************************
-*     Aggressive early deflation:
-*
-*     This subroutine accepts as input an upper Hessenberg matrix
-*     H and performs an orthogonal similarity transformation
-*     designed to detect and deflate fully converged eigenvalues from
-*     a trailing principal submatrix.  On output H has been over-
-*     written by a new Hessenberg matrix that is a perturbation of
-*     an orthogonal similarity transformation of H.  It is to be
-*     hoped that the final version of H has many zero subdiagonal
-*     entries.
-*
-*     ******************************************************************
-*     WANTT   (input) LOGICAL
-*          If .TRUE., then the Hessenberg matrix H is fully updated
-*          so that the quasi-triangular Schur factor may be
-*          computed (in cooperation with the calling subroutine).
-*          If .FALSE., then only enough of H is updated to preserve
-*          the eigenvalues.
-*
-*     WANTZ   (input) LOGICAL
-*          If .TRUE., then the orthogonal matrix Z is updated so
-*          so that the orthogonal Schur factor may be computed
-*          (in cooperation with the calling subroutine).
-*          If .FALSE., then Z is not referenced.
-*
-*     N       (input) INTEGER
-*          The order of the matrix H and (if WANTZ is .TRUE.) the
-*          order of the orthogonal matrix Z.
-*
-*     KTOP    (input) INTEGER
-*          It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
-*          KBOT and KTOP together determine an isolated block
-*          along the diagonal of the Hessenberg matrix.
-*
-*     KBOT    (input) INTEGER
-*          It is assumed without a check that either
-*          KBOT = N or H(KBOT+1,KBOT)=0.  KBOT and KTOP together
-*          determine an isolated block along the diagonal of the
-*          Hessenberg matrix.
-*
-*     NW      (input) INTEGER
-*          Deflation window size.  1 .LE. NW .LE. (KBOT-KTOP+1).
-*
-*     H       (input/output) DOUBLE PRECISION array, dimension (LDH,N)
-*          On input the initial N-by-N section of H stores the
-*          Hessenberg matrix undergoing aggressive early deflation.
-*          On output H has been transformed by an orthogonal
-*          similarity transformation, perturbed, and the returned
-*          to Hessenberg form that (it is to be hoped) has some
-*          zero subdiagonal entries.
-*
-*     LDH     (input) integer
-*          Leading dimension of H just as declared in the calling
-*          subroutine.  N .LE. LDH
-*
-*     ILOZ    (input) INTEGER
-*     IHIZ    (input) INTEGER
-*          Specify the rows of Z to which transformations must be
-*          applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
-*
-*     Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
-*          IF WANTZ is .TRUE., then on output, the orthogonal
-*          similarity transformation mentioned above has been
-*          accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*          If WANTZ is .FALSE., then Z is unreferenced.
-*
-*     LDZ     (input) integer
-*          The leading dimension of Z just as declared in the
-*          calling subroutine.  1 .LE. LDZ.
-*
-*     NS      (output) integer
-*          The number of unconverged (ie approximate) eigenvalues
-*          returned in SR and SI that may be used as shifts by the
-*          calling subroutine.
-*
-*     ND      (output) integer
-*          The number of converged eigenvalues uncovered by this
-*          subroutine.
-*
-*     SR      (output) DOUBLE PRECISION array, dimension KBOT
-*     SI      (output) DOUBLE PRECISION array, dimension KBOT
-*          On output, the real and imaginary parts of approximate
-*          eigenvalues that may be used for shifts are stored in
-*          SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
-*          SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
-*          The real and imaginary parts of converged eigenvalues
-*          are stored in SR(KBOT-ND+1) through SR(KBOT) and
-*          SI(KBOT-ND+1) through SI(KBOT), respectively.
-*
-*     V       (workspace) DOUBLE PRECISION array, dimension (LDV,NW)
-*          An NW-by-NW work array.
-*
-*     LDV     (input) integer scalar
-*          The leading dimension of V just as declared in the
-*          calling subroutine.  NW .LE. LDV
-*
-*     NH      (input) integer scalar
-*          The number of columns of T.  NH.GE.NW.
-*
-*     T       (workspace) DOUBLE PRECISION array, dimension (LDT,NW)
-*
-*     LDT     (input) integer
-*          The leading dimension of T just as declared in the
-*          calling subroutine.  NW .LE. LDT
-*
-*     NV      (input) integer
-*          The number of rows of work array WV available for
-*          workspace.  NV.GE.NW.
-*
-*     WV      (workspace) DOUBLE PRECISION array, dimension (LDWV,NW)
-*
-*     LDWV    (input) integer
-*          The leading dimension of W just as declared in the
-*          calling subroutine.  NW .LE. LDV
-*
-*     WORK    (workspace) DOUBLE PRECISION array, dimension LWORK.
-*          On exit, WORK(1) is set to an estimate of the optimal value
-*          of LWORK for the given values of N, NW, KTOP and KBOT.
-*
-*     LWORK   (input) integer
-*          The dimension of the work array WORK.  LWORK = 2*NW
-*          suffices, but greater efficiency may result from larger
-*          values of LWORK.
-*
-*          If LWORK = -1, then a workspace query is assumed; DLAQR2
-*          only estimates the optimal workspace size for the given
-*          values of N, NW, KTOP and KBOT.  The estimate is returned
-*          in WORK(1).  No error message related to LWORK is issued
-*          by XERBLA.  Neither H nor Z are accessed.
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ================================================================
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0d0, ONE = 1.0d0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S,
-     $                   SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP
-      INTEGER            I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL,
-     $                   KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2,
-     $                   LWKOPT
-      LOGICAL            BULGE, SORTED
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEHRD, DGEMM, DLABAD, DLACPY, DLAHQR,
-     $                   DLANV2, DLARF, DLARFG, DLASET, DORGHR, DTREXC
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, INT, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     ==== Estimate optimal workspace. ====
-*
-      JW = MIN( NW, KBOT-KTOP+1 )
-      IF( JW.LE.2 ) THEN
-         LWKOPT = 1
-      ELSE
-*
-*        ==== Workspace query call to DGEHRD ====
-*
-         CALL DGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
-         LWK1 = INT( WORK( 1 ) )
-*
-*        ==== Workspace query call to DORGHR ====
-*
-         CALL DORGHR( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
-         LWK2 = INT( WORK( 1 ) )
-*
-*        ==== Optimal workspace ====
-*
-         LWKOPT = JW + MAX( LWK1, LWK2 )
-      END IF
-*
-*     ==== Quick return in case of workspace query. ====
-*
-      IF( LWORK.EQ.-1 ) THEN
-         WORK( 1 ) = DBLE( LWKOPT )
-         RETURN
-      END IF
-*
-*     ==== Nothing to do ...
-*     ... for an empty active block ... ====
-      NS = 0
-      ND = 0
-      IF( KTOP.GT.KBOT )
-     $   RETURN
-*     ... nor for an empty deflation window. ====
-      IF( NW.LT.1 )
-     $   RETURN
-*
-*     ==== Machine constants ====
-*
-      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
-      SAFMAX = ONE / SAFMIN
-      CALL DLABAD( SAFMIN, SAFMAX )
-      ULP = DLAMCH( 'PRECISION' )
-      SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-*     ==== Setup deflation window ====
-*
-      JW = MIN( NW, KBOT-KTOP+1 )
-      KWTOP = KBOT - JW + 1
-      IF( KWTOP.EQ.KTOP ) THEN
-         S = ZERO
-      ELSE
-         S = H( KWTOP, KWTOP-1 )
-      END IF
-*
-      IF( KBOT.EQ.KWTOP ) THEN
-*
-*        ==== 1-by-1 deflation window: not much to do ====
-*
-         SR( KWTOP ) = H( KWTOP, KWTOP )
-         SI( KWTOP ) = ZERO
-         NS = 1
-         ND = 0
-         IF( ABS( S ).LE.MAX( SMLNUM, ULP*ABS( H( KWTOP, KWTOP ) ) ) )
-     $        THEN
-            NS = 0
-            ND = 1
-            IF( KWTOP.GT.KTOP )
-     $         H( KWTOP, KWTOP-1 ) = ZERO
-         END IF
-         RETURN
-      END IF
-*
-*     ==== Convert to spike-triangular form.  (In case of a
-*     .    rare QR failure, this routine continues to do
-*     .    aggressive early deflation using that part of
-*     .    the deflation window that converged using INFQR
-*     .    here and there to keep track.) ====
-*
-      CALL DLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
-      CALL DCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
-*
-      CALL DLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
-      CALL DLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
-     $             SI( KWTOP ), 1, JW, V, LDV, INFQR )
-*
-*     ==== DTREXC needs a clean margin near the diagonal ====
-*
-      DO 10 J = 1, JW - 3
-         T( J+2, J ) = ZERO
-         T( J+3, J ) = ZERO
-   10 CONTINUE
-      IF( JW.GT.2 )
-     $   T( JW, JW-2 ) = ZERO
-*
-*     ==== Deflation detection loop ====
-*
-      NS = JW
-      ILST = INFQR + 1
-   20 CONTINUE
-      IF( ILST.LE.NS ) THEN
-         IF( NS.EQ.1 ) THEN
-            BULGE = .FALSE.
-         ELSE
-            BULGE = T( NS, NS-1 ).NE.ZERO
-         END IF
-*
-*        ==== Small spike tip test for deflation ====
-*
-         IF( .NOT.BULGE ) THEN
-*
-*           ==== Real eigenvalue ====
-*
-            FOO = ABS( T( NS, NS ) )
-            IF( FOO.EQ.ZERO )
-     $         FOO = ABS( S )
-            IF( ABS( S*V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-*              ==== Deflatable ====
-*
-               NS = NS - 1
-            ELSE
-*
-*              ==== Undeflatable.   Move it up out of the way.
-*              .    (DTREXC can not fail in this case.) ====
-*
-               IFST = NS
-               CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
-     $                      INFO )
-               ILST = ILST + 1
-            END IF
-         ELSE
-*
-*           ==== Complex conjugate pair ====
-*
-            FOO = ABS( T( NS, NS ) ) + SQRT( ABS( T( NS, NS-1 ) ) )*
-     $            SQRT( ABS( T( NS-1, NS ) ) )
-            IF( FOO.EQ.ZERO )
-     $         FOO = ABS( S )
-            IF( MAX( ABS( S*V( 1, NS ) ), ABS( S*V( 1, NS-1 ) ) ).LE.
-     $          MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-*              ==== Deflatable ====
-*
-               NS = NS - 2
-            ELSE
-*
-*              ==== Undflatable. Move them up out of the way.
-*              .    Fortunately, DTREXC does the right thing with
-*              .    ILST in case of a rare exchange failure. ====
-*
-               IFST = NS
-               CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
-     $                      INFO )
-               ILST = ILST + 2
-            END IF
-         END IF
-*
-*        ==== End deflation detection loop ====
-*
-         GO TO 20
-      END IF
-*
-*        ==== Return to Hessenberg form ====
-*
-      IF( NS.EQ.0 )
-     $   S = ZERO
-*
-      IF( NS.LT.JW ) THEN
-*
-*        ==== sorting diagonal blocks of T improves accuracy for
-*        .    graded matrices.  Bubble sort deals well with
-*        .    exchange failures. ====
-*
-         SORTED = .false.
-         I = NS + 1
-   30    CONTINUE
-         IF( SORTED )
-     $      GO TO 50
-         SORTED = .true.
-*
-         KEND = I - 1
-         I = INFQR + 1
-         IF( I.EQ.NS ) THEN
-            K = I + 1
-         ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
-            K = I + 1
-         ELSE
-            K = I + 2
-         END IF
-   40    CONTINUE
-         IF( K.LE.KEND ) THEN
-            IF( K.EQ.I+1 ) THEN
-               EVI = ABS( T( I, I ) )
-            ELSE
-               EVI = ABS( T( I, I ) ) + SQRT( ABS( T( I+1, I ) ) )*
-     $               SQRT( ABS( T( I, I+1 ) ) )
-            END IF
-*
-            IF( K.EQ.KEND ) THEN
-               EVK = ABS( T( K, K ) )
-            ELSE IF( T( K+1, K ).EQ.ZERO ) THEN
-               EVK = ABS( T( K, K ) )
-            ELSE
-               EVK = ABS( T( K, K ) ) + SQRT( ABS( T( K+1, K ) ) )*
-     $               SQRT( ABS( T( K, K+1 ) ) )
-            END IF
-*
-            IF( EVI.GE.EVK ) THEN
-               I = K
-            ELSE
-               SORTED = .false.
-               IFST = I
-               ILST = K
-               CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
-     $                      INFO )
-               IF( INFO.EQ.0 ) THEN
-                  I = ILST
-               ELSE
-                  I = K
-               END IF
-            END IF
-            IF( I.EQ.KEND ) THEN
-               K = I + 1
-            ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
-               K = I + 1
-            ELSE
-               K = I + 2
-            END IF
-            GO TO 40
-         END IF
-         GO TO 30
-   50    CONTINUE
-      END IF
-*
-*     ==== Restore shift/eigenvalue array from T ====
-*
-      I = JW
-   60 CONTINUE
-      IF( I.GE.INFQR+1 ) THEN
-         IF( I.EQ.INFQR+1 ) THEN
-            SR( KWTOP+I-1 ) = T( I, I )
-            SI( KWTOP+I-1 ) = ZERO
-            I = I - 1
-         ELSE IF( T( I, I-1 ).EQ.ZERO ) THEN
-            SR( KWTOP+I-1 ) = T( I, I )
-            SI( KWTOP+I-1 ) = ZERO
-            I = I - 1
-         ELSE
-            AA = T( I-1, I-1 )
-            CC = T( I, I-1 )
-            BB = T( I-1, I )
-            DD = T( I, I )
-            CALL DLANV2( AA, BB, CC, DD, SR( KWTOP+I-2 ),
-     $                   SI( KWTOP+I-2 ), SR( KWTOP+I-1 ),
-     $                   SI( KWTOP+I-1 ), CS, SN )
-            I = I - 2
-         END IF
-         GO TO 60
-      END IF
-*
-      IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
-         IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-*
-*           ==== Reflect spike back into lower triangle ====
-*
-            CALL DCOPY( NS, V, LDV, WORK, 1 )
-            BETA = WORK( 1 )
-            CALL DLARFG( NS, BETA, WORK( 2 ), 1, TAU )
-            WORK( 1 ) = ONE
-*
-            CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
-*
-            CALL DLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT,
-     $                  WORK( JW+1 ) )
-            CALL DLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
-     $                  WORK( JW+1 ) )
-            CALL DLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
-     $                  WORK( JW+1 ) )
-*
-            CALL DGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
-     $                   LWORK-JW, INFO )
-         END IF
-*
-*        ==== Copy updated reduced window into place ====
-*
-         IF( KWTOP.GT.1 )
-     $      H( KWTOP, KWTOP-1 ) = S*V( 1, 1 )
-         CALL DLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
-         CALL DCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
-     $               LDH+1 )
-*
-*        ==== Accumulate orthogonal matrix in order update
-*        .    H and Z, if requested.  (A modified version
-*        .    of  DORGHR that accumulates block Householder
-*        .    transformations into V directly might be
-*        .    marginally more efficient than the following.) ====
-*
-         IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-            CALL DORGHR( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
-     $                   LWORK-JW, INFO )
-            CALL DGEMM( 'N', 'N', JW, NS, NS, ONE, V, LDV, T, LDT, ZERO,
-     $                  WV, LDWV )
-            CALL DLACPY( 'A', JW, NS, WV, LDWV, V, LDV )
-         END IF
-*
-*        ==== Update vertical slab in H ====
-*
-         IF( WANTT ) THEN
-            LTOP = 1
-         ELSE
-            LTOP = KTOP
-         END IF
-         DO 70 KROW = LTOP, KWTOP - 1, NV
-            KLN = MIN( NV, KWTOP-KROW )
-            CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
-     $                  LDH, V, LDV, ZERO, WV, LDWV )
-            CALL DLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
-   70    CONTINUE
-*
-*        ==== Update horizontal slab in H ====
-*
-         IF( WANTT ) THEN
-            DO 80 KCOL = KBOT + 1, N, NH
-               KLN = MIN( NH, N-KCOL+1 )
-               CALL DGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
-     $                     H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
-               CALL DLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
-     $                      LDH )
-   80       CONTINUE
-         END IF
-*
-*        ==== Update vertical slab in Z ====
-*
-         IF( WANTZ ) THEN
-            DO 90 KROW = ILOZ, IHIZ, NV
-               KLN = MIN( NV, IHIZ-KROW+1 )
-               CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
-     $                     LDZ, V, LDV, ZERO, WV, LDWV )
-               CALL DLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
-     $                      LDZ )
-   90       CONTINUE
-         END IF
-      END IF
-*
-*     ==== Return the number of deflations ... ====
-*
-      ND = JW - NS
-*
-*     ==== ... and the number of shifts. (Subtracting
-*     .    INFQR from the spike length takes care
-*     .    of the case of a rare QR failure while
-*     .    calculating eigenvalues of the deflation
-*     .    window.)  ====
-*
-      NS = NS - INFQR
-*
-*      ==== Return optimal workspace. ====
-*
-      WORK( 1 ) = DBLE( LWKOPT )
-*
-*     ==== End of DLAQR2 ====
-*
-      END
diff --git a/src/lib/lapack/dlaqr3.f b/src/lib/lapack/dlaqr3.f
deleted file mode 100644
index 877b267a..00000000
--- a/src/lib/lapack/dlaqr3.f
+++ /dev/null
@@ -1,561 +0,0 @@
-      SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-     $                   IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
-     $                   LDT, NV, WV, LDWV, WORK, LWORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
-     $                   LDZ, LWORK, N, ND, NH, NS, NV, NW
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
-     $                   V( LDV, * ), WORK( * ), WV( LDWV, * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*     ******************************************************************
-*     Aggressive early deflation:
-*
-*     This subroutine accepts as input an upper Hessenberg matrix
-*     H and performs an orthogonal similarity transformation
-*     designed to detect and deflate fully converged eigenvalues from
-*     a trailing principal submatrix.  On output H has been over-
-*     written by a new Hessenberg matrix that is a perturbation of
-*     an orthogonal similarity transformation of H.  It is to be
-*     hoped that the final version of H has many zero subdiagonal
-*     entries.
-*
-*     ******************************************************************
-*     WANTT   (input) LOGICAL
-*          If .TRUE., then the Hessenberg matrix H is fully updated
-*          so that the quasi-triangular Schur factor may be
-*          computed (in cooperation with the calling subroutine).
-*          If .FALSE., then only enough of H is updated to preserve
-*          the eigenvalues.
-*
-*     WANTZ   (input) LOGICAL
-*          If .TRUE., then the orthogonal matrix Z is updated so
-*          so that the orthogonal Schur factor may be computed
-*          (in cooperation with the calling subroutine).
-*          If .FALSE., then Z is not referenced.
-*
-*     N       (input) INTEGER
-*          The order of the matrix H and (if WANTZ is .TRUE.) the
-*          order of the orthogonal matrix Z.
-*
-*     KTOP    (input) INTEGER
-*          It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
-*          KBOT and KTOP together determine an isolated block
-*          along the diagonal of the Hessenberg matrix.
-*
-*     KBOT    (input) INTEGER
-*          It is assumed without a check that either
-*          KBOT = N or H(KBOT+1,KBOT)=0.  KBOT and KTOP together
-*          determine an isolated block along the diagonal of the
-*          Hessenberg matrix.
-*
-*     NW      (input) INTEGER
-*          Deflation window size.  1 .LE. NW .LE. (KBOT-KTOP+1).
-*
-*     H       (input/output) DOUBLE PRECISION array, dimension (LDH,N)
-*          On input the initial N-by-N section of H stores the
-*          Hessenberg matrix undergoing aggressive early deflation.
-*          On output H has been transformed by an orthogonal
-*          similarity transformation, perturbed, and the returned
-*          to Hessenberg form that (it is to be hoped) has some
-*          zero subdiagonal entries.
-*
-*     LDH     (input) integer
-*          Leading dimension of H just as declared in the calling
-*          subroutine.  N .LE. LDH
-*
-*     ILOZ    (input) INTEGER
-*     IHIZ    (input) INTEGER
-*          Specify the rows of Z to which transformations must be
-*          applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
-*
-*     Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
-*          IF WANTZ is .TRUE., then on output, the orthogonal
-*          similarity transformation mentioned above has been
-*          accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*          If WANTZ is .FALSE., then Z is unreferenced.
-*
-*     LDZ     (input) integer
-*          The leading dimension of Z just as declared in the
-*          calling subroutine.  1 .LE. LDZ.
-*
-*     NS      (output) integer
-*          The number of unconverged (ie approximate) eigenvalues
-*          returned in SR and SI that may be used as shifts by the
-*          calling subroutine.
-*
-*     ND      (output) integer
-*          The number of converged eigenvalues uncovered by this
-*          subroutine.
-*
-*     SR      (output) DOUBLE PRECISION array, dimension KBOT
-*     SI      (output) DOUBLE PRECISION array, dimension KBOT
-*          On output, the real and imaginary parts of approximate
-*          eigenvalues that may be used for shifts are stored in
-*          SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
-*          SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
-*          The real and imaginary parts of converged eigenvalues
-*          are stored in SR(KBOT-ND+1) through SR(KBOT) and
-*          SI(KBOT-ND+1) through SI(KBOT), respectively.
-*
-*     V       (workspace) DOUBLE PRECISION array, dimension (LDV,NW)
-*          An NW-by-NW work array.
-*
-*     LDV     (input) integer scalar
-*          The leading dimension of V just as declared in the
-*          calling subroutine.  NW .LE. LDV
-*
-*     NH      (input) integer scalar
-*          The number of columns of T.  NH.GE.NW.
-*
-*     T       (workspace) DOUBLE PRECISION array, dimension (LDT,NW)
-*
-*     LDT     (input) integer
-*          The leading dimension of T just as declared in the
-*          calling subroutine.  NW .LE. LDT
-*
-*     NV      (input) integer
-*          The number of rows of work array WV available for
-*          workspace.  NV.GE.NW.
-*
-*     WV      (workspace) DOUBLE PRECISION array, dimension (LDWV,NW)
-*
-*     LDWV    (input) integer
-*          The leading dimension of W just as declared in the
-*          calling subroutine.  NW .LE. LDV
-*
-*     WORK    (workspace) DOUBLE PRECISION array, dimension LWORK.
-*          On exit, WORK(1) is set to an estimate of the optimal value
-*          of LWORK for the given values of N, NW, KTOP and KBOT.
-*
-*     LWORK   (input) integer
-*          The dimension of the work array WORK.  LWORK = 2*NW
-*          suffices, but greater efficiency may result from larger
-*          values of LWORK.
-*
-*          If LWORK = -1, then a workspace query is assumed; DLAQR3
-*          only estimates the optimal workspace size for the given
-*          values of N, NW, KTOP and KBOT.  The estimate is returned
-*          in WORK(1).  No error message related to LWORK is issued
-*          by XERBLA.  Neither H nor Z are accessed.
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ==================================================================
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0d0, ONE = 1.0d0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S,
-     $                   SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP
-      INTEGER            I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL,
-     $                   KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3,
-     $                   LWKOPT, NMIN
-      LOGICAL            BULGE, SORTED
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      INTEGER            ILAENV
-      EXTERNAL           DLAMCH, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEHRD, DGEMM, DLABAD, DLACPY, DLAHQR,
-     $                   DLANV2, DLAQR4, DLARF, DLARFG, DLASET, DORGHR,
-     $                   DTREXC
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, INT, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     ==== Estimate optimal workspace. ====
-*
-      JW = MIN( NW, KBOT-KTOP+1 )
-      IF( JW.LE.2 ) THEN
-         LWKOPT = 1
-      ELSE
-*
-*        ==== Workspace query call to DGEHRD ====
-*
-         CALL DGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
-         LWK1 = INT( WORK( 1 ) )
-*
-*        ==== Workspace query call to DORGHR ====
-*
-         CALL DORGHR( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
-         LWK2 = INT( WORK( 1 ) )
-*
-*        ==== Workspace query call to DLAQR4 ====
-*
-         CALL DLAQR4( .true., .true., JW, 1, JW, T, LDT, SR, SI, 1, JW,
-     $                V, LDV, WORK, -1, INFQR )
-         LWK3 = INT( WORK( 1 ) )
-*
-*        ==== Optimal workspace ====
-*
-         LWKOPT = MAX( JW+MAX( LWK1, LWK2 ), LWK3 )
-      END IF
-*
-*     ==== Quick return in case of workspace query. ====
-*
-      IF( LWORK.EQ.-1 ) THEN
-         WORK( 1 ) = DBLE( LWKOPT )
-         RETURN
-      END IF
-*
-*     ==== Nothing to do ...
-*     ... for an empty active block ... ====
-      NS = 0
-      ND = 0
-      IF( KTOP.GT.KBOT )
-     $   RETURN
-*     ... nor for an empty deflation window. ====
-      IF( NW.LT.1 )
-     $   RETURN
-*
-*     ==== Machine constants ====
-*
-      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
-      SAFMAX = ONE / SAFMIN
-      CALL DLABAD( SAFMIN, SAFMAX )
-      ULP = DLAMCH( 'PRECISION' )
-      SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-*     ==== Setup deflation window ====
-*
-      JW = MIN( NW, KBOT-KTOP+1 )
-      KWTOP = KBOT - JW + 1
-      IF( KWTOP.EQ.KTOP ) THEN
-         S = ZERO
-      ELSE
-         S = H( KWTOP, KWTOP-1 )
-      END IF
-*
-      IF( KBOT.EQ.KWTOP ) THEN
-*
-*        ==== 1-by-1 deflation window: not much to do ====
-*
-         SR( KWTOP ) = H( KWTOP, KWTOP )
-         SI( KWTOP ) = ZERO
-         NS = 1
-         ND = 0
-         IF( ABS( S ).LE.MAX( SMLNUM, ULP*ABS( H( KWTOP, KWTOP ) ) ) )
-     $        THEN
-            NS = 0
-            ND = 1
-            IF( KWTOP.GT.KTOP )
-     $         H( KWTOP, KWTOP-1 ) = ZERO
-         END IF
-         RETURN
-      END IF
-*
-*     ==== Convert to spike-triangular form.  (In case of a
-*     .    rare QR failure, this routine continues to do
-*     .    aggressive early deflation using that part of
-*     .    the deflation window that converged using INFQR
-*     .    here and there to keep track.) ====
-*
-      CALL DLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
-      CALL DCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
-*
-      CALL DLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
-      NMIN = ILAENV( 12, 'DLAQR3', 'SV', JW, 1, JW, LWORK )
-      IF( JW.GT.NMIN ) THEN
-         CALL DLAQR4( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
-     $                SI( KWTOP ), 1, JW, V, LDV, WORK, LWORK, INFQR )
-      ELSE
-         CALL DLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ),
-     $                SI( KWTOP ), 1, JW, V, LDV, INFQR )
-      END IF
-*
-*     ==== DTREXC needs a clean margin near the diagonal ====
-*
-      DO 10 J = 1, JW - 3
-         T( J+2, J ) = ZERO
-         T( J+3, J ) = ZERO
-   10 CONTINUE
-      IF( JW.GT.2 )
-     $   T( JW, JW-2 ) = ZERO
-*
-*     ==== Deflation detection loop ====
-*
-      NS = JW
-      ILST = INFQR + 1
-   20 CONTINUE
-      IF( ILST.LE.NS ) THEN
-         IF( NS.EQ.1 ) THEN
-            BULGE = .FALSE.
-         ELSE
-            BULGE = T( NS, NS-1 ).NE.ZERO
-         END IF
-*
-*        ==== Small spike tip test for deflation ====
-*
-         IF( .NOT.BULGE ) THEN
-*
-*           ==== Real eigenvalue ====
-*
-            FOO = ABS( T( NS, NS ) )
-            IF( FOO.EQ.ZERO )
-     $         FOO = ABS( S )
-            IF( ABS( S*V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-*              ==== Deflatable ====
-*
-               NS = NS - 1
-            ELSE
-*
-*              ==== Undeflatable.   Move it up out of the way.
-*              .    (DTREXC can not fail in this case.) ====
-*
-               IFST = NS
-               CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
-     $                      INFO )
-               ILST = ILST + 1
-            END IF
-         ELSE
-*
-*           ==== Complex conjugate pair ====
-*
-            FOO = ABS( T( NS, NS ) ) + SQRT( ABS( T( NS, NS-1 ) ) )*
-     $            SQRT( ABS( T( NS-1, NS ) ) )
-            IF( FOO.EQ.ZERO )
-     $         FOO = ABS( S )
-            IF( MAX( ABS( S*V( 1, NS ) ), ABS( S*V( 1, NS-1 ) ) ).LE.
-     $          MAX( SMLNUM, ULP*FOO ) ) THEN
-*
-*              ==== Deflatable ====
-*
-               NS = NS - 2
-            ELSE
-*
-*              ==== Undflatable. Move them up out of the way.
-*              .    Fortunately, DTREXC does the right thing with
-*              .    ILST in case of a rare exchange failure. ====
-*
-               IFST = NS
-               CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
-     $                      INFO )
-               ILST = ILST + 2
-            END IF
-         END IF
-*
-*        ==== End deflation detection loop ====
-*
-         GO TO 20
-      END IF
-*
-*        ==== Return to Hessenberg form ====
-*
-      IF( NS.EQ.0 )
-     $   S = ZERO
-*
-      IF( NS.LT.JW ) THEN
-*
-*        ==== sorting diagonal blocks of T improves accuracy for
-*        .    graded matrices.  Bubble sort deals well with
-*        .    exchange failures. ====
-*
-         SORTED = .false.
-         I = NS + 1
-   30    CONTINUE
-         IF( SORTED )
-     $      GO TO 50
-         SORTED = .true.
-*
-         KEND = I - 1
-         I = INFQR + 1
-         IF( I.EQ.NS ) THEN
-            K = I + 1
-         ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
-            K = I + 1
-         ELSE
-            K = I + 2
-         END IF
-   40    CONTINUE
-         IF( K.LE.KEND ) THEN
-            IF( K.EQ.I+1 ) THEN
-               EVI = ABS( T( I, I ) )
-            ELSE
-               EVI = ABS( T( I, I ) ) + SQRT( ABS( T( I+1, I ) ) )*
-     $               SQRT( ABS( T( I, I+1 ) ) )
-            END IF
-*
-            IF( K.EQ.KEND ) THEN
-               EVK = ABS( T( K, K ) )
-            ELSE IF( T( K+1, K ).EQ.ZERO ) THEN
-               EVK = ABS( T( K, K ) )
-            ELSE
-               EVK = ABS( T( K, K ) ) + SQRT( ABS( T( K+1, K ) ) )*
-     $               SQRT( ABS( T( K, K+1 ) ) )
-            END IF
-*
-            IF( EVI.GE.EVK ) THEN
-               I = K
-            ELSE
-               SORTED = .false.
-               IFST = I
-               ILST = K
-               CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK,
-     $                      INFO )
-               IF( INFO.EQ.0 ) THEN
-                  I = ILST
-               ELSE
-                  I = K
-               END IF
-            END IF
-            IF( I.EQ.KEND ) THEN
-               K = I + 1
-            ELSE IF( T( I+1, I ).EQ.ZERO ) THEN
-               K = I + 1
-            ELSE
-               K = I + 2
-            END IF
-            GO TO 40
-         END IF
-         GO TO 30
-   50    CONTINUE
-      END IF
-*
-*     ==== Restore shift/eigenvalue array from T ====
-*
-      I = JW
-   60 CONTINUE
-      IF( I.GE.INFQR+1 ) THEN
-         IF( I.EQ.INFQR+1 ) THEN
-            SR( KWTOP+I-1 ) = T( I, I )
-            SI( KWTOP+I-1 ) = ZERO
-            I = I - 1
-         ELSE IF( T( I, I-1 ).EQ.ZERO ) THEN
-            SR( KWTOP+I-1 ) = T( I, I )
-            SI( KWTOP+I-1 ) = ZERO
-            I = I - 1
-         ELSE
-            AA = T( I-1, I-1 )
-            CC = T( I, I-1 )
-            BB = T( I-1, I )
-            DD = T( I, I )
-            CALL DLANV2( AA, BB, CC, DD, SR( KWTOP+I-2 ),
-     $                   SI( KWTOP+I-2 ), SR( KWTOP+I-1 ),
-     $                   SI( KWTOP+I-1 ), CS, SN )
-            I = I - 2
-         END IF
-         GO TO 60
-      END IF
-*
-      IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
-         IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-*
-*           ==== Reflect spike back into lower triangle ====
-*
-            CALL DCOPY( NS, V, LDV, WORK, 1 )
-            BETA = WORK( 1 )
-            CALL DLARFG( NS, BETA, WORK( 2 ), 1, TAU )
-            WORK( 1 ) = ONE
-*
-            CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
-*
-            CALL DLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT,
-     $                  WORK( JW+1 ) )
-            CALL DLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
-     $                  WORK( JW+1 ) )
-            CALL DLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
-     $                  WORK( JW+1 ) )
-*
-            CALL DGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
-     $                   LWORK-JW, INFO )
-         END IF
-*
-*        ==== Copy updated reduced window into place ====
-*
-         IF( KWTOP.GT.1 )
-     $      H( KWTOP, KWTOP-1 ) = S*V( 1, 1 )
-         CALL DLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
-         CALL DCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
-     $               LDH+1 )
-*
-*        ==== Accumulate orthogonal matrix in order update
-*        .    H and Z, if requested.  (A modified version
-*        .    of  DORGHR that accumulates block Householder
-*        .    transformations into V directly might be
-*        .    marginally more efficient than the following.) ====
-*
-         IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-            CALL DORGHR( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
-     $                   LWORK-JW, INFO )
-            CALL DGEMM( 'N', 'N', JW, NS, NS, ONE, V, LDV, T, LDT, ZERO,
-     $                  WV, LDWV )
-            CALL DLACPY( 'A', JW, NS, WV, LDWV, V, LDV )
-         END IF
-*
-*        ==== Update vertical slab in H ====
-*
-         IF( WANTT ) THEN
-            LTOP = 1
-         ELSE
-            LTOP = KTOP
-         END IF
-         DO 70 KROW = LTOP, KWTOP - 1, NV
-            KLN = MIN( NV, KWTOP-KROW )
-            CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
-     $                  LDH, V, LDV, ZERO, WV, LDWV )
-            CALL DLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
-   70    CONTINUE
-*
-*        ==== Update horizontal slab in H ====
-*
-         IF( WANTT ) THEN
-            DO 80 KCOL = KBOT + 1, N, NH
-               KLN = MIN( NH, N-KCOL+1 )
-               CALL DGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
-     $                     H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
-               CALL DLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
-     $                      LDH )
-   80       CONTINUE
-         END IF
-*
-*        ==== Update vertical slab in Z ====
-*
-         IF( WANTZ ) THEN
-            DO 90 KROW = ILOZ, IHIZ, NV
-               KLN = MIN( NV, IHIZ-KROW+1 )
-               CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
-     $                     LDZ, V, LDV, ZERO, WV, LDWV )
-               CALL DLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
-     $                      LDZ )
-   90       CONTINUE
-         END IF
-      END IF
-*
-*     ==== Return the number of deflations ... ====
-*
-      ND = JW - NS
-*
-*     ==== ... and the number of shifts. (Subtracting
-*     .    INFQR from the spike length takes care
-*     .    of the case of a rare QR failure while
-*     .    calculating eigenvalues of the deflation
-*     .    window.)  ====
-*
-      NS = NS - INFQR
-*
-*      ==== Return optimal workspace. ====
-*
-      WORK( 1 ) = DBLE( LWKOPT )
-*
-*     ==== End of DLAQR3 ====
-*
-      END
diff --git a/src/lib/lapack/dlaqr4.f b/src/lib/lapack/dlaqr4.f
deleted file mode 100644
index 8692e7f9..00000000
--- a/src/lib/lapack/dlaqr4.f
+++ /dev/null
@@ -1,640 +0,0 @@
-      SUBROUTINE DLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-     $                   ILOZ, IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   H( LDH, * ), WI( * ), WORK( * ), WR( * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*     This subroutine implements one level of recursion for DLAQR0.
-*     It is a complete implementation of the small bulge multi-shift
-*     QR algorithm.  It may be called by DLAQR0 and, for large enough
-*     deflation window size, it may be called by DLAQR3.  This
-*     subroutine is identical to DLAQR0 except that it calls DLAQR2
-*     instead of DLAQR3.
-*
-*     Purpose
-*     =======
-*
-*     DLAQR4 computes the eigenvalues of a Hessenberg matrix H
-*     and, optionally, the matrices T and Z from the Schur decomposition
-*     H = Z T Z**T, where T is an upper quasi-triangular matrix (the
-*     Schur form), and Z is the orthogonal matrix of Schur vectors.
-*
-*     Optionally Z may be postmultiplied into an input orthogonal
-*     matrix Q so that this routine can give the Schur factorization
-*     of a matrix A which has been reduced to the Hessenberg form H
-*     by the orthogonal matrix Q:  A = Q*H*Q**T = (QZ)*T*(QZ)**T.
-*
-*     Arguments
-*     =========
-*
-*     WANTT   (input) LOGICAL
-*          = .TRUE. : the full Schur form T is required;
-*          = .FALSE.: only eigenvalues are required.
-*
-*     WANTZ   (input) LOGICAL
-*          = .TRUE. : the matrix of Schur vectors Z is required;
-*          = .FALSE.: Schur vectors are not required.
-*
-*     N     (input) INTEGER
-*           The order of the matrix H.  N .GE. 0.
-*
-*     ILO   (input) INTEGER
-*     IHI   (input) INTEGER
-*           It is assumed that H is already upper triangular in rows
-*           and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
-*           H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
-*           previous call to DGEBAL, and then passed to DGEHRD when the
-*           matrix output by DGEBAL is reduced to Hessenberg form.
-*           Otherwise, ILO and IHI should be set to 1 and N,
-*           respectively.  If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*           If N = 0, then ILO = 1 and IHI = 0.
-*
-*     H     (input/output) DOUBLE PRECISION array, dimension (LDH,N)
-*           On entry, the upper Hessenberg matrix H.
-*           On exit, if INFO = 0 and WANTT is .TRUE., then H contains
-*           the upper quasi-triangular matrix T from the Schur
-*           decomposition (the Schur form); 2-by-2 diagonal blocks
-*           (corresponding to complex conjugate pairs of eigenvalues)
-*           are returned in standard form, with H(i,i) = H(i+1,i+1)
-*           and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is
-*           .FALSE., then the contents of H are unspecified on exit.
-*           (The output value of H when INFO.GT.0 is given under the
-*           description of INFO below.)
-*
-*           This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
-*           j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
-*
-*     LDH   (input) INTEGER
-*           The leading dimension of the array H. LDH .GE. max(1,N).
-*
-*     WR    (output) DOUBLE PRECISION array, dimension (IHI)
-*     WI    (output) DOUBLE PRECISION array, dimension (IHI)
-*           The real and imaginary parts, respectively, of the computed
-*           eigenvalues of H(ILO:IHI,ILO:IHI) are stored WR(ILO:IHI)
-*           and WI(ILO:IHI). If two eigenvalues are computed as a
-*           complex conjugate pair, they are stored in consecutive
-*           elements of WR and WI, say the i-th and (i+1)th, with
-*           WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then
-*           the eigenvalues are stored in the same order as on the
-*           diagonal of the Schur form returned in H, with
-*           WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal
-*           block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
-*           WI(i+1) = -WI(i).
-*
-*     ILOZ     (input) INTEGER
-*     IHIZ     (input) INTEGER
-*           Specify the rows of Z to which transformations must be
-*           applied if WANTZ is .TRUE..
-*           1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N.
-*
-*     Z     (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
-*           If WANTZ is .FALSE., then Z is not referenced.
-*           If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
-*           replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
-*           orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
-*           (The output value of Z when INFO.GT.0 is given under
-*           the description of INFO below.)
-*
-*     LDZ   (input) INTEGER
-*           The leading dimension of the array Z.  if WANTZ is .TRUE.
-*           then LDZ.GE.MAX(1,IHIZ).  Otherwize, LDZ.GE.1.
-*
-*     WORK  (workspace/output) DOUBLE PRECISION array, dimension LWORK
-*           On exit, if LWORK = -1, WORK(1) returns an estimate of
-*           the optimal value for LWORK.
-*
-*     LWORK (input) INTEGER
-*           The dimension of the array WORK.  LWORK .GE. max(1,N)
-*           is sufficient, but LWORK typically as large as 6*N may
-*           be required for optimal performance.  A workspace query
-*           to determine the optimal workspace size is recommended.
-*
-*           If LWORK = -1, then DLAQR4 does a workspace query.
-*           In this case, DLAQR4 checks the input parameters and
-*           estimates the optimal workspace size for the given
-*           values of N, ILO and IHI.  The estimate is returned
-*           in WORK(1).  No error message related to LWORK is
-*           issued by XERBLA.  Neither H nor Z are accessed.
-*
-*
-*     INFO  (output) INTEGER
-*             =  0:  successful exit
-*           .GT. 0:  if INFO = i, DLAQR4 failed to compute all of
-*                the eigenvalues.  Elements 1:ilo-1 and i+1:n of WR
-*                and WI contain those eigenvalues which have been
-*                successfully computed.  (Failures are rare.)
-*
-*                If INFO .GT. 0 and WANT is .FALSE., then on exit,
-*                the remaining unconverged eigenvalues are the eigen-
-*                values of the upper Hessenberg matrix rows and
-*                columns ILO through INFO of the final, output
-*                value of H.
-*
-*                If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*
-*           (*)  (initial value of H)*U  = U*(final value of H)
-*
-*                where U is an orthogonal matrix.  The final
-*                value of H is upper Hessenberg and quasi-triangular
-*                in rows and columns INFO+1 through IHI.
-*
-*                If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*
-*                  (final value of Z(ILO:IHI,ILOZ:IHIZ)
-*                   =  (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
-*
-*                where U is the orthogonal matrix in (*) (regard-
-*                less of the value of WANTT.)
-*
-*                If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
-*                accessed.
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ================================================================
-*     References:
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*       Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*       929--947, 2002.
-*
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*       of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-*     ================================================================
-*     .. Parameters ..
-*
-*     ==== Matrices of order NTINY or smaller must be processed by
-*     .    DLAHQR because of insufficient subdiagonal scratch space.
-*     .    (This is a hard limit.) ====
-*
-*     ==== Exceptional deflation windows:  try to cure rare
-*     .    slow convergence by increasing the size of the
-*     .    deflation window after KEXNW iterations. =====
-*
-*     ==== Exceptional shifts: try to cure rare slow convergence
-*     .    with ad-hoc exceptional shifts every KEXSH iterations.
-*     .    The constants WILK1 and WILK2 are used to form the
-*     .    exceptional shifts. ====
-*
-      INTEGER            NTINY
-      PARAMETER          ( NTINY = 11 )
-      INTEGER            KEXNW, KEXSH
-      PARAMETER          ( KEXNW = 5, KEXSH = 6 )
-      DOUBLE PRECISION   WILK1, WILK2
-      PARAMETER          ( WILK1 = 0.75d0, WILK2 = -0.4375d0 )
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0d0, ONE = 1.0d0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   AA, BB, CC, CS, DD, SN, SS, SWAP
-      INTEGER            I, INF, IT, ITMAX, K, KACC22, KBOT, KDU, KS,
-     $                   KT, KTOP, KU, KV, KWH, KWTOP, KWV, LD, LS,
-     $                   LWKOPT, NDFL, NH, NHO, NIBBLE, NMIN, NS, NSMAX,
-     $                   NSR, NVE, NW, NWMAX, NWR
-      LOGICAL            NWINC, SORTED
-      CHARACTER          JBCMPZ*2
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   ZDUM( 1, 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLACPY, DLAHQR, DLANV2, DLAQR2, DLAQR5
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, INT, MAX, MIN, MOD
-*     ..
-*     .. Executable Statements ..
-      INFO = 0
-*
-*     ==== Quick return for N = 0: nothing to do. ====
-*
-      IF( N.EQ.0 ) THEN
-         WORK( 1 ) = ONE
-         RETURN
-      END IF
-*
-*     ==== Set up job flags for ILAENV. ====
-*
-      IF( WANTT ) THEN
-         JBCMPZ( 1: 1 ) = 'S'
-      ELSE
-         JBCMPZ( 1: 1 ) = 'E'
-      END IF
-      IF( WANTZ ) THEN
-         JBCMPZ( 2: 2 ) = 'V'
-      ELSE
-         JBCMPZ( 2: 2 ) = 'N'
-      END IF
-*
-*     ==== Tiny matrices must use DLAHQR. ====
-*
-      IF( N.LE.NTINY ) THEN
-*
-*        ==== Estimate optimal workspace. ====
-*
-         LWKOPT = 1
-         IF( LWORK.NE.-1 )
-     $      CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-     $                   ILOZ, IHIZ, Z, LDZ, INFO )
-      ELSE
-*
-*        ==== Use small bulge multi-shift QR with aggressive early
-*        .    deflation on larger-than-tiny matrices. ====
-*
-*        ==== Hope for the best. ====
-*
-         INFO = 0
-*
-*        ==== NWR = recommended deflation window size.  At this
-*        .    point,  N .GT. NTINY = 11, so there is enough
-*        .    subdiagonal workspace for NWR.GE.2 as required.
-*        .    (In fact, there is enough subdiagonal space for
-*        .    NWR.GE.3.) ====
-*
-         NWR = ILAENV( 13, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
-         NWR = MAX( 2, NWR )
-         NWR = MIN( IHI-ILO+1, ( N-1 ) / 3, NWR )
-         NW = NWR
-*
-*        ==== NSR = recommended number of simultaneous shifts.
-*        .    At this point N .GT. NTINY = 11, so there is at
-*        .    enough subdiagonal workspace for NSR to be even
-*        .    and greater than or equal to two as required. ====
-*
-         NSR = ILAENV( 15, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
-         NSR = MIN( NSR, ( N+6 ) / 9, IHI-ILO )
-         NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
-*
-*        ==== Estimate optimal workspace ====
-*
-*        ==== Workspace query call to DLAQR2 ====
-*
-         CALL DLAQR2( WANTT, WANTZ, N, ILO, IHI, NWR+1, H, LDH, ILOZ,
-     $                IHIZ, Z, LDZ, LS, LD, WR, WI, H, LDH, N, H, LDH,
-     $                N, H, LDH, WORK, -1 )
-*
-*        ==== Optimal workspace = MAX(DLAQR5, DLAQR2) ====
-*
-         LWKOPT = MAX( 3*NSR / 2, INT( WORK( 1 ) ) )
-*
-*        ==== Quick return in case of workspace query. ====
-*
-         IF( LWORK.EQ.-1 ) THEN
-            WORK( 1 ) = DBLE( LWKOPT )
-            RETURN
-         END IF
-*
-*        ==== DLAHQR/DLAQR0 crossover point ====
-*
-         NMIN = ILAENV( 12, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
-         NMIN = MAX( NTINY, NMIN )
-*
-*        ==== Nibble crossover point ====
-*
-         NIBBLE = ILAENV( 14, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
-         NIBBLE = MAX( 0, NIBBLE )
-*
-*        ==== Accumulate reflections during ttswp?  Use block
-*        .    2-by-2 structure during matrix-matrix multiply? ====
-*
-         KACC22 = ILAENV( 16, 'DLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
-         KACC22 = MAX( 0, KACC22 )
-         KACC22 = MIN( 2, KACC22 )
-*
-*        ==== NWMAX = the largest possible deflation window for
-*        .    which there is sufficient workspace. ====
-*
-         NWMAX = MIN( ( N-1 ) / 3, LWORK / 2 )
-*
-*        ==== NSMAX = the Largest number of simultaneous shifts
-*        .    for which there is sufficient workspace. ====
-*
-         NSMAX = MIN( ( N+6 ) / 9, 2*LWORK / 3 )
-         NSMAX = NSMAX - MOD( NSMAX, 2 )
-*
-*        ==== NDFL: an iteration count restarted at deflation. ====
-*
-         NDFL = 1
-*
-*        ==== ITMAX = iteration limit ====
-*
-         ITMAX = MAX( 30, 2*KEXSH )*MAX( 10, ( IHI-ILO+1 ) )
-*
-*        ==== Last row and column in the active block ====
-*
-         KBOT = IHI
-*
-*        ==== Main Loop ====
-*
-         DO 80 IT = 1, ITMAX
-*
-*           ==== Done when KBOT falls below ILO ====
-*
-            IF( KBOT.LT.ILO )
-     $         GO TO 90
-*
-*           ==== Locate active block ====
-*
-            DO 10 K = KBOT, ILO + 1, -1
-               IF( H( K, K-1 ).EQ.ZERO )
-     $            GO TO 20
-   10       CONTINUE
-            K = ILO
-   20       CONTINUE
-            KTOP = K
-*
-*           ==== Select deflation window size ====
-*
-            NH = KBOT - KTOP + 1
-            IF( NDFL.LT.KEXNW .OR. NH.LT.NW ) THEN
-*
-*              ==== Typical deflation window.  If possible and
-*              .    advisable, nibble the entire active block.
-*              .    If not, use size NWR or NWR+1 depending upon
-*              .    which has the smaller corresponding subdiagonal
-*              .    entry (a heuristic). ====
-*
-               NWINC = .TRUE.
-               IF( NH.LE.MIN( NMIN, NWMAX ) ) THEN
-                  NW = NH
-               ELSE
-                  NW = MIN( NWR, NH, NWMAX )
-                  IF( NW.LT.NWMAX ) THEN
-                     IF( NW.GE.NH-1 ) THEN
-                        NW = NH
-                     ELSE
-                        KWTOP = KBOT - NW + 1
-                        IF( ABS( H( KWTOP, KWTOP-1 ) ).GT.
-     $                      ABS( H( KWTOP-1, KWTOP-2 ) ) )NW = NW + 1
-                     END IF
-                  END IF
-               END IF
-            ELSE
-*
-*              ==== Exceptional deflation window.  If there have
-*              .    been no deflations in KEXNW or more iterations,
-*              .    then vary the deflation window size.   At first,
-*              .    because, larger windows are, in general, more
-*              .    powerful than smaller ones, rapidly increase the
-*              .    window up to the maximum reasonable and possible.
-*              .    Then maybe try a slightly smaller window.  ====
-*
-               IF( NWINC .AND. NW.LT.MIN( NWMAX, NH ) ) THEN
-                  NW = MIN( NWMAX, NH, 2*NW )
-               ELSE
-                  NWINC = .FALSE.
-                  IF( NW.EQ.NH .AND. NH.GT.2 )
-     $               NW = NH - 1
-               END IF
-            END IF
-*
-*           ==== Aggressive early deflation:
-*           .    split workspace under the subdiagonal into
-*           .      - an nw-by-nw work array V in the lower
-*           .        left-hand-corner,
-*           .      - an NW-by-at-least-NW-but-more-is-better
-*           .        (NW-by-NHO) horizontal work array along
-*           .        the bottom edge,
-*           .      - an at-least-NW-but-more-is-better (NHV-by-NW)
-*           .        vertical work array along the left-hand-edge.
-*           .        ====
-*
-            KV = N - NW + 1
-            KT = NW + 1
-            NHO = ( N-NW-1 ) - KT + 1
-            KWV = NW + 2
-            NVE = ( N-NW ) - KWV + 1
-*
-*           ==== Aggressive early deflation ====
-*
-            CALL DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-     $                   IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH,
-     $                   NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH,
-     $                   WORK, LWORK )
-*
-*           ==== Adjust KBOT accounting for new deflations. ====
-*
-            KBOT = KBOT - LD
-*
-*           ==== KS points to the shifts. ====
-*
-            KS = KBOT - LS + 1
-*
-*           ==== Skip an expensive QR sweep if there is a (partly
-*           .    heuristic) reason to expect that many eigenvalues
-*           .    will deflate without it.  Here, the QR sweep is
-*           .    skipped if many eigenvalues have just been deflated
-*           .    or if the remaining active block is small.
-*
-            IF( ( LD.EQ.0 ) .OR. ( ( 100*LD.LE.NW*NIBBLE ) .AND. ( KBOT-
-     $          KTOP+1.GT.MIN( NMIN, NWMAX ) ) ) ) THEN
-*
-*              ==== NS = nominal number of simultaneous shifts.
-*              .    This may be lowered (slightly) if DLAQR2
-*              .    did not provide that many shifts. ====
-*
-               NS = MIN( NSMAX, NSR, MAX( 2, KBOT-KTOP ) )
-               NS = NS - MOD( NS, 2 )
-*
-*              ==== If there have been no deflations
-*              .    in a multiple of KEXSH iterations,
-*              .    then try exceptional shifts.
-*              .    Otherwise use shifts provided by
-*              .    DLAQR2 above or from the eigenvalues
-*              .    of a trailing principal submatrix. ====
-*
-               IF( MOD( NDFL, KEXSH ).EQ.0 ) THEN
-                  KS = KBOT - NS + 1
-                  DO 30 I = KBOT, MAX( KS+1, KTOP+2 ), -2
-                     SS = ABS( H( I, I-1 ) ) + ABS( H( I-1, I-2 ) )
-                     AA = WILK1*SS + H( I, I )
-                     BB = SS
-                     CC = WILK2*SS
-                     DD = AA
-                     CALL DLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ),
-     $                            WR( I ), WI( I ), CS, SN )
-   30             CONTINUE
-                  IF( KS.EQ.KTOP ) THEN
-                     WR( KS+1 ) = H( KS+1, KS+1 )
-                     WI( KS+1 ) = ZERO
-                     WR( KS ) = WR( KS+1 )
-                     WI( KS ) = WI( KS+1 )
-                  END IF
-               ELSE
-*
-*                 ==== Got NS/2 or fewer shifts? Use DLAHQR
-*                 .    on a trailing principal submatrix to
-*                 .    get more. (Since NS.LE.NSMAX.LE.(N+6)/9,
-*                 .    there is enough space below the subdiagonal
-*                 .    to fit an NS-by-NS scratch array.) ====
-*
-                  IF( KBOT-KS+1.LE.NS / 2 ) THEN
-                     KS = KBOT - NS + 1
-                     KT = N - NS + 1
-                     CALL DLACPY( 'A', NS, NS, H( KS, KS ), LDH,
-     $                            H( KT, 1 ), LDH )
-                     CALL DLAHQR( .false., .false., NS, 1, NS,
-     $                            H( KT, 1 ), LDH, WR( KS ), WI( KS ),
-     $                            1, 1, ZDUM, 1, INF )
-                     KS = KS + INF
-*
-*                    ==== In case of a rare QR failure use
-*                    .    eigenvalues of the trailing 2-by-2
-*                    .    principal submatrix.  ====
-*
-                     IF( KS.GE.KBOT ) THEN
-                        AA = H( KBOT-1, KBOT-1 )
-                        CC = H( KBOT, KBOT-1 )
-                        BB = H( KBOT-1, KBOT )
-                        DD = H( KBOT, KBOT )
-                        CALL DLANV2( AA, BB, CC, DD, WR( KBOT-1 ),
-     $                               WI( KBOT-1 ), WR( KBOT ),
-     $                               WI( KBOT ), CS, SN )
-                        KS = KBOT - 1
-                     END IF
-                  END IF
-*
-                  IF( KBOT-KS+1.GT.NS ) THEN
-*
-*                    ==== Sort the shifts (Helps a little)
-*                    .    Bubble sort keeps complex conjugate
-*                    .    pairs together. ====
-*
-                     SORTED = .false.
-                     DO 50 K = KBOT, KS + 1, -1
-                        IF( SORTED )
-     $                     GO TO 60
-                        SORTED = .true.
-                        DO 40 I = KS, K - 1
-                           IF( ABS( WR( I ) )+ABS( WI( I ) ).LT.
-     $                         ABS( WR( I+1 ) )+ABS( WI( I+1 ) ) ) THEN
-                              SORTED = .false.
-*
-                              SWAP = WR( I )
-                              WR( I ) = WR( I+1 )
-                              WR( I+1 ) = SWAP
-*
-                              SWAP = WI( I )
-                              WI( I ) = WI( I+1 )
-                              WI( I+1 ) = SWAP
-                           END IF
-   40                   CONTINUE
-   50                CONTINUE
-   60                CONTINUE
-                  END IF
-*
-*                 ==== Shuffle shifts into pairs of real shifts
-*                 .    and pairs of complex conjugate shifts
-*                 .    assuming complex conjugate shifts are
-*                 .    already adjacent to one another. (Yes,
-*                 .    they are.)  ====
-*
-                  DO 70 I = KBOT, KS + 2, -2
-                     IF( WI( I ).NE.-WI( I-1 ) ) THEN
-*
-                        SWAP = WR( I )
-                        WR( I ) = WR( I-1 )
-                        WR( I-1 ) = WR( I-2 )
-                        WR( I-2 ) = SWAP
-*
-                        SWAP = WI( I )
-                        WI( I ) = WI( I-1 )
-                        WI( I-1 ) = WI( I-2 )
-                        WI( I-2 ) = SWAP
-                     END IF
-   70             CONTINUE
-               END IF
-*
-*              ==== If there are only two shifts and both are
-*              .    real, then use only one.  ====
-*
-               IF( KBOT-KS+1.EQ.2 ) THEN
-                  IF( WI( KBOT ).EQ.ZERO ) THEN
-                     IF( ABS( WR( KBOT )-H( KBOT, KBOT ) ).LT.
-     $                   ABS( WR( KBOT-1 )-H( KBOT, KBOT ) ) ) THEN
-                        WR( KBOT-1 ) = WR( KBOT )
-                     ELSE
-                        WR( KBOT ) = WR( KBOT-1 )
-                     END IF
-                  END IF
-               END IF
-*
-*              ==== Use up to NS of the the smallest magnatiude
-*              .    shifts.  If there aren't NS shifts available,
-*              .    then use them all, possibly dropping one to
-*              .    make the number of shifts even. ====
-*
-               NS = MIN( NS, KBOT-KS+1 )
-               NS = NS - MOD( NS, 2 )
-               KS = KBOT - NS + 1
-*
-*              ==== Small-bulge multi-shift QR sweep:
-*              .    split workspace under the subdiagonal into
-*              .    - a KDU-by-KDU work array U in the lower
-*              .      left-hand-corner,
-*              .    - a KDU-by-at-least-KDU-but-more-is-better
-*              .      (KDU-by-NHo) horizontal work array WH along
-*              .      the bottom edge,
-*              .    - and an at-least-KDU-but-more-is-better-by-KDU
-*              .      (NVE-by-KDU) vertical work WV arrow along
-*              .      the left-hand-edge. ====
-*
-               KDU = 3*NS - 3
-               KU = N - KDU + 1
-               KWH = KDU + 1
-               NHO = ( N-KDU+1-4 ) - ( KDU+1 ) + 1
-               KWV = KDU + 4
-               NVE = N - KDU - KWV + 1
-*
-*              ==== Small-bulge multi-shift QR sweep ====
-*
-               CALL DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NS,
-     $                      WR( KS ), WI( KS ), H, LDH, ILOZ, IHIZ, Z,
-     $                      LDZ, WORK, 3, H( KU, 1 ), LDH, NVE,
-     $                      H( KWV, 1 ), LDH, NHO, H( KU, KWH ), LDH )
-            END IF
-*
-*           ==== Note progress (or the lack of it). ====
-*
-            IF( LD.GT.0 ) THEN
-               NDFL = 1
-            ELSE
-               NDFL = NDFL + 1
-            END IF
-*
-*           ==== End of main loop ====
-   80    CONTINUE
-*
-*        ==== Iteration limit exceeded.  Set INFO to show where
-*        .    the problem occurred and exit. ====
-*
-         INFO = KBOT
-   90    CONTINUE
-      END IF
-*
-*     ==== Return the optimal value of LWORK. ====
-*
-      WORK( 1 ) = DBLE( LWKOPT )
-*
-*     ==== End of DLAQR4 ====
-*
-      END
diff --git a/src/lib/lapack/dlaqr5.f b/src/lib/lapack/dlaqr5.f
deleted file mode 100644
index 17857572..00000000
--- a/src/lib/lapack/dlaqr5.f
+++ /dev/null
@@ -1,812 +0,0 @@
-      SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
-     $                   SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,
-     $                   LDU, NV, WV, LDWV, NH, WH, LDWH )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV,
-     $                   LDWH, LDWV, LDZ, N, NH, NSHFTS, NV
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   H( LDH, * ), SI( * ), SR( * ), U( LDU, * ),
-     $                   V( LDV, * ), WH( LDWH, * ), WV( LDWV, * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*     This auxiliary subroutine called by DLAQR0 performs a
-*     single small-bulge multi-shift QR sweep.
-*
-*      WANTT  (input) logical scalar
-*             WANTT = .true. if the quasi-triangular Schur factor
-*             is being computed.  WANTT is set to .false. otherwise.
-*
-*      WANTZ  (input) logical scalar
-*             WANTZ = .true. if the orthogonal Schur factor is being
-*             computed.  WANTZ is set to .false. otherwise.
-*
-*      KACC22 (input) integer with value 0, 1, or 2.
-*             Specifies the computation mode of far-from-diagonal
-*             orthogonal updates.
-*        = 0: DLAQR5 does not accumulate reflections and does not
-*             use matrix-matrix multiply to update far-from-diagonal
-*             matrix entries.
-*        = 1: DLAQR5 accumulates reflections and uses matrix-matrix
-*             multiply to update the far-from-diagonal matrix entries.
-*        = 2: DLAQR5 accumulates reflections, uses matrix-matrix
-*             multiply to update the far-from-diagonal matrix entries,
-*             and takes advantage of 2-by-2 block structure during
-*             matrix multiplies.
-*
-*      N      (input) integer scalar
-*             N is the order of the Hessenberg matrix H upon which this
-*             subroutine operates.
-*
-*      KTOP   (input) integer scalar
-*      KBOT   (input) integer scalar
-*             These are the first and last rows and columns of an
-*             isolated diagonal block upon which the QR sweep is to be
-*             applied. It is assumed without a check that
-*                       either KTOP = 1  or   H(KTOP,KTOP-1) = 0
-*             and
-*                       either KBOT = N  or   H(KBOT+1,KBOT) = 0.
-*
-*      NSHFTS (input) integer scalar
-*             NSHFTS gives the number of simultaneous shifts.  NSHFTS
-*             must be positive and even.
-*
-*      SR     (input) DOUBLE PRECISION array of size (NSHFTS)
-*      SI     (input) DOUBLE PRECISION array of size (NSHFTS)
-*             SR contains the real parts and SI contains the imaginary
-*             parts of the NSHFTS shifts of origin that define the
-*             multi-shift QR sweep.
-*
-*      H      (input/output) DOUBLE PRECISION array of size (LDH,N)
-*             On input H contains a Hessenberg matrix.  On output a
-*             multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
-*             to the isolated diagonal block in rows and columns KTOP
-*             through KBOT.
-*
-*      LDH    (input) integer scalar
-*             LDH is the leading dimension of H just as declared in the
-*             calling procedure.  LDH.GE.MAX(1,N).
-*
-*      ILOZ   (input) INTEGER
-*      IHIZ   (input) INTEGER
-*             Specify the rows of Z to which transformations must be
-*             applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N
-*
-*      Z      (input/output) DOUBLE PRECISION array of size (LDZ,IHI)
-*             If WANTZ = .TRUE., then the QR Sweep orthogonal
-*             similarity transformation is accumulated into
-*             Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*             If WANTZ = .FALSE., then Z is unreferenced.
-*
-*      LDZ    (input) integer scalar
-*             LDA is the leading dimension of Z just as declared in
-*             the calling procedure. LDZ.GE.N.
-*
-*      V      (workspace) DOUBLE PRECISION array of size (LDV,NSHFTS/2)
-*
-*      LDV    (input) integer scalar
-*             LDV is the leading dimension of V as declared in the
-*             calling procedure.  LDV.GE.3.
-*
-*      U      (workspace) DOUBLE PRECISION array of size
-*             (LDU,3*NSHFTS-3)
-*
-*      LDU    (input) integer scalar
-*             LDU is the leading dimension of U just as declared in the
-*             in the calling subroutine.  LDU.GE.3*NSHFTS-3.
-*
-*      NH     (input) integer scalar
-*             NH is the number of columns in array WH available for
-*             workspace. NH.GE.1.
-*
-*      WH     (workspace) DOUBLE PRECISION array of size (LDWH,NH)
-*
-*      LDWH   (input) integer scalar
-*             Leading dimension of WH just as declared in the
-*             calling procedure.  LDWH.GE.3*NSHFTS-3.
-*
-*      NV     (input) integer scalar
-*             NV is the number of rows in WV agailable for workspace.
-*             NV.GE.1.
-*
-*      WV     (workspace) DOUBLE PRECISION array of size
-*             (LDWV,3*NSHFTS-3)
-*
-*      LDWV   (input) integer scalar
-*             LDWV is the leading dimension of WV as declared in the
-*             in the calling subroutine.  LDWV.GE.NV.
-*
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ============================================================
-*     Reference:
-*
-*     K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*     Algorithm Part I: Maintaining Well Focused Shifts, and
-*     Level 3 Performance, SIAM Journal of Matrix Analysis,
-*     volume 23, pages 929--947, 2002.
-*
-*     ============================================================
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0d0, ONE = 1.0d0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   ALPHA, BETA, H11, H12, H21, H22, REFSUM,
-     $                   SAFMAX, SAFMIN, SCL, SMLNUM, SWAP, TST1, TST2,
-     $                   ULP
-      INTEGER            I, I2, I4, INCOL, J, J2, J4, JBOT, JCOL, JLEN,
-     $                   JROW, JTOP, K, K1, KDU, KMS, KNZ, KRCOL, KZS,
-     $                   M, M22, MBOT, MEND, MSTART, MTOP, NBMPS, NDCOL,
-     $                   NS, NU
-      LOGICAL            ACCUM, BLK22, BMP22
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-*
-      INTRINSIC          ABS, DBLE, MAX, MIN, MOD
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   VT( 3 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMM, DLABAD, DLACPY, DLAQR1, DLARFG, DLASET,
-     $                   DTRMM
-*     ..
-*     .. Executable Statements ..
-*
-*     ==== If there are no shifts, then there is nothing to do. ====
-*
-      IF( NSHFTS.LT.2 )
-     $   RETURN
-*
-*     ==== If the active block is empty or 1-by-1, then there
-*     .    is nothing to do. ====
-*
-      IF( KTOP.GE.KBOT )
-     $   RETURN
-*
-*     ==== Shuffle shifts into pairs of real shifts and pairs
-*     .    of complex conjugate shifts assuming complex
-*     .    conjugate shifts are already adjacent to one
-*     .    another. ====
-*
-      DO 10 I = 1, NSHFTS - 2, 2
-         IF( SI( I ).NE.-SI( I+1 ) ) THEN
-*
-            SWAP = SR( I )
-            SR( I ) = SR( I+1 )
-            SR( I+1 ) = SR( I+2 )
-            SR( I+2 ) = SWAP
-*
-            SWAP = SI( I )
-            SI( I ) = SI( I+1 )
-            SI( I+1 ) = SI( I+2 )
-            SI( I+2 ) = SWAP
-         END IF
-   10 CONTINUE
-*
-*     ==== NSHFTS is supposed to be even, but if is odd,
-*     .    then simply reduce it by one.  The shuffle above
-*     .    ensures that the dropped shift is real and that
-*     .    the remaining shifts are paired. ====
-*
-      NS = NSHFTS - MOD( NSHFTS, 2 )
-*
-*     ==== Machine constants for deflation ====
-*
-      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
-      SAFMAX = ONE / SAFMIN
-      CALL DLABAD( SAFMIN, SAFMAX )
-      ULP = DLAMCH( 'PRECISION' )
-      SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-*     ==== Use accumulated reflections to update far-from-diagonal
-*     .    entries ? ====
-*
-      ACCUM = ( KACC22.EQ.1 ) .OR. ( KACC22.EQ.2 )
-*
-*     ==== If so, exploit the 2-by-2 block structure? ====
-*
-      BLK22 = ( NS.GT.2 ) .AND. ( KACC22.EQ.2 )
-*
-*     ==== clear trash ====
-*
-      IF( KTOP+2.LE.KBOT )
-     $   H( KTOP+2, KTOP ) = ZERO
-*
-*     ==== NBMPS = number of 2-shift bulges in the chain ====
-*
-      NBMPS = NS / 2
-*
-*     ==== KDU = width of slab ====
-*
-      KDU = 6*NBMPS - 3
-*
-*     ==== Create and chase chains of NBMPS bulges ====
-*
-      DO 220 INCOL = 3*( 1-NBMPS ) + KTOP - 1, KBOT - 2, 3*NBMPS - 2
-         NDCOL = INCOL + KDU
-         IF( ACCUM )
-     $      CALL DLASET( 'ALL', KDU, KDU, ZERO, ONE, U, LDU )
-*
-*        ==== Near-the-diagonal bulge chase.  The following loop
-*        .    performs the near-the-diagonal part of a small bulge
-*        .    multi-shift QR sweep.  Each 6*NBMPS-2 column diagonal
-*        .    chunk extends from column INCOL to column NDCOL
-*        .    (including both column INCOL and column NDCOL). The
-*        .    following loop chases a 3*NBMPS column long chain of
-*        .    NBMPS bulges 3*NBMPS-2 columns to the right.  (INCOL
-*        .    may be less than KTOP and and NDCOL may be greater than
-*        .    KBOT indicating phantom columns from which to chase
-*        .    bulges before they are actually introduced or to which
-*        .    to chase bulges beyond column KBOT.)  ====
-*
-         DO 150 KRCOL = INCOL, MIN( INCOL+3*NBMPS-3, KBOT-2 )
-*
-*           ==== Bulges number MTOP to MBOT are active double implicit
-*           .    shift bulges.  There may or may not also be small
-*           .    2-by-2 bulge, if there is room.  The inactive bulges
-*           .    (if any) must wait until the active bulges have moved
-*           .    down the diagonal to make room.  The phantom matrix
-*           .    paradigm described above helps keep track.  ====
-*
-            MTOP = MAX( 1, ( ( KTOP-1 )-KRCOL+2 ) / 3+1 )
-            MBOT = MIN( NBMPS, ( KBOT-KRCOL ) / 3 )
-            M22 = MBOT + 1
-            BMP22 = ( MBOT.LT.NBMPS ) .AND. ( KRCOL+3*( M22-1 ) ).EQ.
-     $              ( KBOT-2 )
-*
-*           ==== Generate reflections to chase the chain right
-*           .    one column.  (The minimum value of K is KTOP-1.) ====
-*
-            DO 20 M = MTOP, MBOT
-               K = KRCOL + 3*( M-1 )
-               IF( K.EQ.KTOP-1 ) THEN
-                  CALL DLAQR1( 3, H( KTOP, KTOP ), LDH, SR( 2*M-1 ),
-     $                         SI( 2*M-1 ), SR( 2*M ), SI( 2*M ),
-     $                         V( 1, M ) )
-                  ALPHA = V( 1, M )
-                  CALL DLARFG( 3, ALPHA, V( 2, M ), 1, V( 1, M ) )
-               ELSE
-                  BETA = H( K+1, K )
-                  V( 2, M ) = H( K+2, K )
-                  V( 3, M ) = H( K+3, K )
-                  CALL DLARFG( 3, BETA, V( 2, M ), 1, V( 1, M ) )
-*
-*                 ==== A Bulge may collapse because of vigilant
-*                 .    deflation or destructive underflow.  (The
-*                 .    initial bulge is always collapsed.) Use
-*                 .    the two-small-subdiagonals trick to try
-*                 .    to get it started again. If V(2,M).NE.0 and
-*                 .    V(3,M) = H(K+3,K+1) = H(K+3,K+2) = 0, then
-*                 .    this bulge is collapsing into a zero
-*                 .    subdiagonal.  It will be restarted next
-*                 .    trip through the loop.)
-*
-                  IF( V( 1, M ).NE.ZERO .AND.
-     $                ( V( 3, M ).NE.ZERO .OR. ( H( K+3,
-     $                K+1 ).EQ.ZERO .AND. H( K+3, K+2 ).EQ.ZERO ) ) )
-     $                 THEN
-*
-*                    ==== Typical case: not collapsed (yet). ====
-*
-                     H( K+1, K ) = BETA
-                     H( K+2, K ) = ZERO
-                     H( K+3, K ) = ZERO
-                  ELSE
-*
-*                    ==== Atypical case: collapsed.  Attempt to
-*                    .    reintroduce ignoring H(K+1,K).  If the
-*                    .    fill resulting from the new reflector
-*                    .    is too large, then abandon it.
-*                    .    Otherwise, use the new one. ====
-*
-                     CALL DLAQR1( 3, H( K+1, K+1 ), LDH, SR( 2*M-1 ),
-     $                            SI( 2*M-1 ), SR( 2*M ), SI( 2*M ),
-     $                            VT )
-                     SCL = ABS( VT( 1 ) ) + ABS( VT( 2 ) ) +
-     $                     ABS( VT( 3 ) )
-                     IF( SCL.NE.ZERO ) THEN
-                        VT( 1 ) = VT( 1 ) / SCL
-                        VT( 2 ) = VT( 2 ) / SCL
-                        VT( 3 ) = VT( 3 ) / SCL
-                     END IF
-*
-*                    ==== The following is the traditional and
-*                    .    conservative two-small-subdiagonals
-*                    .    test.  ====
-*                    .
-                     IF( ABS( H( K+1, K ) )*( ABS( VT( 2 ) )+
-     $                   ABS( VT( 3 ) ) ).GT.ULP*ABS( VT( 1 ) )*
-     $                   ( ABS( H( K, K ) )+ABS( H( K+1,
-     $                   K+1 ) )+ABS( H( K+2, K+2 ) ) ) ) THEN
-*
-*                       ==== Starting a new bulge here would
-*                       .    create non-negligible fill.   If
-*                       .    the old reflector is diagonal (only
-*                       .    possible with underflows), then
-*                       .    change it to I.  Otherwise, use
-*                       .    it with trepidation. ====
-*
-                        IF( V( 2, M ).EQ.ZERO .AND. V( 3, M ).EQ.ZERO )
-     $                       THEN
-                           V( 1, M ) = ZERO
-                        ELSE
-                           H( K+1, K ) = BETA
-                           H( K+2, K ) = ZERO
-                           H( K+3, K ) = ZERO
-                        END IF
-                     ELSE
-*
-*                       ==== Stating a new bulge here would
-*                       .    create only negligible fill.
-*                       .    Replace the old reflector with
-*                       .    the new one. ====
-*
-                        ALPHA = VT( 1 )
-                        CALL DLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
-                        REFSUM = H( K+1, K ) + H( K+2, K )*VT( 2 ) +
-     $                           H( K+3, K )*VT( 3 )
-                        H( K+1, K ) = H( K+1, K ) - VT( 1 )*REFSUM
-                        H( K+2, K ) = ZERO
-                        H( K+3, K ) = ZERO
-                        V( 1, M ) = VT( 1 )
-                        V( 2, M ) = VT( 2 )
-                        V( 3, M ) = VT( 3 )
-                     END IF
-                  END IF
-               END IF
-   20       CONTINUE
-*
-*           ==== Generate a 2-by-2 reflection, if needed. ====
-*
-            K = KRCOL + 3*( M22-1 )
-            IF( BMP22 ) THEN
-               IF( K.EQ.KTOP-1 ) THEN
-                  CALL DLAQR1( 2, H( K+1, K+1 ), LDH, SR( 2*M22-1 ),
-     $                         SI( 2*M22-1 ), SR( 2*M22 ), SI( 2*M22 ),
-     $                         V( 1, M22 ) )
-                  BETA = V( 1, M22 )
-                  CALL DLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
-               ELSE
-                  BETA = H( K+1, K )
-                  V( 2, M22 ) = H( K+2, K )
-                  CALL DLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
-                  H( K+1, K ) = BETA
-                  H( K+2, K ) = ZERO
-               END IF
-            ELSE
-*
-*              ==== Initialize V(1,M22) here to avoid possible undefined
-*              .    variable problems later. ====
-*
-               V( 1, M22 ) = ZERO
-            END IF
-*
-*           ==== Multiply H by reflections from the left ====
-*
-            IF( ACCUM ) THEN
-               JBOT = MIN( NDCOL, KBOT )
-            ELSE IF( WANTT ) THEN
-               JBOT = N
-            ELSE
-               JBOT = KBOT
-            END IF
-            DO 40 J = MAX( KTOP, KRCOL ), JBOT
-               MEND = MIN( MBOT, ( J-KRCOL+2 ) / 3 )
-               DO 30 M = MTOP, MEND
-                  K = KRCOL + 3*( M-1 )
-                  REFSUM = V( 1, M )*( H( K+1, J )+V( 2, M )*
-     $                     H( K+2, J )+V( 3, M )*H( K+3, J ) )
-                  H( K+1, J ) = H( K+1, J ) - REFSUM
-                  H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M )
-                  H( K+3, J ) = H( K+3, J ) - REFSUM*V( 3, M )
-   30          CONTINUE
-   40       CONTINUE
-            IF( BMP22 ) THEN
-               K = KRCOL + 3*( M22-1 )
-               DO 50 J = MAX( K+1, KTOP ), JBOT
-                  REFSUM = V( 1, M22 )*( H( K+1, J )+V( 2, M22 )*
-     $                     H( K+2, J ) )
-                  H( K+1, J ) = H( K+1, J ) - REFSUM
-                  H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M22 )
-   50          CONTINUE
-            END IF
-*
-*           ==== Multiply H by reflections from the right.
-*           .    Delay filling in the last row until the
-*           .    vigilant deflation check is complete. ====
-*
-            IF( ACCUM ) THEN
-               JTOP = MAX( KTOP, INCOL )
-            ELSE IF( WANTT ) THEN
-               JTOP = 1
-            ELSE
-               JTOP = KTOP
-            END IF
-            DO 90 M = MTOP, MBOT
-               IF( V( 1, M ).NE.ZERO ) THEN
-                  K = KRCOL + 3*( M-1 )
-                  DO 60 J = JTOP, MIN( KBOT, K+3 )
-                     REFSUM = V( 1, M )*( H( J, K+1 )+V( 2, M )*
-     $                        H( J, K+2 )+V( 3, M )*H( J, K+3 ) )
-                     H( J, K+1 ) = H( J, K+1 ) - REFSUM
-                     H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M )
-                     H( J, K+3 ) = H( J, K+3 ) - REFSUM*V( 3, M )
-   60             CONTINUE
-*
-                  IF( ACCUM ) THEN
-*
-*                    ==== Accumulate U. (If necessary, update Z later
-*                    .    with with an efficient matrix-matrix
-*                    .    multiply.) ====
-*
-                     KMS = K - INCOL
-                     DO 70 J = MAX( 1, KTOP-INCOL ), KDU
-                        REFSUM = V( 1, M )*( U( J, KMS+1 )+V( 2, M )*
-     $                           U( J, KMS+2 )+V( 3, M )*U( J, KMS+3 ) )
-                        U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
-                        U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M )
-                        U( J, KMS+3 ) = U( J, KMS+3 ) - REFSUM*V( 3, M )
-   70                CONTINUE
-                  ELSE IF( WANTZ ) THEN
-*
-*                    ==== U is not accumulated, so update Z
-*                    .    now by multiplying by reflections
-*                    .    from the right. ====
-*
-                     DO 80 J = ILOZ, IHIZ
-                        REFSUM = V( 1, M )*( Z( J, K+1 )+V( 2, M )*
-     $                           Z( J, K+2 )+V( 3, M )*Z( J, K+3 ) )
-                        Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
-                        Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M )
-                        Z( J, K+3 ) = Z( J, K+3 ) - REFSUM*V( 3, M )
-   80                CONTINUE
-                  END IF
-               END IF
-   90       CONTINUE
-*
-*           ==== Special case: 2-by-2 reflection (if needed) ====
-*
-            K = KRCOL + 3*( M22-1 )
-            IF( BMP22 .AND. ( V( 1, M22 ).NE.ZERO ) ) THEN
-               DO 100 J = JTOP, MIN( KBOT, K+3 )
-                  REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )*
-     $                     H( J, K+2 ) )
-                  H( J, K+1 ) = H( J, K+1 ) - REFSUM
-                  H( J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M22 )
-  100          CONTINUE
-*
-               IF( ACCUM ) THEN
-                  KMS = K - INCOL
-                  DO 110 J = MAX( 1, KTOP-INCOL ), KDU
-                     REFSUM = V( 1, M22 )*( U( J, KMS+1 )+V( 2, M22 )*
-     $                        U( J, KMS+2 ) )
-                     U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
-                     U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M22 )
-  110             CONTINUE
-               ELSE IF( WANTZ ) THEN
-                  DO 120 J = ILOZ, IHIZ
-                     REFSUM = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )*
-     $                        Z( J, K+2 ) )
-                     Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
-                     Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M22 )
-  120             CONTINUE
-               END IF
-            END IF
-*
-*           ==== Vigilant deflation check ====
-*
-            MSTART = MTOP
-            IF( KRCOL+3*( MSTART-1 ).LT.KTOP )
-     $         MSTART = MSTART + 1
-            MEND = MBOT
-            IF( BMP22 )
-     $         MEND = MEND + 1
-            IF( KRCOL.EQ.KBOT-2 )
-     $         MEND = MEND + 1
-            DO 130 M = MSTART, MEND
-               K = MIN( KBOT-1, KRCOL+3*( M-1 ) )
-*
-*              ==== The following convergence test requires that
-*              .    the tradition small-compared-to-nearby-diagonals
-*              .    criterion and the Ahues & Tisseur (LAWN 122, 1997)
-*              .    criteria both be satisfied.  The latter improves
-*              .    accuracy in some examples. Falling back on an
-*              .    alternate convergence criterion when TST1 or TST2
-*              .    is zero (as done here) is traditional but probably
-*              .    unnecessary. ====
-*
-               IF( H( K+1, K ).NE.ZERO ) THEN
-                  TST1 = ABS( H( K, K ) ) + ABS( H( K+1, K+1 ) )
-                  IF( TST1.EQ.ZERO ) THEN
-                     IF( K.GE.KTOP+1 )
-     $                  TST1 = TST1 + ABS( H( K, K-1 ) )
-                     IF( K.GE.KTOP+2 )
-     $                  TST1 = TST1 + ABS( H( K, K-2 ) )
-                     IF( K.GE.KTOP+3 )
-     $                  TST1 = TST1 + ABS( H( K, K-3 ) )
-                     IF( K.LE.KBOT-2 )
-     $                  TST1 = TST1 + ABS( H( K+2, K+1 ) )
-                     IF( K.LE.KBOT-3 )
-     $                  TST1 = TST1 + ABS( H( K+3, K+1 ) )
-                     IF( K.LE.KBOT-4 )
-     $                  TST1 = TST1 + ABS( H( K+4, K+1 ) )
-                  END IF
-                  IF( ABS( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) )
-     $                 THEN
-                     H12 = MAX( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
-                     H21 = MIN( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
-                     H11 = MAX( ABS( H( K+1, K+1 ) ),
-     $                     ABS( H( K, K )-H( K+1, K+1 ) ) )
-                     H22 = MIN( ABS( H( K+1, K+1 ) ),
-     $                     ABS( H( K, K )-H( K+1, K+1 ) ) )
-                     SCL = H11 + H12
-                     TST2 = H22*( H11 / SCL )
-*
-                     IF( TST2.EQ.ZERO .OR. H21*( H12 / SCL ).LE.
-     $                   MAX( SMLNUM, ULP*TST2 ) )H( K+1, K ) = ZERO
-                  END IF
-               END IF
-  130       CONTINUE
-*
-*           ==== Fill in the last row of each bulge. ====
-*
-            MEND = MIN( NBMPS, ( KBOT-KRCOL-1 ) / 3 )
-            DO 140 M = MTOP, MEND
-               K = KRCOL + 3*( M-1 )
-               REFSUM = V( 1, M )*V( 3, M )*H( K+4, K+3 )
-               H( K+4, K+1 ) = -REFSUM
-               H( K+4, K+2 ) = -REFSUM*V( 2, M )
-               H( K+4, K+3 ) = H( K+4, K+3 ) - REFSUM*V( 3, M )
-  140       CONTINUE
-*
-*           ==== End of near-the-diagonal bulge chase. ====
-*
-  150    CONTINUE
-*
-*        ==== Use U (if accumulated) to update far-from-diagonal
-*        .    entries in H.  If required, use U to update Z as
-*        .    well. ====
-*
-         IF( ACCUM ) THEN
-            IF( WANTT ) THEN
-               JTOP = 1
-               JBOT = N
-            ELSE
-               JTOP = KTOP
-               JBOT = KBOT
-            END IF
-            IF( ( .NOT.BLK22 ) .OR. ( INCOL.LT.KTOP ) .OR.
-     $          ( NDCOL.GT.KBOT ) .OR. ( NS.LE.2 ) ) THEN
-*
-*              ==== Updates not exploiting the 2-by-2 block
-*              .    structure of U.  K1 and NU keep track of
-*              .    the location and size of U in the special
-*              .    cases of introducing bulges and chasing
-*              .    bulges off the bottom.  In these special
-*              .    cases and in case the number of shifts
-*              .    is NS = 2, there is no 2-by-2 block
-*              .    structure to exploit.  ====
-*
-               K1 = MAX( 1, KTOP-INCOL )
-               NU = ( KDU-MAX( 0, NDCOL-KBOT ) ) - K1 + 1
-*
-*              ==== Horizontal Multiply ====
-*
-               DO 160 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
-                  JLEN = MIN( NH, JBOT-JCOL+1 )
-                  CALL DGEMM( 'C', 'N', NU, JLEN, NU, ONE, U( K1, K1 ),
-     $                        LDU, H( INCOL+K1, JCOL ), LDH, ZERO, WH,
-     $                        LDWH )
-                  CALL DLACPY( 'ALL', NU, JLEN, WH, LDWH,
-     $                         H( INCOL+K1, JCOL ), LDH )
-  160          CONTINUE
-*
-*              ==== Vertical multiply ====
-*
-               DO 170 JROW = JTOP, MAX( KTOP, INCOL ) - 1, NV
-                  JLEN = MIN( NV, MAX( KTOP, INCOL )-JROW )
-                  CALL DGEMM( 'N', 'N', JLEN, NU, NU, ONE,
-     $                        H( JROW, INCOL+K1 ), LDH, U( K1, K1 ),
-     $                        LDU, ZERO, WV, LDWV )
-                  CALL DLACPY( 'ALL', JLEN, NU, WV, LDWV,
-     $                         H( JROW, INCOL+K1 ), LDH )
-  170          CONTINUE
-*
-*              ==== Z multiply (also vertical) ====
-*
-               IF( WANTZ ) THEN
-                  DO 180 JROW = ILOZ, IHIZ, NV
-                     JLEN = MIN( NV, IHIZ-JROW+1 )
-                     CALL DGEMM( 'N', 'N', JLEN, NU, NU, ONE,
-     $                           Z( JROW, INCOL+K1 ), LDZ, U( K1, K1 ),
-     $                           LDU, ZERO, WV, LDWV )
-                     CALL DLACPY( 'ALL', JLEN, NU, WV, LDWV,
-     $                            Z( JROW, INCOL+K1 ), LDZ )
-  180             CONTINUE
-               END IF
-            ELSE
-*
-*              ==== Updates exploiting U's 2-by-2 block structure.
-*              .    (I2, I4, J2, J4 are the last rows and columns
-*              .    of the blocks.) ====
-*
-               I2 = ( KDU+1 ) / 2
-               I4 = KDU
-               J2 = I4 - I2
-               J4 = KDU
-*
-*              ==== KZS and KNZ deal with the band of zeros
-*              .    along the diagonal of one of the triangular
-*              .    blocks. ====
-*
-               KZS = ( J4-J2 ) - ( NS+1 )
-               KNZ = NS + 1
-*
-*              ==== Horizontal multiply ====
-*
-               DO 190 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
-                  JLEN = MIN( NH, JBOT-JCOL+1 )
-*
-*                 ==== Copy bottom of H to top+KZS of scratch ====
-*                  (The first KZS rows get multiplied by zero.) ====
-*
-                  CALL DLACPY( 'ALL', KNZ, JLEN, H( INCOL+1+J2, JCOL ),
-     $                         LDH, WH( KZS+1, 1 ), LDWH )
-*
-*                 ==== Multiply by U21' ====
-*
-                  CALL DLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH )
-                  CALL DTRMM( 'L', 'U', 'C', 'N', KNZ, JLEN, ONE,
-     $                        U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ),
-     $                        LDWH )
-*
-*                 ==== Multiply top of H by U11' ====
-*
-                  CALL DGEMM( 'C', 'N', I2, JLEN, J2, ONE, U, LDU,
-     $                        H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH )
-*
-*                 ==== Copy top of H bottom of WH ====
-*
-                  CALL DLACPY( 'ALL', J2, JLEN, H( INCOL+1, JCOL ), LDH,
-     $                         WH( I2+1, 1 ), LDWH )
-*
-*                 ==== Multiply by U21' ====
-*
-                  CALL DTRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE,
-     $                        U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH )
-*
-*                 ==== Multiply by U22 ====
-*
-                  CALL DGEMM( 'C', 'N', I4-I2, JLEN, J4-J2, ONE,
-     $                        U( J2+1, I2+1 ), LDU,
-     $                        H( INCOL+1+J2, JCOL ), LDH, ONE,
-     $                        WH( I2+1, 1 ), LDWH )
-*
-*                 ==== Copy it back ====
-*
-                  CALL DLACPY( 'ALL', KDU, JLEN, WH, LDWH,
-     $                         H( INCOL+1, JCOL ), LDH )
-  190          CONTINUE
-*
-*              ==== Vertical multiply ====
-*
-               DO 200 JROW = JTOP, MAX( INCOL, KTOP ) - 1, NV
-                  JLEN = MIN( NV, MAX( INCOL, KTOP )-JROW )
-*
-*                 ==== Copy right of H to scratch (the first KZS
-*                 .    columns get multiplied by zero) ====
-*
-                  CALL DLACPY( 'ALL', JLEN, KNZ, H( JROW, INCOL+1+J2 ),
-     $                         LDH, WV( 1, 1+KZS ), LDWV )
-*
-*                 ==== Multiply by U21 ====
-*
-                  CALL DLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV, LDWV )
-                  CALL DTRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE,
-     $                        U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
-     $                        LDWV )
-*
-*                 ==== Multiply by U11 ====
-*
-                  CALL DGEMM( 'N', 'N', JLEN, I2, J2, ONE,
-     $                        H( JROW, INCOL+1 ), LDH, U, LDU, ONE, WV,
-     $                        LDWV )
-*
-*                 ==== Copy left of H to right of scratch ====
-*
-                  CALL DLACPY( 'ALL', JLEN, J2, H( JROW, INCOL+1 ), LDH,
-     $                         WV( 1, 1+I2 ), LDWV )
-*
-*                 ==== Multiply by U21 ====
-*
-                  CALL DTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,
-     $                        U( 1, I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )
-*
-*                 ==== Multiply by U22 ====
-*
-                  CALL DGEMM( 'N', 'N', JLEN, I4-I2, J4-J2, ONE,
-     $                        H( JROW, INCOL+1+J2 ), LDH,
-     $                        U( J2+1, I2+1 ), LDU, ONE, WV( 1, 1+I2 ),
-     $                        LDWV )
-*
-*                 ==== Copy it back ====
-*
-                  CALL DLACPY( 'ALL', JLEN, KDU, WV, LDWV,
-     $                         H( JROW, INCOL+1 ), LDH )
-  200          CONTINUE
-*
-*              ==== Multiply Z (also vertical) ====
-*
-               IF( WANTZ ) THEN
-                  DO 210 JROW = ILOZ, IHIZ, NV
-                     JLEN = MIN( NV, IHIZ-JROW+1 )
-*
-*                    ==== Copy right of Z to left of scratch (first
-*                    .     KZS columns get multiplied by zero) ====
-*
-                     CALL DLACPY( 'ALL', JLEN, KNZ,
-     $                            Z( JROW, INCOL+1+J2 ), LDZ,
-     $                            WV( 1, 1+KZS ), LDWV )
-*
-*                    ==== Multiply by U12 ====
-*
-                     CALL DLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV,
-     $                            LDWV )
-                     CALL DTRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE,
-     $                           U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
-     $                           LDWV )
-*
-*                    ==== Multiply by U11 ====
-*
-                     CALL DGEMM( 'N', 'N', JLEN, I2, J2, ONE,
-     $                           Z( JROW, INCOL+1 ), LDZ, U, LDU, ONE,
-     $                           WV, LDWV )
-*
-*                    ==== Copy left of Z to right of scratch ====
-*
-                     CALL DLACPY( 'ALL', JLEN, J2, Z( JROW, INCOL+1 ),
-     $                            LDZ, WV( 1, 1+I2 ), LDWV )
-*
-*                    ==== Multiply by U21 ====
-*
-                     CALL DTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,
-     $                           U( 1, I2+1 ), LDU, WV( 1, 1+I2 ),
-     $                           LDWV )
-*
-*                    ==== Multiply by U22 ====
-*
-                     CALL DGEMM( 'N', 'N', JLEN, I4-I2, J4-J2, ONE,
-     $                           Z( JROW, INCOL+1+J2 ), LDZ,
-     $                           U( J2+1, I2+1 ), LDU, ONE,
-     $                           WV( 1, 1+I2 ), LDWV )
-*
-*                    ==== Copy the result back to Z ====
-*
-                     CALL DLACPY( 'ALL', JLEN, KDU, WV, LDWV,
-     $                            Z( JROW, INCOL+1 ), LDZ )
-  210             CONTINUE
-               END IF
-            END IF
-         END IF
-  220 CONTINUE
-*
-*     ==== End of DLAQR5 ====
-*
-      END
diff --git a/src/lib/lapack/dlarf.f b/src/lib/lapack/dlarf.f
deleted file mode 100644
index 22edc899..00000000
--- a/src/lib/lapack/dlarf.f
+++ /dev/null
@@ -1,115 +0,0 @@
-      SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE
-      INTEGER            INCV, LDC, M, N
-      DOUBLE PRECISION   TAU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   C( LDC, * ), V( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLARF applies a real elementary reflector H to a real m by n matrix
-*  C, from either the left or the right. H is represented in the form
-*
-*        H = I - tau * v * v'
-*
-*  where tau is a real scalar and v is a real vector.
-*
-*  If tau = 0, then H is taken to be the unit matrix.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': form  H * C
-*          = 'R': form  C * H
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  V       (input) DOUBLE PRECISION array, dimension
-*                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
-*                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
-*          The vector v in the representation of H. V is not used if
-*          TAU = 0.
-*
-*  INCV    (input) INTEGER
-*          The increment between elements of v. INCV <> 0.
-*
-*  TAU     (input) DOUBLE PRECISION
-*          The value tau in the representation of H.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the m by n matrix C.
-*          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*          or C * H if SIDE = 'R'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension
-*                         (N) if SIDE = 'L'
-*                      or (M) if SIDE = 'R'
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMV, DGER
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Executable Statements ..
-*
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        Form  H * C
-*
-         IF( TAU.NE.ZERO ) THEN
-*
-*           w := C' * v
-*
-            CALL DGEMV( 'Transpose', M, N, ONE, C, LDC, V, INCV, ZERO,
-     $                  WORK, 1 )
-*
-*           C := C - v * w'
-*
-            CALL DGER( M, N, -TAU, V, INCV, WORK, 1, C, LDC )
-         END IF
-      ELSE
-*
-*        Form  C * H
-*
-         IF( TAU.NE.ZERO ) THEN
-*
-*           w := C * v
-*
-            CALL DGEMV( 'No transpose', M, N, ONE, C, LDC, V, INCV,
-     $                  ZERO, WORK, 1 )
-*
-*           C := C - w * v'
-*
-            CALL DGER( M, N, -TAU, WORK, 1, V, INCV, C, LDC )
-         END IF
-      END IF
-      RETURN
-*
-*     End of DLARF
-*
-      END
diff --git a/src/lib/lapack/dlarfb.f b/src/lib/lapack/dlarfb.f
deleted file mode 100644
index d4422473..00000000
--- a/src/lib/lapack/dlarfb.f
+++ /dev/null
@@ -1,587 +0,0 @@
-      SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
-     $                   T, LDT, C, LDC, WORK, LDWORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, SIDE, STOREV, TRANS
-      INTEGER            K, LDC, LDT, LDV, LDWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   C( LDC, * ), T( LDT, * ), V( LDV, * ),
-     $                   WORK( LDWORK, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLARFB applies a real block reflector H or its transpose H' to a
-*  real m by n matrix C, from either the left or the right.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply H or H' from the Left
-*          = 'R': apply H or H' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply H (No transpose)
-*          = 'T': apply H' (Transpose)
-*
-*  DIRECT  (input) CHARACTER*1
-*          Indicates how H is formed from a product of elementary
-*          reflectors
-*          = 'F': H = H(1) H(2) . . . H(k) (Forward)
-*          = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*
-*  STOREV  (input) CHARACTER*1
-*          Indicates how the vectors which define the elementary
-*          reflectors are stored:
-*          = 'C': Columnwise
-*          = 'R': Rowwise
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  K       (input) INTEGER
-*          The order of the matrix T (= the number of elementary
-*          reflectors whose product defines the block reflector).
-*
-*  V       (input) DOUBLE PRECISION array, dimension
-*                                (LDV,K) if STOREV = 'C'
-*                                (LDV,M) if STOREV = 'R' and SIDE = 'L'
-*                                (LDV,N) if STOREV = 'R' and SIDE = 'R'
-*          The matrix V. See further details.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V.
-*          If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
-*          if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
-*          if STOREV = 'R', LDV >= K.
-*
-*  T       (input) DOUBLE PRECISION array, dimension (LDT,K)
-*          The triangular k by k matrix T in the representation of the
-*          block reflector.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= K.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the m by n matrix C.
-*          On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDA >= max(1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (LDWORK,K)
-*
-*  LDWORK  (input) INTEGER
-*          The leading dimension of the array WORK.
-*          If SIDE = 'L', LDWORK >= max(1,N);
-*          if SIDE = 'R', LDWORK >= max(1,M).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      CHARACTER          TRANST
-      INTEGER            I, J
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEMM, DTRMM
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 .OR. N.LE.0 )
-     $   RETURN
-*
-      IF( LSAME( TRANS, 'N' ) ) THEN
-         TRANST = 'T'
-      ELSE
-         TRANST = 'N'
-      END IF
-*
-      IF( LSAME( STOREV, 'C' ) ) THEN
-*
-         IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-*           Let  V =  ( V1 )    (first K rows)
-*                     ( V2 )
-*           where  V1  is unit lower triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
-*
-*              W := C1'
-*
-               DO 10 J = 1, K
-                  CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
-   10          CONTINUE
-*
-*              W := W * V1
-*
-               CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C2'*V2
-*
-                  CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K,
-     $                        ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
-     $                        ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C2 := C2 - V2 * W'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K,
-     $                        -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
-     $                        C( K+1, 1 ), LDC )
-               END IF
-*
-*              W := W * V1'
-*
-               CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K,
-     $                     ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W'
-*
-               DO 30 J = 1, K
-                  DO 20 I = 1, N
-                     C( J, I ) = C( J, I ) - WORK( I, J )
-   20             CONTINUE
-   30          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
-*
-*              W := C1
-*
-               DO 40 J = 1, K
-                  CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
-   40          CONTINUE
-*
-*              W := W * V1
-*
-               CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C2 * V2
-*
-                  CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K,
-     $                        ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
-     $                        ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V'
-*
-               IF( N.GT.K ) THEN
-*
-*                 C2 := C2 - W * V2'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K,
-     $                        -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
-     $                        C( 1, K+1 ), LDC )
-               END IF
-*
-*              W := W * V1'
-*
-               CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K,
-     $                     ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W
-*
-               DO 60 J = 1, K
-                  DO 50 I = 1, M
-                     C( I, J ) = C( I, J ) - WORK( I, J )
-   50             CONTINUE
-   60          CONTINUE
-            END IF
-*
-         ELSE
-*
-*           Let  V =  ( V1 )
-*                     ( V2 )    (last K rows)
-*           where  V2  is unit upper triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
-*
-*              W := C2'
-*
-               DO 70 J = 1, K
-                  CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
-   70          CONTINUE
-*
-*              W := W * V2
-*
-               CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
-     $                     K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C1'*V1
-*
-                  CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K,
-     $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C1 := C1 - V1 * W'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K,
-     $                        -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
-               END IF
-*
-*              W := W * V2'
-*
-               CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K,
-     $                     ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
-*
-*              C2 := C2 - W'
-*
-               DO 90 J = 1, K
-                  DO 80 I = 1, N
-                     C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J )
-   80             CONTINUE
-   90          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
-*
-*              W := C2
-*
-               DO 100 J = 1, K
-                  CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
-  100          CONTINUE
-*
-*              W := W * V2
-*
-               CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
-     $                     K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C1 * V1
-*
-                  CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K,
-     $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V'
-*
-               IF( N.GT.K ) THEN
-*
-*                 C1 := C1 - W * V1'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K,
-     $                        -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
-               END IF
-*
-*              W := W * V2'
-*
-               CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K,
-     $                     ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
-*
-*              C2 := C2 - W
-*
-               DO 120 J = 1, K
-                  DO 110 I = 1, M
-                     C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
-  110             CONTINUE
-  120          CONTINUE
-            END IF
-         END IF
-*
-      ELSE IF( LSAME( STOREV, 'R' ) ) THEN
-*
-         IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-*           Let  V =  ( V1  V2 )    (V1: first K columns)
-*           where  V1  is unit upper triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
-*
-*              W := C1'
-*
-               DO 130 J = 1, K
-                  CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
-  130          CONTINUE
-*
-*              W := W * V1'
-*
-               CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K,
-     $                     ONE, V, LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C2'*V2'
-*
-                  CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE,
-     $                        C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE,
-     $                        WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V' * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C2 := C2 - V2' * W'
-*
-                  CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE,
-     $                        V( 1, K+1 ), LDV, WORK, LDWORK, ONE,
-     $                        C( K+1, 1 ), LDC )
-               END IF
-*
-*              W := W * V1
-*
-               CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W'
-*
-               DO 150 J = 1, K
-                  DO 140 I = 1, N
-                     C( J, I ) = C( J, I ) - WORK( I, J )
-  140             CONTINUE
-  150          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
-*
-*              W := C1
-*
-               DO 160 J = 1, K
-                  CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
-  160          CONTINUE
-*
-*              W := W * V1'
-*
-               CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K,
-     $                     ONE, V, LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C2 * V2'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K,
-     $                        ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
-     $                        ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V
-*
-               IF( N.GT.K ) THEN
-*
-*                 C2 := C2 - W * V2
-*
-                  CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K,
-     $                        -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE,
-     $                        C( 1, K+1 ), LDC )
-               END IF
-*
-*              W := W * V1
-*
-               CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W
-*
-               DO 180 J = 1, K
-                  DO 170 I = 1, M
-                     C( I, J ) = C( I, J ) - WORK( I, J )
-  170             CONTINUE
-  180          CONTINUE
-*
-            END IF
-*
-         ELSE
-*
-*           Let  V =  ( V1  V2 )    (V2: last K columns)
-*           where  V2  is unit lower triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
-*
-*              W := C2'
-*
-               DO 190 J = 1, K
-                  CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
-  190          CONTINUE
-*
-*              W := W * V2'
-*
-               CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K,
-     $                     ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C1'*V1'
-*
-                  CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE,
-     $                        C, LDC, V, LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V' * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C1 := C1 - V1' * W'
-*
-                  CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE,
-     $                        V, LDV, WORK, LDWORK, ONE, C, LDC )
-               END IF
-*
-*              W := W * V2
-*
-               CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
-     $                     K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
-*
-*              C2 := C2 - W'
-*
-               DO 210 J = 1, K
-                  DO 200 I = 1, N
-                     C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J )
-  200             CONTINUE
-  210          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
-*
-*              W := C2
-*
-               DO 220 J = 1, K
-                  CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
-  220          CONTINUE
-*
-*              W := W * V2'
-*
-               CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K,
-     $                     ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C1 * V1'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K,
-     $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V
-*
-               IF( N.GT.K ) THEN
-*
-*                 C1 := C1 - W * V1
-*
-                  CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K,
-     $                        -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
-               END IF
-*
-*              W := W * V2
-*
-               CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
-     $                     K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W
-*
-               DO 240 J = 1, K
-                  DO 230 I = 1, M
-                     C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
-  230             CONTINUE
-  240          CONTINUE
-*
-            END IF
-*
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DLARFB
-*
-      END
diff --git a/src/lib/lapack/dlarfg.f b/src/lib/lapack/dlarfg.f
deleted file mode 100644
index be981880..00000000
--- a/src/lib/lapack/dlarfg.f
+++ /dev/null
@@ -1,137 +0,0 @@
-      SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-      DOUBLE PRECISION   ALPHA, TAU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLARFG generates a real elementary reflector H of order n, such
-*  that
-*
-*        H * ( alpha ) = ( beta ),   H' * H = I.
-*            (   x   )   (   0  )
-*
-*  where alpha and beta are scalars, and x is an (n-1)-element real
-*  vector. H is represented in the form
-*
-*        H = I - tau * ( 1 ) * ( 1 v' ) ,
-*                      ( v )
-*
-*  where tau is a real scalar and v is a real (n-1)-element
-*  vector.
-*
-*  If the elements of x are all zero, then tau = 0 and H is taken to be
-*  the unit matrix.
-*
-*  Otherwise  1 <= tau <= 2.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the elementary reflector.
-*
-*  ALPHA   (input/output) DOUBLE PRECISION
-*          On entry, the value alpha.
-*          On exit, it is overwritten with the value beta.
-*
-*  X       (input/output) DOUBLE PRECISION array, dimension
-*                         (1+(N-2)*abs(INCX))
-*          On entry, the vector x.
-*          On exit, it is overwritten with the vector v.
-*
-*  INCX    (input) INTEGER
-*          The increment between elements of X. INCX > 0.
-*
-*  TAU     (output) DOUBLE PRECISION
-*          The value tau.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            J, KNT
-      DOUBLE PRECISION   BETA, RSAFMN, SAFMIN, XNORM
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH, DLAPY2, DNRM2
-      EXTERNAL           DLAMCH, DLAPY2, DNRM2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, SIGN
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSCAL
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.LE.1 ) THEN
-         TAU = ZERO
-         RETURN
-      END IF
-*
-      XNORM = DNRM2( N-1, X, INCX )
-*
-      IF( XNORM.EQ.ZERO ) THEN
-*
-*        H  =  I
-*
-         TAU = ZERO
-      ELSE
-*
-*        general case
-*
-         BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
-         SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )
-         IF( ABS( BETA ).LT.SAFMIN ) THEN
-*
-*           XNORM, BETA may be inaccurate; scale X and recompute them
-*
-            RSAFMN = ONE / SAFMIN
-            KNT = 0
-   10       CONTINUE
-            KNT = KNT + 1
-            CALL DSCAL( N-1, RSAFMN, X, INCX )
-            BETA = BETA*RSAFMN
-            ALPHA = ALPHA*RSAFMN
-            IF( ABS( BETA ).LT.SAFMIN )
-     $         GO TO 10
-*
-*           New BETA is at most 1, at least SAFMIN
-*
-            XNORM = DNRM2( N-1, X, INCX )
-            BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
-            TAU = ( BETA-ALPHA ) / BETA
-            CALL DSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
-*
-*           If ALPHA is subnormal, it may lose relative accuracy
-*
-            ALPHA = BETA
-            DO 20 J = 1, KNT
-               ALPHA = ALPHA*SAFMIN
-   20       CONTINUE
-         ELSE
-            TAU = ( BETA-ALPHA ) / BETA
-            CALL DSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
-            ALPHA = BETA
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DLARFG
-*
-      END
diff --git a/src/lib/lapack/dlarft.f b/src/lib/lapack/dlarft.f
deleted file mode 100644
index 2cd115f4..00000000
--- a/src/lib/lapack/dlarft.f
+++ /dev/null
@@ -1,217 +0,0 @@
-      SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, STOREV
-      INTEGER            K, LDT, LDV, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   T( LDT, * ), TAU( * ), V( LDV, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLARFT forms the triangular factor T of a real block reflector H
-*  of order n, which is defined as a product of k elementary reflectors.
-*
-*  If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
-*
-*  If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
-*
-*  If STOREV = 'C', the vector which defines the elementary reflector
-*  H(i) is stored in the i-th column of the array V, and
-*
-*     H  =  I - V * T * V'
-*
-*  If STOREV = 'R', the vector which defines the elementary reflector
-*  H(i) is stored in the i-th row of the array V, and
-*
-*     H  =  I - V' * T * V
-*
-*  Arguments
-*  =========
-*
-*  DIRECT  (input) CHARACTER*1
-*          Specifies the order in which the elementary reflectors are
-*          multiplied to form the block reflector:
-*          = 'F': H = H(1) H(2) . . . H(k) (Forward)
-*          = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*
-*  STOREV  (input) CHARACTER*1
-*          Specifies how the vectors which define the elementary
-*          reflectors are stored (see also Further Details):
-*          = 'C': columnwise
-*          = 'R': rowwise
-*
-*  N       (input) INTEGER
-*          The order of the block reflector H. N >= 0.
-*
-*  K       (input) INTEGER
-*          The order of the triangular factor T (= the number of
-*          elementary reflectors). K >= 1.
-*
-*  V       (input/output) DOUBLE PRECISION array, dimension
-*                               (LDV,K) if STOREV = 'C'
-*                               (LDV,N) if STOREV = 'R'
-*          The matrix V. See further details.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V.
-*          If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i).
-*
-*  T       (output) DOUBLE PRECISION array, dimension (LDT,K)
-*          The k by k triangular factor T of the block reflector.
-*          If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
-*          lower triangular. The rest of the array is not used.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= K.
-*
-*  Further Details
-*  ===============
-*
-*  The shape of the matrix V and the storage of the vectors which define
-*  the H(i) is best illustrated by the following example with n = 5 and
-*  k = 3. The elements equal to 1 are not stored; the corresponding
-*  array elements are modified but restored on exit. The rest of the
-*  array is not used.
-*
-*  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
-*
-*               V = (  1       )                 V = (  1 v1 v1 v1 v1 )
-*                   ( v1  1    )                     (     1 v2 v2 v2 )
-*                   ( v1 v2  1 )                     (        1 v3 v3 )
-*                   ( v1 v2 v3 )
-*                   ( v1 v2 v3 )
-*
-*  DIRECT = 'B' and STOREV = 'C':         DIRECT = 'B' and STOREV = 'R':
-*
-*               V = ( v1 v2 v3 )                 V = ( v1 v1  1       )
-*                   ( v1 v2 v3 )                     ( v2 v2 v2  1    )
-*                   (  1 v2 v3 )                     ( v3 v3 v3 v3  1 )
-*                   (     1 v3 )
-*                   (        1 )
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   VII
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMV, DTRMV
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      IF( LSAME( DIRECT, 'F' ) ) THEN
-         DO 20 I = 1, K
-            IF( TAU( I ).EQ.ZERO ) THEN
-*
-*              H(i)  =  I
-*
-               DO 10 J = 1, I
-                  T( J, I ) = ZERO
-   10          CONTINUE
-            ELSE
-*
-*              general case
-*
-               VII = V( I, I )
-               V( I, I ) = ONE
-               IF( LSAME( STOREV, 'C' ) ) THEN
-*
-*                 T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i)
-*
-                  CALL DGEMV( 'Transpose', N-I+1, I-1, -TAU( I ),
-     $                        V( I, 1 ), LDV, V( I, I ), 1, ZERO,
-     $                        T( 1, I ), 1 )
-               ELSE
-*
-*                 T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)'
-*
-                  CALL DGEMV( 'No transpose', I-1, N-I+1, -TAU( I ),
-     $                        V( 1, I ), LDV, V( I, I ), LDV, ZERO,
-     $                        T( 1, I ), 1 )
-               END IF
-               V( I, I ) = VII
-*
-*              T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
-*
-               CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
-     $                     LDT, T( 1, I ), 1 )
-               T( I, I ) = TAU( I )
-            END IF
-   20    CONTINUE
-      ELSE
-         DO 40 I = K, 1, -1
-            IF( TAU( I ).EQ.ZERO ) THEN
-*
-*              H(i)  =  I
-*
-               DO 30 J = I, K
-                  T( J, I ) = ZERO
-   30          CONTINUE
-            ELSE
-*
-*              general case
-*
-               IF( I.LT.K ) THEN
-                  IF( LSAME( STOREV, 'C' ) ) THEN
-                     VII = V( N-K+I, I )
-                     V( N-K+I, I ) = ONE
-*
-*                    T(i+1:k,i) :=
-*                            - tau(i) * V(1:n-k+i,i+1:k)' * V(1:n-k+i,i)
-*
-                     CALL DGEMV( 'Transpose', N-K+I, K-I, -TAU( I ),
-     $                           V( 1, I+1 ), LDV, V( 1, I ), 1, ZERO,
-     $                           T( I+1, I ), 1 )
-                     V( N-K+I, I ) = VII
-                  ELSE
-                     VII = V( I, N-K+I )
-                     V( I, N-K+I ) = ONE
-*
-*                    T(i+1:k,i) :=
-*                            - tau(i) * V(i+1:k,1:n-k+i) * V(i,1:n-k+i)'
-*
-                     CALL DGEMV( 'No transpose', K-I, N-K+I, -TAU( I ),
-     $                           V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO,
-     $                           T( I+1, I ), 1 )
-                     V( I, N-K+I ) = VII
-                  END IF
-*
-*                 T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
-*
-                  CALL DTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
-     $                        T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
-               END IF
-               T( I, I ) = TAU( I )
-            END IF
-   40    CONTINUE
-      END IF
-      RETURN
-*
-*     End of DLARFT
-*
-      END
diff --git a/src/lib/lapack/dlarfx.f b/src/lib/lapack/dlarfx.f
deleted file mode 100644
index cc4654e0..00000000
--- a/src/lib/lapack/dlarfx.f
+++ /dev/null
@@ -1,638 +0,0 @@
-      SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE
-      INTEGER            LDC, M, N
-      DOUBLE PRECISION   TAU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   C( LDC, * ), V( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLARFX applies a real elementary reflector H to a real m by n
-*  matrix C, from either the left or the right. H is represented in the
-*  form
-*
-*        H = I - tau * v * v'
-*
-*  where tau is a real scalar and v is a real vector.
-*
-*  If tau = 0, then H is taken to be the unit matrix
-*
-*  This version uses inline code if H has order < 11.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': form  H * C
-*          = 'R': form  C * H
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  V       (input) DOUBLE PRECISION array, dimension (M) if SIDE = 'L'
-*                                     or (N) if SIDE = 'R'
-*          The vector v in the representation of H.
-*
-*  TAU     (input) DOUBLE PRECISION
-*          The value tau in the representation of H.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the m by n matrix C.
-*          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*          or C * H if SIDE = 'R'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDA >= (1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension
-*                      (N) if SIDE = 'L'
-*                      or (M) if SIDE = 'R'
-*          WORK is not referenced if H has order < 11.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            J
-      DOUBLE PRECISION   SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
-     $                   V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMV, DGER
-*     ..
-*     .. Executable Statements ..
-*
-      IF( TAU.EQ.ZERO )
-     $   RETURN
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        Form  H * C, where H has order m.
-*
-         GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
-     $           170, 190 )M
-*
-*        Code for general M
-*
-*        w := C'*v
-*
-         CALL DGEMV( 'Transpose', M, N, ONE, C, LDC, V, 1, ZERO, WORK,
-     $               1 )
-*
-*        C := C - tau * v * w'
-*
-         CALL DGER( M, N, -TAU, V, 1, WORK, 1, C, LDC )
-         GO TO 410
-   10    CONTINUE
-*
-*        Special code for 1 x 1 Householder
-*
-         T1 = ONE - TAU*V( 1 )*V( 1 )
-         DO 20 J = 1, N
-            C( 1, J ) = T1*C( 1, J )
-   20    CONTINUE
-         GO TO 410
-   30    CONTINUE
-*
-*        Special code for 2 x 2 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         DO 40 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-   40    CONTINUE
-         GO TO 410
-   50    CONTINUE
-*
-*        Special code for 3 x 3 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         DO 60 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-   60    CONTINUE
-         GO TO 410
-   70    CONTINUE
-*
-*        Special code for 4 x 4 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         DO 80 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-   80    CONTINUE
-         GO TO 410
-   90    CONTINUE
-*
-*        Special code for 5 x 5 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         DO 100 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-  100    CONTINUE
-         GO TO 410
-  110    CONTINUE
-*
-*        Special code for 6 x 6 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         V6 = V( 6 )
-         T6 = TAU*V6
-         DO 120 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-            C( 6, J ) = C( 6, J ) - SUM*T6
-  120    CONTINUE
-         GO TO 410
-  130    CONTINUE
-*
-*        Special code for 7 x 7 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         V6 = V( 6 )
-         T6 = TAU*V6
-         V7 = V( 7 )
-         T7 = TAU*V7
-         DO 140 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
-     $            V7*C( 7, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-            C( 6, J ) = C( 6, J ) - SUM*T6
-            C( 7, J ) = C( 7, J ) - SUM*T7
-  140    CONTINUE
-         GO TO 410
-  150    CONTINUE
-*
-*        Special code for 8 x 8 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         V6 = V( 6 )
-         T6 = TAU*V6
-         V7 = V( 7 )
-         T7 = TAU*V7
-         V8 = V( 8 )
-         T8 = TAU*V8
-         DO 160 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
-     $            V7*C( 7, J ) + V8*C( 8, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-            C( 6, J ) = C( 6, J ) - SUM*T6
-            C( 7, J ) = C( 7, J ) - SUM*T7
-            C( 8, J ) = C( 8, J ) - SUM*T8
-  160    CONTINUE
-         GO TO 410
-  170    CONTINUE
-*
-*        Special code for 9 x 9 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         V6 = V( 6 )
-         T6 = TAU*V6
-         V7 = V( 7 )
-         T7 = TAU*V7
-         V8 = V( 8 )
-         T8 = TAU*V8
-         V9 = V( 9 )
-         T9 = TAU*V9
-         DO 180 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
-     $            V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-            C( 6, J ) = C( 6, J ) - SUM*T6
-            C( 7, J ) = C( 7, J ) - SUM*T7
-            C( 8, J ) = C( 8, J ) - SUM*T8
-            C( 9, J ) = C( 9, J ) - SUM*T9
-  180    CONTINUE
-         GO TO 410
-  190    CONTINUE
-*
-*        Special code for 10 x 10 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         V6 = V( 6 )
-         T6 = TAU*V6
-         V7 = V( 7 )
-         T7 = TAU*V7
-         V8 = V( 8 )
-         T8 = TAU*V8
-         V9 = V( 9 )
-         T9 = TAU*V9
-         V10 = V( 10 )
-         T10 = TAU*V10
-         DO 200 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
-     $            V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J ) +
-     $            V10*C( 10, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-            C( 6, J ) = C( 6, J ) - SUM*T6
-            C( 7, J ) = C( 7, J ) - SUM*T7
-            C( 8, J ) = C( 8, J ) - SUM*T8
-            C( 9, J ) = C( 9, J ) - SUM*T9
-            C( 10, J ) = C( 10, J ) - SUM*T10
-  200    CONTINUE
-         GO TO 410
-      ELSE
-*
-*        Form  C * H, where H has order n.
-*
-         GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
-     $           370, 390 )N
-*
-*        Code for general N
-*
-*        w := C * v
-*
-         CALL DGEMV( 'No transpose', M, N, ONE, C, LDC, V, 1, ZERO,
-     $               WORK, 1 )
-*
-*        C := C - tau * w * v'
-*
-         CALL DGER( M, N, -TAU, WORK, 1, V, 1, C, LDC )
-         GO TO 410
-  210    CONTINUE
-*
-*        Special code for 1 x 1 Householder
-*
-         T1 = ONE - TAU*V( 1 )*V( 1 )
-         DO 220 J = 1, M
-            C( J, 1 ) = T1*C( J, 1 )
-  220    CONTINUE
-         GO TO 410
-  230    CONTINUE
-*
-*        Special code for 2 x 2 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         DO 240 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-  240    CONTINUE
-         GO TO 410
-  250    CONTINUE
-*
-*        Special code for 3 x 3 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         DO 260 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-  260    CONTINUE
-         GO TO 410
-  270    CONTINUE
-*
-*        Special code for 4 x 4 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         DO 280 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-  280    CONTINUE
-         GO TO 410
-  290    CONTINUE
-*
-*        Special code for 5 x 5 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         DO 300 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-  300    CONTINUE
-         GO TO 410
-  310    CONTINUE
-*
-*        Special code for 6 x 6 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         V6 = V( 6 )
-         T6 = TAU*V6
-         DO 320 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-            C( J, 6 ) = C( J, 6 ) - SUM*T6
-  320    CONTINUE
-         GO TO 410
-  330    CONTINUE
-*
-*        Special code for 7 x 7 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         V6 = V( 6 )
-         T6 = TAU*V6
-         V7 = V( 7 )
-         T7 = TAU*V7
-         DO 340 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
-     $            V7*C( J, 7 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-            C( J, 6 ) = C( J, 6 ) - SUM*T6
-            C( J, 7 ) = C( J, 7 ) - SUM*T7
-  340    CONTINUE
-         GO TO 410
-  350    CONTINUE
-*
-*        Special code for 8 x 8 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         V6 = V( 6 )
-         T6 = TAU*V6
-         V7 = V( 7 )
-         T7 = TAU*V7
-         V8 = V( 8 )
-         T8 = TAU*V8
-         DO 360 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
-     $            V7*C( J, 7 ) + V8*C( J, 8 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-            C( J, 6 ) = C( J, 6 ) - SUM*T6
-            C( J, 7 ) = C( J, 7 ) - SUM*T7
-            C( J, 8 ) = C( J, 8 ) - SUM*T8
-  360    CONTINUE
-         GO TO 410
-  370    CONTINUE
-*
-*        Special code for 9 x 9 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         V6 = V( 6 )
-         T6 = TAU*V6
-         V7 = V( 7 )
-         T7 = TAU*V7
-         V8 = V( 8 )
-         T8 = TAU*V8
-         V9 = V( 9 )
-         T9 = TAU*V9
-         DO 380 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
-     $            V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-            C( J, 6 ) = C( J, 6 ) - SUM*T6
-            C( J, 7 ) = C( J, 7 ) - SUM*T7
-            C( J, 8 ) = C( J, 8 ) - SUM*T8
-            C( J, 9 ) = C( J, 9 ) - SUM*T9
-  380    CONTINUE
-         GO TO 410
-  390    CONTINUE
-*
-*        Special code for 10 x 10 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*V1
-         V2 = V( 2 )
-         T2 = TAU*V2
-         V3 = V( 3 )
-         T3 = TAU*V3
-         V4 = V( 4 )
-         T4 = TAU*V4
-         V5 = V( 5 )
-         T5 = TAU*V5
-         V6 = V( 6 )
-         T6 = TAU*V6
-         V7 = V( 7 )
-         T7 = TAU*V7
-         V8 = V( 8 )
-         T8 = TAU*V8
-         V9 = V( 9 )
-         T9 = TAU*V9
-         V10 = V( 10 )
-         T10 = TAU*V10
-         DO 400 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
-     $            V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 ) +
-     $            V10*C( J, 10 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-            C( J, 6 ) = C( J, 6 ) - SUM*T6
-            C( J, 7 ) = C( J, 7 ) - SUM*T7
-            C( J, 8 ) = C( J, 8 ) - SUM*T8
-            C( J, 9 ) = C( J, 9 ) - SUM*T9
-            C( J, 10 ) = C( J, 10 ) - SUM*T10
-  400    CONTINUE
-         GO TO 410
-      END IF
-  410 CONTINUE
-      RETURN
-*
-*     End of DLARFX
-*
-      END
diff --git a/src/lib/lapack/dlartg.f b/src/lib/lapack/dlartg.f
deleted file mode 100644
index eb807c1d..00000000
--- a/src/lib/lapack/dlartg.f
+++ /dev/null
@@ -1,145 +0,0 @@
-      SUBROUTINE DLARTG( F, G, CS, SN, R )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   CS, F, G, R, SN
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLARTG generate a plane rotation so that
-*
-*     [  CS  SN  ]  .  [ F ]  =  [ R ]   where CS**2 + SN**2 = 1.
-*     [ -SN  CS  ]     [ G ]     [ 0 ]
-*
-*  This is a slower, more accurate version of the BLAS1 routine DROTG,
-*  with the following other differences:
-*     F and G are unchanged on return.
-*     If G=0, then CS=1 and SN=0.
-*     If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
-*        floating point operations (saves work in DBDSQR when
-*        there are zeros on the diagonal).
-*
-*  If F exceeds G in magnitude, CS will be positive.
-*
-*  Arguments
-*  =========
-*
-*  F       (input) DOUBLE PRECISION
-*          The first component of vector to be rotated.
-*
-*  G       (input) DOUBLE PRECISION
-*          The second component of vector to be rotated.
-*
-*  CS      (output) DOUBLE PRECISION
-*          The cosine of the rotation.
-*
-*  SN      (output) DOUBLE PRECISION
-*          The sine of the rotation.
-*
-*  R       (output) DOUBLE PRECISION
-*          The nonzero component of the rotated vector.
-*
-*  This version has a few statements commented out for thread safety
-*  (machine parameters are computed on each entry). 10 feb 03, SJH.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D0 )
-      DOUBLE PRECISION   TWO
-      PARAMETER          ( TWO = 2.0D0 )
-*     ..
-*     .. Local Scalars ..
-*     LOGICAL            FIRST
-      INTEGER            COUNT, I
-      DOUBLE PRECISION   EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, INT, LOG, MAX, SQRT
-*     ..
-*     .. Save statement ..
-*     SAVE               FIRST, SAFMX2, SAFMIN, SAFMN2
-*     ..
-*     .. Data statements ..
-*     DATA               FIRST / .TRUE. /
-*     ..
-*     .. Executable Statements ..
-*
-*     IF( FIRST ) THEN
-         SAFMIN = DLAMCH( 'S' )
-         EPS = DLAMCH( 'E' )
-         SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
-     $            LOG( DLAMCH( 'B' ) ) / TWO )
-         SAFMX2 = ONE / SAFMN2
-*        FIRST = .FALSE.
-*     END IF
-      IF( G.EQ.ZERO ) THEN
-         CS = ONE
-         SN = ZERO
-         R = F
-      ELSE IF( F.EQ.ZERO ) THEN
-         CS = ZERO
-         SN = ONE
-         R = G
-      ELSE
-         F1 = F
-         G1 = G
-         SCALE = MAX( ABS( F1 ), ABS( G1 ) )
-         IF( SCALE.GE.SAFMX2 ) THEN
-            COUNT = 0
-   10       CONTINUE
-            COUNT = COUNT + 1
-            F1 = F1*SAFMN2
-            G1 = G1*SAFMN2
-            SCALE = MAX( ABS( F1 ), ABS( G1 ) )
-            IF( SCALE.GE.SAFMX2 )
-     $         GO TO 10
-            R = SQRT( F1**2+G1**2 )
-            CS = F1 / R
-            SN = G1 / R
-            DO 20 I = 1, COUNT
-               R = R*SAFMX2
-   20       CONTINUE
-         ELSE IF( SCALE.LE.SAFMN2 ) THEN
-            COUNT = 0
-   30       CONTINUE
-            COUNT = COUNT + 1
-            F1 = F1*SAFMX2
-            G1 = G1*SAFMX2
-            SCALE = MAX( ABS( F1 ), ABS( G1 ) )
-            IF( SCALE.LE.SAFMN2 )
-     $         GO TO 30
-            R = SQRT( F1**2+G1**2 )
-            CS = F1 / R
-            SN = G1 / R
-            DO 40 I = 1, COUNT
-               R = R*SAFMN2
-   40       CONTINUE
-         ELSE
-            R = SQRT( F1**2+G1**2 )
-            CS = F1 / R
-            SN = G1 / R
-         END IF
-         IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN
-            CS = -CS
-            SN = -SN
-            R = -R
-         END IF
-      END IF
-      RETURN
-*
-*     End of DLARTG
-*
-      END
diff --git a/src/lib/lapack/dlarz.f b/src/lib/lapack/dlarz.f
deleted file mode 100644
index b302fdc2..00000000
--- a/src/lib/lapack/dlarz.f
+++ /dev/null
@@ -1,152 +0,0 @@
-      SUBROUTINE DLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE
-      INTEGER            INCV, L, LDC, M, N
-      DOUBLE PRECISION   TAU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   C( LDC, * ), V( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLARZ applies a real elementary reflector H to a real M-by-N
-*  matrix C, from either the left or the right. H is represented in the
-*  form
-*
-*        H = I - tau * v * v'
-*
-*  where tau is a real scalar and v is a real vector.
-*
-*  If tau = 0, then H is taken to be the unit matrix.
-*
-*
-*  H is a product of k elementary reflectors as returned by DTZRZF.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': form  H * C
-*          = 'R': form  C * H
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  L       (input) INTEGER
-*          The number of entries of the vector V containing
-*          the meaningful part of the Householder vectors.
-*          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*
-*  V       (input) DOUBLE PRECISION array, dimension (1+(L-1)*abs(INCV))
-*          The vector v in the representation of H as returned by
-*          DTZRZF. V is not used if TAU = 0.
-*
-*  INCV    (input) INTEGER
-*          The increment between elements of v. INCV <> 0.
-*
-*  TAU     (input) DOUBLE PRECISION
-*          The value tau in the representation of H.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*          or C * H if SIDE = 'R'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension
-*                         (N) if SIDE = 'L'
-*                      or (M) if SIDE = 'R'
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DCOPY, DGEMV, DGER
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Executable Statements ..
-*
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        Form  H * C
-*
-         IF( TAU.NE.ZERO ) THEN
-*
-*           w( 1:n ) = C( 1, 1:n )
-*
-            CALL DCOPY( N, C, LDC, WORK, 1 )
-*
-*           w( 1:n ) = w( 1:n ) + C( m-l+1:m, 1:n )' * v( 1:l )
-*
-            CALL DGEMV( 'Transpose', L, N, ONE, C( M-L+1, 1 ), LDC, V,
-     $                  INCV, ONE, WORK, 1 )
-*
-*           C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
-*
-            CALL DAXPY( N, -TAU, WORK, 1, C, LDC )
-*
-*           C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
-*                               tau * v( 1:l ) * w( 1:n )'
-*
-            CALL DGER( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
-     $                 LDC )
-         END IF
-*
-      ELSE
-*
-*        Form  C * H
-*
-         IF( TAU.NE.ZERO ) THEN
-*
-*           w( 1:m ) = C( 1:m, 1 )
-*
-            CALL DCOPY( M, C, 1, WORK, 1 )
-*
-*           w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
-*
-            CALL DGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
-     $                  V, INCV, ONE, WORK, 1 )
-*
-*           C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
-*
-            CALL DAXPY( M, -TAU, WORK, 1, C, 1 )
-*
-*           C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
-*                               tau * w( 1:m ) * v( 1:l )'
-*
-            CALL DGER( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
-     $                 LDC )
-*
-         END IF
-*
-      END IF
-*
-      RETURN
-*
-*     End of DLARZ
-*
-      END
diff --git a/src/lib/lapack/dlarzb.f b/src/lib/lapack/dlarzb.f
deleted file mode 100644
index ec59d8d5..00000000
--- a/src/lib/lapack/dlarzb.f
+++ /dev/null
@@ -1,220 +0,0 @@
-      SUBROUTINE DLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
-     $                   LDV, T, LDT, C, LDC, WORK, LDWORK )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, SIDE, STOREV, TRANS
-      INTEGER            K, L, LDC, LDT, LDV, LDWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   C( LDC, * ), T( LDT, * ), V( LDV, * ),
-     $                   WORK( LDWORK, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLARZB applies a real block reflector H or its transpose H**T to
-*  a real distributed M-by-N  C from the left or the right.
-*
-*  Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply H or H' from the Left
-*          = 'R': apply H or H' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply H (No transpose)
-*          = 'C': apply H' (Transpose)
-*
-*  DIRECT  (input) CHARACTER*1
-*          Indicates how H is formed from a product of elementary
-*          reflectors
-*          = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
-*          = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*
-*  STOREV  (input) CHARACTER*1
-*          Indicates how the vectors which define the elementary
-*          reflectors are stored:
-*          = 'C': Columnwise                        (not supported yet)
-*          = 'R': Rowwise
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  K       (input) INTEGER
-*          The order of the matrix T (= the number of elementary
-*          reflectors whose product defines the block reflector).
-*
-*  L       (input) INTEGER
-*          The number of columns of the matrix V containing the
-*          meaningful part of the Householder reflectors.
-*          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*
-*  V       (input) DOUBLE PRECISION array, dimension (LDV,NV).
-*          If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V.
-*          If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
-*
-*  T       (input) DOUBLE PRECISION array, dimension (LDT,K)
-*          The triangular K-by-K matrix T in the representation of the
-*          block reflector.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= K.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (LDWORK,K)
-*
-*  LDWORK  (input) INTEGER
-*          The leading dimension of the array WORK.
-*          If SIDE = 'L', LDWORK >= max(1,N);
-*          if SIDE = 'R', LDWORK >= max(1,M).
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      CHARACTER          TRANST
-      INTEGER            I, INFO, J
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEMM, DTRMM, XERBLA
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 .OR. N.LE.0 )
-     $   RETURN
-*
-*     Check for currently supported options
-*
-      INFO = 0
-      IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
-         INFO = -3
-      ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DLARZB', -INFO )
-         RETURN
-      END IF
-*
-      IF( LSAME( TRANS, 'N' ) ) THEN
-         TRANST = 'T'
-      ELSE
-         TRANST = 'N'
-      END IF
-*
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        Form  H * C  or  H' * C
-*
-*        W( 1:n, 1:k ) = C( 1:k, 1:n )'
-*
-         DO 10 J = 1, K
-            CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
-   10    CONTINUE
-*
-*        W( 1:n, 1:k ) = W( 1:n, 1:k ) + ...
-*                        C( m-l+1:m, 1:n )' * V( 1:k, 1:l )'
-*
-         IF( L.GT.0 )
-     $      CALL DGEMM( 'Transpose', 'Transpose', N, K, L, ONE,
-     $                  C( M-L+1, 1 ), LDC, V, LDV, ONE, WORK, LDWORK )
-*
-*        W( 1:n, 1:k ) = W( 1:n, 1:k ) * T'  or  W( 1:m, 1:k ) * T
-*
-         CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T,
-     $               LDT, WORK, LDWORK )
-*
-*        C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )'
-*
-         DO 30 J = 1, N
-            DO 20 I = 1, K
-               C( I, J ) = C( I, J ) - WORK( J, I )
-   20       CONTINUE
-   30    CONTINUE
-*
-*        C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
-*                            V( 1:k, 1:l )' * W( 1:n, 1:k )'
-*
-         IF( L.GT.0 )
-     $      CALL DGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV,
-     $                  WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC )
-*
-      ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*        Form  C * H  or  C * H'
-*
-*        W( 1:m, 1:k ) = C( 1:m, 1:k )
-*
-         DO 40 J = 1, K
-            CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
-   40    CONTINUE
-*
-*        W( 1:m, 1:k ) = W( 1:m, 1:k ) + ...
-*                        C( 1:m, n-l+1:n ) * V( 1:k, 1:l )'
-*
-         IF( L.GT.0 )
-     $      CALL DGEMM( 'No transpose', 'Transpose', M, K, L, ONE,
-     $                  C( 1, N-L+1 ), LDC, V, LDV, ONE, WORK, LDWORK )
-*
-*        W( 1:m, 1:k ) = W( 1:m, 1:k ) * T  or  W( 1:m, 1:k ) * T'
-*
-         CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T,
-     $               LDT, WORK, LDWORK )
-*
-*        C( 1:m, 1:k ) = C( 1:m, 1:k ) - W( 1:m, 1:k )
-*
-         DO 60 J = 1, K
-            DO 50 I = 1, M
-               C( I, J ) = C( I, J ) - WORK( I, J )
-   50       CONTINUE
-   60    CONTINUE
-*
-*        C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
-*                            W( 1:m, 1:k ) * V( 1:k, 1:l )
-*
-         IF( L.GT.0 )
-     $      CALL DGEMM( 'No transpose', 'No transpose', M, L, K, -ONE,
-     $                  WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC )
-*
-      END IF
-*
-      RETURN
-*
-*     End of DLARZB
-*
-      END
diff --git a/src/lib/lapack/dlarzt.f b/src/lib/lapack/dlarzt.f
deleted file mode 100644
index d79636e0..00000000
--- a/src/lib/lapack/dlarzt.f
+++ /dev/null
@@ -1,184 +0,0 @@
-      SUBROUTINE DLARZT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, STOREV
-      INTEGER            K, LDT, LDV, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   T( LDT, * ), TAU( * ), V( LDV, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLARZT forms the triangular factor T of a real block reflector
-*  H of order > n, which is defined as a product of k elementary
-*  reflectors.
-*
-*  If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
-*
-*  If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
-*
-*  If STOREV = 'C', the vector which defines the elementary reflector
-*  H(i) is stored in the i-th column of the array V, and
-*
-*     H  =  I - V * T * V'
-*
-*  If STOREV = 'R', the vector which defines the elementary reflector
-*  H(i) is stored in the i-th row of the array V, and
-*
-*     H  =  I - V' * T * V
-*
-*  Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
-*
-*  Arguments
-*  =========
-*
-*  DIRECT  (input) CHARACTER*1
-*          Specifies the order in which the elementary reflectors are
-*          multiplied to form the block reflector:
-*          = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
-*          = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*
-*  STOREV  (input) CHARACTER*1
-*          Specifies how the vectors which define the elementary
-*          reflectors are stored (see also Further Details):
-*          = 'C': columnwise                        (not supported yet)
-*          = 'R': rowwise
-*
-*  N       (input) INTEGER
-*          The order of the block reflector H. N >= 0.
-*
-*  K       (input) INTEGER
-*          The order of the triangular factor T (= the number of
-*          elementary reflectors). K >= 1.
-*
-*  V       (input/output) DOUBLE PRECISION array, dimension
-*                               (LDV,K) if STOREV = 'C'
-*                               (LDV,N) if STOREV = 'R'
-*          The matrix V. See further details.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V.
-*          If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i).
-*
-*  T       (output) DOUBLE PRECISION array, dimension (LDT,K)
-*          The k by k triangular factor T of the block reflector.
-*          If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
-*          lower triangular. The rest of the array is not used.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= K.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  The shape of the matrix V and the storage of the vectors which define
-*  the H(i) is best illustrated by the following example with n = 5 and
-*  k = 3. The elements equal to 1 are not stored; the corresponding
-*  array elements are modified but restored on exit. The rest of the
-*  array is not used.
-*
-*  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
-*
-*                                              ______V_____
-*         ( v1 v2 v3 )                        /            \
-*         ( v1 v2 v3 )                      ( v1 v1 v1 v1 v1 . . . . 1 )
-*     V = ( v1 v2 v3 )                      ( v2 v2 v2 v2 v2 . . . 1   )
-*         ( v1 v2 v3 )                      ( v3 v3 v3 v3 v3 . . 1     )
-*         ( v1 v2 v3 )
-*            .  .  .
-*            .  .  .
-*            1  .  .
-*               1  .
-*                  1
-*
-*  DIRECT = 'B' and STOREV = 'C':         DIRECT = 'B' and STOREV = 'R':
-*
-*                                                        ______V_____
-*            1                                          /            \
-*            .  1                           ( 1 . . . . v1 v1 v1 v1 v1 )
-*            .  .  1                        ( . 1 . . . v2 v2 v2 v2 v2 )
-*            .  .  .                        ( . . 1 . . v3 v3 v3 v3 v3 )
-*            .  .  .
-*         ( v1 v2 v3 )
-*         ( v1 v2 v3 )
-*     V = ( v1 v2 v3 )
-*         ( v1 v2 v3 )
-*         ( v1 v2 v3 )
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, INFO, J
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMV, DTRMV, XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Executable Statements ..
-*
-*     Check for currently supported options
-*
-      INFO = 0
-      IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
-         INFO = -2
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DLARZT', -INFO )
-         RETURN
-      END IF
-*
-      DO 20 I = K, 1, -1
-         IF( TAU( I ).EQ.ZERO ) THEN
-*
-*           H(i)  =  I
-*
-            DO 10 J = I, K
-               T( J, I ) = ZERO
-   10       CONTINUE
-         ELSE
-*
-*           general case
-*
-            IF( I.LT.K ) THEN
-*
-*              T(i+1:k,i) = - tau(i) * V(i+1:k,1:n) * V(i,1:n)'
-*
-               CALL DGEMV( 'No transpose', K-I, N, -TAU( I ),
-     $                     V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO,
-     $                     T( I+1, I ), 1 )
-*
-*              T(i+1:k,i) = T(i+1:k,i+1:k) * T(i+1:k,i)
-*
-               CALL DTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
-     $                     T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
-            END IF
-            T( I, I ) = TAU( I )
-         END IF
-   20 CONTINUE
-      RETURN
-*
-*     End of DLARZT
-*
-      END
diff --git a/src/lib/lapack/dlas2.f b/src/lib/lapack/dlas2.f
deleted file mode 100644
index e100a4d8..00000000
--- a/src/lib/lapack/dlas2.f
+++ /dev/null
@@ -1,121 +0,0 @@
-      SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   F, G, H, SSMAX, SSMIN
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAS2  computes the singular values of the 2-by-2 matrix
-*     [  F   G  ]
-*     [  0   H  ].
-*  On return, SSMIN is the smaller singular value and SSMAX is the
-*  larger singular value.
-*
-*  Arguments
-*  =========
-*
-*  F       (input) DOUBLE PRECISION
-*          The (1,1) element of the 2-by-2 matrix.
-*
-*  G       (input) DOUBLE PRECISION
-*          The (1,2) element of the 2-by-2 matrix.
-*
-*  H       (input) DOUBLE PRECISION
-*          The (2,2) element of the 2-by-2 matrix.
-*
-*  SSMIN   (output) DOUBLE PRECISION
-*          The smaller singular value.
-*
-*  SSMAX   (output) DOUBLE PRECISION
-*          The larger singular value.
-*
-*  Further Details
-*  ===============
-*
-*  Barring over/underflow, all output quantities are correct to within
-*  a few units in the last place (ulps), even in the absence of a guard
-*  digit in addition/subtraction.
-*
-*  In IEEE arithmetic, the code works correctly if one matrix element is
-*  infinite.
-*
-*  Overflow will not occur unless the largest singular value itself
-*  overflows, or is within a few ulps of overflow. (On machines with
-*  partial overflow, like the Cray, overflow may occur if the largest
-*  singular value is within a factor of 2 of overflow.)
-*
-*  Underflow is harmless if underflow is gradual. Otherwise, results
-*  may correspond to a matrix modified by perturbations of size near
-*  the underflow threshold.
-*
-*  ====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D0 )
-      DOUBLE PRECISION   TWO
-      PARAMETER          ( TWO = 2.0D0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   AS, AT, AU, C, FA, FHMN, FHMX, GA, HA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      FA = ABS( F )
-      GA = ABS( G )
-      HA = ABS( H )
-      FHMN = MIN( FA, HA )
-      FHMX = MAX( FA, HA )
-      IF( FHMN.EQ.ZERO ) THEN
-         SSMIN = ZERO
-         IF( FHMX.EQ.ZERO ) THEN
-            SSMAX = GA
-         ELSE
-            SSMAX = MAX( FHMX, GA )*SQRT( ONE+
-     $              ( MIN( FHMX, GA ) / MAX( FHMX, GA ) )**2 )
-         END IF
-      ELSE
-         IF( GA.LT.FHMX ) THEN
-            AS = ONE + FHMN / FHMX
-            AT = ( FHMX-FHMN ) / FHMX
-            AU = ( GA / FHMX )**2
-            C = TWO / ( SQRT( AS*AS+AU )+SQRT( AT*AT+AU ) )
-            SSMIN = FHMN*C
-            SSMAX = FHMX / C
-         ELSE
-            AU = FHMX / GA
-            IF( AU.EQ.ZERO ) THEN
-*
-*              Avoid possible harmful underflow if exponent range
-*              asymmetric (true SSMIN may not underflow even if
-*              AU underflows)
-*
-               SSMIN = ( FHMN*FHMX ) / GA
-               SSMAX = GA
-            ELSE
-               AS = ONE + FHMN / FHMX
-               AT = ( FHMX-FHMN ) / FHMX
-               C = ONE / ( SQRT( ONE+( AS*AU )**2 )+
-     $             SQRT( ONE+( AT*AU )**2 ) )
-               SSMIN = ( FHMN*C )*AU
-               SSMIN = SSMIN + SSMIN
-               SSMAX = GA / ( C+C )
-            END IF
-         END IF
-      END IF
-      RETURN
-*
-*     End of DLAS2
-*
-      END
diff --git a/src/lib/lapack/dlascl.f b/src/lib/lapack/dlascl.f
deleted file mode 100644
index 7a7a78fd..00000000
--- a/src/lib/lapack/dlascl.f
+++ /dev/null
@@ -1,267 +0,0 @@
-      SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TYPE
-      INTEGER            INFO, KL, KU, LDA, M, N
-      DOUBLE PRECISION   CFROM, CTO
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASCL multiplies the M by N real matrix A by the real scalar
-*  CTO/CFROM.  This is done without over/underflow as long as the final
-*  result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
-*  A may be full, upper triangular, lower triangular, upper Hessenberg,
-*  or banded.
-*
-*  Arguments
-*  =========
-*
-*  TYPE    (input) CHARACTER*1
-*          TYPE indices the storage type of the input matrix.
-*          = 'G':  A is a full matrix.
-*          = 'L':  A is a lower triangular matrix.
-*          = 'U':  A is an upper triangular matrix.
-*          = 'H':  A is an upper Hessenberg matrix.
-*          = 'B':  A is a symmetric band matrix with lower bandwidth KL
-*                  and upper bandwidth KU and with the only the lower
-*                  half stored.
-*          = 'Q':  A is a symmetric band matrix with lower bandwidth KL
-*                  and upper bandwidth KU and with the only the upper
-*                  half stored.
-*          = 'Z':  A is a band matrix with lower bandwidth KL and upper
-*                  bandwidth KU.
-*
-*  KL      (input) INTEGER
-*          The lower bandwidth of A.  Referenced only if TYPE = 'B',
-*          'Q' or 'Z'.
-*
-*  KU      (input) INTEGER
-*          The upper bandwidth of A.  Referenced only if TYPE = 'B',
-*          'Q' or 'Z'.
-*
-*  CFROM   (input) DOUBLE PRECISION
-*  CTO     (input) DOUBLE PRECISION
-*          The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
-*          without over/underflow if the final result CTO*A(I,J)/CFROM
-*          can be represented without over/underflow.  CFROM must be
-*          nonzero.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          The matrix to be multiplied by CTO/CFROM.  See TYPE for the
-*          storage type.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  INFO    (output) INTEGER
-*          0  - successful exit
-*          <0 - if INFO = -i, the i-th argument had an illegal value.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            DONE
-      INTEGER            I, ITYPE, J, K1, K2, K3, K4
-      DOUBLE PRECISION   BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-*
-      IF( LSAME( TYPE, 'G' ) ) THEN
-         ITYPE = 0
-      ELSE IF( LSAME( TYPE, 'L' ) ) THEN
-         ITYPE = 1
-      ELSE IF( LSAME( TYPE, 'U' ) ) THEN
-         ITYPE = 2
-      ELSE IF( LSAME( TYPE, 'H' ) ) THEN
-         ITYPE = 3
-      ELSE IF( LSAME( TYPE, 'B' ) ) THEN
-         ITYPE = 4
-      ELSE IF( LSAME( TYPE, 'Q' ) ) THEN
-         ITYPE = 5
-      ELSE IF( LSAME( TYPE, 'Z' ) ) THEN
-         ITYPE = 6
-      ELSE
-         ITYPE = -1
-      END IF
-*
-      IF( ITYPE.EQ.-1 ) THEN
-         INFO = -1
-      ELSE IF( CFROM.EQ.ZERO ) THEN
-         INFO = -4
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -6
-      ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR.
-     $         ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN
-         INFO = -7
-      ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -9
-      ELSE IF( ITYPE.GE.4 ) THEN
-         IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN
-            INFO = -2
-         ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR.
-     $            ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) )
-     $             THEN
-            INFO = -3
-         ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR.
-     $            ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR.
-     $            ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN
-            INFO = -9
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DLASCL', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 .OR. M.EQ.0 )
-     $   RETURN
-*
-*     Get machine parameters
-*
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-*
-      CFROMC = CFROM
-      CTOC = CTO
-*
-   10 CONTINUE
-      CFROM1 = CFROMC*SMLNUM
-      CTO1 = CTOC / BIGNUM
-      IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN
-         MUL = SMLNUM
-         DONE = .FALSE.
-         CFROMC = CFROM1
-      ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN
-         MUL = BIGNUM
-         DONE = .FALSE.
-         CTOC = CTO1
-      ELSE
-         MUL = CTOC / CFROMC
-         DONE = .TRUE.
-      END IF
-*
-      IF( ITYPE.EQ.0 ) THEN
-*
-*        Full matrix
-*
-         DO 30 J = 1, N
-            DO 20 I = 1, M
-               A( I, J ) = A( I, J )*MUL
-   20       CONTINUE
-   30    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.1 ) THEN
-*
-*        Lower triangular matrix
-*
-         DO 50 J = 1, N
-            DO 40 I = J, M
-               A( I, J ) = A( I, J )*MUL
-   40       CONTINUE
-   50    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.2 ) THEN
-*
-*        Upper triangular matrix
-*
-         DO 70 J = 1, N
-            DO 60 I = 1, MIN( J, M )
-               A( I, J ) = A( I, J )*MUL
-   60       CONTINUE
-   70    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.3 ) THEN
-*
-*        Upper Hessenberg matrix
-*
-         DO 90 J = 1, N
-            DO 80 I = 1, MIN( J+1, M )
-               A( I, J ) = A( I, J )*MUL
-   80       CONTINUE
-   90    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.4 ) THEN
-*
-*        Lower half of a symmetric band matrix
-*
-         K3 = KL + 1
-         K4 = N + 1
-         DO 110 J = 1, N
-            DO 100 I = 1, MIN( K3, K4-J )
-               A( I, J ) = A( I, J )*MUL
-  100       CONTINUE
-  110    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.5 ) THEN
-*
-*        Upper half of a symmetric band matrix
-*
-         K1 = KU + 2
-         K3 = KU + 1
-         DO 130 J = 1, N
-            DO 120 I = MAX( K1-J, 1 ), K3
-               A( I, J ) = A( I, J )*MUL
-  120       CONTINUE
-  130    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.6 ) THEN
-*
-*        Band matrix
-*
-         K1 = KL + KU + 2
-         K2 = KL + 1
-         K3 = 2*KL + KU + 1
-         K4 = KL + KU + 1 + M
-         DO 150 J = 1, N
-            DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J )
-               A( I, J ) = A( I, J )*MUL
-  140       CONTINUE
-  150    CONTINUE
-*
-      END IF
-*
-      IF( .NOT.DONE )
-     $   GO TO 10
-*
-      RETURN
-*
-*     End of DLASCL
-*
-      END
diff --git a/src/lib/lapack/dlaset.f b/src/lib/lapack/dlaset.f
deleted file mode 100644
index fc7bc2f5..00000000
--- a/src/lib/lapack/dlaset.f
+++ /dev/null
@@ -1,114 +0,0 @@
-      SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            LDA, M, N
-      DOUBLE PRECISION   ALPHA, BETA
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASET initializes an m-by-n matrix A to BETA on the diagonal and
-*  ALPHA on the offdiagonals.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies the part of the matrix A to be set.
-*          = 'U':      Upper triangular part is set; the strictly lower
-*                      triangular part of A is not changed.
-*          = 'L':      Lower triangular part is set; the strictly upper
-*                      triangular part of A is not changed.
-*          Otherwise:  All of the matrix A is set.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  ALPHA   (input) DOUBLE PRECISION
-*          The constant to which the offdiagonal elements are to be set.
-*
-*  BETA    (input) DOUBLE PRECISION
-*          The constant to which the diagonal elements are to be set.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On exit, the leading m-by-n submatrix of A is set as follows:
-*
-*          if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
-*          if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
-*          otherwise,     A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
-*
-*          and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, J
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-      IF( LSAME( UPLO, 'U' ) ) THEN
-*
-*        Set the strictly upper triangular or trapezoidal part of the
-*        array to ALPHA.
-*
-         DO 20 J = 2, N
-            DO 10 I = 1, MIN( J-1, M )
-               A( I, J ) = ALPHA
-   10       CONTINUE
-   20    CONTINUE
-*
-      ELSE IF( LSAME( UPLO, 'L' ) ) THEN
-*
-*        Set the strictly lower triangular or trapezoidal part of the
-*        array to ALPHA.
-*
-         DO 40 J = 1, MIN( M, N )
-            DO 30 I = J + 1, M
-               A( I, J ) = ALPHA
-   30       CONTINUE
-   40    CONTINUE
-*
-      ELSE
-*
-*        Set the leading m-by-n submatrix to ALPHA.
-*
-         DO 60 J = 1, N
-            DO 50 I = 1, M
-               A( I, J ) = ALPHA
-   50       CONTINUE
-   60    CONTINUE
-      END IF
-*
-*     Set the first min(M,N) diagonal elements to BETA.
-*
-      DO 70 I = 1, MIN( M, N )
-         A( I, I ) = BETA
-   70 CONTINUE
-*
-      RETURN
-*
-*     End of DLASET
-*
-      END
diff --git a/src/lib/lapack/dlasq1.f b/src/lib/lapack/dlasq1.f
deleted file mode 100644
index 6f4c3413..00000000
--- a/src/lib/lapack/dlasq1.f
+++ /dev/null
@@ -1,148 +0,0 @@
-      SUBROUTINE DLASQ1( N, D, E, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASQ1 computes the singular values of a real N-by-N bidiagonal
-*  matrix with diagonal D and off-diagonal E. The singular values
-*  are computed to high relative accuracy, in the absence of
-*  denormalization, underflow and overflow. The algorithm was first
-*  presented in
-*
-*  "Accurate singular values and differential qd algorithms" by K. V.
-*  Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
-*  1994,
-*
-*  and the present implementation is described in "An implementation of
-*  the dqds Algorithm (Positive Case)", LAPACK Working Note.
-*
-*  Arguments
-*  =========
-*
-*  N     (input) INTEGER
-*        The number of rows and columns in the matrix. N >= 0.
-*
-*  D     (input/output) DOUBLE PRECISION array, dimension (N)
-*        On entry, D contains the diagonal elements of the
-*        bidiagonal matrix whose SVD is desired. On normal exit,
-*        D contains the singular values in decreasing order.
-*
-*  E     (input/output) DOUBLE PRECISION array, dimension (N)
-*        On entry, elements E(1:N-1) contain the off-diagonal elements
-*        of the bidiagonal matrix whose SVD is desired.
-*        On exit, E is overwritten.
-*
-*  WORK  (workspace) DOUBLE PRECISION array, dimension (4*N)
-*
-*  INFO  (output) INTEGER
-*        = 0: successful exit
-*        < 0: if INFO = -i, the i-th argument had an illegal value
-*        > 0: the algorithm failed
-*             = 1, a split was marked by a positive value in E
-*             = 2, current block of Z not diagonalized after 30*N
-*                  iterations (in inner while loop)
-*             = 3, termination criterion of outer while loop not met 
-*                  (program created more than N unreduced blocks)
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, IINFO
-      DOUBLE PRECISION   EPS, SCALE, SAFMIN, SIGMN, SIGMX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DLAS2, DLASCL, DLASQ2, DLASRT, XERBLA
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-      IF( N.LT.0 ) THEN
-         INFO = -2
-         CALL XERBLA( 'DLASQ1', -INFO )
-         RETURN
-      ELSE IF( N.EQ.0 ) THEN
-         RETURN
-      ELSE IF( N.EQ.1 ) THEN
-         D( 1 ) = ABS( D( 1 ) )
-         RETURN
-      ELSE IF( N.EQ.2 ) THEN
-         CALL DLAS2( D( 1 ), E( 1 ), D( 2 ), SIGMN, SIGMX )
-         D( 1 ) = SIGMX
-         D( 2 ) = SIGMN
-         RETURN
-      END IF
-*
-*     Estimate the largest singular value.
-*
-      SIGMX = ZERO
-      DO 10 I = 1, N - 1
-         D( I ) = ABS( D( I ) )
-         SIGMX = MAX( SIGMX, ABS( E( I ) ) )
-   10 CONTINUE
-      D( N ) = ABS( D( N ) )
-*
-*     Early return if SIGMX is zero (matrix is already diagonal).
-*
-      IF( SIGMX.EQ.ZERO ) THEN
-         CALL DLASRT( 'D', N, D, IINFO )
-         RETURN
-      END IF
-*
-      DO 20 I = 1, N
-         SIGMX = MAX( SIGMX, D( I ) )
-   20 CONTINUE
-*
-*     Copy D and E into WORK (in the Z format) and scale (squaring the
-*     input data makes scaling by a power of the radix pointless).
-*
-      EPS = DLAMCH( 'Precision' )
-      SAFMIN = DLAMCH( 'Safe minimum' )
-      SCALE = SQRT( EPS / SAFMIN )
-      CALL DCOPY( N, D, 1, WORK( 1 ), 2 )
-      CALL DCOPY( N-1, E, 1, WORK( 2 ), 2 )
-      CALL DLASCL( 'G', 0, 0, SIGMX, SCALE, 2*N-1, 1, WORK, 2*N-1,
-     $             IINFO )
-*         
-*     Compute the q's and e's.
-*
-      DO 30 I = 1, 2*N - 1
-         WORK( I ) = WORK( I )**2
-   30 CONTINUE
-      WORK( 2*N ) = ZERO
-*
-      CALL DLASQ2( N, WORK, INFO )
-*
-      IF( INFO.EQ.0 ) THEN
-         DO 40 I = 1, N
-            D( I ) = SQRT( WORK( I ) )
-   40    CONTINUE
-         CALL DLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, D, N, IINFO )
-      END IF
-*
-      RETURN
-*
-*     End of DLASQ1
-*
-      END
diff --git a/src/lib/lapack/dlasq2.f b/src/lib/lapack/dlasq2.f
deleted file mode 100644
index b6b79aeb..00000000
--- a/src/lib/lapack/dlasq2.f
+++ /dev/null
@@ -1,448 +0,0 @@
-      SUBROUTINE DLASQ2( N, Z, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     Modified to call DLAZQ3 in place of DLASQ3, 13 Feb 03, SJH.
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   Z( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASQ2 computes all the eigenvalues of the symmetric positive 
-*  definite tridiagonal matrix associated with the qd array Z to high
-*  relative accuracy are computed to high relative accuracy, in the
-*  absence of denormalization, underflow and overflow.
-*
-*  To see the relation of Z to the tridiagonal matrix, let L be a
-*  unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and
-*  let U be an upper bidiagonal matrix with 1's above and diagonal
-*  Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the
-*  symmetric tridiagonal to which it is similar.
-*
-*  Note : DLASQ2 defines a logical variable, IEEE, which is true
-*  on machines which follow ieee-754 floating-point standard in their
-*  handling of infinities and NaNs, and false otherwise. This variable
-*  is passed to DLAZQ3.
-*
-*  Arguments
-*  =========
-*
-*  N     (input) INTEGER
-*        The number of rows and columns in the matrix. N >= 0.
-*
-*  Z     (workspace) DOUBLE PRECISION array, dimension ( 4*N )
-*        On entry Z holds the qd array. On exit, entries 1 to N hold
-*        the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
-*        trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If
-*        N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 )
-*        holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of
-*        shifts that failed.
-*
-*  INFO  (output) INTEGER
-*        = 0: successful exit
-*        < 0: if the i-th argument is a scalar and had an illegal
-*             value, then INFO = -i, if the i-th argument is an
-*             array and the j-entry had an illegal value, then
-*             INFO = -(i*100+j)
-*        > 0: the algorithm failed
-*              = 1, a split was marked by a positive value in E
-*              = 2, current block of Z not diagonalized after 30*N
-*                   iterations (in inner while loop)
-*              = 3, termination criterion of outer while loop not met 
-*                   (program created more than N unreduced blocks)
-*
-*  Further Details
-*  ===============
-*  Local Variables: I0:N0 defines a current unreduced segment of Z.
-*  The shifts are accumulated in SIGMA. Iteration count is in ITER.
-*  Ping-pong is controlled by PP (alternates between 0 and 1).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   CBIAS
-      PARAMETER          ( CBIAS = 1.50D0 )
-      DOUBLE PRECISION   ZERO, HALF, ONE, TWO, FOUR, HUNDRD
-      PARAMETER          ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0,
-     $                     TWO = 2.0D0, FOUR = 4.0D0, HUNDRD = 100.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            IEEE
-      INTEGER            I0, I4, IINFO, IPN4, ITER, IWHILA, IWHILB, K, 
-     $                   N0, NBIG, NDIV, NFAIL, PP, SPLT, TTYPE
-      DOUBLE PRECISION   D, DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, E,
-     $                   EMAX, EMIN, EPS, OLDEMN, QMAX, QMIN, S, SAFMIN,
-     $                   SIGMA, T, TAU, TEMP, TOL, TOL2, TRACE, ZMAX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLAZQ3, DLASRT, XERBLA
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH, ILAENV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*      
-*     Test the input arguments.
-*     (in case DLASQ2 is not called by DLASQ1)
-*
-      INFO = 0
-      EPS = DLAMCH( 'Precision' )
-      SAFMIN = DLAMCH( 'Safe minimum' )
-      TOL = EPS*HUNDRD
-      TOL2 = TOL**2
-*
-      IF( N.LT.0 ) THEN
-         INFO = -1
-         CALL XERBLA( 'DLASQ2', 1 )
-         RETURN
-      ELSE IF( N.EQ.0 ) THEN
-         RETURN
-      ELSE IF( N.EQ.1 ) THEN
-*
-*        1-by-1 case.
-*
-         IF( Z( 1 ).LT.ZERO ) THEN
-            INFO = -201
-            CALL XERBLA( 'DLASQ2', 2 )
-         END IF
-         RETURN
-      ELSE IF( N.EQ.2 ) THEN
-*
-*        2-by-2 case.
-*
-         IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN
-            INFO = -2
-            CALL XERBLA( 'DLASQ2', 2 )
-            RETURN
-         ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN
-            D = Z( 3 )
-            Z( 3 ) = Z( 1 )
-            Z( 1 ) = D
-         END IF
-         Z( 5 ) = Z( 1 ) + Z( 2 ) + Z( 3 )
-         IF( Z( 2 ).GT.Z( 3 )*TOL2 ) THEN
-            T = HALF*( ( Z( 1 )-Z( 3 ) )+Z( 2 ) ) 
-            S = Z( 3 )*( Z( 2 ) / T )
-            IF( S.LE.T ) THEN
-               S = Z( 3 )*( Z( 2 ) / ( T*( ONE+SQRT( ONE+S / T ) ) ) )
-            ELSE
-               S = Z( 3 )*( Z( 2 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
-            END IF
-            T = Z( 1 ) + ( S+Z( 2 ) )
-            Z( 3 ) = Z( 3 )*( Z( 1 ) / T )
-            Z( 1 ) = T
-         END IF
-         Z( 2 ) = Z( 3 )
-         Z( 6 ) = Z( 2 ) + Z( 1 )
-         RETURN
-      END IF
-*
-*     Check for negative data and compute sums of q's and e's.
-*
-      Z( 2*N ) = ZERO
-      EMIN = Z( 2 )
-      QMAX = ZERO
-      ZMAX = ZERO
-      D = ZERO
-      E = ZERO
-*
-      DO 10 K = 1, 2*( N-1 ), 2
-         IF( Z( K ).LT.ZERO ) THEN
-            INFO = -( 200+K )
-            CALL XERBLA( 'DLASQ2', 2 )
-            RETURN
-         ELSE IF( Z( K+1 ).LT.ZERO ) THEN
-            INFO = -( 200+K+1 )
-            CALL XERBLA( 'DLASQ2', 2 )
-            RETURN
-         END IF
-         D = D + Z( K )
-         E = E + Z( K+1 )
-         QMAX = MAX( QMAX, Z( K ) )
-         EMIN = MIN( EMIN, Z( K+1 ) )
-         ZMAX = MAX( QMAX, ZMAX, Z( K+1 ) )
-   10 CONTINUE
-      IF( Z( 2*N-1 ).LT.ZERO ) THEN
-         INFO = -( 200+2*N-1 )
-         CALL XERBLA( 'DLASQ2', 2 )
-         RETURN
-      END IF
-      D = D + Z( 2*N-1 )
-      QMAX = MAX( QMAX, Z( 2*N-1 ) )
-      ZMAX = MAX( QMAX, ZMAX )
-*
-*     Check for diagonality.
-*
-      IF( E.EQ.ZERO ) THEN
-         DO 20 K = 2, N
-            Z( K ) = Z( 2*K-1 )
-   20    CONTINUE
-         CALL DLASRT( 'D', N, Z, IINFO )
-         Z( 2*N-1 ) = D
-         RETURN
-      END IF
-*
-      TRACE = D + E
-*
-*     Check for zero data.
-*
-      IF( TRACE.EQ.ZERO ) THEN
-         Z( 2*N-1 ) = ZERO
-         RETURN
-      END IF
-*         
-*     Check whether the machine is IEEE conformable.
-*         
-      IEEE = ILAENV( 10, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 .AND.
-     $       ILAENV( 11, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1      
-*         
-*     Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...).
-*
-      DO 30 K = 2*N, 2, -2
-         Z( 2*K ) = ZERO 
-         Z( 2*K-1 ) = Z( K ) 
-         Z( 2*K-2 ) = ZERO 
-         Z( 2*K-3 ) = Z( K-1 ) 
-   30 CONTINUE
-*
-      I0 = 1
-      N0 = N
-*
-*     Reverse the qd-array, if warranted.
-*
-      IF( CBIAS*Z( 4*I0-3 ).LT.Z( 4*N0-3 ) ) THEN
-         IPN4 = 4*( I0+N0 )
-         DO 40 I4 = 4*I0, 2*( I0+N0-1 ), 4
-            TEMP = Z( I4-3 )
-            Z( I4-3 ) = Z( IPN4-I4-3 )
-            Z( IPN4-I4-3 ) = TEMP
-            TEMP = Z( I4-1 )
-            Z( I4-1 ) = Z( IPN4-I4-5 )
-            Z( IPN4-I4-5 ) = TEMP
-   40    CONTINUE
-      END IF
-*
-*     Initial split checking via dqd and Li's test.
-*
-      PP = 0
-*
-      DO 80 K = 1, 2
-*
-         D = Z( 4*N0+PP-3 )
-         DO 50 I4 = 4*( N0-1 ) + PP, 4*I0 + PP, -4
-            IF( Z( I4-1 ).LE.TOL2*D ) THEN
-               Z( I4-1 ) = -ZERO
-               D = Z( I4-3 )
-            ELSE
-               D = Z( I4-3 )*( D / ( D+Z( I4-1 ) ) )
-            END IF
-   50    CONTINUE
-*
-*        dqd maps Z to ZZ plus Li's test.
-*
-         EMIN = Z( 4*I0+PP+1 )
-         D = Z( 4*I0+PP-3 )
-         DO 60 I4 = 4*I0 + PP, 4*( N0-1 ) + PP, 4
-            Z( I4-2*PP-2 ) = D + Z( I4-1 )
-            IF( Z( I4-1 ).LE.TOL2*D ) THEN
-               Z( I4-1 ) = -ZERO
-               Z( I4-2*PP-2 ) = D
-               Z( I4-2*PP ) = ZERO
-               D = Z( I4+1 )
-            ELSE IF( SAFMIN*Z( I4+1 ).LT.Z( I4-2*PP-2 ) .AND.
-     $               SAFMIN*Z( I4-2*PP-2 ).LT.Z( I4+1 ) ) THEN
-               TEMP = Z( I4+1 ) / Z( I4-2*PP-2 )
-               Z( I4-2*PP ) = Z( I4-1 )*TEMP
-               D = D*TEMP
-            ELSE
-               Z( I4-2*PP ) = Z( I4+1 )*( Z( I4-1 ) / Z( I4-2*PP-2 ) )
-               D = Z( I4+1 )*( D / Z( I4-2*PP-2 ) )
-            END IF
-            EMIN = MIN( EMIN, Z( I4-2*PP ) )
-   60    CONTINUE 
-         Z( 4*N0-PP-2 ) = D
-*
-*        Now find qmax.
-*
-         QMAX = Z( 4*I0-PP-2 )
-         DO 70 I4 = 4*I0 - PP + 2, 4*N0 - PP - 2, 4
-            QMAX = MAX( QMAX, Z( I4 ) )
-   70    CONTINUE
-*
-*        Prepare for the next iteration on K.
-*
-         PP = 1 - PP
-   80 CONTINUE
-*
-*     Initialise variables to pass to DLAZQ3
-*
-      TTYPE = 0
-      DMIN1 = ZERO
-      DMIN2 = ZERO
-      DN    = ZERO
-      DN1   = ZERO
-      DN2   = ZERO
-      TAU   = ZERO
-*
-      ITER = 2
-      NFAIL = 0
-      NDIV = 2*( N0-I0 )
-*
-      DO 140 IWHILA = 1, N + 1
-         IF( N0.LT.1 ) 
-     $      GO TO 150
-*
-*        While array unfinished do 
-*
-*        E(N0) holds the value of SIGMA when submatrix in I0:N0
-*        splits from the rest of the array, but is negated.
-*      
-         DESIG = ZERO
-         IF( N0.EQ.N ) THEN
-            SIGMA = ZERO
-         ELSE
-            SIGMA = -Z( 4*N0-1 )
-         END IF
-         IF( SIGMA.LT.ZERO ) THEN
-            INFO = 1
-            RETURN
-         END IF
-*
-*        Find last unreduced submatrix's top index I0, find QMAX and
-*        EMIN. Find Gershgorin-type bound if Q's much greater than E's.
-*
-         EMAX = ZERO 
-         IF( N0.GT.I0 ) THEN
-            EMIN = ABS( Z( 4*N0-5 ) )
-         ELSE
-            EMIN = ZERO
-         END IF
-         QMIN = Z( 4*N0-3 )
-         QMAX = QMIN
-         DO 90 I4 = 4*N0, 8, -4
-            IF( Z( I4-5 ).LE.ZERO )
-     $         GO TO 100
-            IF( QMIN.GE.FOUR*EMAX ) THEN
-               QMIN = MIN( QMIN, Z( I4-3 ) )
-               EMAX = MAX( EMAX, Z( I4-5 ) )
-            END IF
-            QMAX = MAX( QMAX, Z( I4-7 )+Z( I4-5 ) )
-            EMIN = MIN( EMIN, Z( I4-5 ) )
-   90    CONTINUE
-         I4 = 4 
-*
-  100    CONTINUE
-         I0 = I4 / 4
-*
-*        Store EMIN for passing to DLAZQ3.
-*
-         Z( 4*N0-1 ) = EMIN
-*
-*        Put -(initial shift) into DMIN.
-*
-         DMIN = -MAX( ZERO, QMIN-TWO*SQRT( QMIN )*SQRT( EMAX ) )
-*
-*        Now I0:N0 is unreduced. PP = 0 for ping, PP = 1 for pong.
-*
-         PP = 0 
-*
-         NBIG = 30*( N0-I0+1 )
-         DO 120 IWHILB = 1, NBIG
-            IF( I0.GT.N0 ) 
-     $         GO TO 130
-*
-*           While submatrix unfinished take a good dqds step.
-*
-            CALL DLAZQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
-     $                   ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
-     $                   DN2, TAU )
-*
-            PP = 1 - PP
-*
-*           When EMIN is very small check for splits.
-*
-            IF( PP.EQ.0 .AND. N0-I0.GE.3 ) THEN
-               IF( Z( 4*N0 ).LE.TOL2*QMAX .OR.
-     $             Z( 4*N0-1 ).LE.TOL2*SIGMA ) THEN
-                  SPLT = I0 - 1
-                  QMAX = Z( 4*I0-3 )
-                  EMIN = Z( 4*I0-1 )
-                  OLDEMN = Z( 4*I0 )
-                  DO 110 I4 = 4*I0, 4*( N0-3 ), 4
-                     IF( Z( I4 ).LE.TOL2*Z( I4-3 ) .OR.
-     $                   Z( I4-1 ).LE.TOL2*SIGMA ) THEN
-                        Z( I4-1 ) = -SIGMA
-                        SPLT = I4 / 4
-                        QMAX = ZERO
-                        EMIN = Z( I4+3 )
-                        OLDEMN = Z( I4+4 )
-                     ELSE
-                        QMAX = MAX( QMAX, Z( I4+1 ) )
-                        EMIN = MIN( EMIN, Z( I4-1 ) )
-                        OLDEMN = MIN( OLDEMN, Z( I4 ) )
-                     END IF
-  110             CONTINUE
-                  Z( 4*N0-1 ) = EMIN
-                  Z( 4*N0 ) = OLDEMN
-                  I0 = SPLT + 1
-               END IF
-            END IF
-*
-  120    CONTINUE
-*
-         INFO = 2
-         RETURN
-*
-*        end IWHILB
-*
-  130    CONTINUE
-*
-  140 CONTINUE
-*
-      INFO = 3
-      RETURN
-*
-*     end IWHILA   
-*
-  150 CONTINUE
-*      
-*     Move q's to the front.
-*      
-      DO 160 K = 2, N
-         Z( K ) = Z( 4*K-3 )
-  160 CONTINUE
-*      
-*     Sort and compute sum of eigenvalues.
-*
-      CALL DLASRT( 'D', N, Z, IINFO )
-*
-      E = ZERO
-      DO 170 K = N, 1, -1
-         E = E + Z( K )
-  170 CONTINUE
-*
-*     Store trace, sum(eigenvalues) and information on performance.
-*
-      Z( 2*N+1 ) = TRACE 
-      Z( 2*N+2 ) = E
-      Z( 2*N+3 ) = DBLE( ITER )
-      Z( 2*N+4 ) = DBLE( NDIV ) / DBLE( N**2 )
-      Z( 2*N+5 ) = HUNDRD*NFAIL / DBLE( ITER )
-      RETURN
-*
-*     End of DLASQ2
-*
-      END
diff --git a/src/lib/lapack/dlasq3.f b/src/lib/lapack/dlasq3.f
deleted file mode 100644
index ce4055d8..00000000
--- a/src/lib/lapack/dlasq3.f
+++ /dev/null
@@ -1,295 +0,0 @@
-      SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
-     $                   ITER, NDIV, IEEE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            IEEE
-      INTEGER            I0, ITER, N0, NDIV, NFAIL, PP
-      DOUBLE PRECISION   DESIG, DMIN, QMAX, SIGMA
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   Z( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds.
-*  In case of failure it changes shifts, and tries again until output
-*  is positive.
-*
-*  Arguments
-*  =========
-*
-*  I0     (input) INTEGER
-*         First index.
-*
-*  N0     (input) INTEGER
-*         Last index.
-*
-*  Z      (input) DOUBLE PRECISION array, dimension ( 4*N )
-*         Z holds the qd array.
-*
-*  PP     (input) INTEGER
-*         PP=0 for ping, PP=1 for pong.
-*
-*  DMIN   (output) DOUBLE PRECISION
-*         Minimum value of d.
-*
-*  SIGMA  (output) DOUBLE PRECISION
-*         Sum of shifts used in current segment.
-*
-*  DESIG  (input/output) DOUBLE PRECISION
-*         Lower order part of SIGMA
-*
-*  QMAX   (input) DOUBLE PRECISION
-*         Maximum value of q.
-*
-*  NFAIL  (output) INTEGER
-*         Number of times shift was too big.
-*
-*  ITER   (output) INTEGER
-*         Number of iterations.
-*
-*  NDIV   (output) INTEGER
-*         Number of divisions.
-*
-*  TTYPE  (output) INTEGER
-*         Shift type.
-*
-*  IEEE   (input) LOGICAL
-*         Flag for IEEE or non IEEE arithmetic (passed to DLASQ5).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   CBIAS
-      PARAMETER          ( CBIAS = 1.50D0 )
-      DOUBLE PRECISION   ZERO, QURTR, HALF, ONE, TWO, HUNDRD
-      PARAMETER          ( ZERO = 0.0D0, QURTR = 0.250D0, HALF = 0.5D0,
-     $                     ONE = 1.0D0, TWO = 2.0D0, HUNDRD = 100.0D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            IPN4, J4, N0IN, NN, TTYPE
-      DOUBLE PRECISION   DMIN1, DMIN2, DN, DN1, DN2, EPS, S, SAFMIN, T,
-     $                   TAU, TEMP, TOL, TOL2
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASQ4, DLASQ5, DLASQ6
-*     ..
-*     .. External Function ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
-*     ..
-*     .. Save statement ..
-      SAVE               TTYPE
-      SAVE               DMIN1, DMIN2, DN, DN1, DN2, TAU
-*     ..
-*     .. Data statement ..
-      DATA               TTYPE / 0 /
-      DATA               DMIN1 / ZERO /, DMIN2 / ZERO /, DN / ZERO /,
-     $                   DN1 / ZERO /, DN2 / ZERO /, TAU / ZERO /
-*     ..
-*     .. Executable Statements ..
-*
-      N0IN = N0
-      EPS = DLAMCH( 'Precision' )
-      SAFMIN = DLAMCH( 'Safe minimum' )
-      TOL = EPS*HUNDRD
-      TOL2 = TOL**2
-*
-*     Check for deflation.
-*
-   10 CONTINUE
-*
-      IF( N0.LT.I0 )
-     $   RETURN
-      IF( N0.EQ.I0 )
-     $   GO TO 20
-      NN = 4*N0 + PP
-      IF( N0.EQ.( I0+1 ) )
-     $   GO TO 40
-*
-*     Check whether E(N0-1) is negligible, 1 eigenvalue.
-*
-      IF( Z( NN-5 ).GT.TOL2*( SIGMA+Z( NN-3 ) ) .AND.
-     $    Z( NN-2*PP-4 ).GT.TOL2*Z( NN-7 ) )
-     $   GO TO 30
-*
-   20 CONTINUE
-*
-      Z( 4*N0-3 ) = Z( 4*N0+PP-3 ) + SIGMA
-      N0 = N0 - 1
-      GO TO 10
-*
-*     Check  whether E(N0-2) is negligible, 2 eigenvalues.
-*
-   30 CONTINUE
-*
-      IF( Z( NN-9 ).GT.TOL2*SIGMA .AND.
-     $    Z( NN-2*PP-8 ).GT.TOL2*Z( NN-11 ) )
-     $   GO TO 50
-*
-   40 CONTINUE
-*
-      IF( Z( NN-3 ).GT.Z( NN-7 ) ) THEN
-         S = Z( NN-3 )
-         Z( NN-3 ) = Z( NN-7 )
-         Z( NN-7 ) = S
-      END IF
-      IF( Z( NN-5 ).GT.Z( NN-3 )*TOL2 ) THEN
-         T = HALF*( ( Z( NN-7 )-Z( NN-3 ) )+Z( NN-5 ) )
-         S = Z( NN-3 )*( Z( NN-5 ) / T )
-         IF( S.LE.T ) THEN
-            S = Z( NN-3 )*( Z( NN-5 ) /
-     $          ( T*( ONE+SQRT( ONE+S / T ) ) ) )
-         ELSE
-            S = Z( NN-3 )*( Z( NN-5 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
-         END IF
-         T = Z( NN-7 ) + ( S+Z( NN-5 ) )
-         Z( NN-3 ) = Z( NN-3 )*( Z( NN-7 ) / T )
-         Z( NN-7 ) = T
-      END IF
-      Z( 4*N0-7 ) = Z( NN-7 ) + SIGMA
-      Z( 4*N0-3 ) = Z( NN-3 ) + SIGMA
-      N0 = N0 - 2
-      GO TO 10
-*
-   50 CONTINUE
-*
-*     Reverse the qd-array, if warranted.
-*
-      IF( DMIN.LE.ZERO .OR. N0.LT.N0IN ) THEN
-         IF( CBIAS*Z( 4*I0+PP-3 ).LT.Z( 4*N0+PP-3 ) ) THEN
-            IPN4 = 4*( I0+N0 )
-            DO 60 J4 = 4*I0, 2*( I0+N0-1 ), 4
-               TEMP = Z( J4-3 )
-               Z( J4-3 ) = Z( IPN4-J4-3 )
-               Z( IPN4-J4-3 ) = TEMP
-               TEMP = Z( J4-2 )
-               Z( J4-2 ) = Z( IPN4-J4-2 )
-               Z( IPN4-J4-2 ) = TEMP
-               TEMP = Z( J4-1 )
-               Z( J4-1 ) = Z( IPN4-J4-5 )
-               Z( IPN4-J4-5 ) = TEMP
-               TEMP = Z( J4 )
-               Z( J4 ) = Z( IPN4-J4-4 )
-               Z( IPN4-J4-4 ) = TEMP
-   60       CONTINUE
-            IF( N0-I0.LE.4 ) THEN
-               Z( 4*N0+PP-1 ) = Z( 4*I0+PP-1 )
-               Z( 4*N0-PP ) = Z( 4*I0-PP )
-            END IF
-            DMIN2 = MIN( DMIN2, Z( 4*N0+PP-1 ) )
-            Z( 4*N0+PP-1 ) = MIN( Z( 4*N0+PP-1 ), Z( 4*I0+PP-1 ),
-     $                            Z( 4*I0+PP+3 ) )
-            Z( 4*N0-PP ) = MIN( Z( 4*N0-PP ), Z( 4*I0-PP ),
-     $                          Z( 4*I0-PP+4 ) )
-            QMAX = MAX( QMAX, Z( 4*I0+PP-3 ), Z( 4*I0+PP+1 ) )
-            DMIN = -ZERO
-         END IF
-      END IF
-*
-      IF( DMIN.LT.ZERO .OR. SAFMIN*QMAX.LT.MIN( Z( 4*N0+PP-1 ),
-     $    Z( 4*N0+PP-9 ), DMIN2+Z( 4*N0-PP ) ) ) THEN
-*
-*        Choose a shift.
-*
-         CALL DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1,
-     $                DN2, TAU, TTYPE )
-*
-*        Call dqds until DMIN > 0.
-*
-   80    CONTINUE
-*
-         CALL DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
-     $                DN1, DN2, IEEE )
-*
-         NDIV = NDIV + ( N0-I0+2 )
-         ITER = ITER + 1
-*
-*        Check status.
-*
-         IF( DMIN.GE.ZERO .AND. DMIN1.GT.ZERO ) THEN
-*
-*           Success.
-*
-            GO TO 100
-*
-         ELSE IF( DMIN.LT.ZERO .AND. DMIN1.GT.ZERO .AND.
-     $            Z( 4*( N0-1 )-PP ).LT.TOL*( SIGMA+DN1 ) .AND.
-     $            ABS( DN ).LT.TOL*SIGMA ) THEN
-*
-*           Convergence hidden by negative DN.
-*
-            Z( 4*( N0-1 )-PP+2 ) = ZERO
-            DMIN = ZERO
-            GO TO 100
-         ELSE IF( DMIN.LT.ZERO ) THEN
-*
-*           TAU too big. Select new TAU and try again.
-*
-            NFAIL = NFAIL + 1
-            IF( TTYPE.LT.-22 ) THEN
-*
-*              Failed twice. Play it safe.
-*
-               TAU = ZERO
-            ELSE IF( DMIN1.GT.ZERO ) THEN
-*
-*              Late failure. Gives excellent shift.
-*
-               TAU = ( TAU+DMIN )*( ONE-TWO*EPS )
-               TTYPE = TTYPE - 11
-            ELSE
-*
-*              Early failure. Divide by 4.
-*
-               TAU = QURTR*TAU
-               TTYPE = TTYPE - 12
-            END IF
-            GO TO 80
-         ELSE IF( DMIN.NE.DMIN ) THEN
-*
-*           NaN.
-*
-            TAU = ZERO
-            GO TO 80
-         ELSE
-*
-*           Possible underflow. Play it safe.
-*
-            GO TO 90
-         END IF
-      END IF
-*
-*     Risk of underflow.
-*
-   90 CONTINUE
-      CALL DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DN1, DN2 )
-      NDIV = NDIV + ( N0-I0+2 )
-      ITER = ITER + 1
-      TAU = ZERO
-*
-  100 CONTINUE
-      IF( TAU.LT.SIGMA ) THEN
-         DESIG = DESIG + TAU
-         T = SIGMA + DESIG
-         DESIG = DESIG - ( T-SIGMA )
-      ELSE
-         T = SIGMA + TAU
-         DESIG = SIGMA - ( T-TAU ) + DESIG
-      END IF
-      SIGMA = T
-*
-      RETURN
-*
-*     End of DLASQ3
-*
-      END
diff --git a/src/lib/lapack/dlasq4.f b/src/lib/lapack/dlasq4.f
deleted file mode 100644
index db2b6fe5..00000000
--- a/src/lib/lapack/dlasq4.f
+++ /dev/null
@@ -1,329 +0,0 @@
-      SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
-     $                   DN1, DN2, TAU, TTYPE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            I0, N0, N0IN, PP, TTYPE
-      DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DN1, DN2, TAU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   Z( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASQ4 computes an approximation TAU to the smallest eigenvalue 
-*  using values of d from the previous transform.
-*
-*  I0    (input) INTEGER
-*        First index.
-*
-*  N0    (input) INTEGER
-*        Last index.
-*
-*  Z     (input) DOUBLE PRECISION array, dimension ( 4*N )
-*        Z holds the qd array.
-*
-*  PP    (input) INTEGER
-*        PP=0 for ping, PP=1 for pong.
-*
-*  N0IN  (input) INTEGER
-*        The value of N0 at start of EIGTEST.
-*
-*  DMIN  (input) DOUBLE PRECISION
-*        Minimum value of d.
-*
-*  DMIN1 (input) DOUBLE PRECISION
-*        Minimum value of d, excluding D( N0 ).
-*
-*  DMIN2 (input) DOUBLE PRECISION
-*        Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*
-*  DN    (input) DOUBLE PRECISION
-*        d(N)
-*
-*  DN1   (input) DOUBLE PRECISION
-*        d(N-1)
-*
-*  DN2   (input) DOUBLE PRECISION
-*        d(N-2)
-*
-*  TAU   (output) DOUBLE PRECISION
-*        This is the shift.
-*
-*  TTYPE (output) INTEGER
-*        Shift type.
-*
-*  Further Details
-*  ===============
-*  CNST1 = 9/16
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   CNST1, CNST2, CNST3
-      PARAMETER          ( CNST1 = 0.5630D0, CNST2 = 1.010D0,
-     $                   CNST3 = 1.050D0 )
-      DOUBLE PRECISION   QURTR, THIRD, HALF, ZERO, ONE, TWO, HUNDRD
-      PARAMETER          ( QURTR = 0.250D0, THIRD = 0.3330D0,
-     $                   HALF = 0.50D0, ZERO = 0.0D0, ONE = 1.0D0,
-     $                   TWO = 2.0D0, HUNDRD = 100.0D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I4, NN, NP
-      DOUBLE PRECISION   A2, B1, B2, G, GAM, GAP1, GAP2, S
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN, SQRT
-*     ..
-*     .. Save statement ..
-      SAVE               G
-*     ..
-*     .. Data statement ..
-      DATA               G / ZERO /
-*     ..
-*     .. Executable Statements ..
-*
-*     A negative DMIN forces the shift to take that absolute value
-*     TTYPE records the type of shift.
-*
-      IF( DMIN.LE.ZERO ) THEN
-         TAU = -DMIN
-         TTYPE = -1
-         RETURN
-      END IF
-*       
-      NN = 4*N0 + PP
-      IF( N0IN.EQ.N0 ) THEN
-*
-*        No eigenvalues deflated.
-*
-         IF( DMIN.EQ.DN .OR. DMIN.EQ.DN1 ) THEN
-*
-            B1 = SQRT( Z( NN-3 ) )*SQRT( Z( NN-5 ) )
-            B2 = SQRT( Z( NN-7 ) )*SQRT( Z( NN-9 ) )
-            A2 = Z( NN-7 ) + Z( NN-5 )
-*
-*           Cases 2 and 3.
-*
-            IF( DMIN.EQ.DN .AND. DMIN1.EQ.DN1 ) THEN
-               GAP2 = DMIN2 - A2 - DMIN2*QURTR
-               IF( GAP2.GT.ZERO .AND. GAP2.GT.B2 ) THEN
-                  GAP1 = A2 - DN - ( B2 / GAP2 )*B2
-               ELSE
-                  GAP1 = A2 - DN - ( B1+B2 )
-               END IF
-               IF( GAP1.GT.ZERO .AND. GAP1.GT.B1 ) THEN
-                  S = MAX( DN-( B1 / GAP1 )*B1, HALF*DMIN )
-                  TTYPE = -2
-               ELSE
-                  S = ZERO
-                  IF( DN.GT.B1 )
-     $               S = DN - B1
-                  IF( A2.GT.( B1+B2 ) )
-     $               S = MIN( S, A2-( B1+B2 ) )
-                  S = MAX( S, THIRD*DMIN )
-                  TTYPE = -3
-               END IF
-            ELSE
-*
-*              Case 4.
-*
-               TTYPE = -4
-               S = QURTR*DMIN
-               IF( DMIN.EQ.DN ) THEN
-                  GAM = DN
-                  A2 = ZERO
-                  IF( Z( NN-5 ) .GT. Z( NN-7 ) )
-     $               RETURN
-                  B2 = Z( NN-5 ) / Z( NN-7 )
-                  NP = NN - 9
-               ELSE
-                  NP = NN - 2*PP
-                  B2 = Z( NP-2 )
-                  GAM = DN1
-                  IF( Z( NP-4 ) .GT. Z( NP-2 ) )
-     $               RETURN
-                  A2 = Z( NP-4 ) / Z( NP-2 )
-                  IF( Z( NN-9 ) .GT. Z( NN-11 ) )
-     $               RETURN
-                  B2 = Z( NN-9 ) / Z( NN-11 )
-                  NP = NN - 13
-               END IF
-*
-*              Approximate contribution to norm squared from I < NN-1.
-*
-               A2 = A2 + B2
-               DO 10 I4 = NP, 4*I0 - 1 + PP, -4
-                  IF( B2.EQ.ZERO )
-     $               GO TO 20
-                  B1 = B2
-                  IF( Z( I4 ) .GT. Z( I4-2 ) )
-     $               RETURN
-                  B2 = B2*( Z( I4 ) / Z( I4-2 ) )
-                  A2 = A2 + B2
-                  IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 ) 
-     $               GO TO 20
-   10          CONTINUE
-   20          CONTINUE
-               A2 = CNST3*A2
-*
-*              Rayleigh quotient residual bound.
-*
-               IF( A2.LT.CNST1 )
-     $            S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
-            END IF
-         ELSE IF( DMIN.EQ.DN2 ) THEN
-*
-*           Case 5.
-*
-            TTYPE = -5
-            S = QURTR*DMIN
-*
-*           Compute contribution to norm squared from I > NN-2.
-*
-            NP = NN - 2*PP
-            B1 = Z( NP-2 )
-            B2 = Z( NP-6 )
-            GAM = DN2
-            IF( Z( NP-8 ).GT.B2 .OR. Z( NP-4 ).GT.B1 )
-     $         RETURN
-            A2 = ( Z( NP-8 ) / B2 )*( ONE+Z( NP-4 ) / B1 )
-*
-*           Approximate contribution to norm squared from I < NN-2.
-*
-            IF( N0-I0.GT.2 ) THEN
-               B2 = Z( NN-13 ) / Z( NN-15 )
-               A2 = A2 + B2
-               DO 30 I4 = NN - 17, 4*I0 - 1 + PP, -4
-                  IF( B2.EQ.ZERO )
-     $               GO TO 40
-                  B1 = B2
-                  IF( Z( I4 ) .GT. Z( I4-2 ) )
-     $               RETURN
-                  B2 = B2*( Z( I4 ) / Z( I4-2 ) )
-                  A2 = A2 + B2
-                  IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 ) 
-     $               GO TO 40
-   30          CONTINUE
-   40          CONTINUE
-               A2 = CNST3*A2
-            END IF
-*
-            IF( A2.LT.CNST1 )
-     $         S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
-         ELSE
-*
-*           Case 6, no information to guide us.
-*
-            IF( TTYPE.EQ.-6 ) THEN
-               G = G + THIRD*( ONE-G )
-            ELSE IF( TTYPE.EQ.-18 ) THEN
-               G = QURTR*THIRD
-            ELSE
-               G = QURTR
-            END IF
-            S = G*DMIN
-            TTYPE = -6
-         END IF
-*
-      ELSE IF( N0IN.EQ.( N0+1 ) ) THEN
-*
-*        One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN.
-*
-         IF( DMIN1.EQ.DN1 .AND. DMIN2.EQ.DN2 ) THEN 
-*
-*           Cases 7 and 8.
-*
-            TTYPE = -7
-            S = THIRD*DMIN1
-            IF( Z( NN-5 ).GT.Z( NN-7 ) )
-     $         RETURN
-            B1 = Z( NN-5 ) / Z( NN-7 )
-            B2 = B1
-            IF( B2.EQ.ZERO )
-     $         GO TO 60
-            DO 50 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
-               A2 = B1
-               IF( Z( I4 ).GT.Z( I4-2 ) )
-     $            RETURN
-               B1 = B1*( Z( I4 ) / Z( I4-2 ) )
-               B2 = B2 + B1
-               IF( HUNDRD*MAX( B1, A2 ).LT.B2 ) 
-     $            GO TO 60
-   50       CONTINUE
-   60       CONTINUE
-            B2 = SQRT( CNST3*B2 )
-            A2 = DMIN1 / ( ONE+B2**2 )
-            GAP2 = HALF*DMIN2 - A2
-            IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
-               S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
-            ELSE 
-               S = MAX( S, A2*( ONE-CNST2*B2 ) )
-               TTYPE = -8
-            END IF
-         ELSE
-*
-*           Case 9.
-*
-            S = QURTR*DMIN1
-            IF( DMIN1.EQ.DN1 )
-     $         S = HALF*DMIN1
-            TTYPE = -9
-         END IF
-*
-      ELSE IF( N0IN.EQ.( N0+2 ) ) THEN
-*
-*        Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN.
-*
-*        Cases 10 and 11.
-*
-         IF( DMIN2.EQ.DN2 .AND. TWO*Z( NN-5 ).LT.Z( NN-7 ) ) THEN 
-            TTYPE = -10
-            S = THIRD*DMIN2
-            IF( Z( NN-5 ).GT.Z( NN-7 ) )
-     $         RETURN
-            B1 = Z( NN-5 ) / Z( NN-7 )
-            B2 = B1
-            IF( B2.EQ.ZERO )
-     $         GO TO 80
-            DO 70 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
-               IF( Z( I4 ).GT.Z( I4-2 ) )
-     $            RETURN
-               B1 = B1*( Z( I4 ) / Z( I4-2 ) )
-               B2 = B2 + B1
-               IF( HUNDRD*B1.LT.B2 )
-     $            GO TO 80
-   70       CONTINUE
-   80       CONTINUE
-            B2 = SQRT( CNST3*B2 )
-            A2 = DMIN2 / ( ONE+B2**2 )
-            GAP2 = Z( NN-7 ) + Z( NN-9 ) -
-     $             SQRT( Z( NN-11 ) )*SQRT( Z( NN-9 ) ) - A2
-            IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
-               S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
-            ELSE 
-               S = MAX( S, A2*( ONE-CNST2*B2 ) )
-            END IF
-         ELSE
-            S = QURTR*DMIN2
-            TTYPE = -11
-         END IF
-      ELSE IF( N0IN.GT.( N0+2 ) ) THEN
-*
-*        Case 12, more than two eigenvalues deflated. No information.
-*
-         S = ZERO 
-         TTYPE = -12
-      END IF
-*
-      TAU = S
-      RETURN
-*
-*     End of DLASQ4
-*
-      END
diff --git a/src/lib/lapack/dlasq5.f b/src/lib/lapack/dlasq5.f
deleted file mode 100644
index a006c99e..00000000
--- a/src/lib/lapack/dlasq5.f
+++ /dev/null
@@ -1,195 +0,0 @@
-      SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
-     $                   DNM1, DNM2, IEEE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            IEEE
-      INTEGER            I0, N0, PP
-      DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   Z( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASQ5 computes one dqds transform in ping-pong form, one
-*  version for IEEE machines another for non IEEE machines.
-*
-*  Arguments
-*  =========
-*
-*  I0    (input) INTEGER
-*        First index.
-*
-*  N0    (input) INTEGER
-*        Last index.
-*
-*  Z     (input) DOUBLE PRECISION array, dimension ( 4*N )
-*        Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
-*        an extra argument.
-*
-*  PP    (input) INTEGER
-*        PP=0 for ping, PP=1 for pong.
-*
-*  TAU   (input) DOUBLE PRECISION
-*        This is the shift.
-*
-*  DMIN  (output) DOUBLE PRECISION
-*        Minimum value of d.
-*
-*  DMIN1 (output) DOUBLE PRECISION
-*        Minimum value of d, excluding D( N0 ).
-*
-*  DMIN2 (output) DOUBLE PRECISION
-*        Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*
-*  DN    (output) DOUBLE PRECISION
-*        d(N0), the last value of d.
-*
-*  DNM1  (output) DOUBLE PRECISION
-*        d(N0-1).
-*
-*  DNM2  (output) DOUBLE PRECISION
-*        d(N0-2).
-*
-*  IEEE  (input) LOGICAL
-*        Flag for IEEE or non IEEE arithmetic.
-*
-*  =====================================================================
-*
-*     .. Parameter ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            J4, J4P2
-      DOUBLE PRECISION   D, EMIN, TEMP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-      IF( ( N0-I0-1 ).LE.0 )
-     $   RETURN
-*
-      J4 = 4*I0 + PP - 3
-      EMIN = Z( J4+4 )
-      D = Z( J4 ) - TAU
-      DMIN = D
-      DMIN1 = -Z( J4 )
-*
-      IF( IEEE ) THEN
-*
-*        Code for IEEE arithmetic.
-*
-         IF( PP.EQ.0 ) THEN
-            DO 10 J4 = 4*I0, 4*( N0-3 ), 4
-               Z( J4-2 ) = D + Z( J4-1 )
-               TEMP = Z( J4+1 ) / Z( J4-2 )
-               D = D*TEMP - TAU
-               DMIN = MIN( DMIN, D )
-               Z( J4 ) = Z( J4-1 )*TEMP
-               EMIN = MIN( Z( J4 ), EMIN )
-   10       CONTINUE
-         ELSE
-            DO 20 J4 = 4*I0, 4*( N0-3 ), 4
-               Z( J4-3 ) = D + Z( J4 )
-               TEMP = Z( J4+2 ) / Z( J4-3 )
-               D = D*TEMP - TAU
-               DMIN = MIN( DMIN, D )
-               Z( J4-1 ) = Z( J4 )*TEMP
-               EMIN = MIN( Z( J4-1 ), EMIN )
-   20       CONTINUE
-         END IF
-*
-*        Unroll last two steps.
-*
-         DNM2 = D
-         DMIN2 = DMIN
-         J4 = 4*( N0-2 ) - PP
-         J4P2 = J4 + 2*PP - 1
-         Z( J4-2 ) = DNM2 + Z( J4P2 )
-         Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
-         DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
-         DMIN = MIN( DMIN, DNM1 )
-*
-         DMIN1 = DMIN
-         J4 = J4 + 4
-         J4P2 = J4 + 2*PP - 1
-         Z( J4-2 ) = DNM1 + Z( J4P2 )
-         Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
-         DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
-         DMIN = MIN( DMIN, DN )
-*
-      ELSE
-*
-*        Code for non IEEE arithmetic.
-*
-         IF( PP.EQ.0 ) THEN
-            DO 30 J4 = 4*I0, 4*( N0-3 ), 4
-               Z( J4-2 ) = D + Z( J4-1 )
-               IF( D.LT.ZERO ) THEN
-                  RETURN
-               ELSE
-                  Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
-                  D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
-               END IF
-               DMIN = MIN( DMIN, D )
-               EMIN = MIN( EMIN, Z( J4 ) )
-   30       CONTINUE
-         ELSE
-            DO 40 J4 = 4*I0, 4*( N0-3 ), 4
-               Z( J4-3 ) = D + Z( J4 )
-               IF( D.LT.ZERO ) THEN
-                  RETURN
-               ELSE
-                  Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
-                  D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
-               END IF
-               DMIN = MIN( DMIN, D )
-               EMIN = MIN( EMIN, Z( J4-1 ) )
-   40       CONTINUE
-         END IF
-*
-*        Unroll last two steps.
-*
-         DNM2 = D
-         DMIN2 = DMIN
-         J4 = 4*( N0-2 ) - PP
-         J4P2 = J4 + 2*PP - 1
-         Z( J4-2 ) = DNM2 + Z( J4P2 )
-         IF( DNM2.LT.ZERO ) THEN
-            RETURN
-         ELSE
-            Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
-            DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
-         END IF
-         DMIN = MIN( DMIN, DNM1 )
-*
-         DMIN1 = DMIN
-         J4 = J4 + 4
-         J4P2 = J4 + 2*PP - 1
-         Z( J4-2 ) = DNM1 + Z( J4P2 )
-         IF( DNM1.LT.ZERO ) THEN
-            RETURN
-         ELSE
-            Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
-            DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
-         END IF
-         DMIN = MIN( DMIN, DN )
-*
-      END IF
-*
-      Z( J4+2 ) = DN
-      Z( 4*N0-PP ) = EMIN
-      RETURN
-*
-*     End of DLASQ5
-*
-      END
diff --git a/src/lib/lapack/dlasq6.f b/src/lib/lapack/dlasq6.f
deleted file mode 100644
index e7eb7d0a..00000000
--- a/src/lib/lapack/dlasq6.f
+++ /dev/null
@@ -1,175 +0,0 @@
-      SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
-     $                   DNM1, DNM2 )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            I0, N0, PP
-      DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   Z( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASQ6 computes one dqd (shift equal to zero) transform in
-*  ping-pong form, with protection against underflow and overflow.
-*
-*  Arguments
-*  =========
-*
-*  I0    (input) INTEGER
-*        First index.
-*
-*  N0    (input) INTEGER
-*        Last index.
-*
-*  Z     (input) DOUBLE PRECISION array, dimension ( 4*N )
-*        Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
-*        an extra argument.
-*
-*  PP    (input) INTEGER
-*        PP=0 for ping, PP=1 for pong.
-*
-*  DMIN  (output) DOUBLE PRECISION
-*        Minimum value of d.
-*
-*  DMIN1 (output) DOUBLE PRECISION
-*        Minimum value of d, excluding D( N0 ).
-*
-*  DMIN2 (output) DOUBLE PRECISION
-*        Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*
-*  DN    (output) DOUBLE PRECISION
-*        d(N0), the last value of d.
-*
-*  DNM1  (output) DOUBLE PRECISION
-*        d(N0-1).
-*
-*  DNM2  (output) DOUBLE PRECISION
-*        d(N0-2).
-*
-*  =====================================================================
-*
-*     .. Parameter ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            J4, J4P2
-      DOUBLE PRECISION   D, EMIN, SAFMIN, TEMP
-*     ..
-*     .. External Function ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-      IF( ( N0-I0-1 ).LE.0 )
-     $   RETURN
-*
-      SAFMIN = DLAMCH( 'Safe minimum' )
-      J4 = 4*I0 + PP - 3
-      EMIN = Z( J4+4 ) 
-      D = Z( J4 )
-      DMIN = D
-*
-      IF( PP.EQ.0 ) THEN
-         DO 10 J4 = 4*I0, 4*( N0-3 ), 4
-            Z( J4-2 ) = D + Z( J4-1 ) 
-            IF( Z( J4-2 ).EQ.ZERO ) THEN
-               Z( J4 ) = ZERO
-               D = Z( J4+1 )
-               DMIN = D
-               EMIN = ZERO
-            ELSE IF( SAFMIN*Z( J4+1 ).LT.Z( J4-2 ) .AND.
-     $               SAFMIN*Z( J4-2 ).LT.Z( J4+1 ) ) THEN
-               TEMP = Z( J4+1 ) / Z( J4-2 )
-               Z( J4 ) = Z( J4-1 )*TEMP
-               D = D*TEMP
-            ELSE 
-               Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
-               D = Z( J4+1 )*( D / Z( J4-2 ) )
-            END IF
-            DMIN = MIN( DMIN, D )
-            EMIN = MIN( EMIN, Z( J4 ) )
-   10    CONTINUE
-      ELSE
-         DO 20 J4 = 4*I0, 4*( N0-3 ), 4
-            Z( J4-3 ) = D + Z( J4 ) 
-            IF( Z( J4-3 ).EQ.ZERO ) THEN
-               Z( J4-1 ) = ZERO
-               D = Z( J4+2 )
-               DMIN = D
-               EMIN = ZERO
-            ELSE IF( SAFMIN*Z( J4+2 ).LT.Z( J4-3 ) .AND.
-     $               SAFMIN*Z( J4-3 ).LT.Z( J4+2 ) ) THEN
-               TEMP = Z( J4+2 ) / Z( J4-3 )
-               Z( J4-1 ) = Z( J4 )*TEMP
-               D = D*TEMP
-            ELSE 
-               Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
-               D = Z( J4+2 )*( D / Z( J4-3 ) )
-            END IF
-            DMIN = MIN( DMIN, D )
-            EMIN = MIN( EMIN, Z( J4-1 ) )
-   20    CONTINUE
-      END IF
-*
-*     Unroll last two steps. 
-*
-      DNM2 = D
-      DMIN2 = DMIN
-      J4 = 4*( N0-2 ) - PP
-      J4P2 = J4 + 2*PP - 1
-      Z( J4-2 ) = DNM2 + Z( J4P2 )
-      IF( Z( J4-2 ).EQ.ZERO ) THEN
-         Z( J4 ) = ZERO
-         DNM1 = Z( J4P2+2 )
-         DMIN = DNM1
-         EMIN = ZERO
-      ELSE IF( SAFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) .AND.
-     $         SAFMIN*Z( J4-2 ).LT.Z( J4P2+2 ) ) THEN
-         TEMP = Z( J4P2+2 ) / Z( J4-2 )
-         Z( J4 ) = Z( J4P2 )*TEMP
-         DNM1 = DNM2*TEMP
-      ELSE
-         Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
-         DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) )
-      END IF
-      DMIN = MIN( DMIN, DNM1 )
-*
-      DMIN1 = DMIN
-      J4 = J4 + 4
-      J4P2 = J4 + 2*PP - 1
-      Z( J4-2 ) = DNM1 + Z( J4P2 )
-      IF( Z( J4-2 ).EQ.ZERO ) THEN
-         Z( J4 ) = ZERO
-         DN = Z( J4P2+2 )
-         DMIN = DN
-         EMIN = ZERO
-      ELSE IF( SAFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) .AND.
-     $         SAFMIN*Z( J4-2 ).LT.Z( J4P2+2 ) ) THEN
-         TEMP = Z( J4P2+2 ) / Z( J4-2 )
-         Z( J4 ) = Z( J4P2 )*TEMP
-         DN = DNM1*TEMP
-      ELSE
-         Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
-         DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) )
-      END IF
-      DMIN = MIN( DMIN, DN )
-*
-      Z( J4+2 ) = DN
-      Z( 4*N0-PP ) = EMIN
-      RETURN
-*
-*     End of DLASQ6
-*
-      END
diff --git a/src/lib/lapack/dlasr.f b/src/lib/lapack/dlasr.f
deleted file mode 100644
index 7e54bfc7..00000000
--- a/src/lib/lapack/dlasr.f
+++ /dev/null
@@ -1,361 +0,0 @@
-      SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, PIVOT, SIDE
-      INTEGER            LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( * ), S( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASR applies a sequence of plane rotations to a real matrix A,
-*  from either the left or the right.
-*  
-*  When SIDE = 'L', the transformation takes the form
-*  
-*     A := P*A
-*  
-*  and when SIDE = 'R', the transformation takes the form
-*  
-*     A := A*P**T
-*  
-*  where P is an orthogonal matrix consisting of a sequence of z plane
-*  rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
-*  and P**T is the transpose of P.
-*  
-*  When DIRECT = 'F' (Forward sequence), then
-*  
-*     P = P(z-1) * ... * P(2) * P(1)
-*  
-*  and when DIRECT = 'B' (Backward sequence), then
-*  
-*     P = P(1) * P(2) * ... * P(z-1)
-*  
-*  where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
-*  
-*     R(k) = (  c(k)  s(k) )
-*          = ( -s(k)  c(k) ).
-*  
-*  When PIVOT = 'V' (Variable pivot), the rotation is performed
-*  for the plane (k,k+1), i.e., P(k) has the form
-*  
-*     P(k) = (  1                                            )
-*            (       ...                                     )
-*            (              1                                )
-*            (                   c(k)  s(k)                  )
-*            (                  -s(k)  c(k)                  )
-*            (                                1              )
-*            (                                     ...       )
-*            (                                            1  )
-*  
-*  where R(k) appears as a rank-2 modification to the identity matrix in
-*  rows and columns k and k+1.
-*  
-*  When PIVOT = 'T' (Top pivot), the rotation is performed for the
-*  plane (1,k+1), so P(k) has the form
-*  
-*     P(k) = (  c(k)                    s(k)                 )
-*            (         1                                     )
-*            (              ...                              )
-*            (                     1                         )
-*            ( -s(k)                    c(k)                 )
-*            (                                 1             )
-*            (                                      ...      )
-*            (                                             1 )
-*  
-*  where R(k) appears in rows and columns 1 and k+1.
-*  
-*  Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
-*  performed for the plane (k,z), giving P(k) the form
-*  
-*     P(k) = ( 1                                             )
-*            (      ...                                      )
-*            (             1                                 )
-*            (                  c(k)                    s(k) )
-*            (                         1                     )
-*            (                              ...              )
-*            (                                     1         )
-*            (                 -s(k)                    c(k) )
-*  
-*  where R(k) appears in rows and columns k and z.  The rotations are
-*  performed without ever forming P(k) explicitly.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          Specifies whether the plane rotation matrix P is applied to
-*          A on the left or the right.
-*          = 'L':  Left, compute A := P*A
-*          = 'R':  Right, compute A:= A*P**T
-*
-*  PIVOT   (input) CHARACTER*1
-*          Specifies the plane for which P(k) is a plane rotation
-*          matrix.
-*          = 'V':  Variable pivot, the plane (k,k+1)
-*          = 'T':  Top pivot, the plane (1,k+1)
-*          = 'B':  Bottom pivot, the plane (k,z)
-*
-*  DIRECT  (input) CHARACTER*1
-*          Specifies whether P is a forward or backward sequence of
-*          plane rotations.
-*          = 'F':  Forward, P = P(z-1)*...*P(2)*P(1)
-*          = 'B':  Backward, P = P(1)*P(2)*...*P(z-1)
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  If m <= 1, an immediate
-*          return is effected.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  If n <= 1, an
-*          immediate return is effected.
-*
-*  C       (input) DOUBLE PRECISION array, dimension
-*                  (M-1) if SIDE = 'L'
-*                  (N-1) if SIDE = 'R'
-*          The cosines c(k) of the plane rotations.
-*
-*  S       (input) DOUBLE PRECISION array, dimension
-*                  (M-1) if SIDE = 'L'
-*                  (N-1) if SIDE = 'R'
-*          The sines s(k) of the plane rotations.  The 2-by-2 plane
-*          rotation part of the matrix P(k), R(k), has the form
-*          R(k) = (  c(k)  s(k) )
-*                 ( -s(k)  c(k) ).
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          The M-by-N matrix A.  On exit, A is overwritten by P*A if
-*          SIDE = 'R' or by A*P**T if SIDE = 'L'.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, INFO, J
-      DOUBLE PRECISION   CTEMP, STEMP, TEMP
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
-         INFO = 1
-      ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
-     $         'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
-         INFO = 2
-      ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
-     $          THEN
-         INFO = 3
-      ELSE IF( M.LT.0 ) THEN
-         INFO = 4
-      ELSE IF( N.LT.0 ) THEN
-         INFO = 5
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = 9
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DLASR ', INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
-     $   RETURN
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        Form  P * A
-*
-         IF( LSAME( PIVOT, 'V' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 20 J = 1, M - 1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 10 I = 1, N
-                        TEMP = A( J+1, I )
-                        A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
-                        A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
-   10                CONTINUE
-                  END IF
-   20          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 40 J = M - 1, 1, -1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 30 I = 1, N
-                        TEMP = A( J+1, I )
-                        A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
-                        A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
-   30                CONTINUE
-                  END IF
-   40          CONTINUE
-            END IF
-         ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 60 J = 2, M
-                  CTEMP = C( J-1 )
-                  STEMP = S( J-1 )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 50 I = 1, N
-                        TEMP = A( J, I )
-                        A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
-                        A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
-   50                CONTINUE
-                  END IF
-   60          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 80 J = M, 2, -1
-                  CTEMP = C( J-1 )
-                  STEMP = S( J-1 )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 70 I = 1, N
-                        TEMP = A( J, I )
-                        A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
-                        A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
-   70                CONTINUE
-                  END IF
-   80          CONTINUE
-            END IF
-         ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 100 J = 1, M - 1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 90 I = 1, N
-                        TEMP = A( J, I )
-                        A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
-                        A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
-   90                CONTINUE
-                  END IF
-  100          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 120 J = M - 1, 1, -1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 110 I = 1, N
-                        TEMP = A( J, I )
-                        A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
-                        A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
-  110                CONTINUE
-                  END IF
-  120          CONTINUE
-            END IF
-         END IF
-      ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*        Form A * P'
-*
-         IF( LSAME( PIVOT, 'V' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 140 J = 1, N - 1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 130 I = 1, M
-                        TEMP = A( I, J+1 )
-                        A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
-                        A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
-  130                CONTINUE
-                  END IF
-  140          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 160 J = N - 1, 1, -1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 150 I = 1, M
-                        TEMP = A( I, J+1 )
-                        A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
-                        A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
-  150                CONTINUE
-                  END IF
-  160          CONTINUE
-            END IF
-         ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 180 J = 2, N
-                  CTEMP = C( J-1 )
-                  STEMP = S( J-1 )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 170 I = 1, M
-                        TEMP = A( I, J )
-                        A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
-                        A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
-  170                CONTINUE
-                  END IF
-  180          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 200 J = N, 2, -1
-                  CTEMP = C( J-1 )
-                  STEMP = S( J-1 )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 190 I = 1, M
-                        TEMP = A( I, J )
-                        A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
-                        A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
-  190                CONTINUE
-                  END IF
-  200          CONTINUE
-            END IF
-         ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 220 J = 1, N - 1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 210 I = 1, M
-                        TEMP = A( I, J )
-                        A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
-                        A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
-  210                CONTINUE
-                  END IF
-  220          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 240 J = N - 1, 1, -1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 230 I = 1, M
-                        TEMP = A( I, J )
-                        A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
-                        A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
-  230                CONTINUE
-                  END IF
-  240          CONTINUE
-            END IF
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DLASR
-*
-      END
diff --git a/src/lib/lapack/dlasrt.f b/src/lib/lapack/dlasrt.f
deleted file mode 100644
index 37e02178..00000000
--- a/src/lib/lapack/dlasrt.f
+++ /dev/null
@@ -1,243 +0,0 @@
-      SUBROUTINE DLASRT( ID, N, D, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          ID
-      INTEGER            INFO, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  Sort the numbers in D in increasing order (if ID = 'I') or
-*  in decreasing order (if ID = 'D' ).
-*
-*  Use Quick Sort, reverting to Insertion sort on arrays of
-*  size <= 20. Dimension of STACK limits N to about 2**32.
-*
-*  Arguments
-*  =========
-*
-*  ID      (input) CHARACTER*1
-*          = 'I': sort D in increasing order;
-*          = 'D': sort D in decreasing order.
-*
-*  N       (input) INTEGER
-*          The length of the array D.
-*
-*  D       (input/output) DOUBLE PRECISION array, dimension (N)
-*          On entry, the array to be sorted.
-*          On exit, D has been sorted into increasing order
-*          (D(1) <= ... <= D(N) ) or into decreasing order
-*          (D(1) >= ... >= D(N) ), depending on ID.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            SELECT
-      PARAMETER          ( SELECT = 20 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            DIR, ENDD, I, J, START, STKPNT
-      DOUBLE PRECISION   D1, D2, D3, DMNMX, TMP
-*     ..
-*     .. Local Arrays ..
-      INTEGER            STACK( 2, 32 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input paramters.
-*
-      INFO = 0
-      DIR = -1
-      IF( LSAME( ID, 'D' ) ) THEN
-         DIR = 0
-      ELSE IF( LSAME( ID, 'I' ) ) THEN
-         DIR = 1
-      END IF
-      IF( DIR.EQ.-1 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DLASRT', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-      STKPNT = 1
-      STACK( 1, 1 ) = 1
-      STACK( 2, 1 ) = N
-   10 CONTINUE
-      START = STACK( 1, STKPNT )
-      ENDD = STACK( 2, STKPNT )
-      STKPNT = STKPNT - 1
-      IF( ENDD-START.LE.SELECT .AND. ENDD-START.GT.0 ) THEN
-*
-*        Do Insertion sort on D( START:ENDD )
-*
-         IF( DIR.EQ.0 ) THEN
-*
-*           Sort into decreasing order
-*
-            DO 30 I = START + 1, ENDD
-               DO 20 J = I, START + 1, -1
-                  IF( D( J ).GT.D( J-1 ) ) THEN
-                     DMNMX = D( J )
-                     D( J ) = D( J-1 )
-                     D( J-1 ) = DMNMX
-                  ELSE
-                     GO TO 30
-                  END IF
-   20          CONTINUE
-   30       CONTINUE
-*
-         ELSE
-*
-*           Sort into increasing order
-*
-            DO 50 I = START + 1, ENDD
-               DO 40 J = I, START + 1, -1
-                  IF( D( J ).LT.D( J-1 ) ) THEN
-                     DMNMX = D( J )
-                     D( J ) = D( J-1 )
-                     D( J-1 ) = DMNMX
-                  ELSE
-                     GO TO 50
-                  END IF
-   40          CONTINUE
-   50       CONTINUE
-*
-         END IF
-*
-      ELSE IF( ENDD-START.GT.SELECT ) THEN
-*
-*        Partition D( START:ENDD ) and stack parts, largest one first
-*
-*        Choose partition entry as median of 3
-*
-         D1 = D( START )
-         D2 = D( ENDD )
-         I = ( START+ENDD ) / 2
-         D3 = D( I )
-         IF( D1.LT.D2 ) THEN
-            IF( D3.LT.D1 ) THEN
-               DMNMX = D1
-            ELSE IF( D3.LT.D2 ) THEN
-               DMNMX = D3
-            ELSE
-               DMNMX = D2
-            END IF
-         ELSE
-            IF( D3.LT.D2 ) THEN
-               DMNMX = D2
-            ELSE IF( D3.LT.D1 ) THEN
-               DMNMX = D3
-            ELSE
-               DMNMX = D1
-            END IF
-         END IF
-*
-         IF( DIR.EQ.0 ) THEN
-*
-*           Sort into decreasing order
-*
-            I = START - 1
-            J = ENDD + 1
-   60       CONTINUE
-   70       CONTINUE
-            J = J - 1
-            IF( D( J ).LT.DMNMX )
-     $         GO TO 70
-   80       CONTINUE
-            I = I + 1
-            IF( D( I ).GT.DMNMX )
-     $         GO TO 80
-            IF( I.LT.J ) THEN
-               TMP = D( I )
-               D( I ) = D( J )
-               D( J ) = TMP
-               GO TO 60
-            END IF
-            IF( J-START.GT.ENDD-J-1 ) THEN
-               STKPNT = STKPNT + 1
-               STACK( 1, STKPNT ) = START
-               STACK( 2, STKPNT ) = J
-               STKPNT = STKPNT + 1
-               STACK( 1, STKPNT ) = J + 1
-               STACK( 2, STKPNT ) = ENDD
-            ELSE
-               STKPNT = STKPNT + 1
-               STACK( 1, STKPNT ) = J + 1
-               STACK( 2, STKPNT ) = ENDD
-               STKPNT = STKPNT + 1
-               STACK( 1, STKPNT ) = START
-               STACK( 2, STKPNT ) = J
-            END IF
-         ELSE
-*
-*           Sort into increasing order
-*
-            I = START - 1
-            J = ENDD + 1
-   90       CONTINUE
-  100       CONTINUE
-            J = J - 1
-            IF( D( J ).GT.DMNMX )
-     $         GO TO 100
-  110       CONTINUE
-            I = I + 1
-            IF( D( I ).LT.DMNMX )
-     $         GO TO 110
-            IF( I.LT.J ) THEN
-               TMP = D( I )
-               D( I ) = D( J )
-               D( J ) = TMP
-               GO TO 90
-            END IF
-            IF( J-START.GT.ENDD-J-1 ) THEN
-               STKPNT = STKPNT + 1
-               STACK( 1, STKPNT ) = START
-               STACK( 2, STKPNT ) = J
-               STKPNT = STKPNT + 1
-               STACK( 1, STKPNT ) = J + 1
-               STACK( 2, STKPNT ) = ENDD
-            ELSE
-               STKPNT = STKPNT + 1
-               STACK( 1, STKPNT ) = J + 1
-               STACK( 2, STKPNT ) = ENDD
-               STKPNT = STKPNT + 1
-               STACK( 1, STKPNT ) = START
-               STACK( 2, STKPNT ) = J
-            END IF
-         END IF
-      END IF
-      IF( STKPNT.GT.0 )
-     $   GO TO 10
-      RETURN
-*
-*     End of DLASRT
-*
-      END
diff --git a/src/lib/lapack/dlassq.f b/src/lib/lapack/dlassq.f
deleted file mode 100644
index 217e794d..00000000
--- a/src/lib/lapack/dlassq.f
+++ /dev/null
@@ -1,88 +0,0 @@
-      SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-      DOUBLE PRECISION   SCALE, SUMSQ
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASSQ  returns the values  scl  and  smsq  such that
-*
-*     ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
-*
-*  where  x( i ) = X( 1 + ( i - 1 )*INCX ). The value of  sumsq  is
-*  assumed to be non-negative and  scl  returns the value
-*
-*     scl = max( scale, abs( x( i ) ) ).
-*
-*  scale and sumsq must be supplied in SCALE and SUMSQ and
-*  scl and smsq are overwritten on SCALE and SUMSQ respectively.
-*
-*  The routine makes only one pass through the vector x.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of elements to be used from the vector X.
-*
-*  X       (input) DOUBLE PRECISION array, dimension (N)
-*          The vector for which a scaled sum of squares is computed.
-*             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
-*
-*  INCX    (input) INTEGER
-*          The increment between successive values of the vector X.
-*          INCX > 0.
-*
-*  SCALE   (input/output) DOUBLE PRECISION
-*          On entry, the value  scale  in the equation above.
-*          On exit, SCALE is overwritten with  scl , the scaling factor
-*          for the sum of squares.
-*
-*  SUMSQ   (input/output) DOUBLE PRECISION
-*          On entry, the value  sumsq  in the equation above.
-*          On exit, SUMSQ is overwritten with  smsq , the basic sum of
-*          squares from which  scl  has been factored out.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            IX
-      DOUBLE PRECISION   ABSXI
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.GT.0 ) THEN
-         DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
-            IF( X( IX ).NE.ZERO ) THEN
-               ABSXI = ABS( X( IX ) )
-               IF( SCALE.LT.ABSXI ) THEN
-                  SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
-                  SCALE = ABSXI
-               ELSE
-                  SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
-               END IF
-            END IF
-   10    CONTINUE
-      END IF
-      RETURN
-*
-*     End of DLASSQ
-*
-      END
diff --git a/src/lib/lapack/dlasv2.f b/src/lib/lapack/dlasv2.f
deleted file mode 100644
index 4a00b25d..00000000
--- a/src/lib/lapack/dlasv2.f
+++ /dev/null
@@ -1,249 +0,0 @@
-      SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASV2 computes the singular value decomposition of a 2-by-2
-*  triangular matrix
-*     [  F   G  ]
-*     [  0   H  ].
-*  On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
-*  smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
-*  right singular vectors for abs(SSMAX), giving the decomposition
-*
-*     [ CSL  SNL ] [  F   G  ] [ CSR -SNR ]  =  [ SSMAX   0   ]
-*     [-SNL  CSL ] [  0   H  ] [ SNR  CSR ]     [  0    SSMIN ].
-*
-*  Arguments
-*  =========
-*
-*  F       (input) DOUBLE PRECISION
-*          The (1,1) element of the 2-by-2 matrix.
-*
-*  G       (input) DOUBLE PRECISION
-*          The (1,2) element of the 2-by-2 matrix.
-*
-*  H       (input) DOUBLE PRECISION
-*          The (2,2) element of the 2-by-2 matrix.
-*
-*  SSMIN   (output) DOUBLE PRECISION
-*          abs(SSMIN) is the smaller singular value.
-*
-*  SSMAX   (output) DOUBLE PRECISION
-*          abs(SSMAX) is the larger singular value.
-*
-*  SNL     (output) DOUBLE PRECISION
-*  CSL     (output) DOUBLE PRECISION
-*          The vector (CSL, SNL) is a unit left singular vector for the
-*          singular value abs(SSMAX).
-*
-*  SNR     (output) DOUBLE PRECISION
-*  CSR     (output) DOUBLE PRECISION
-*          The vector (CSR, SNR) is a unit right singular vector for the
-*          singular value abs(SSMAX).
-*
-*  Further Details
-*  ===============
-*
-*  Any input parameter may be aliased with any output parameter.
-*
-*  Barring over/underflow and assuming a guard digit in subtraction, all
-*  output quantities are correct to within a few units in the last
-*  place (ulps).
-*
-*  In IEEE arithmetic, the code works correctly if one matrix element is
-*  infinite.
-*
-*  Overflow will not occur unless the largest singular value itself
-*  overflows or is within a few ulps of overflow. (On machines with
-*  partial overflow, like the Cray, overflow may occur if the largest
-*  singular value is within a factor of 2 of overflow.)
-*
-*  Underflow is harmless if underflow is gradual. Otherwise, results
-*  may correspond to a matrix modified by perturbations of size near
-*  the underflow threshold.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-      DOUBLE PRECISION   HALF
-      PARAMETER          ( HALF = 0.5D0 )
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D0 )
-      DOUBLE PRECISION   TWO
-      PARAMETER          ( TWO = 2.0D0 )
-      DOUBLE PRECISION   FOUR
-      PARAMETER          ( FOUR = 4.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            GASMAL, SWAP
-      INTEGER            PMAX
-      DOUBLE PRECISION   A, CLT, CRT, D, FA, FT, GA, GT, HA, HT, L, M,
-     $                   MM, R, S, SLT, SRT, T, TEMP, TSIGN, TT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, SIGN, SQRT
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Executable Statements ..
-*
-      FT = F
-      FA = ABS( FT )
-      HT = H
-      HA = ABS( H )
-*
-*     PMAX points to the maximum absolute element of matrix
-*       PMAX = 1 if F largest in absolute values
-*       PMAX = 2 if G largest in absolute values
-*       PMAX = 3 if H largest in absolute values
-*
-      PMAX = 1
-      SWAP = ( HA.GT.FA )
-      IF( SWAP ) THEN
-         PMAX = 3
-         TEMP = FT
-         FT = HT
-         HT = TEMP
-         TEMP = FA
-         FA = HA
-         HA = TEMP
-*
-*        Now FA .ge. HA
-*
-      END IF
-      GT = G
-      GA = ABS( GT )
-      IF( GA.EQ.ZERO ) THEN
-*
-*        Diagonal matrix
-*
-         SSMIN = HA
-         SSMAX = FA
-         CLT = ONE
-         CRT = ONE
-         SLT = ZERO
-         SRT = ZERO
-      ELSE
-         GASMAL = .TRUE.
-         IF( GA.GT.FA ) THEN
-            PMAX = 2
-            IF( ( FA / GA ).LT.DLAMCH( 'EPS' ) ) THEN
-*
-*              Case of very large GA
-*
-               GASMAL = .FALSE.
-               SSMAX = GA
-               IF( HA.GT.ONE ) THEN
-                  SSMIN = FA / ( GA / HA )
-               ELSE
-                  SSMIN = ( FA / GA )*HA
-               END IF
-               CLT = ONE
-               SLT = HT / GT
-               SRT = ONE
-               CRT = FT / GT
-            END IF
-         END IF
-         IF( GASMAL ) THEN
-*
-*           Normal case
-*
-            D = FA - HA
-            IF( D.EQ.FA ) THEN
-*
-*              Copes with infinite F or H
-*
-               L = ONE
-            ELSE
-               L = D / FA
-            END IF
-*
-*           Note that 0 .le. L .le. 1
-*
-            M = GT / FT
-*
-*           Note that abs(M) .le. 1/macheps
-*
-            T = TWO - L
-*
-*           Note that T .ge. 1
-*
-            MM = M*M
-            TT = T*T
-            S = SQRT( TT+MM )
-*
-*           Note that 1 .le. S .le. 1 + 1/macheps
-*
-            IF( L.EQ.ZERO ) THEN
-               R = ABS( M )
-            ELSE
-               R = SQRT( L*L+MM )
-            END IF
-*
-*           Note that 0 .le. R .le. 1 + 1/macheps
-*
-            A = HALF*( S+R )
-*
-*           Note that 1 .le. A .le. 1 + abs(M)
-*
-            SSMIN = HA / A
-            SSMAX = FA*A
-            IF( MM.EQ.ZERO ) THEN
-*
-*              Note that M is very tiny
-*
-               IF( L.EQ.ZERO ) THEN
-                  T = SIGN( TWO, FT )*SIGN( ONE, GT )
-               ELSE
-                  T = GT / SIGN( D, FT ) + M / T
-               END IF
-            ELSE
-               T = ( M / ( S+T )+M / ( R+L ) )*( ONE+A )
-            END IF
-            L = SQRT( T*T+FOUR )
-            CRT = TWO / L
-            SRT = T / L
-            CLT = ( CRT+SRT*M ) / A
-            SLT = ( HT / FT )*SRT / A
-         END IF
-      END IF
-      IF( SWAP ) THEN
-         CSL = SRT
-         SNL = CRT
-         CSR = SLT
-         SNR = CLT
-      ELSE
-         CSL = CLT
-         SNL = SLT
-         CSR = CRT
-         SNR = SRT
-      END IF
-*
-*     Correct signs of SSMAX and SSMIN
-*
-      IF( PMAX.EQ.1 )
-     $   TSIGN = SIGN( ONE, CSR )*SIGN( ONE, CSL )*SIGN( ONE, F )
-      IF( PMAX.EQ.2 )
-     $   TSIGN = SIGN( ONE, SNR )*SIGN( ONE, CSL )*SIGN( ONE, G )
-      IF( PMAX.EQ.3 )
-     $   TSIGN = SIGN( ONE, SNR )*SIGN( ONE, SNL )*SIGN( ONE, H )
-      SSMAX = SIGN( SSMAX, TSIGN )
-      SSMIN = SIGN( SSMIN, TSIGN*SIGN( ONE, F )*SIGN( ONE, H ) )
-      RETURN
-*
-*     End of DLASV2
-*
-      END
diff --git a/src/lib/lapack/dlaswp.f b/src/lib/lapack/dlaswp.f
deleted file mode 100644
index a11a87e9..00000000
--- a/src/lib/lapack/dlaswp.f
+++ /dev/null
@@ -1,119 +0,0 @@
-      SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, K1, K2, LDA, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASWP performs a series of row interchanges on the matrix A.
-*  One row interchange is initiated for each of rows K1 through K2 of A.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the matrix of column dimension N to which the row
-*          interchanges will be applied.
-*          On exit, the permuted matrix.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*
-*  K1      (input) INTEGER
-*          The first element of IPIV for which a row interchange will
-*          be done.
-*
-*  K2      (input) INTEGER
-*          The last element of IPIV for which a row interchange will
-*          be done.
-*
-*  IPIV    (input) INTEGER array, dimension (K2*abs(INCX))
-*          The vector of pivot indices.  Only the elements in positions
-*          K1 through K2 of IPIV are accessed.
-*          IPIV(K) = L implies rows K and L are to be interchanged.
-*
-*  INCX    (input) INTEGER
-*          The increment between successive values of IPIV.  If IPIV
-*          is negative, the pivots are applied in reverse order.
-*
-*  Further Details
-*  ===============
-*
-*  Modified by
-*   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
-      DOUBLE PRECISION   TEMP
-*     ..
-*     .. Executable Statements ..
-*
-*     Interchange row I with row IPIV(I) for each of rows K1 through K2.
-*
-      IF( INCX.GT.0 ) THEN
-         IX0 = K1
-         I1 = K1
-         I2 = K2
-         INC = 1
-      ELSE IF( INCX.LT.0 ) THEN
-         IX0 = 1 + ( 1-K2 )*INCX
-         I1 = K2
-         I2 = K1
-         INC = -1
-      ELSE
-         RETURN
-      END IF
-*
-      N32 = ( N / 32 )*32
-      IF( N32.NE.0 ) THEN
-         DO 30 J = 1, N32, 32
-            IX = IX0
-            DO 20 I = I1, I2, INC
-               IP = IPIV( IX )
-               IF( IP.NE.I ) THEN
-                  DO 10 K = J, J + 31
-                     TEMP = A( I, K )
-                     A( I, K ) = A( IP, K )
-                     A( IP, K ) = TEMP
-   10             CONTINUE
-               END IF
-               IX = IX + INCX
-   20       CONTINUE
-   30    CONTINUE
-      END IF
-      IF( N32.NE.N ) THEN
-         N32 = N32 + 1
-         IX = IX0
-         DO 50 I = I1, I2, INC
-            IP = IPIV( IX )
-            IF( IP.NE.I ) THEN
-               DO 40 K = N32, N
-                  TEMP = A( I, K )
-                  A( I, K ) = A( IP, K )
-                  A( IP, K ) = TEMP
-   40          CONTINUE
-            END IF
-            IX = IX + INCX
-   50    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of DLASWP
-*
-      END
diff --git a/src/lib/lapack/dlasy2.f b/src/lib/lapack/dlasy2.f
deleted file mode 100644
index 3ff12070..00000000
--- a/src/lib/lapack/dlasy2.f
+++ /dev/null
@@ -1,381 +0,0 @@
-      SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR,
-     $                   LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            LTRANL, LTRANR
-      INTEGER            INFO, ISGN, LDB, LDTL, LDTR, LDX, N1, N2
-      DOUBLE PRECISION   SCALE, XNORM
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   B( LDB, * ), TL( LDTL, * ), TR( LDTR, * ),
-     $                   X( LDX, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in
-*
-*         op(TL)*X + ISGN*X*op(TR) = SCALE*B,
-*
-*  where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or
-*  -1.  op(T) = T or T', where T' denotes the transpose of T.
-*
-*  Arguments
-*  =========
-*
-*  LTRANL  (input) LOGICAL
-*          On entry, LTRANL specifies the op(TL):
-*             = .FALSE., op(TL) = TL,
-*             = .TRUE., op(TL) = TL'.
-*
-*  LTRANR  (input) LOGICAL
-*          On entry, LTRANR specifies the op(TR):
-*            = .FALSE., op(TR) = TR,
-*            = .TRUE., op(TR) = TR'.
-*
-*  ISGN    (input) INTEGER
-*          On entry, ISGN specifies the sign of the equation
-*          as described before. ISGN may only be 1 or -1.
-*
-*  N1      (input) INTEGER
-*          On entry, N1 specifies the order of matrix TL.
-*          N1 may only be 0, 1 or 2.
-*
-*  N2      (input) INTEGER
-*          On entry, N2 specifies the order of matrix TR.
-*          N2 may only be 0, 1 or 2.
-*
-*  TL      (input) DOUBLE PRECISION array, dimension (LDTL,2)
-*          On entry, TL contains an N1 by N1 matrix.
-*
-*  LDTL    (input) INTEGER
-*          The leading dimension of the matrix TL. LDTL >= max(1,N1).
-*
-*  TR      (input) DOUBLE PRECISION array, dimension (LDTR,2)
-*          On entry, TR contains an N2 by N2 matrix.
-*
-*  LDTR    (input) INTEGER
-*          The leading dimension of the matrix TR. LDTR >= max(1,N2).
-*
-*  B       (input) DOUBLE PRECISION array, dimension (LDB,2)
-*          On entry, the N1 by N2 matrix B contains the right-hand
-*          side of the equation.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the matrix B. LDB >= max(1,N1).
-*
-*  SCALE   (output) DOUBLE PRECISION
-*          On exit, SCALE contains the scale factor. SCALE is chosen
-*          less than or equal to 1 to prevent the solution overflowing.
-*
-*  X       (output) DOUBLE PRECISION array, dimension (LDX,2)
-*          On exit, X contains the N1 by N2 solution.
-*
-*  LDX     (input) INTEGER
-*          The leading dimension of the matrix X. LDX >= max(1,N1).
-*
-*  XNORM   (output) DOUBLE PRECISION
-*          On exit, XNORM is the infinity-norm of the solution.
-*
-*  INFO    (output) INTEGER
-*          On exit, INFO is set to
-*             0: successful exit.
-*             1: TL and TR have too close eigenvalues, so TL or
-*                TR is perturbed to get a nonsingular equation.
-*          NOTE: In the interests of speed, this routine does not
-*                check the inputs for errors.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-      DOUBLE PRECISION   TWO, HALF, EIGHT
-      PARAMETER          ( TWO = 2.0D+0, HALF = 0.5D+0, EIGHT = 8.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            BSWAP, XSWAP
-      INTEGER            I, IP, IPIV, IPSV, J, JP, JPSV, K
-      DOUBLE PRECISION   BET, EPS, GAM, L21, SGN, SMIN, SMLNUM, TAU1,
-     $                   TEMP, U11, U12, U22, XMAX
-*     ..
-*     .. Local Arrays ..
-      LOGICAL            BSWPIV( 4 ), XSWPIV( 4 )
-      INTEGER            JPIV( 4 ), LOCL21( 4 ), LOCU12( 4 ),
-     $                   LOCU22( 4 )
-      DOUBLE PRECISION   BTMP( 4 ), T16( 4, 4 ), TMP( 4 ), X2( 2 )
-*     ..
-*     .. External Functions ..
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           IDAMAX, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX
-*     ..
-*     .. Data statements ..
-      DATA               LOCU12 / 3, 4, 1, 2 / , LOCL21 / 2, 1, 4, 3 / ,
-     $                   LOCU22 / 4, 3, 2, 1 /
-      DATA               XSWPIV / .FALSE., .FALSE., .TRUE., .TRUE. /
-      DATA               BSWPIV / .FALSE., .TRUE., .FALSE., .TRUE. /
-*     ..
-*     .. Executable Statements ..
-*
-*     Do not check the input parameters for errors
-*
-      INFO = 0
-*
-*     Quick return if possible
-*
-      IF( N1.EQ.0 .OR. N2.EQ.0 )
-     $   RETURN
-*
-*     Set constants to control overflow
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' ) / EPS
-      SGN = ISGN
-*
-      K = N1 + N1 + N2 - 2
-      GO TO ( 10, 20, 30, 50 )K
-*
-*     1 by 1: TL11*X + SGN*X*TR11 = B11
-*
-   10 CONTINUE
-      TAU1 = TL( 1, 1 ) + SGN*TR( 1, 1 )
-      BET = ABS( TAU1 )
-      IF( BET.LE.SMLNUM ) THEN
-         TAU1 = SMLNUM
-         BET = SMLNUM
-         INFO = 1
-      END IF
-*
-      SCALE = ONE
-      GAM = ABS( B( 1, 1 ) )
-      IF( SMLNUM*GAM.GT.BET )
-     $   SCALE = ONE / GAM
-*
-      X( 1, 1 ) = ( B( 1, 1 )*SCALE ) / TAU1
-      XNORM = ABS( X( 1, 1 ) )
-      RETURN
-*
-*     1 by 2:
-*     TL11*[X11 X12] + ISGN*[X11 X12]*op[TR11 TR12]  = [B11 B12]
-*                                       [TR21 TR22]
-*
-   20 CONTINUE
-*
-      SMIN = MAX( EPS*MAX( ABS( TL( 1, 1 ) ), ABS( TR( 1, 1 ) ),
-     $       ABS( TR( 1, 2 ) ), ABS( TR( 2, 1 ) ), ABS( TR( 2, 2 ) ) ),
-     $       SMLNUM )
-      TMP( 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
-      TMP( 4 ) = TL( 1, 1 ) + SGN*TR( 2, 2 )
-      IF( LTRANR ) THEN
-         TMP( 2 ) = SGN*TR( 2, 1 )
-         TMP( 3 ) = SGN*TR( 1, 2 )
-      ELSE
-         TMP( 2 ) = SGN*TR( 1, 2 )
-         TMP( 3 ) = SGN*TR( 2, 1 )
-      END IF
-      BTMP( 1 ) = B( 1, 1 )
-      BTMP( 2 ) = B( 1, 2 )
-      GO TO 40
-*
-*     2 by 1:
-*          op[TL11 TL12]*[X11] + ISGN* [X11]*TR11  = [B11]
-*            [TL21 TL22] [X21]         [X21]         [B21]
-*
-   30 CONTINUE
-      SMIN = MAX( EPS*MAX( ABS( TR( 1, 1 ) ), ABS( TL( 1, 1 ) ),
-     $       ABS( TL( 1, 2 ) ), ABS( TL( 2, 1 ) ), ABS( TL( 2, 2 ) ) ),
-     $       SMLNUM )
-      TMP( 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
-      TMP( 4 ) = TL( 2, 2 ) + SGN*TR( 1, 1 )
-      IF( LTRANL ) THEN
-         TMP( 2 ) = TL( 1, 2 )
-         TMP( 3 ) = TL( 2, 1 )
-      ELSE
-         TMP( 2 ) = TL( 2, 1 )
-         TMP( 3 ) = TL( 1, 2 )
-      END IF
-      BTMP( 1 ) = B( 1, 1 )
-      BTMP( 2 ) = B( 2, 1 )
-   40 CONTINUE
-*
-*     Solve 2 by 2 system using complete pivoting.
-*     Set pivots less than SMIN to SMIN.
-*
-      IPIV = IDAMAX( 4, TMP, 1 )
-      U11 = TMP( IPIV )
-      IF( ABS( U11 ).LE.SMIN ) THEN
-         INFO = 1
-         U11 = SMIN
-      END IF
-      U12 = TMP( LOCU12( IPIV ) )
-      L21 = TMP( LOCL21( IPIV ) ) / U11
-      U22 = TMP( LOCU22( IPIV ) ) - U12*L21
-      XSWAP = XSWPIV( IPIV )
-      BSWAP = BSWPIV( IPIV )
-      IF( ABS( U22 ).LE.SMIN ) THEN
-         INFO = 1
-         U22 = SMIN
-      END IF
-      IF( BSWAP ) THEN
-         TEMP = BTMP( 2 )
-         BTMP( 2 ) = BTMP( 1 ) - L21*TEMP
-         BTMP( 1 ) = TEMP
-      ELSE
-         BTMP( 2 ) = BTMP( 2 ) - L21*BTMP( 1 )
-      END IF
-      SCALE = ONE
-      IF( ( TWO*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( U22 ) .OR.
-     $    ( TWO*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( U11 ) ) THEN
-         SCALE = HALF / MAX( ABS( BTMP( 1 ) ), ABS( BTMP( 2 ) ) )
-         BTMP( 1 ) = BTMP( 1 )*SCALE
-         BTMP( 2 ) = BTMP( 2 )*SCALE
-      END IF
-      X2( 2 ) = BTMP( 2 ) / U22
-      X2( 1 ) = BTMP( 1 ) / U11 - ( U12 / U11 )*X2( 2 )
-      IF( XSWAP ) THEN
-         TEMP = X2( 2 )
-         X2( 2 ) = X2( 1 )
-         X2( 1 ) = TEMP
-      END IF
-      X( 1, 1 ) = X2( 1 )
-      IF( N1.EQ.1 ) THEN
-         X( 1, 2 ) = X2( 2 )
-         XNORM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
-      ELSE
-         X( 2, 1 ) = X2( 2 )
-         XNORM = MAX( ABS( X( 1, 1 ) ), ABS( X( 2, 1 ) ) )
-      END IF
-      RETURN
-*
-*     2 by 2:
-*     op[TL11 TL12]*[X11 X12] +ISGN* [X11 X12]*op[TR11 TR12] = [B11 B12]
-*       [TL21 TL22] [X21 X22]        [X21 X22]   [TR21 TR22]   [B21 B22]
-*
-*     Solve equivalent 4 by 4 system using complete pivoting.
-*     Set pivots less than SMIN to SMIN.
-*
-   50 CONTINUE
-      SMIN = MAX( ABS( TR( 1, 1 ) ), ABS( TR( 1, 2 ) ),
-     $       ABS( TR( 2, 1 ) ), ABS( TR( 2, 2 ) ) )
-      SMIN = MAX( SMIN, ABS( TL( 1, 1 ) ), ABS( TL( 1, 2 ) ),
-     $       ABS( TL( 2, 1 ) ), ABS( TL( 2, 2 ) ) )
-      SMIN = MAX( EPS*SMIN, SMLNUM )
-      BTMP( 1 ) = ZERO
-      CALL DCOPY( 16, BTMP, 0, T16, 1 )
-      T16( 1, 1 ) = TL( 1, 1 ) + SGN*TR( 1, 1 )
-      T16( 2, 2 ) = TL( 2, 2 ) + SGN*TR( 1, 1 )
-      T16( 3, 3 ) = TL( 1, 1 ) + SGN*TR( 2, 2 )
-      T16( 4, 4 ) = TL( 2, 2 ) + SGN*TR( 2, 2 )
-      IF( LTRANL ) THEN
-         T16( 1, 2 ) = TL( 2, 1 )
-         T16( 2, 1 ) = TL( 1, 2 )
-         T16( 3, 4 ) = TL( 2, 1 )
-         T16( 4, 3 ) = TL( 1, 2 )
-      ELSE
-         T16( 1, 2 ) = TL( 1, 2 )
-         T16( 2, 1 ) = TL( 2, 1 )
-         T16( 3, 4 ) = TL( 1, 2 )
-         T16( 4, 3 ) = TL( 2, 1 )
-      END IF
-      IF( LTRANR ) THEN
-         T16( 1, 3 ) = SGN*TR( 1, 2 )
-         T16( 2, 4 ) = SGN*TR( 1, 2 )
-         T16( 3, 1 ) = SGN*TR( 2, 1 )
-         T16( 4, 2 ) = SGN*TR( 2, 1 )
-      ELSE
-         T16( 1, 3 ) = SGN*TR( 2, 1 )
-         T16( 2, 4 ) = SGN*TR( 2, 1 )
-         T16( 3, 1 ) = SGN*TR( 1, 2 )
-         T16( 4, 2 ) = SGN*TR( 1, 2 )
-      END IF
-      BTMP( 1 ) = B( 1, 1 )
-      BTMP( 2 ) = B( 2, 1 )
-      BTMP( 3 ) = B( 1, 2 )
-      BTMP( 4 ) = B( 2, 2 )
-*
-*     Perform elimination
-*
-      DO 100 I = 1, 3
-         XMAX = ZERO
-         DO 70 IP = I, 4
-            DO 60 JP = I, 4
-               IF( ABS( T16( IP, JP ) ).GE.XMAX ) THEN
-                  XMAX = ABS( T16( IP, JP ) )
-                  IPSV = IP
-                  JPSV = JP
-               END IF
-   60       CONTINUE
-   70    CONTINUE
-         IF( IPSV.NE.I ) THEN
-            CALL DSWAP( 4, T16( IPSV, 1 ), 4, T16( I, 1 ), 4 )
-            TEMP = BTMP( I )
-            BTMP( I ) = BTMP( IPSV )
-            BTMP( IPSV ) = TEMP
-         END IF
-         IF( JPSV.NE.I )
-     $      CALL DSWAP( 4, T16( 1, JPSV ), 1, T16( 1, I ), 1 )
-         JPIV( I ) = JPSV
-         IF( ABS( T16( I, I ) ).LT.SMIN ) THEN
-            INFO = 1
-            T16( I, I ) = SMIN
-         END IF
-         DO 90 J = I + 1, 4
-            T16( J, I ) = T16( J, I ) / T16( I, I )
-            BTMP( J ) = BTMP( J ) - T16( J, I )*BTMP( I )
-            DO 80 K = I + 1, 4
-               T16( J, K ) = T16( J, K ) - T16( J, I )*T16( I, K )
-   80       CONTINUE
-   90    CONTINUE
-  100 CONTINUE
-      IF( ABS( T16( 4, 4 ) ).LT.SMIN )
-     $   T16( 4, 4 ) = SMIN
-      SCALE = ONE
-      IF( ( EIGHT*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( T16( 1, 1 ) ) .OR.
-     $    ( EIGHT*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( T16( 2, 2 ) ) .OR.
-     $    ( EIGHT*SMLNUM )*ABS( BTMP( 3 ) ).GT.ABS( T16( 3, 3 ) ) .OR.
-     $    ( EIGHT*SMLNUM )*ABS( BTMP( 4 ) ).GT.ABS( T16( 4, 4 ) ) ) THEN
-         SCALE = ( ONE / EIGHT ) / MAX( ABS( BTMP( 1 ) ),
-     $           ABS( BTMP( 2 ) ), ABS( BTMP( 3 ) ), ABS( BTMP( 4 ) ) )
-         BTMP( 1 ) = BTMP( 1 )*SCALE
-         BTMP( 2 ) = BTMP( 2 )*SCALE
-         BTMP( 3 ) = BTMP( 3 )*SCALE
-         BTMP( 4 ) = BTMP( 4 )*SCALE
-      END IF
-      DO 120 I = 1, 4
-         K = 5 - I
-         TEMP = ONE / T16( K, K )
-         TMP( K ) = BTMP( K )*TEMP
-         DO 110 J = K + 1, 4
-            TMP( K ) = TMP( K ) - ( TEMP*T16( K, J ) )*TMP( J )
-  110    CONTINUE
-  120 CONTINUE
-      DO 130 I = 1, 3
-         IF( JPIV( 4-I ).NE.4-I ) THEN
-            TEMP = TMP( 4-I )
-            TMP( 4-I ) = TMP( JPIV( 4-I ) )
-            TMP( JPIV( 4-I ) ) = TEMP
-         END IF
-  130 CONTINUE
-      X( 1, 1 ) = TMP( 1 )
-      X( 2, 1 ) = TMP( 2 )
-      X( 1, 2 ) = TMP( 3 )
-      X( 2, 2 ) = TMP( 4 )
-      XNORM = MAX( ABS( TMP( 1 ) )+ABS( TMP( 3 ) ),
-     $        ABS( TMP( 2 ) )+ABS( TMP( 4 ) ) )
-      RETURN
-*
-*     End of DLASY2
-*
-      END
diff --git a/src/lib/lapack/dlasyf.f b/src/lib/lapack/dlasyf.f
deleted file mode 100644
index 67b9c147..00000000
--- a/src/lib/lapack/dlasyf.f
+++ /dev/null
@@ -1,587 +0,0 @@
-      SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, KB, LDA, LDW, N, NB
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * ), W( LDW, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLASYF computes a partial factorization of a real symmetric matrix A
-*  using the Bunch-Kaufman 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' U22' )
-*
-*  A  =  ( L11  0 ) (  D   0  ) ( L11' L21' )  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 is an auxiliary routine called by DSYTRF. It uses blocked code
-*  (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or
-*  A22 (if UPLO = 'L').
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          symmetric matrix A is stored:
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  NB      (input) 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.
-*
-*  KB      (output) INTEGER
-*          The number of columns of A that were actually factored.
-*          KB is either NB-1 or NB, or N if N <= NB.
-*
-*  A       (input/output) 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, A contains details of the partial factorization.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (output) INTEGER array, dimension (N)
-*          Details of the interchanges and the block structure of D.
-*          If UPLO = 'U', only the last KB elements of IPIV are set;
-*          if UPLO = 'L', only the first KB elements are set.
-*
-*          If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*          interchanged and D(k,k) is a 1-by-1 diagonal block.
-*          If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*          columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*          is a 2-by-2 diagonal block.  If UPLO = 'L' and IPIV(k) =
-*          IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*          interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*
-*  W       (workspace) DOUBLE PRECISION array, dimension (LDW,NB)
-*
-*  LDW     (input) INTEGER
-*          The leading dimension of the array W.  LDW >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          > 0: if INFO = k, D(k,k) is exactly zero.  The factorization
-*               has been completed, but the block diagonal matrix D is
-*               exactly singular.
-*
-*  =====================================================================
-*
-*     .. 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 ..
-      INTEGER            IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP,
-     $                   KSTEP, KW
-      DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, D11, D21, D22, R1,
-     $                   ROWMAX, T
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX
-      EXTERNAL           LSAME, IDAMAX
-*     ..
-*     .. 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
-*
-      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
-*
-*        K is the main loop index, decreasing from N in steps of 1 or 2
-*
-*        KW is the column of W which corresponds to column K of A
-*
-         K = N
-   10    CONTINUE
-         KW = NB + K - N
-*
-*        Exit from loop
-*
-         IF( ( K.LE.N-NB+1 .AND. NB.LT.N ) .OR. K.LT.1 )
-     $      GO TO 30
-*
-*        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 )
-*
-         KSTEP = 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
-*
-         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: set INFO and continue
-*
-            IF( INFO.EQ.0 )
-     $         INFO = K
-            KP = K
-         ELSE
-            IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-*              no interchange, use 1-by-1 pivot block
-*
-               KP = K
-            ELSE
-*
-*              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
-*
-               JMAX = IMAX + IDAMAX( K-IMAX, W( IMAX+1, KW-1 ), 1 )
-               ROWMAX = ABS( W( JMAX, KW-1 ) )
-               IF( IMAX.GT.1 ) THEN
-                  JMAX = IDAMAX( IMAX-1, W( 1, KW-1 ), 1 )
-                  ROWMAX = MAX( ROWMAX, ABS( W( JMAX, KW-1 ) ) )
-               END IF
-*
-               IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-*                 no interchange, use 1-by-1 pivot block
-*
-                  KP = K
-               ELSE IF( ABS( W( IMAX, KW-1 ) ).GE.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
-*
-                  CALL DCOPY( K, W( 1, KW-1 ), 1, W( 1, KW ), 1 )
-               ELSE
-*
-*                 interchange rows and columns K-1 and IMAX, use 2-by-2
-*                 pivot block
-*
-                  KP = IMAX
-                  KSTEP = 2
-               END IF
-            END IF
-*
-            KK = K - KSTEP + 1
-            KKW = NB + KK - N
-*
-*           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 KK 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 )
-               R1 = ONE / A( K, K )
-               CALL DSCAL( K-1, R1, A( 1, K ), 1 )
-            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
-*
-                  D21 = W( K-1, KW )
-                  D11 = W( K, KW ) / D21
-                  D22 = W( K-1, KW-1 ) / D21
-                  T = ONE / ( D11*D22-ONE )
-                  D21 = T / D21
-                  DO 20 J = 1, K - 2
-                     A( J, K-1 ) = D21*( D11*W( J, KW-1 )-W( J, KW ) )
-                     A( J, K ) = D21*( D22*W( J, KW )-W( J, KW-1 ) )
-   20             CONTINUE
-               END IF
-*
-*              Copy D(k) to A
-*
-               A( K-1, K-1 ) = W( K-1, KW-1 )
-               A( K-1, K ) = W( K-1, KW )
-               A( K, K ) = W( K, KW )
-            END IF
-         END IF
-*
-*        Store details of the interchanges in IPIV
-*
-         IF( KSTEP.EQ.1 ) THEN
-            IPIV( K ) = KP
-         ELSE
-            IPIV( K ) = -KP
-            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' = A11 - U12*W'
-*
-*        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
-*
-            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
-*
-*        Put U12 in standard form by partially undoing the interchanges
-*        in columns k+1:n
-*
-         J = K + 1
-   60    CONTINUE
-         JJ = J
-         JP = IPIV( J )
-         IF( JP.LT.0 ) THEN
-            JP = -JP
-            J = J + 1
-         END IF
-         J = J + 1
-         IF( JP.NE.JJ .AND. J.LE.N )
-     $      CALL DSWAP( N-J+1, A( JP, J ), LDA, A( JJ, J ), LDA )
-         IF( J.LE.N )
-     $      GO TO 60
-*
-*        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
-*
-*        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
-*
-*        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 )
-         CALL DGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ), LDA,
-     $               W( K, 1 ), LDW, ONE, W( K, K ), 1 )
-*
-         KSTEP = 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
-*
-         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: set INFO and continue
-*
-            IF( INFO.EQ.0 )
-     $         INFO = K
-            KP = K
-         ELSE
-            IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-*              no interchange, use 1-by-1 pivot block
-*
-               KP = K
-            ELSE
-*
-*              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 )
-               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
-*
-               JMAX = K - 1 + IDAMAX( IMAX-K, W( K, K+1 ), 1 )
-               ROWMAX = ABS( W( JMAX, K+1 ) )
-               IF( IMAX.LT.N ) THEN
-                  JMAX = IMAX + IDAMAX( N-IMAX, W( IMAX+1, K+1 ), 1 )
-                  ROWMAX = MAX( ROWMAX, ABS( W( JMAX, K+1 ) ) )
-               END IF
-*
-               IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-*                 no interchange, use 1-by-1 pivot block
-*
-                  KP = K
-               ELSE IF( ABS( W( IMAX, K+1 ) ).GE.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
-*
-                  CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 )
-               ELSE
-*
-*                 interchange rows and columns K+1 and IMAX, use 2-by-2
-*                 pivot block
-*
-                  KP = IMAX
-                  KSTEP = 2
-               END IF
-            END IF
-*
-            KK = K + KSTEP - 1
-*
-*           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
-                  R1 = ONE / A( K, K )
-                  CALL DSCAL( N-K, R1, A( K+1, K ), 1 )
-               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 )
-                  D21 = T / D21
-                  DO 80 J = K + 2, N
-                     A( J, K ) = D21*( D11*W( J, K )-W( J, K+1 ) )
-                     A( J, K+1 ) = D21*( D22*W( J, K+1 )-W( J, K ) )
-   80             CONTINUE
-               END IF
-*
-*              Copy D(k) to A
-*
-               A( K, K ) = W( K, K )
-               A( K+1, K ) = W( K+1, K )
-               A( K+1, K+1 ) = W( K+1, K+1 )
-            END IF
-         END IF
-*
-*        Store details of the interchanges in IPIV
-*
-         IF( KSTEP.EQ.1 ) THEN
-            IPIV( K ) = KP
-         ELSE
-            IPIV( K ) = -KP
-            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' = A22 - L21*W'
-*
-*        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
-*
-*        Put L21 in standard form by partially undoing the interchanges
-*        in columns 1:k-1
-*
-         J = K - 1
-  120    CONTINUE
-         JJ = J
-         JP = IPIV( J )
-         IF( JP.LT.0 ) THEN
-            JP = -JP
-            J = J - 1
-         END IF
-         J = J - 1
-         IF( JP.NE.JJ .AND. J.GE.1 )
-     $      CALL DSWAP( J, A( JP, 1 ), LDA, A( JJ, 1 ), LDA )
-         IF( J.GE.1 )
-     $      GO TO 120
-*
-*        Set KB to the number of columns factorized
-*
-         KB = K - 1
-*
-      END IF
-      RETURN
-*
-*     End of DLASYF
-*
-      END
diff --git a/src/lib/lapack/dlatdf.f b/src/lib/lapack/dlatdf.f
deleted file mode 100644
index 91fa46e3..00000000
--- a/src/lib/lapack/dlatdf.f
+++ /dev/null
@@ -1,237 +0,0 @@
-      SUBROUTINE DLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
-     $                   JPIV )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IJOB, LDZ, N
-      DOUBLE PRECISION   RDSCAL, RDSUM
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * ), JPIV( * )
-      DOUBLE PRECISION   RHS( * ), Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLATDF uses the LU factorization of the n-by-n matrix Z computed by
-*  DGETC2 and computes a contribution to the reciprocal Dif-estimate
-*  by solving Z * x = b for x, and choosing the r.h.s. b such that
-*  the norm of x is as large as possible. On entry RHS = b holds the
-*  contribution from earlier solved sub-systems, and on return RHS = x.
-*
-*  The factorization of Z returned by DGETC2 has the form Z = P*L*U*Q,
-*  where P and Q are permutation matrices. L is lower triangular with
-*  unit diagonal elements and U is upper triangular.
-*
-*  Arguments
-*  =========
-*
-*  IJOB    (input) INTEGER
-*          IJOB = 2: First compute an approximative null-vector e
-*              of Z using DGECON, e is normalized and solve for
-*              Zx = +-e - f with the sign giving the greater value
-*              of 2-norm(x). About 5 times as expensive as Default.
-*          IJOB .ne. 2: Local look ahead strategy where all entries of
-*              the r.h.s. b is choosen as either +1 or -1 (Default).
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Z.
-*
-*  Z       (input) DOUBLE PRECISION array, dimension (LDZ, N)
-*          On entry, the LU part of the factorization of the n-by-n
-*          matrix Z computed by DGETC2:  Z = P * L * U * Q
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z.  LDA >= max(1, N).
-*
-*  RHS     (input/output) DOUBLE PRECISION array, dimension N.
-*          On entry, RHS contains contributions from other subsystems.
-*          On exit, RHS contains the solution of the subsystem with
-*          entries acoording to the value of IJOB (see above).
-*
-*  RDSUM   (input/output) DOUBLE PRECISION
-*          On entry, the sum of squares of computed contributions to
-*          the Dif-estimate under computation by DTGSYL, where the
-*          scaling factor RDSCAL (see below) has been factored out.
-*          On exit, the corresponding sum of squares updated with the
-*          contributions from the current sub-system.
-*          If TRANS = 'T' RDSUM is not touched.
-*          NOTE: RDSUM only makes sense when DTGSY2 is called by STGSYL.
-*
-*  RDSCAL  (input/output) DOUBLE PRECISION
-*          On entry, scaling factor used to prevent overflow in RDSUM.
-*          On exit, RDSCAL is updated w.r.t. the current contributions
-*          in RDSUM.
-*          If TRANS = 'T', RDSCAL is not touched.
-*          NOTE: RDSCAL only makes sense when DTGSY2 is called by
-*                DTGSYL.
-*
-*  IPIV    (input) INTEGER array, dimension (N).
-*          The pivot indices; for 1 <= i <= N, row i of the
-*          matrix has been interchanged with row IPIV(i).
-*
-*  JPIV    (input) INTEGER array, dimension (N).
-*          The pivot indices; for 1 <= j <= N, column j of the
-*          matrix has been interchanged with column JPIV(j).
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  This routine is a further developed implementation of algorithm
-*  BSOLVE in [1] using complete pivoting in the LU factorization.
-*
-*  [1] Bo Kagstrom and Lars Westin,
-*      Generalized Schur Methods with Condition Estimators for
-*      Solving the Generalized Sylvester Equation, IEEE Transactions
-*      on Automatic Control, Vol. 34, No. 7, July 1989, pp 745-751.
-*
-*  [2] Peter Poromaa,
-*      On Efficient and Robust Estimators for the Separation
-*      between two Regular Matrix Pairs with Applications in
-*      Condition Estimation. Report IMINF-95.05, Departement of
-*      Computing Science, Umea University, S-901 87 Umea, Sweden, 1995.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            MAXDIM
-      PARAMETER          ( MAXDIM = 8 )
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, INFO, J, K
-      DOUBLE PRECISION   BM, BP, PMONE, SMINU, SPLUS, TEMP
-*     ..
-*     .. Local Arrays ..
-      INTEGER            IWORK( MAXDIM )
-      DOUBLE PRECISION   WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DCOPY, DGECON, DGESC2, DLASSQ, DLASWP,
-     $                   DSCAL
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DASUM, DDOT
-      EXTERNAL           DASUM, DDOT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( IJOB.NE.2 ) THEN
-*
-*        Apply permutations IPIV to RHS
-*
-         CALL DLASWP( 1, RHS, LDZ, 1, N-1, IPIV, 1 )
-*
-*        Solve for L-part choosing RHS either to +1 or -1.
-*
-         PMONE = -ONE
-*
-         DO 10 J = 1, N - 1
-            BP = RHS( J ) + ONE
-            BM = RHS( J ) - ONE
-            SPLUS = ONE
-*
-*           Look-ahead for L-part RHS(1:N-1) = + or -1, SPLUS and
-*           SMIN computed more efficiently than in BSOLVE [1].
-*
-            SPLUS = SPLUS + DDOT( N-J, Z( J+1, J ), 1, Z( J+1, J ), 1 )
-            SMINU = DDOT( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 )
-            SPLUS = SPLUS*RHS( J )
-            IF( SPLUS.GT.SMINU ) THEN
-               RHS( J ) = BP
-            ELSE IF( SMINU.GT.SPLUS ) THEN
-               RHS( J ) = BM
-            ELSE
-*
-*              In this case the updating sums are equal and we can
-*              choose RHS(J) +1 or -1. The first time this happens
-*              we choose -1, thereafter +1. This is a simple way to
-*              get good estimates of matrices like Byers well-known
-*              example (see [1]). (Not done in BSOLVE.)
-*
-               RHS( J ) = RHS( J ) + PMONE
-               PMONE = ONE
-            END IF
-*
-*           Compute the remaining r.h.s.
-*
-            TEMP = -RHS( J )
-            CALL DAXPY( N-J, TEMP, Z( J+1, J ), 1, RHS( J+1 ), 1 )
-*
-   10    CONTINUE
-*
-*        Solve for U-part, look-ahead for RHS(N) = +-1. This is not done
-*        in BSOLVE and will hopefully give us a better estimate because
-*        any ill-conditioning of the original matrix is transfered to U
-*        and not to L. U(N, N) is an approximation to sigma_min(LU).
-*
-         CALL DCOPY( N-1, RHS, 1, XP, 1 )
-         XP( N ) = RHS( N ) + ONE
-         RHS( N ) = RHS( N ) - ONE
-         SPLUS = ZERO
-         SMINU = ZERO
-         DO 30 I = N, 1, -1
-            TEMP = ONE / Z( I, I )
-            XP( I ) = XP( I )*TEMP
-            RHS( I ) = RHS( I )*TEMP
-            DO 20 K = I + 1, N
-               XP( I ) = XP( I ) - XP( K )*( Z( I, K )*TEMP )
-               RHS( I ) = RHS( I ) - RHS( K )*( Z( I, K )*TEMP )
-   20       CONTINUE
-            SPLUS = SPLUS + ABS( XP( I ) )
-            SMINU = SMINU + ABS( RHS( I ) )
-   30    CONTINUE
-         IF( SPLUS.GT.SMINU )
-     $      CALL DCOPY( N, XP, 1, RHS, 1 )
-*
-*        Apply the permutations JPIV to the computed solution (RHS)
-*
-         CALL DLASWP( 1, RHS, LDZ, 1, N-1, JPIV, -1 )
-*
-*        Compute the sum of squares
-*
-         CALL DLASSQ( N, RHS, 1, RDSCAL, RDSUM )
-*
-      ELSE
-*
-*        IJOB = 2, Compute approximate nullvector XM of Z
-*
-         CALL DGECON( 'I', N, Z, LDZ, ONE, TEMP, WORK, IWORK, INFO )
-         CALL DCOPY( N, WORK( N+1 ), 1, XM, 1 )
-*
-*        Compute RHS
-*
-         CALL DLASWP( 1, XM, LDZ, 1, N-1, IPIV, -1 )
-         TEMP = ONE / SQRT( DDOT( N, XM, 1, XM, 1 ) )
-         CALL DSCAL( N, TEMP, XM, 1 )
-         CALL DCOPY( N, XM, 1, XP, 1 )
-         CALL DAXPY( N, ONE, RHS, 1, XP, 1 )
-         CALL DAXPY( N, -ONE, XM, 1, RHS, 1 )
-         CALL DGESC2( N, Z, LDZ, RHS, IPIV, JPIV, TEMP )
-         CALL DGESC2( N, Z, LDZ, XP, IPIV, JPIV, TEMP )
-         IF( DASUM( N, XP, 1 ).GT.DASUM( N, RHS, 1 ) )
-     $      CALL DCOPY( N, XP, 1, RHS, 1 )
-*
-*        Compute the sum of squares
-*
-         CALL DLASSQ( N, RHS, 1, RDSCAL, RDSUM )
-*
-      END IF
-*
-      RETURN
-*
-*     End of DLATDF
-*
-      END
diff --git a/src/lib/lapack/dlatrd.f b/src/lib/lapack/dlatrd.f
deleted file mode 100644
index 27bf9b98..00000000
--- a/src/lib/lapack/dlatrd.f
+++ /dev/null
@@ -1,258 +0,0 @@
-      SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            LDA, LDW, N, NB
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), E( * ), TAU( * ), W( LDW, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLATRD reduces NB rows and columns of a real symmetric matrix A to
-*  symmetric tridiagonal form by an orthogonal similarity
-*  transformation Q' * A * Q, and returns the matrices V and W which are
-*  needed to apply the transformation to the unreduced part of A.
-*
-*  If UPLO = 'U', DLATRD reduces the last NB rows and columns of a
-*  matrix, of which the upper triangle is supplied;
-*  if UPLO = 'L', DLATRD reduces the first NB rows and columns of a
-*  matrix, of which the lower triangle is supplied.
-*
-*  This is an auxiliary routine called by DSYTRD.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          symmetric matrix A is stored:
-*          = 'U': Upper triangular
-*          = 'L': Lower triangular
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.
-*
-*  NB      (input) INTEGER
-*          The number of rows and columns to be reduced.
-*
-*  A       (input/output) 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 last NB columns have been reduced to
-*            tridiagonal form, with the diagonal elements overwriting
-*            the diagonal elements of A; the elements above the diagonal
-*            with the array TAU, represent the orthogonal matrix Q as a
-*            product of elementary reflectors;
-*          if UPLO = 'L', the first NB columns have been reduced to
-*            tridiagonal form, with the diagonal elements overwriting
-*            the diagonal elements of A; the elements below the diagonal
-*            with the array TAU, represent the  orthogonal matrix Q as a
-*            product of elementary reflectors.
-*          See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= (1,N).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (N-1)
-*          If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
-*          elements of the last NB columns of the reduced matrix;
-*          if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
-*          the first NB columns of the reduced matrix.
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (N-1)
-*          The scalar factors of the elementary reflectors, stored in
-*          TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
-*          See Further Details.
-*
-*  W       (output) DOUBLE PRECISION array, dimension (LDW,NB)
-*          The n-by-nb matrix W required to update the unreduced part
-*          of A.
-*
-*  LDW     (input) INTEGER
-*          The leading dimension of the array W. LDW >= max(1,N).
-*
-*  Further Details
-*  ===============
-*
-*  If UPLO = 'U', the matrix Q is represented as a product of elementary
-*  reflectors
-*
-*     Q = H(n) H(n-1) . . . H(n-nb+1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
-*  and tau in TAU(i-1).
-*
-*  If UPLO = 'L', the matrix Q is represented as a product of elementary
-*  reflectors
-*
-*     Q = H(1) H(2) . . . H(nb).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
-*  and tau in TAU(i).
-*
-*  The elements of the vectors v together form the n-by-nb matrix V
-*  which is needed, with W, to apply the transformation to the unreduced
-*  part of the matrix, using a symmetric rank-2k update of the form:
-*  A := A - V*W' - W*V'.
-*
-*  The contents of A on exit are illustrated by the following examples
-*  with n = 5 and nb = 2:
-*
-*  if UPLO = 'U':                       if UPLO = 'L':
-*
-*    (  a   a   a   v4  v5 )              (  d                  )
-*    (      a   a   v4  v5 )              (  1   d              )
-*    (          a   1   v5 )              (  v1  1   a          )
-*    (              d   1  )              (  v1  v2  a   a      )
-*    (                  d  )              (  v1  v2  a   a   a  )
-*
-*  where d denotes a diagonal element of the reduced matrix, a denotes
-*  an element of the original matrix that is unchanged, and vi denotes
-*  an element of the vector defining H(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE, HALF
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, HALF = 0.5D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, IW
-      DOUBLE PRECISION   ALPHA
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DGEMV, DLARFG, DSCAL, DSYMV
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DDOT
-      EXTERNAL           LSAME, DDOT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-      IF( LSAME( UPLO, 'U' ) ) THEN
-*
-*        Reduce last NB columns of upper triangle
-*
-         DO 10 I = N, N - NB + 1, -1
-            IW = I - N + NB
-            IF( I.LT.N ) THEN
-*
-*              Update A(1:i,i)
-*
-               CALL DGEMV( 'No transpose', I, N-I, -ONE, A( 1, I+1 ),
-     $                     LDA, W( I, IW+1 ), LDW, ONE, A( 1, I ), 1 )
-               CALL DGEMV( 'No transpose', I, N-I, -ONE, W( 1, IW+1 ),
-     $                     LDW, A( I, I+1 ), LDA, ONE, A( 1, I ), 1 )
-            END IF
-            IF( I.GT.1 ) THEN
-*
-*              Generate elementary reflector H(i) to annihilate
-*              A(1:i-2,i)
-*
-               CALL DLARFG( I-1, A( I-1, I ), A( 1, I ), 1, TAU( I-1 ) )
-               E( I-1 ) = A( I-1, I )
-               A( I-1, I ) = ONE
-*
-*              Compute W(1:i-1,i)
-*
-               CALL DSYMV( 'Upper', I-1, ONE, A, LDA, A( 1, I ), 1,
-     $                     ZERO, W( 1, IW ), 1 )
-               IF( I.LT.N ) THEN
-                  CALL DGEMV( 'Transpose', I-1, N-I, ONE, W( 1, IW+1 ),
-     $                        LDW, A( 1, I ), 1, ZERO, W( I+1, IW ), 1 )
-                  CALL DGEMV( 'No transpose', I-1, N-I, -ONE,
-     $                        A( 1, I+1 ), LDA, W( I+1, IW ), 1, ONE,
-     $                        W( 1, IW ), 1 )
-                  CALL DGEMV( 'Transpose', I-1, N-I, ONE, A( 1, I+1 ),
-     $                        LDA, A( 1, I ), 1, ZERO, W( I+1, IW ), 1 )
-                  CALL DGEMV( 'No transpose', I-1, N-I, -ONE,
-     $                        W( 1, IW+1 ), LDW, W( I+1, IW ), 1, ONE,
-     $                        W( 1, IW ), 1 )
-               END IF
-               CALL DSCAL( I-1, TAU( I-1 ), W( 1, IW ), 1 )
-               ALPHA = -HALF*TAU( I-1 )*DDOT( I-1, W( 1, IW ), 1,
-     $                 A( 1, I ), 1 )
-               CALL DAXPY( I-1, ALPHA, A( 1, I ), 1, W( 1, IW ), 1 )
-            END IF
-*
-   10    CONTINUE
-      ELSE
-*
-*        Reduce first NB columns of lower triangle
-*
-         DO 20 I = 1, NB
-*
-*           Update A(i:n,i)
-*
-            CALL DGEMV( 'No transpose', N-I+1, I-1, -ONE, A( I, 1 ),
-     $                  LDA, W( I, 1 ), LDW, ONE, A( I, I ), 1 )
-            CALL DGEMV( 'No transpose', N-I+1, I-1, -ONE, W( I, 1 ),
-     $                  LDW, A( I, 1 ), LDA, ONE, A( I, I ), 1 )
-            IF( I.LT.N ) THEN
-*
-*              Generate elementary reflector H(i) to annihilate
-*              A(i+2:n,i)
-*
-               CALL DLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
-     $                      TAU( I ) )
-               E( I ) = A( I+1, I )
-               A( I+1, I ) = ONE
-*
-*              Compute W(i+1:n,i)
-*
-               CALL DSYMV( 'Lower', N-I, ONE, A( I+1, I+1 ), LDA,
-     $                     A( I+1, I ), 1, ZERO, W( I+1, I ), 1 )
-               CALL DGEMV( 'Transpose', N-I, I-1, ONE, W( I+1, 1 ), LDW,
-     $                     A( I+1, I ), 1, ZERO, W( 1, I ), 1 )
-               CALL DGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, 1 ),
-     $                     LDA, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
-               CALL DGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA,
-     $                     A( I+1, I ), 1, ZERO, W( 1, I ), 1 )
-               CALL DGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, 1 ),
-     $                     LDW, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
-               CALL DSCAL( N-I, TAU( I ), W( I+1, I ), 1 )
-               ALPHA = -HALF*TAU( I )*DDOT( N-I, W( I+1, I ), 1,
-     $                 A( I+1, I ), 1 )
-               CALL DAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), 1 )
-            END IF
-*
-   20    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of DLATRD
-*
-      END
diff --git a/src/lib/lapack/dlatrs.f b/src/lib/lapack/dlatrs.f
deleted file mode 100644
index bbd3a9e4..00000000
--- a/src/lib/lapack/dlatrs.f
+++ /dev/null
@@ -1,701 +0,0 @@
-      SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
-     $                   CNORM, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIAG, NORMIN, TRANS, UPLO
-      INTEGER            INFO, LDA, N
-      DOUBLE PRECISION   SCALE
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), CNORM( * ), X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLATRS solves one of the triangular systems
-*
-*     A *x = s*b  or  A'*x = s*b
-*
-*  with scaling to prevent overflow.  Here A is an upper or lower
-*  triangular matrix, A' denotes the transpose of A, x and b are
-*  n-element vectors, and s is a scaling factor, usually less than
-*  or equal to 1, chosen so that the components of x will be less than
-*  the overflow threshold.  If the unscaled problem will not cause
-*  overflow, the Level 2 BLAS routine DTRSV is called.  If the matrix A
-*  is singular (A(j,j) = 0 for some j), then s is set to 0 and a
-*  non-trivial solution to A*x = 0 is returned.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the matrix A is upper or lower triangular.
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
-*
-*  TRANS   (input) CHARACTER*1
-*          Specifies the operation applied to A.
-*          = 'N':  Solve A * x = s*b  (No transpose)
-*          = 'T':  Solve A'* x = s*b  (Transpose)
-*          = 'C':  Solve A'* x = s*b  (Conjugate transpose = Transpose)
-*
-*  DIAG    (input) CHARACTER*1
-*          Specifies whether or not the matrix A is unit triangular.
-*          = 'N':  Non-unit triangular
-*          = 'U':  Unit triangular
-*
-*  NORMIN  (input) CHARACTER*1
-*          Specifies whether CNORM has been set or not.
-*          = 'Y':  CNORM contains the column norms on entry
-*          = 'N':  CNORM is not set on entry.  On exit, the norms will
-*                  be computed and stored in CNORM.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The triangular matrix A.  If UPLO = 'U', the leading n by n
-*          upper triangular part of the array A contains the upper
-*          triangular matrix, and the strictly lower triangular part of
-*          A is not referenced.  If UPLO = 'L', the leading n by n lower
-*          triangular part of the array A contains the lower triangular
-*          matrix, and the strictly upper triangular part of A is not
-*          referenced.  If DIAG = 'U', the diagonal elements of A are
-*          also not referenced and are assumed to be 1.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max (1,N).
-*
-*  X       (input/output) DOUBLE PRECISION array, dimension (N)
-*          On entry, the right hand side b of the triangular system.
-*          On exit, X is overwritten by the solution vector x.
-*
-*  SCALE   (output) DOUBLE PRECISION
-*          The scaling factor s for the triangular system
-*             A * x = s*b  or  A'* x = s*b.
-*          If SCALE = 0, the matrix A is singular or badly scaled, and
-*          the vector x is an exact or approximate solution to A*x = 0.
-*
-*  CNORM   (input or output) DOUBLE PRECISION array, dimension (N)
-*
-*          If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
-*          contains the norm of the off-diagonal part of the j-th column
-*          of A.  If TRANS = 'N', CNORM(j) must be greater than or equal
-*          to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
-*          must be greater than or equal to the 1-norm.
-*
-*          If NORMIN = 'N', CNORM is an output argument and CNORM(j)
-*          returns the 1-norm of the offdiagonal part of the j-th column
-*          of A.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -k, the k-th argument had an illegal value
-*
-*  Further Details
-*  ======= =======
-*
-*  A rough bound on x is computed; if that is less than overflow, DTRSV
-*  is called, otherwise, specific code is used which checks for possible
-*  overflow or divide-by-zero at every operation.
-*
-*  A columnwise scheme is used for solving A*x = b.  The basic algorithm
-*  if A is lower triangular is
-*
-*       x[1:n] := b[1:n]
-*       for j = 1, ..., n
-*            x(j) := x(j) / A(j,j)
-*            x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
-*       end
-*
-*  Define bounds on the components of x after j iterations of the loop:
-*     M(j) = bound on x[1:j]
-*     G(j) = bound on x[j+1:n]
-*  Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
-*
-*  Then for iteration j+1 we have
-*     M(j+1) <= G(j) / | A(j+1,j+1) |
-*     G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
-*            <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
-*
-*  where CNORM(j+1) is greater than or equal to the infinity-norm of
-*  column j+1 of A, not counting the diagonal.  Hence
-*
-*     G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
-*                  1<=i<=j
-*  and
-*
-*     |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
-*                                   1<=i< j
-*
-*  Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTRSV if the
-*  reciprocal of the largest M(j), j=1,..,n, is larger than
-*  max(underflow, 1/overflow).
-*
-*  The bound on x(j) is also used to determine when a step in the
-*  columnwise method can be performed without fear of overflow.  If
-*  the computed bound is greater than a large constant, x is scaled to
-*  prevent overflow, but if the bound overflows, x is set to 0, x(j) to
-*  1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
-*
-*  Similarly, a row-wise scheme is used to solve A'*x = b.  The basic
-*  algorithm for A upper triangular is
-*
-*       for j = 1, ..., n
-*            x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
-*       end
-*
-*  We simultaneously compute two bounds
-*       G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
-*       M(j) = bound on x(i), 1<=i<=j
-*
-*  The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
-*  add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
-*  Then the bound on x(j) is
-*
-*       M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
-*
-*            <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
-*                      1<=i<=j
-*
-*  and we can safely call DTRSV if 1/M(n) and 1/G(n) are both greater
-*  than max(underflow, 1/overflow).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, HALF, ONE
-      PARAMETER          ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOTRAN, NOUNIT, UPPER
-      INTEGER            I, IMAX, J, JFIRST, JINC, JLAST
-      DOUBLE PRECISION   BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
-     $                   TMAX, TSCAL, USCAL, XBND, XJ, XMAX
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DASUM, DDOT, DLAMCH
-      EXTERNAL           LSAME, IDAMAX, DASUM, DDOT, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DSCAL, DTRSV, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-      UPPER = LSAME( UPLO, 'U' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      NOUNIT = LSAME( DIAG, 'N' )
-*
-*     Test the input parameters.
-*
-      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
-     $         LSAME( TRANS, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
-         INFO = -3
-      ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
-     $         LSAME( NORMIN, 'N' ) ) THEN
-         INFO = -4
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DLATRS', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Determine machine dependent parameters to control overflow.
-*
-      SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
-      BIGNUM = ONE / SMLNUM
-      SCALE = ONE
-*
-      IF( LSAME( NORMIN, 'N' ) ) THEN
-*
-*        Compute the 1-norm of each column, not including the diagonal.
-*
-         IF( UPPER ) THEN
-*
-*           A is upper triangular.
-*
-            DO 10 J = 1, N
-               CNORM( J ) = DASUM( J-1, A( 1, J ), 1 )
-   10       CONTINUE
-         ELSE
-*
-*           A is lower triangular.
-*
-            DO 20 J = 1, N - 1
-               CNORM( J ) = DASUM( N-J, A( J+1, J ), 1 )
-   20       CONTINUE
-            CNORM( N ) = ZERO
-         END IF
-      END IF
-*
-*     Scale the column norms by TSCAL if the maximum element in CNORM is
-*     greater than BIGNUM.
-*
-      IMAX = IDAMAX( N, CNORM, 1 )
-      TMAX = CNORM( IMAX )
-      IF( TMAX.LE.BIGNUM ) THEN
-         TSCAL = ONE
-      ELSE
-         TSCAL = ONE / ( SMLNUM*TMAX )
-         CALL DSCAL( N, TSCAL, CNORM, 1 )
-      END IF
-*
-*     Compute a bound on the computed solution vector to see if the
-*     Level 2 BLAS routine DTRSV can be used.
-*
-      J = IDAMAX( N, X, 1 )
-      XMAX = ABS( X( J ) )
-      XBND = XMAX
-      IF( NOTRAN ) THEN
-*
-*        Compute the growth in A * x = b.
-*
-         IF( UPPER ) THEN
-            JFIRST = N
-            JLAST = 1
-            JINC = -1
-         ELSE
-            JFIRST = 1
-            JLAST = N
-            JINC = 1
-         END IF
-*
-         IF( TSCAL.NE.ONE ) THEN
-            GROW = ZERO
-            GO TO 50
-         END IF
-*
-         IF( NOUNIT ) THEN
-*
-*           A is non-unit triangular.
-*
-*           Compute GROW = 1/G(j) and XBND = 1/M(j).
-*           Initially, G(0) = max{x(i), i=1,...,n}.
-*
-            GROW = ONE / MAX( XBND, SMLNUM )
-            XBND = GROW
-            DO 30 J = JFIRST, JLAST, JINC
-*
-*              Exit the loop if the growth factor is too small.
-*
-               IF( GROW.LE.SMLNUM )
-     $            GO TO 50
-*
-*              M(j) = G(j-1) / abs(A(j,j))
-*
-               TJJ = ABS( A( J, J ) )
-               XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
-               IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
-*
-*                 G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
-*
-                  GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
-               ELSE
-*
-*                 G(j) could overflow, set GROW to 0.
-*
-                  GROW = ZERO
-               END IF
-   30       CONTINUE
-            GROW = XBND
-         ELSE
-*
-*           A is unit triangular.
-*
-*           Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
-            GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
-            DO 40 J = JFIRST, JLAST, JINC
-*
-*              Exit the loop if the growth factor is too small.
-*
-               IF( GROW.LE.SMLNUM )
-     $            GO TO 50
-*
-*              G(j) = G(j-1)*( 1 + CNORM(j) )
-*
-               GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
-   40       CONTINUE
-         END IF
-   50    CONTINUE
-*
-      ELSE
-*
-*        Compute the growth in A' * x = b.
-*
-         IF( UPPER ) THEN
-            JFIRST = 1
-            JLAST = N
-            JINC = 1
-         ELSE
-            JFIRST = N
-            JLAST = 1
-            JINC = -1
-         END IF
-*
-         IF( TSCAL.NE.ONE ) THEN
-            GROW = ZERO
-            GO TO 80
-         END IF
-*
-         IF( NOUNIT ) THEN
-*
-*           A is non-unit triangular.
-*
-*           Compute GROW = 1/G(j) and XBND = 1/M(j).
-*           Initially, M(0) = max{x(i), i=1,...,n}.
-*
-            GROW = ONE / MAX( XBND, SMLNUM )
-            XBND = GROW
-            DO 60 J = JFIRST, JLAST, JINC
-*
-*              Exit the loop if the growth factor is too small.
-*
-               IF( GROW.LE.SMLNUM )
-     $            GO TO 80
-*
-*              G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
-*
-               XJ = ONE + CNORM( J )
-               GROW = MIN( GROW, XBND / XJ )
-*
-*              M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
-*
-               TJJ = ABS( A( J, J ) )
-               IF( XJ.GT.TJJ )
-     $            XBND = XBND*( TJJ / XJ )
-   60       CONTINUE
-            GROW = MIN( GROW, XBND )
-         ELSE
-*
-*           A is unit triangular.
-*
-*           Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
-            GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
-            DO 70 J = JFIRST, JLAST, JINC
-*
-*              Exit the loop if the growth factor is too small.
-*
-               IF( GROW.LE.SMLNUM )
-     $            GO TO 80
-*
-*              G(j) = ( 1 + CNORM(j) )*G(j-1)
-*
-               XJ = ONE + CNORM( J )
-               GROW = GROW / XJ
-   70       CONTINUE
-         END IF
-   80    CONTINUE
-      END IF
-*
-      IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
-*
-*        Use the Level 2 BLAS solve if the reciprocal of the bound on
-*        elements of X is not too small.
-*
-         CALL DTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
-      ELSE
-*
-*        Use a Level 1 BLAS solve, scaling intermediate results.
-*
-         IF( XMAX.GT.BIGNUM ) THEN
-*
-*           Scale X so that its components are less than or equal to
-*           BIGNUM in absolute value.
-*
-            SCALE = BIGNUM / XMAX
-            CALL DSCAL( N, SCALE, X, 1 )
-            XMAX = BIGNUM
-         END IF
-*
-         IF( NOTRAN ) THEN
-*
-*           Solve A * x = b
-*
-            DO 110 J = JFIRST, JLAST, JINC
-*
-*              Compute x(j) = b(j) / A(j,j), scaling x if necessary.
-*
-               XJ = ABS( X( J ) )
-               IF( NOUNIT ) THEN
-                  TJJS = A( J, J )*TSCAL
-               ELSE
-                  TJJS = TSCAL
-                  IF( TSCAL.EQ.ONE )
-     $               GO TO 100
-               END IF
-               TJJ = ABS( TJJS )
-               IF( TJJ.GT.SMLNUM ) THEN
-*
-*                    abs(A(j,j)) > SMLNUM:
-*
-                  IF( TJJ.LT.ONE ) THEN
-                     IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-*                          Scale x by 1/b(j).
-*
-                        REC = ONE / XJ
-                        CALL DSCAL( N, REC, X, 1 )
-                        SCALE = SCALE*REC
-                        XMAX = XMAX*REC
-                     END IF
-                  END IF
-                  X( J ) = X( J ) / TJJS
-                  XJ = ABS( X( J ) )
-               ELSE IF( TJJ.GT.ZERO ) THEN
-*
-*                    0 < abs(A(j,j)) <= SMLNUM:
-*
-                  IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-*                       Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
-*                       to avoid overflow when dividing by A(j,j).
-*
-                     REC = ( TJJ*BIGNUM ) / XJ
-                     IF( CNORM( J ).GT.ONE ) THEN
-*
-*                          Scale by 1/CNORM(j) to avoid overflow when
-*                          multiplying x(j) times column j.
-*
-                        REC = REC / CNORM( J )
-                     END IF
-                     CALL DSCAL( N, REC, X, 1 )
-                     SCALE = SCALE*REC
-                     XMAX = XMAX*REC
-                  END IF
-                  X( J ) = X( J ) / TJJS
-                  XJ = ABS( X( J ) )
-               ELSE
-*
-*                    A(j,j) = 0:  Set x(1:n) = 0, x(j) = 1, and
-*                    scale = 0, and compute a solution to A*x = 0.
-*
-                  DO 90 I = 1, N
-                     X( I ) = ZERO
-   90             CONTINUE
-                  X( J ) = ONE
-                  XJ = ONE
-                  SCALE = ZERO
-                  XMAX = ZERO
-               END IF
-  100          CONTINUE
-*
-*              Scale x if necessary to avoid overflow when adding a
-*              multiple of column j of A.
-*
-               IF( XJ.GT.ONE ) THEN
-                  REC = ONE / XJ
-                  IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
-*
-*                    Scale x by 1/(2*abs(x(j))).
-*
-                     REC = REC*HALF
-                     CALL DSCAL( N, REC, X, 1 )
-                     SCALE = SCALE*REC
-                  END IF
-               ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
-*
-*                 Scale x by 1/2.
-*
-                  CALL DSCAL( N, HALF, X, 1 )
-                  SCALE = SCALE*HALF
-               END IF
-*
-               IF( UPPER ) THEN
-                  IF( J.GT.1 ) THEN
-*
-*                    Compute the update
-*                       x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
-*
-                     CALL DAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X,
-     $                           1 )
-                     I = IDAMAX( J-1, X, 1 )
-                     XMAX = ABS( X( I ) )
-                  END IF
-               ELSE
-                  IF( J.LT.N ) THEN
-*
-*                    Compute the update
-*                       x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
-*
-                     CALL DAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1,
-     $                           X( J+1 ), 1 )
-                     I = J + IDAMAX( N-J, X( J+1 ), 1 )
-                     XMAX = ABS( X( I ) )
-                  END IF
-               END IF
-  110       CONTINUE
-*
-         ELSE
-*
-*           Solve A' * x = b
-*
-            DO 160 J = JFIRST, JLAST, JINC
-*
-*              Compute x(j) = b(j) - sum A(k,j)*x(k).
-*                                    k<>j
-*
-               XJ = ABS( X( J ) )
-               USCAL = TSCAL
-               REC = ONE / MAX( XMAX, ONE )
-               IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-*                 If x(j) could overflow, scale x by 1/(2*XMAX).
-*
-                  REC = REC*HALF
-                  IF( NOUNIT ) THEN
-                     TJJS = A( J, J )*TSCAL
-                  ELSE
-                     TJJS = TSCAL
-                  END IF
-                  TJJ = ABS( TJJS )
-                  IF( TJJ.GT.ONE ) THEN
-*
-*                       Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
-                     REC = MIN( ONE, REC*TJJ )
-                     USCAL = USCAL / TJJS
-                  END IF
-                  IF( REC.LT.ONE ) THEN
-                     CALL DSCAL( N, REC, X, 1 )
-                     SCALE = SCALE*REC
-                     XMAX = XMAX*REC
-                  END IF
-               END IF
-*
-               SUMJ = ZERO
-               IF( USCAL.EQ.ONE ) THEN
-*
-*                 If the scaling needed for A in the dot product is 1,
-*                 call DDOT to perform the dot product.
-*
-                  IF( UPPER ) THEN
-                     SUMJ = DDOT( J-1, A( 1, J ), 1, X, 1 )
-                  ELSE IF( J.LT.N ) THEN
-                     SUMJ = DDOT( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
-                  END IF
-               ELSE
-*
-*                 Otherwise, use in-line code for the dot product.
-*
-                  IF( UPPER ) THEN
-                     DO 120 I = 1, J - 1
-                        SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I )
-  120                CONTINUE
-                  ELSE IF( J.LT.N ) THEN
-                     DO 130 I = J + 1, N
-                        SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I )
-  130                CONTINUE
-                  END IF
-               END IF
-*
-               IF( USCAL.EQ.TSCAL ) THEN
-*
-*                 Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
-*                 was not used to scale the dotproduct.
-*
-                  X( J ) = X( J ) - SUMJ
-                  XJ = ABS( X( J ) )
-                  IF( NOUNIT ) THEN
-                     TJJS = A( J, J )*TSCAL
-                  ELSE
-                     TJJS = TSCAL
-                     IF( TSCAL.EQ.ONE )
-     $                  GO TO 150
-                  END IF
-*
-*                    Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
-                  TJJ = ABS( TJJS )
-                  IF( TJJ.GT.SMLNUM ) THEN
-*
-*                       abs(A(j,j)) > SMLNUM:
-*
-                     IF( TJJ.LT.ONE ) THEN
-                        IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-*                             Scale X by 1/abs(x(j)).
-*
-                           REC = ONE / XJ
-                           CALL DSCAL( N, REC, X, 1 )
-                           SCALE = SCALE*REC
-                           XMAX = XMAX*REC
-                        END IF
-                     END IF
-                     X( J ) = X( J ) / TJJS
-                  ELSE IF( TJJ.GT.ZERO ) THEN
-*
-*                       0 < abs(A(j,j)) <= SMLNUM:
-*
-                     IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-*                          Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
-                        REC = ( TJJ*BIGNUM ) / XJ
-                        CALL DSCAL( N, REC, X, 1 )
-                        SCALE = SCALE*REC
-                        XMAX = XMAX*REC
-                     END IF
-                     X( J ) = X( J ) / TJJS
-                  ELSE
-*
-*                       A(j,j) = 0:  Set x(1:n) = 0, x(j) = 1, and
-*                       scale = 0, and compute a solution to A'*x = 0.
-*
-                     DO 140 I = 1, N
-                        X( I ) = ZERO
-  140                CONTINUE
-                     X( J ) = ONE
-                     SCALE = ZERO
-                     XMAX = ZERO
-                  END IF
-  150             CONTINUE
-               ELSE
-*
-*                 Compute x(j) := x(j) / A(j,j)  - sumj if the dot
-*                 product has already been divided by 1/A(j,j).
-*
-                  X( J ) = X( J ) / TJJS - SUMJ
-               END IF
-               XMAX = MAX( XMAX, ABS( X( J ) ) )
-  160       CONTINUE
-         END IF
-         SCALE = SCALE / TSCAL
-      END IF
-*
-*     Scale the column norms by 1/TSCAL for return.
-*
-      IF( TSCAL.NE.ONE ) THEN
-         CALL DSCAL( N, ONE / TSCAL, CNORM, 1 )
-      END IF
-*
-      RETURN
-*
-*     End of DLATRS
-*
-      END
diff --git a/src/lib/lapack/dlatrz.f b/src/lib/lapack/dlatrz.f
deleted file mode 100644
index e1a2cf97..00000000
--- a/src/lib/lapack/dlatrz.f
+++ /dev/null
@@ -1,127 +0,0 @@
-      SUBROUTINE DLATRZ( M, N, L, A, LDA, TAU, WORK )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            L, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLATRZ factors the M-by-(M+L) real upper trapezoidal matrix
-*  [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R  0 ) * Z, by means
-*  of orthogonal transformations.  Z is an (M+L)-by-(M+L) orthogonal
-*  matrix and, R and A1 are M-by-M upper triangular matrices.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  L       (input) INTEGER
-*          The number of columns of the matrix A containing the
-*          meaningful part of the Householder vectors. N-M >= L >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the leading M-by-N upper trapezoidal part of the
-*          array A must contain the matrix to be factorized.
-*          On exit, the leading M-by-M upper triangular part of A
-*          contains the upper triangular matrix R, and elements N-L+1 to
-*          N of the first M rows of A, with the array TAU, represent the
-*          orthogonal matrix Z as a product of M elementary reflectors.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (M)
-*          The scalar factors of the elementary reflectors.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (M)
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  The factorization is obtained by Householder's method.  The kth
-*  transformation matrix, Z( k ), which is used to introduce zeros into
-*  the ( m - k + 1 )th row of A, is given in the form
-*
-*     Z( k ) = ( I     0   ),
-*              ( 0  T( k ) )
-*
-*  where
-*
-*     T( k ) = I - tau*u( k )*u( k )',   u( k ) = (   1    ),
-*                                                 (   0    )
-*                                                 ( z( k ) )
-*
-*  tau is a scalar and z( k ) is an l element vector. tau and z( k )
-*  are chosen to annihilate the elements of the kth row of A2.
-*
-*  The scalar tau is returned in the kth element of TAU and the vector
-*  u( k ) in the kth row of A2, such that the elements of z( k ) are
-*  in  a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in
-*  the upper triangular part of A1.
-*
-*  Z is given by
-*
-*     Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARFG, DLARZ
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 ) THEN
-         RETURN
-      ELSE IF( M.EQ.N ) THEN
-         DO 10 I = 1, N
-            TAU( I ) = ZERO
-   10    CONTINUE
-         RETURN
-      END IF
-*
-      DO 20 I = M, 1, -1
-*
-*        Generate elementary reflector H(i) to annihilate
-*        [ A(i,i) A(i,n-l+1:n) ]
-*
-         CALL DLARFG( L+1, A( I, I ), A( I, N-L+1 ), LDA, TAU( I ) )
-*
-*        Apply H(i) to A(1:i-1,i:n) from the right
-*
-         CALL DLARZ( 'Right', I-1, N-I+1, L, A( I, N-L+1 ), LDA,
-     $               TAU( I ), A( 1, I ), LDA, WORK )
-*
-   20 CONTINUE
-*
-      RETURN
-*
-*     End of DLATRZ
-*
-      END
diff --git a/src/lib/lapack/dlatzm.f b/src/lib/lapack/dlatzm.f
deleted file mode 100644
index 2467ab60..00000000
--- a/src/lib/lapack/dlatzm.f
+++ /dev/null
@@ -1,142 +0,0 @@
-      SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE
-      INTEGER            INCV, LDC, M, N
-      DOUBLE PRECISION   TAU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  This routine is deprecated and has been replaced by routine DORMRZ.
-*
-*  DLATZM applies a Householder matrix generated by DTZRQF to a matrix.
-*
-*  Let P = I - tau*u*u',   u = ( 1 ),
-*                              ( v )
-*  where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
-*  SIDE = 'R'.
-*
-*  If SIDE equals 'L', let
-*         C = [ C1 ] 1
-*             [ C2 ] m-1
-*               n
-*  Then C is overwritten by P*C.
-*
-*  If SIDE equals 'R', let
-*         C = [ C1, C2 ] m
-*                1  n-1
-*  Then C is overwritten by C*P.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': form P * C
-*          = 'R': form C * P
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  V       (input) DOUBLE PRECISION array, dimension
-*                  (1 + (M-1)*abs(INCV)) if SIDE = 'L'
-*                  (1 + (N-1)*abs(INCV)) if SIDE = 'R'
-*          The vector v in the representation of P. V is not used
-*          if TAU = 0.
-*
-*  INCV    (input) INTEGER
-*          The increment between elements of v. INCV <> 0
-*
-*  TAU     (input) DOUBLE PRECISION
-*          The value tau in the representation of P.
-*
-*  C1      (input/output) DOUBLE PRECISION array, dimension
-*                         (LDC,N) if SIDE = 'L'
-*                         (M,1)   if SIDE = 'R'
-*          On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
-*          if SIDE = 'R'.
-*
-*          On exit, the first row of P*C if SIDE = 'L', or the first
-*          column of C*P if SIDE = 'R'.
-*
-*  C2      (input/output) DOUBLE PRECISION array, dimension
-*                         (LDC, N)   if SIDE = 'L'
-*                         (LDC, N-1) if SIDE = 'R'
-*          On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
-*          m x (n - 1) matrix C2 if SIDE = 'R'.
-*
-*          On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
-*          if SIDE = 'R'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the arrays C1 and C2. LDC >= (1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension
-*                      (N) if SIDE = 'L'
-*                      (M) if SIDE = 'R'
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DCOPY, DGEMV, DGER
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-      IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
-     $   RETURN
-*
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        w := C1 + v' * C2
-*
-         CALL DCOPY( N, C1, LDC, WORK, 1 )
-         CALL DGEMV( 'Transpose', M-1, N, ONE, C2, LDC, V, INCV, ONE,
-     $               WORK, 1 )
-*
-*        [ C1 ] := [ C1 ] - tau* [ 1 ] * w'
-*        [ C2 ]    [ C2 ]        [ v ]
-*
-         CALL DAXPY( N, -TAU, WORK, 1, C1, LDC )
-         CALL DGER( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
-*
-      ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*        w := C1 + C2 * v
-*
-         CALL DCOPY( M, C1, 1, WORK, 1 )
-         CALL DGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
-     $               WORK, 1 )
-*
-*        [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v']
-*
-         CALL DAXPY( M, -TAU, WORK, 1, C1, 1 )
-         CALL DGER( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
-      END IF
-*
-      RETURN
-*
-*     End of DLATZM
-*
-      END
diff --git a/src/lib/lapack/dlazq3.f b/src/lib/lapack/dlazq3.f
deleted file mode 100644
index 784248f7..00000000
--- a/src/lib/lapack/dlazq3.f
+++ /dev/null
@@ -1,302 +0,0 @@
-      SUBROUTINE DLAZQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
-     $                   ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
-     $                   DN2, TAU )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            IEEE
-      INTEGER            I0, ITER, N0, NDIV, NFAIL, PP, TTYPE
-      DOUBLE PRECISION   DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, QMAX,
-     $                   SIGMA, TAU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   Z( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAZQ3 checks for deflation, computes a shift (TAU) and calls dqds.
-*  In case of failure it changes shifts, and tries again until output
-*  is positive.
-*
-*  Arguments
-*  =========
-*
-*  I0     (input) INTEGER
-*         First index.
-*
-*  N0     (input) INTEGER
-*         Last index.
-*
-*  Z      (input) DOUBLE PRECISION array, dimension ( 4*N )
-*         Z holds the qd array.
-*
-*  PP     (input) INTEGER
-*         PP=0 for ping, PP=1 for pong.
-*
-*  DMIN   (output) DOUBLE PRECISION
-*         Minimum value of d.
-*
-*  SIGMA  (output) DOUBLE PRECISION
-*         Sum of shifts used in current segment.
-*
-*  DESIG  (input/output) DOUBLE PRECISION
-*         Lower order part of SIGMA
-*
-*  QMAX   (input) DOUBLE PRECISION
-*         Maximum value of q.
-*
-*  NFAIL  (output) INTEGER
-*         Number of times shift was too big.
-*
-*  ITER   (output) INTEGER
-*         Number of iterations.
-*
-*  NDIV   (output) INTEGER
-*         Number of divisions.
-*
-*  IEEE   (input) LOGICAL
-*         Flag for IEEE or non IEEE arithmetic (passed to DLASQ5).
-*
-*  TTYPE  (input/output) INTEGER
-*         Shift type.  TTYPE is passed as an argument in order to save
-*         its value between calls to DLAZQ3
-*
-*  DMIN1  (input/output) REAL
-*  DMIN2  (input/output) REAL
-*  DN     (input/output) REAL
-*  DN1    (input/output) REAL
-*  DN2    (input/output) REAL
-*  TAU    (input/output) REAL
-*         These are passed as arguments in order to save their values
-*         between calls to DLAZQ3
-*
-*  This is a thread safe version of DLASQ3, which passes TTYPE, DMIN1,
-*  DMIN2, DN, DN1. DN2 and TAU through the argument list in place of
-*  declaring them in a SAVE statment.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   CBIAS
-      PARAMETER          ( CBIAS = 1.50D0 )
-      DOUBLE PRECISION   ZERO, QURTR, HALF, ONE, TWO, HUNDRD
-      PARAMETER          ( ZERO = 0.0D0, QURTR = 0.250D0, HALF = 0.5D0,
-     $                     ONE = 1.0D0, TWO = 2.0D0, HUNDRD = 100.0D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            IPN4, J4, N0IN, NN
-      DOUBLE PRECISION   EPS, G, S, SAFMIN, T, TEMP, TOL, TOL2
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASQ5, DLASQ6, DLAZQ4
-*     ..
-*     .. External Function ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      N0IN   = N0
-      EPS    = DLAMCH( 'Precision' )
-      SAFMIN = DLAMCH( 'Safe minimum' )
-      TOL    = EPS*HUNDRD
-      TOL2   = TOL**2
-      G      = ZERO
-*
-*     Check for deflation.
-*
-   10 CONTINUE
-*
-      IF( N0.LT.I0 )
-     $   RETURN
-      IF( N0.EQ.I0 )
-     $   GO TO 20
-      NN = 4*N0 + PP
-      IF( N0.EQ.( I0+1 ) )
-     $   GO TO 40
-*
-*     Check whether E(N0-1) is negligible, 1 eigenvalue.
-*
-      IF( Z( NN-5 ).GT.TOL2*( SIGMA+Z( NN-3 ) ) .AND.
-     $    Z( NN-2*PP-4 ).GT.TOL2*Z( NN-7 ) )
-     $   GO TO 30
-*
-   20 CONTINUE
-*
-      Z( 4*N0-3 ) = Z( 4*N0+PP-3 ) + SIGMA
-      N0 = N0 - 1
-      GO TO 10
-*
-*     Check  whether E(N0-2) is negligible, 2 eigenvalues.
-*
-   30 CONTINUE
-*
-      IF( Z( NN-9 ).GT.TOL2*SIGMA .AND.
-     $    Z( NN-2*PP-8 ).GT.TOL2*Z( NN-11 ) )
-     $   GO TO 50
-*
-   40 CONTINUE
-*
-      IF( Z( NN-3 ).GT.Z( NN-7 ) ) THEN
-         S = Z( NN-3 )
-         Z( NN-3 ) = Z( NN-7 )
-         Z( NN-7 ) = S
-      END IF
-      IF( Z( NN-5 ).GT.Z( NN-3 )*TOL2 ) THEN
-         T = HALF*( ( Z( NN-7 )-Z( NN-3 ) )+Z( NN-5 ) )
-         S = Z( NN-3 )*( Z( NN-5 ) / T )
-         IF( S.LE.T ) THEN
-            S = Z( NN-3 )*( Z( NN-5 ) /
-     $          ( T*( ONE+SQRT( ONE+S / T ) ) ) )
-         ELSE
-            S = Z( NN-3 )*( Z( NN-5 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
-         END IF
-         T = Z( NN-7 ) + ( S+Z( NN-5 ) )
-         Z( NN-3 ) = Z( NN-3 )*( Z( NN-7 ) / T )
-         Z( NN-7 ) = T
-      END IF
-      Z( 4*N0-7 ) = Z( NN-7 ) + SIGMA
-      Z( 4*N0-3 ) = Z( NN-3 ) + SIGMA
-      N0 = N0 - 2
-      GO TO 10
-*
-   50 CONTINUE
-*
-*     Reverse the qd-array, if warranted.
-*
-      IF( DMIN.LE.ZERO .OR. N0.LT.N0IN ) THEN
-         IF( CBIAS*Z( 4*I0+PP-3 ).LT.Z( 4*N0+PP-3 ) ) THEN
-            IPN4 = 4*( I0+N0 )
-            DO 60 J4 = 4*I0, 2*( I0+N0-1 ), 4
-               TEMP = Z( J4-3 )
-               Z( J4-3 ) = Z( IPN4-J4-3 )
-               Z( IPN4-J4-3 ) = TEMP
-               TEMP = Z( J4-2 )
-               Z( J4-2 ) = Z( IPN4-J4-2 )
-               Z( IPN4-J4-2 ) = TEMP
-               TEMP = Z( J4-1 )
-               Z( J4-1 ) = Z( IPN4-J4-5 )
-               Z( IPN4-J4-5 ) = TEMP
-               TEMP = Z( J4 )
-               Z( J4 ) = Z( IPN4-J4-4 )
-               Z( IPN4-J4-4 ) = TEMP
-   60       CONTINUE
-            IF( N0-I0.LE.4 ) THEN
-               Z( 4*N0+PP-1 ) = Z( 4*I0+PP-1 )
-               Z( 4*N0-PP ) = Z( 4*I0-PP )
-            END IF
-            DMIN2 = MIN( DMIN2, Z( 4*N0+PP-1 ) )
-            Z( 4*N0+PP-1 ) = MIN( Z( 4*N0+PP-1 ), Z( 4*I0+PP-1 ),
-     $                            Z( 4*I0+PP+3 ) )
-            Z( 4*N0-PP ) = MIN( Z( 4*N0-PP ), Z( 4*I0-PP ),
-     $                          Z( 4*I0-PP+4 ) )
-            QMAX = MAX( QMAX, Z( 4*I0+PP-3 ), Z( 4*I0+PP+1 ) )
-            DMIN = -ZERO
-         END IF
-      END IF
-*
-      IF( DMIN.LT.ZERO .OR. SAFMIN*QMAX.LT.MIN( Z( 4*N0+PP-1 ),
-     $    Z( 4*N0+PP-9 ), DMIN2+Z( 4*N0-PP ) ) ) THEN
-*
-*        Choose a shift.
-*
-         CALL DLAZQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1,
-     $                DN2, TAU, TTYPE, G )
-*
-*        Call dqds until DMIN > 0.
-*
-   80    CONTINUE
-*
-         CALL DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
-     $                DN1, DN2, IEEE )
-*
-         NDIV = NDIV + ( N0-I0+2 )
-         ITER = ITER + 1
-*
-*        Check status.
-*
-         IF( DMIN.GE.ZERO .AND. DMIN1.GT.ZERO ) THEN
-*
-*           Success.
-*
-            GO TO 100
-*
-         ELSE IF( DMIN.LT.ZERO .AND. DMIN1.GT.ZERO .AND.
-     $            Z( 4*( N0-1 )-PP ).LT.TOL*( SIGMA+DN1 ) .AND.
-     $            ABS( DN ).LT.TOL*SIGMA ) THEN
-*
-*           Convergence hidden by negative DN.
-*
-            Z( 4*( N0-1 )-PP+2 ) = ZERO
-            DMIN = ZERO
-            GO TO 100
-         ELSE IF( DMIN.LT.ZERO ) THEN
-*
-*           TAU too big. Select new TAU and try again.
-*
-            NFAIL = NFAIL + 1
-            IF( TTYPE.LT.-22 ) THEN
-*
-*              Failed twice. Play it safe.
-*
-               TAU = ZERO
-            ELSE IF( DMIN1.GT.ZERO ) THEN
-*
-*              Late failure. Gives excellent shift.
-*
-               TAU = ( TAU+DMIN )*( ONE-TWO*EPS )
-               TTYPE = TTYPE - 11
-            ELSE
-*
-*              Early failure. Divide by 4.
-*
-               TAU = QURTR*TAU
-               TTYPE = TTYPE - 12
-            END IF
-            GO TO 80
-         ELSE IF( DMIN.NE.DMIN ) THEN
-*
-*           NaN.
-*
-            TAU = ZERO
-            GO TO 80
-         ELSE
-*
-*           Possible underflow. Play it safe.
-*
-            GO TO 90
-         END IF
-      END IF
-*
-*     Risk of underflow.
-*
-   90 CONTINUE
-      CALL DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DN1, DN2 )
-      NDIV = NDIV + ( N0-I0+2 )
-      ITER = ITER + 1
-      TAU = ZERO
-*
-  100 CONTINUE
-      IF( TAU.LT.SIGMA ) THEN
-         DESIG = DESIG + TAU
-         T = SIGMA + DESIG
-         DESIG = DESIG - ( T-SIGMA )
-      ELSE
-         T = SIGMA + TAU
-         DESIG = SIGMA - ( T-TAU ) + DESIG
-      END IF
-      SIGMA = T
-*
-      RETURN
-*
-*     End of DLAZQ3
-*
-      END
diff --git a/src/lib/lapack/dlazq4.f b/src/lib/lapack/dlazq4.f
deleted file mode 100644
index 7c257f8d..00000000
--- a/src/lib/lapack/dlazq4.f
+++ /dev/null
@@ -1,330 +0,0 @@
-      SUBROUTINE DLAZQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
-     $                   DN1, DN2, TAU, TTYPE, G )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            I0, N0, N0IN, PP, TTYPE
-      DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   Z( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLAZQ4 computes an approximation TAU to the smallest eigenvalue 
-*  using values of d from the previous transform.
-*
-*  I0    (input) INTEGER
-*        First index.
-*
-*  N0    (input) INTEGER
-*        Last index.
-*
-*  Z     (input) DOUBLE PRECISION array, dimension ( 4*N )
-*        Z holds the qd array.
-*
-*  PP    (input) INTEGER
-*        PP=0 for ping, PP=1 for pong.
-*
-*  N0IN  (input) INTEGER
-*        The value of N0 at start of EIGTEST.
-*
-*  DMIN  (input) DOUBLE PRECISION
-*        Minimum value of d.
-*
-*  DMIN1 (input) DOUBLE PRECISION
-*        Minimum value of d, excluding D( N0 ).
-*
-*  DMIN2 (input) DOUBLE PRECISION
-*        Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*
-*  DN    (input) DOUBLE PRECISION
-*        d(N)
-*
-*  DN1   (input) DOUBLE PRECISION
-*        d(N-1)
-*
-*  DN2   (input) DOUBLE PRECISION
-*        d(N-2)
-*
-*  TAU   (output) DOUBLE PRECISION
-*        This is the shift.
-*
-*  TTYPE (output) INTEGER
-*        Shift type.
-*
-*  G     (input/output) DOUBLE PRECISION
-*        G is passed as an argument in order to save its value between
-*        calls to DLAZQ4
-*
-*  Further Details
-*  ===============
-*  CNST1 = 9/16
-*
-*  This is a thread safe version of DLASQ4, which passes G through the
-*  argument list in place of declaring G in a SAVE statment.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   CNST1, CNST2, CNST3
-      PARAMETER          ( CNST1 = 0.5630D0, CNST2 = 1.010D0,
-     $                   CNST3 = 1.050D0 )
-      DOUBLE PRECISION   QURTR, THIRD, HALF, ZERO, ONE, TWO, HUNDRD
-      PARAMETER          ( QURTR = 0.250D0, THIRD = 0.3330D0,
-     $                   HALF = 0.50D0, ZERO = 0.0D0, ONE = 1.0D0,
-     $                   TWO = 2.0D0, HUNDRD = 100.0D0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I4, NN, NP
-      DOUBLE PRECISION   A2, B1, B2, GAM, GAP1, GAP2, S
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     A negative DMIN forces the shift to take that absolute value
-*     TTYPE records the type of shift.
-*
-      IF( DMIN.LE.ZERO ) THEN
-         TAU = -DMIN
-         TTYPE = -1
-         RETURN
-      END IF
-*       
-      NN = 4*N0 + PP
-      IF( N0IN.EQ.N0 ) THEN
-*
-*        No eigenvalues deflated.
-*
-         IF( DMIN.EQ.DN .OR. DMIN.EQ.DN1 ) THEN
-*
-            B1 = SQRT( Z( NN-3 ) )*SQRT( Z( NN-5 ) )
-            B2 = SQRT( Z( NN-7 ) )*SQRT( Z( NN-9 ) )
-            A2 = Z( NN-7 ) + Z( NN-5 )
-*
-*           Cases 2 and 3.
-*
-            IF( DMIN.EQ.DN .AND. DMIN1.EQ.DN1 ) THEN
-               GAP2 = DMIN2 - A2 - DMIN2*QURTR
-               IF( GAP2.GT.ZERO .AND. GAP2.GT.B2 ) THEN
-                  GAP1 = A2 - DN - ( B2 / GAP2 )*B2
-               ELSE
-                  GAP1 = A2 - DN - ( B1+B2 )
-               END IF
-               IF( GAP1.GT.ZERO .AND. GAP1.GT.B1 ) THEN
-                  S = MAX( DN-( B1 / GAP1 )*B1, HALF*DMIN )
-                  TTYPE = -2
-               ELSE
-                  S = ZERO
-                  IF( DN.GT.B1 )
-     $               S = DN - B1
-                  IF( A2.GT.( B1+B2 ) )
-     $               S = MIN( S, A2-( B1+B2 ) )
-                  S = MAX( S, THIRD*DMIN )
-                  TTYPE = -3
-               END IF
-            ELSE
-*
-*              Case 4.
-*
-               TTYPE = -4
-               S = QURTR*DMIN
-               IF( DMIN.EQ.DN ) THEN
-                  GAM = DN
-                  A2 = ZERO
-                  IF( Z( NN-5 ) .GT. Z( NN-7 ) )
-     $               RETURN
-                  B2 = Z( NN-5 ) / Z( NN-7 )
-                  NP = NN - 9
-               ELSE
-                  NP = NN - 2*PP
-                  B2 = Z( NP-2 )
-                  GAM = DN1
-                  IF( Z( NP-4 ) .GT. Z( NP-2 ) )
-     $               RETURN
-                  A2 = Z( NP-4 ) / Z( NP-2 )
-                  IF( Z( NN-9 ) .GT. Z( NN-11 ) )
-     $               RETURN
-                  B2 = Z( NN-9 ) / Z( NN-11 )
-                  NP = NN - 13
-               END IF
-*
-*              Approximate contribution to norm squared from I < NN-1.
-*
-               A2 = A2 + B2
-               DO 10 I4 = NP, 4*I0 - 1 + PP, -4
-                  IF( B2.EQ.ZERO )
-     $               GO TO 20
-                  B1 = B2
-                  IF( Z( I4 ) .GT. Z( I4-2 ) )
-     $               RETURN
-                  B2 = B2*( Z( I4 ) / Z( I4-2 ) )
-                  A2 = A2 + B2
-                  IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 ) 
-     $               GO TO 20
-   10          CONTINUE
-   20          CONTINUE
-               A2 = CNST3*A2
-*
-*              Rayleigh quotient residual bound.
-*
-               IF( A2.LT.CNST1 )
-     $            S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
-            END IF
-         ELSE IF( DMIN.EQ.DN2 ) THEN
-*
-*           Case 5.
-*
-            TTYPE = -5
-            S = QURTR*DMIN
-*
-*           Compute contribution to norm squared from I > NN-2.
-*
-            NP = NN - 2*PP
-            B1 = Z( NP-2 )
-            B2 = Z( NP-6 )
-            GAM = DN2
-            IF( Z( NP-8 ).GT.B2 .OR. Z( NP-4 ).GT.B1 )
-     $         RETURN
-            A2 = ( Z( NP-8 ) / B2 )*( ONE+Z( NP-4 ) / B1 )
-*
-*           Approximate contribution to norm squared from I < NN-2.
-*
-            IF( N0-I0.GT.2 ) THEN
-               B2 = Z( NN-13 ) / Z( NN-15 )
-               A2 = A2 + B2
-               DO 30 I4 = NN - 17, 4*I0 - 1 + PP, -4
-                  IF( B2.EQ.ZERO )
-     $               GO TO 40
-                  B1 = B2
-                  IF( Z( I4 ) .GT. Z( I4-2 ) )
-     $               RETURN
-                  B2 = B2*( Z( I4 ) / Z( I4-2 ) )
-                  A2 = A2 + B2
-                  IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 ) 
-     $               GO TO 40
-   30          CONTINUE
-   40          CONTINUE
-               A2 = CNST3*A2
-            END IF
-*
-            IF( A2.LT.CNST1 )
-     $         S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
-         ELSE
-*
-*           Case 6, no information to guide us.
-*
-            IF( TTYPE.EQ.-6 ) THEN
-               G = G + THIRD*( ONE-G )
-            ELSE IF( TTYPE.EQ.-18 ) THEN
-               G = QURTR*THIRD
-            ELSE
-               G = QURTR
-            END IF
-            S = G*DMIN
-            TTYPE = -6
-         END IF
-*
-      ELSE IF( N0IN.EQ.( N0+1 ) ) THEN
-*
-*        One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN.
-*
-         IF( DMIN1.EQ.DN1 .AND. DMIN2.EQ.DN2 ) THEN 
-*
-*           Cases 7 and 8.
-*
-            TTYPE = -7
-            S = THIRD*DMIN1
-            IF( Z( NN-5 ).GT.Z( NN-7 ) )
-     $         RETURN
-            B1 = Z( NN-5 ) / Z( NN-7 )
-            B2 = B1
-            IF( B2.EQ.ZERO )
-     $         GO TO 60
-            DO 50 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
-               A2 = B1
-               IF( Z( I4 ).GT.Z( I4-2 ) )
-     $            RETURN
-               B1 = B1*( Z( I4 ) / Z( I4-2 ) )
-               B2 = B2 + B1
-               IF( HUNDRD*MAX( B1, A2 ).LT.B2 ) 
-     $            GO TO 60
-   50       CONTINUE
-   60       CONTINUE
-            B2 = SQRT( CNST3*B2 )
-            A2 = DMIN1 / ( ONE+B2**2 )
-            GAP2 = HALF*DMIN2 - A2
-            IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
-               S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
-            ELSE 
-               S = MAX( S, A2*( ONE-CNST2*B2 ) )
-               TTYPE = -8
-            END IF
-         ELSE
-*
-*           Case 9.
-*
-            S = QURTR*DMIN1
-            IF( DMIN1.EQ.DN1 )
-     $         S = HALF*DMIN1
-            TTYPE = -9
-         END IF
-*
-      ELSE IF( N0IN.EQ.( N0+2 ) ) THEN
-*
-*        Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN.
-*
-*        Cases 10 and 11.
-*
-         IF( DMIN2.EQ.DN2 .AND. TWO*Z( NN-5 ).LT.Z( NN-7 ) ) THEN 
-            TTYPE = -10
-            S = THIRD*DMIN2
-            IF( Z( NN-5 ).GT.Z( NN-7 ) )
-     $         RETURN
-            B1 = Z( NN-5 ) / Z( NN-7 )
-            B2 = B1
-            IF( B2.EQ.ZERO )
-     $         GO TO 80
-            DO 70 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
-               IF( Z( I4 ).GT.Z( I4-2 ) )
-     $            RETURN
-               B1 = B1*( Z( I4 ) / Z( I4-2 ) )
-               B2 = B2 + B1
-               IF( HUNDRD*B1.LT.B2 )
-     $            GO TO 80
-   70       CONTINUE
-   80       CONTINUE
-            B2 = SQRT( CNST3*B2 )
-            A2 = DMIN2 / ( ONE+B2**2 )
-            GAP2 = Z( NN-7 ) + Z( NN-9 ) -
-     $             SQRT( Z( NN-11 ) )*SQRT( Z( NN-9 ) ) - A2
-            IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
-               S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
-            ELSE 
-               S = MAX( S, A2*( ONE-CNST2*B2 ) )
-            END IF
-         ELSE
-            S = QURTR*DMIN2
-            TTYPE = -11
-         END IF
-      ELSE IF( N0IN.GT.( N0+2 ) ) THEN
-*
-*        Case 12, more than two eigenvalues deflated. No information.
-*
-         S = ZERO 
-         TTYPE = -12
-      END IF
-*
-      TAU = S
-      RETURN
-*
-*     End of DLAZQ4
-*
-      END
diff --git a/src/lib/lapack/dopgtr.f b/src/lib/lapack/dopgtr.f
deleted file mode 100644
index cf0901ff..00000000
--- a/src/lib/lapack/dopgtr.f
+++ /dev/null
@@ -1,160 +0,0 @@
-      SUBROUTINE DOPGTR( UPLO, N, AP, TAU, Q, LDQ, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDQ, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   AP( * ), Q( LDQ, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DOPGTR generates a real orthogonal matrix Q which is defined as the
-*  product of n-1 elementary reflectors H(i) of order n, as returned by
-*  DSPTRD using packed storage:
-*
-*  if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
-*
-*  if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U': Upper triangular packed storage used in previous
-*                 call to DSPTRD;
-*          = 'L': Lower triangular packed storage used in previous
-*                 call to DSPTRD.
-*
-*  N       (input) INTEGER
-*          The order of the matrix Q. N >= 0.
-*
-*  AP      (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*          The vectors which define the elementary reflectors, as
-*          returned by DSPTRD.
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (N-1)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DSPTRD.
-*
-*  Q       (output) DOUBLE PRECISION array, dimension (LDQ,N)
-*          The N-by-N orthogonal matrix Q.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q. LDQ >= max(1,N).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N-1)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            I, IINFO, IJ, J
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DORG2L, DORG2R, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      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( LDQ.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DOPGTR', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      IF( UPPER ) THEN
-*
-*        Q was determined by a call to DSPTRD with UPLO = 'U'
-*
-*        Unpack the vectors which define the elementary reflectors and
-*        set the last row and column of Q equal to those of the unit
-*        matrix
-*
-         IJ = 2
-         DO 20 J = 1, N - 1
-            DO 10 I = 1, J - 1
-               Q( I, J ) = AP( IJ )
-               IJ = IJ + 1
-   10       CONTINUE
-            IJ = IJ + 2
-            Q( N, J ) = ZERO
-   20    CONTINUE
-         DO 30 I = 1, N - 1
-            Q( I, N ) = ZERO
-   30    CONTINUE
-         Q( N, N ) = ONE
-*
-*        Generate Q(1:n-1,1:n-1)
-*
-         CALL DORG2L( N-1, N-1, N-1, Q, LDQ, TAU, WORK, IINFO )
-*
-      ELSE
-*
-*        Q was determined by a call to DSPTRD with UPLO = 'L'.
-*
-*        Unpack the vectors which define the elementary reflectors and
-*        set the first row and column of Q equal to those of the unit
-*        matrix
-*
-         Q( 1, 1 ) = ONE
-         DO 40 I = 2, N
-            Q( I, 1 ) = ZERO
-   40    CONTINUE
-         IJ = 3
-         DO 60 J = 2, N
-            Q( 1, J ) = ZERO
-            DO 50 I = J + 1, N
-               Q( I, J ) = AP( IJ )
-               IJ = IJ + 1
-   50       CONTINUE
-            IJ = IJ + 2
-   60    CONTINUE
-         IF( N.GT.1 ) THEN
-*
-*           Generate Q(2:n,2:n)
-*
-            CALL DORG2R( N-1, N-1, N-1, Q( 2, 2 ), LDQ, TAU, WORK,
-     $                   IINFO )
-         END IF
-      END IF
-      RETURN
-*
-*     End of DOPGTR
-*
-      END
diff --git a/src/lib/lapack/dorg2l.f b/src/lib/lapack/dorg2l.f
deleted file mode 100644
index a20965fd..00000000
--- a/src/lib/lapack/dorg2l.f
+++ /dev/null
@@ -1,127 +0,0 @@
-      SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORG2L generates an m by n real matrix Q with orthonormal columns,
-*  which is defined as the last n columns of a product of k elementary
-*  reflectors of order m
-*
-*        Q  =  H(k) . . . H(2) H(1)
-*
-*  as returned by DGEQLF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. M >= N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. N >= K >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the (n-k+i)-th column must contain the vector which
-*          defines the elementary reflector H(i), for i = 1,2,...,k, as
-*          returned by DGEQLF in the last k columns of its array
-*          argument A.
-*          On exit, the m by n matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGEQLF.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, II, J, L
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DSCAL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORG2L', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-*     Initialise columns 1:n-k to columns of the unit matrix
-*
-      DO 20 J = 1, N - K
-         DO 10 L = 1, M
-            A( L, J ) = ZERO
-   10    CONTINUE
-         A( M-N+J, J ) = ONE
-   20 CONTINUE
-*
-      DO 40 I = 1, K
-         II = N - K + I
-*
-*        Apply H(i) to A(1:m-k+i,1:n-k+i) from the left
-*
-         A( M-N+II, II ) = ONE
-         CALL DLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A,
-     $               LDA, WORK )
-         CALL DSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 )
-         A( M-N+II, II ) = ONE - TAU( I )
-*
-*        Set A(m-k+i+1:m,n-k+i) to zero
-*
-         DO 30 L = M - N + II + 1, M
-            A( L, II ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-      RETURN
-*
-*     End of DORG2L
-*
-      END
diff --git a/src/lib/lapack/dorg2r.f b/src/lib/lapack/dorg2r.f
deleted file mode 100644
index 476e9f70..00000000
--- a/src/lib/lapack/dorg2r.f
+++ /dev/null
@@ -1,129 +0,0 @@
-      SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORG2R generates an m by n real matrix Q with orthonormal columns,
-*  which is defined as the first n columns of a product of k elementary
-*  reflectors of order m
-*
-*        Q  =  H(1) H(2) . . . H(k)
-*
-*  as returned by DGEQRF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. M >= N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. N >= K >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the i-th column must contain the vector which
-*          defines the elementary reflector H(i), for i = 1,2,...,k, as
-*          returned by DGEQRF in the first k columns of its array
-*          argument A.
-*          On exit, the m-by-n matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGEQRF.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J, L
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DSCAL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORG2R', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-*     Initialise columns k+1:n to columns of the unit matrix
-*
-      DO 20 J = K + 1, N
-         DO 10 L = 1, M
-            A( L, J ) = ZERO
-   10    CONTINUE
-         A( J, J ) = ONE
-   20 CONTINUE
-*
-      DO 40 I = K, 1, -1
-*
-*        Apply H(i) to A(i:m,i:n) from the left
-*
-         IF( I.LT.N ) THEN
-            A( I, I ) = ONE
-            CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
-     $                  A( I, I+1 ), LDA, WORK )
-         END IF
-         IF( I.LT.M )
-     $      CALL DSCAL( M-I, -TAU( I ), A( I+1, I ), 1 )
-         A( I, I ) = ONE - TAU( I )
-*
-*        Set A(1:i-1,i) to zero
-*
-         DO 30 L = 1, I - 1
-            A( L, I ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-      RETURN
-*
-*     End of DORG2R
-*
-      END
diff --git a/src/lib/lapack/dorgbr.f b/src/lib/lapack/dorgbr.f
deleted file mode 100644
index dc882990..00000000
--- a/src/lib/lapack/dorgbr.f
+++ /dev/null
@@ -1,244 +0,0 @@
-      SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          VECT
-      INTEGER            INFO, K, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORGBR generates one of the real orthogonal matrices Q or P**T
-*  determined by DGEBRD when reducing a real matrix A to bidiagonal
-*  form: A = Q * B * P**T.  Q and P**T are defined as products of
-*  elementary reflectors H(i) or G(i) respectively.
-*
-*  If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
-*  is of order M:
-*  if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n
-*  columns of Q, where m >= n >= k;
-*  if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an
-*  M-by-M matrix.
-*
-*  If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
-*  is of order N:
-*  if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m
-*  rows of P**T, where n >= m >= k;
-*  if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as
-*  an N-by-N matrix.
-*
-*  Arguments
-*  =========
-*
-*  VECT    (input) CHARACTER*1
-*          Specifies whether the matrix Q or the matrix P**T is
-*          required, as defined in the transformation applied by DGEBRD:
-*          = 'Q':  generate Q;
-*          = 'P':  generate P**T.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q or P**T to be returned.
-*          M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q or P**T to be returned.
-*          N >= 0.
-*          If VECT = 'Q', M >= N >= min(M,K);
-*          if VECT = 'P', N >= M >= min(N,K).
-*
-*  K       (input) INTEGER
-*          If VECT = 'Q', the number of columns in the original M-by-K
-*          matrix reduced by DGEBRD.
-*          If VECT = 'P', the number of rows in the original K-by-N
-*          matrix reduced by DGEBRD.
-*          K >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the vectors which define the elementary reflectors,
-*          as returned by DGEBRD.
-*          On exit, the M-by-N matrix Q or P**T.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension
-*                                (min(M,K)) if VECT = 'Q'
-*                                (min(N,K)) if VECT = 'P'
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i) or G(i), which determines Q or P**T, as
-*          returned by DGEBRD in its array argument TAUQ or TAUP.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= max(1,min(M,N)).
-*          For optimum performance LWORK >= min(M,N)*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, WANTQ
-      INTEGER            I, IINFO, J, LWKOPT, MN, NB
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DORGLQ, DORGQR, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      WANTQ = LSAME( VECT, 'Q' )
-      MN = MIN( M, N )
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
-         INFO = -1
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 .OR. ( WANTQ .AND. ( N.GT.M .OR. N.LT.MIN( M,
-     $         K ) ) ) .OR. ( .NOT.WANTQ .AND. ( M.GT.N .OR. M.LT.
-     $         MIN( N, K ) ) ) ) THEN
-         INFO = -3
-      ELSE IF( K.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -6
-      ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
-         INFO = -9
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( WANTQ ) THEN
-            NB = ILAENV( 1, 'DORGQR', ' ', M, N, K, -1 )
-         ELSE
-            NB = ILAENV( 1, 'DORGLQ', ' ', M, N, K, -1 )
-         END IF
-         LWKOPT = MAX( 1, MN )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORGBR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      IF( WANTQ ) THEN
-*
-*        Form Q, determined by a call to DGEBRD to reduce an m-by-k
-*        matrix
-*
-         IF( M.GE.K ) THEN
-*
-*           If m >= k, assume m >= n >= k
-*
-            CALL DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
-*
-         ELSE
-*
-*           If m < k, assume m = n
-*
-*           Shift the vectors which define the elementary reflectors one
-*           column to the right, and set the first row and column of Q
-*           to those of the unit matrix
-*
-            DO 20 J = M, 2, -1
-               A( 1, J ) = ZERO
-               DO 10 I = J + 1, M
-                  A( I, J ) = A( I, J-1 )
-   10          CONTINUE
-   20       CONTINUE
-            A( 1, 1 ) = ONE
-            DO 30 I = 2, M
-               A( I, 1 ) = ZERO
-   30       CONTINUE
-            IF( M.GT.1 ) THEN
-*
-*              Form Q(2:m,2:m)
-*
-               CALL DORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
-     $                      LWORK, IINFO )
-            END IF
-         END IF
-      ELSE
-*
-*        Form P', determined by a call to DGEBRD to reduce a k-by-n
-*        matrix
-*
-         IF( K.LT.N ) THEN
-*
-*           If k < n, assume k <= m <= n
-*
-            CALL DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
-*
-         ELSE
-*
-*           If k >= n, assume m = n
-*
-*           Shift the vectors which define the elementary reflectors one
-*           row downward, and set the first row and column of P' to
-*           those of the unit matrix
-*
-            A( 1, 1 ) = ONE
-            DO 40 I = 2, N
-               A( I, 1 ) = ZERO
-   40       CONTINUE
-            DO 60 J = 2, N
-               DO 50 I = J - 1, 2, -1
-                  A( I, J ) = A( I-1, J )
-   50          CONTINUE
-               A( 1, J ) = ZERO
-   60       CONTINUE
-            IF( N.GT.1 ) THEN
-*
-*              Form P'(2:n,2:n)
-*
-               CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
-     $                      LWORK, IINFO )
-            END IF
-         END IF
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DORGBR
-*
-      END
diff --git a/src/lib/lapack/dorghr.f b/src/lib/lapack/dorghr.f
deleted file mode 100644
index 1283aece..00000000
--- a/src/lib/lapack/dorghr.f
+++ /dev/null
@@ -1,164 +0,0 @@
-      SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, ILO, INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORGHR generates a real orthogonal matrix Q which is defined as the
-*  product of IHI-ILO elementary reflectors of order N, as returned by
-*  DGEHRD:
-*
-*  Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix Q. N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          ILO and IHI must have the same values as in the previous call
-*          of DGEHRD. Q is equal to the unit matrix except in the
-*          submatrix Q(ilo+1:ihi,ilo+1:ihi).
-*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the vectors which define the elementary reflectors,
-*          as returned by DGEHRD.
-*          On exit, the N-by-N orthogonal matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (N-1)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGEHRD.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= IHI-ILO.
-*          For optimum performance LWORK >= (IHI-ILO)*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IINFO, J, LWKOPT, NB, NH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DORGQR, XERBLA
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NH = IHI - ILO
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( N.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
-         INFO = -2
-      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
-         INFO = -8
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         NB = ILAENV( 1, 'DORGQR', ' ', NH, NH, NH, -1 )
-         LWKOPT = MAX( 1, NH )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORGHR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-*     Shift the vectors which define the elementary reflectors one
-*     column to the right, and set the first ilo and the last n-ihi
-*     rows and columns to those of the unit matrix
-*
-      DO 40 J = IHI, ILO + 1, -1
-         DO 10 I = 1, J - 1
-            A( I, J ) = ZERO
-   10    CONTINUE
-         DO 20 I = J + 1, IHI
-            A( I, J ) = A( I, J-1 )
-   20    CONTINUE
-         DO 30 I = IHI + 1, N
-            A( I, J ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-      DO 60 J = 1, ILO
-         DO 50 I = 1, N
-            A( I, J ) = ZERO
-   50    CONTINUE
-         A( J, J ) = ONE
-   60 CONTINUE
-      DO 80 J = IHI + 1, N
-         DO 70 I = 1, N
-            A( I, J ) = ZERO
-   70    CONTINUE
-         A( J, J ) = ONE
-   80 CONTINUE
-*
-      IF( NH.GT.0 ) THEN
-*
-*        Generate Q(ilo+1:ihi,ilo+1:ihi)
-*
-         CALL DORGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
-     $                WORK, LWORK, IINFO )
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DORGHR
-*
-      END
diff --git a/src/lib/lapack/dorgl2.f b/src/lib/lapack/dorgl2.f
deleted file mode 100644
index 1e08344d..00000000
--- a/src/lib/lapack/dorgl2.f
+++ /dev/null
@@ -1,133 +0,0 @@
-      SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORGL2 generates an m by n real matrix Q with orthonormal rows,
-*  which is defined as the first m rows of a product of k elementary
-*  reflectors of order n
-*
-*        Q  =  H(k) . . . H(2) H(1)
-*
-*  as returned by DGELQF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. N >= M.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. M >= K >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the i-th row must contain the vector which defines
-*          the elementary reflector H(i), for i = 1,2,...,k, as returned
-*          by DGELQF in the first k rows of its array argument A.
-*          On exit, the m-by-n matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGELQF.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (M)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J, L
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DSCAL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORGL2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 )
-     $   RETURN
-*
-      IF( K.LT.M ) THEN
-*
-*        Initialise rows k+1:m to rows of the unit matrix
-*
-         DO 20 J = 1, N
-            DO 10 L = K + 1, M
-               A( L, J ) = ZERO
-   10       CONTINUE
-            IF( J.GT.K .AND. J.LE.M )
-     $         A( J, J ) = ONE
-   20    CONTINUE
-      END IF
-*
-      DO 40 I = K, 1, -1
-*
-*        Apply H(i) to A(i:m,i:n) from the right
-*
-         IF( I.LT.N ) THEN
-            IF( I.LT.M ) THEN
-               A( I, I ) = ONE
-               CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
-     $                     TAU( I ), A( I+1, I ), LDA, WORK )
-            END IF
-            CALL DSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA )
-         END IF
-         A( I, I ) = ONE - TAU( I )
-*
-*        Set A(i,1:i-1) to zero
-*
-         DO 30 L = 1, I - 1
-            A( I, L ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-      RETURN
-*
-*     End of DORGL2
-*
-      END
diff --git a/src/lib/lapack/dorglq.f b/src/lib/lapack/dorglq.f
deleted file mode 100644
index e4f58c96..00000000
--- a/src/lib/lapack/dorglq.f
+++ /dev/null
@@ -1,215 +0,0 @@
-      SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORGLQ generates an M-by-N real matrix Q with orthonormal rows,
-*  which is defined as the first M rows of a product of K elementary
-*  reflectors of order N
-*
-*        Q  =  H(k) . . . H(2) H(1)
-*
-*  as returned by DGELQF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. N >= M.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. M >= K >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the i-th row must contain the vector which defines
-*          the elementary reflector H(i), for i = 1,2,...,k, as returned
-*          by DGELQF in the first k rows of its array argument A.
-*          On exit, the M-by-N matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGELQF.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= max(1,M).
-*          For optimum performance LWORK >= M*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
-     $                   LWKOPT, NB, NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORGL2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NB = ILAENV( 1, 'DORGLQ', ' ', M, N, K, -1 )
-      LWKOPT = MAX( 1, M )*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
-         INFO = -8
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORGLQ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = M
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'DORGLQ', ' ', M, N, K, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = M
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'DORGLQ', ' ', M, N, K, -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code after the last block.
-*        The first kk rows are handled by the block method.
-*
-         KI = ( ( K-NX-1 ) / NB )*NB
-         KK = MIN( K, KI+NB )
-*
-*        Set A(kk+1:m,1:kk) to zero.
-*
-         DO 20 J = 1, KK
-            DO 10 I = KK + 1, M
-               A( I, J ) = ZERO
-   10       CONTINUE
-   20    CONTINUE
-      ELSE
-         KK = 0
-      END IF
-*
-*     Use unblocked code for the last or only block.
-*
-      IF( KK.LT.M )
-     $   CALL DORGL2( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
-     $                TAU( KK+1 ), WORK, IINFO )
-*
-      IF( KK.GT.0 ) THEN
-*
-*        Use blocked code
-*
-         DO 50 I = KI + 1, 1, -NB
-            IB = MIN( NB, K-I+1 )
-            IF( I+IB.LE.M ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i) H(i+1) . . . H(i+ib-1)
-*
-               CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
-     $                      LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H' to A(i+ib:m,i:n) from the right
-*
-               CALL DLARFB( 'Right', 'Transpose', 'Forward', 'Rowwise',
-     $                      M-I-IB+1, N-I+1, IB, A( I, I ), LDA, WORK,
-     $                      LDWORK, A( I+IB, I ), LDA, WORK( IB+1 ),
-     $                      LDWORK )
-            END IF
-*
-*           Apply H' to columns i:n of current block
-*
-            CALL DORGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
-     $                   IINFO )
-*
-*           Set columns 1:i-1 of current block to zero
-*
-            DO 40 J = 1, I - 1
-               DO 30 L = I, I + IB - 1
-                  A( L, J ) = ZERO
-   30          CONTINUE
-   40       CONTINUE
-   50    CONTINUE
-      END IF
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of DORGLQ
-*
-      END
diff --git a/src/lib/lapack/dorgql.f b/src/lib/lapack/dorgql.f
deleted file mode 100644
index 1c4896e9..00000000
--- a/src/lib/lapack/dorgql.f
+++ /dev/null
@@ -1,222 +0,0 @@
-      SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORGQL generates an M-by-N real matrix Q with orthonormal columns,
-*  which is defined as the last N columns of a product of K elementary
-*  reflectors of order M
-*
-*        Q  =  H(k) . . . H(2) H(1)
-*
-*  as returned by DGEQLF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. M >= N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. N >= K >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the (n-k+i)-th column must contain the vector which
-*          defines the elementary reflector H(i), for i = 1,2,...,k, as
-*          returned by DGEQLF in the last k columns of its array
-*          argument A.
-*          On exit, the M-by-N matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGEQLF.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= max(1,N).
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
-     $                   NB, NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORG2L, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( N.EQ.0 ) THEN
-            LWKOPT = 1
-         ELSE
-            NB = ILAENV( 1, 'DORGQL', ' ', M, N, K, -1 )
-            LWKOPT = N*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-            INFO = -8
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORGQL', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 ) THEN
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = N
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'DORGQL', ' ', M, N, K, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = N
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'DORGQL', ' ', M, N, K, -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code after the first block.
-*        The last kk columns are handled by the block method.
-*
-         KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
-*
-*        Set A(m-kk+1:m,1:n-kk) to zero.
-*
-         DO 20 J = 1, N - KK
-            DO 10 I = M - KK + 1, M
-               A( I, J ) = ZERO
-   10       CONTINUE
-   20    CONTINUE
-      ELSE
-         KK = 0
-      END IF
-*
-*     Use unblocked code for the first or only block.
-*
-      CALL DORG2L( M-KK, N-KK, K-KK, A, LDA, TAU, WORK, IINFO )
-*
-      IF( KK.GT.0 ) THEN
-*
-*        Use blocked code
-*
-         DO 50 I = K - KK + 1, K, NB
-            IB = MIN( NB, K-I+1 )
-            IF( N-K+I.GT.1 ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i+ib-1) . . . H(i+1) H(i)
-*
-               CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
-     $                      A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
-*
-               CALL DLARFB( 'Left', 'No transpose', 'Backward',
-     $                      'Columnwise', M-K+I+IB-1, N-K+I-1, IB,
-     $                      A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA,
-     $                      WORK( IB+1 ), LDWORK )
-            END IF
-*
-*           Apply H to rows 1:m-k+i+ib-1 of current block
-*
-            CALL DORG2L( M-K+I+IB-1, IB, IB, A( 1, N-K+I ), LDA,
-     $                   TAU( I ), WORK, IINFO )
-*
-*           Set rows m-k+i+ib:m of current block to zero
-*
-            DO 40 J = N - K + I, N - K + I + IB - 1
-               DO 30 L = M - K + I + IB, M
-                  A( L, J ) = ZERO
-   30          CONTINUE
-   40       CONTINUE
-   50    CONTINUE
-      END IF
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of DORGQL
-*
-      END
diff --git a/src/lib/lapack/dorgqr.f b/src/lib/lapack/dorgqr.f
deleted file mode 100644
index 4db0ef5a..00000000
--- a/src/lib/lapack/dorgqr.f
+++ /dev/null
@@ -1,216 +0,0 @@
-      SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORGQR generates an M-by-N real matrix Q with orthonormal columns,
-*  which is defined as the first N columns of a product of K elementary
-*  reflectors of order M
-*
-*        Q  =  H(1) H(2) . . . H(k)
-*
-*  as returned by DGEQRF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. M >= N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. N >= K >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the i-th column must contain the vector which
-*          defines the elementary reflector H(i), for i = 1,2,...,k, as
-*          returned by DGEQRF in the first k columns of its array
-*          argument A.
-*          On exit, the M-by-N matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGEQRF.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= max(1,N).
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
-     $                   LWKOPT, NB, NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORG2R, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NB = ILAENV( 1, 'DORGQR', ' ', M, N, K, -1 )
-      LWKOPT = MAX( 1, N )*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -8
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORGQR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = N
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'DORGQR', ' ', M, N, K, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = N
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'DORGQR', ' ', M, N, K, -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code after the last block.
-*        The first kk columns are handled by the block method.
-*
-         KI = ( ( K-NX-1 ) / NB )*NB
-         KK = MIN( K, KI+NB )
-*
-*        Set A(1:kk,kk+1:n) to zero.
-*
-         DO 20 J = KK + 1, N
-            DO 10 I = 1, KK
-               A( I, J ) = ZERO
-   10       CONTINUE
-   20    CONTINUE
-      ELSE
-         KK = 0
-      END IF
-*
-*     Use unblocked code for the last or only block.
-*
-      IF( KK.LT.N )
-     $   CALL DORG2R( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
-     $                TAU( KK+1 ), WORK, IINFO )
-*
-      IF( KK.GT.0 ) THEN
-*
-*        Use blocked code
-*
-         DO 50 I = KI + 1, 1, -NB
-            IB = MIN( NB, K-I+1 )
-            IF( I+IB.LE.N ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i) H(i+1) . . . H(i+ib-1)
-*
-               CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
-     $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H to A(i:m,i+ib:n) from the left
-*
-               CALL DLARFB( 'Left', 'No transpose', 'Forward',
-     $                      'Columnwise', M-I+1, N-I-IB+1, IB,
-     $                      A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
-     $                      LDA, WORK( IB+1 ), LDWORK )
-            END IF
-*
-*           Apply H to rows i:m of current block
-*
-            CALL DORG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK,
-     $                   IINFO )
-*
-*           Set rows 1:i-1 of current block to zero
-*
-            DO 40 J = I, I + IB - 1
-               DO 30 L = 1, I - 1
-                  A( L, J ) = ZERO
-   30          CONTINUE
-   40       CONTINUE
-   50    CONTINUE
-      END IF
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of DORGQR
-*
-      END
diff --git a/src/lib/lapack/dorgr2.f b/src/lib/lapack/dorgr2.f
deleted file mode 100644
index 9da45c5f..00000000
--- a/src/lib/lapack/dorgr2.f
+++ /dev/null
@@ -1,131 +0,0 @@
-      SUBROUTINE DORGR2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORGR2 generates an m by n real matrix Q with orthonormal rows,
-*  which is defined as the last m rows of a product of k elementary
-*  reflectors of order n
-*
-*        Q  =  H(1) H(2) . . . H(k)
-*
-*  as returned by DGERQF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. N >= M.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. M >= K >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the (m-k+i)-th row must contain the vector which
-*          defines the elementary reflector H(i), for i = 1,2,...,k, as
-*          returned by DGERQF in the last k rows of its array argument
-*          A.
-*          On exit, the m by n matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGERQF.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (M)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, II, J, L
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, DSCAL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORGR2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 )
-     $   RETURN
-*
-      IF( K.LT.M ) THEN
-*
-*        Initialise rows 1:m-k to rows of the unit matrix
-*
-         DO 20 J = 1, N
-            DO 10 L = 1, M - K
-               A( L, J ) = ZERO
-   10       CONTINUE
-            IF( J.GT.N-M .AND. J.LE.N-K )
-     $         A( M-N+J, J ) = ONE
-   20    CONTINUE
-      END IF
-*
-      DO 40 I = 1, K
-         II = M - K + I
-*
-*        Apply H(i) to A(1:m-k+i,1:n-k+i) from the right
-*
-         A( II, N-M+II ) = ONE
-         CALL DLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, TAU( I ),
-     $               A, LDA, WORK )
-         CALL DSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA )
-         A( II, N-M+II ) = ONE - TAU( I )
-*
-*        Set A(m-k+i,n-k+i+1:n) to zero
-*
-         DO 30 L = N - M + II + 1, N
-            A( II, L ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-      RETURN
-*
-*     End of DORGR2
-*
-      END
diff --git a/src/lib/lapack/dorgrq.f b/src/lib/lapack/dorgrq.f
deleted file mode 100644
index 11633403..00000000
--- a/src/lib/lapack/dorgrq.f
+++ /dev/null
@@ -1,222 +0,0 @@
-      SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORGRQ generates an M-by-N real matrix Q with orthonormal rows,
-*  which is defined as the last M rows of a product of K elementary
-*  reflectors of order N
-*
-*        Q  =  H(1) H(2) . . . H(k)
-*
-*  as returned by DGERQF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. N >= M.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. M >= K >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the (m-k+i)-th row must contain the vector which
-*          defines the elementary reflector H(i), for i = 1,2,...,k, as
-*          returned by DGERQF in the last k rows of its array argument
-*          A.
-*          On exit, the M-by-N matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGERQF.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= max(1,M).
-*          For optimum performance LWORK >= M*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, II, IINFO, IWS, J, KK, L, LDWORK,
-     $                   LWKOPT, NB, NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORGR2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( M.LE.0 ) THEN
-            LWKOPT = 1
-         ELSE
-            NB = ILAENV( 1, 'DORGRQ', ' ', M, N, K, -1 )
-            LWKOPT = M*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
-            INFO = -8
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORGRQ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 ) THEN
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = M
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'DORGRQ', ' ', M, N, K, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = M
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'DORGRQ', ' ', M, N, K, -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code after the first block.
-*        The last kk rows are handled by the block method.
-*
-         KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
-*
-*        Set A(1:m-kk,n-kk+1:n) to zero.
-*
-         DO 20 J = N - KK + 1, N
-            DO 10 I = 1, M - KK
-               A( I, J ) = ZERO
-   10       CONTINUE
-   20    CONTINUE
-      ELSE
-         KK = 0
-      END IF
-*
-*     Use unblocked code for the first or only block.
-*
-      CALL DORGR2( M-KK, N-KK, K-KK, A, LDA, TAU, WORK, IINFO )
-*
-      IF( KK.GT.0 ) THEN
-*
-*        Use blocked code
-*
-         DO 50 I = K - KK + 1, K, NB
-            IB = MIN( NB, K-I+1 )
-            II = M - K + I
-            IF( II.GT.1 ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i+ib-1) . . . H(i+1) H(i)
-*
-               CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB,
-     $                      A( II, 1 ), LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H' to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
-*
-               CALL DLARFB( 'Right', 'Transpose', 'Backward', 'Rowwise',
-     $                      II-1, N-K+I+IB-1, IB, A( II, 1 ), LDA, WORK,
-     $                      LDWORK, A, LDA, WORK( IB+1 ), LDWORK )
-            END IF
-*
-*           Apply H' to columns 1:n-k+i+ib-1 of current block
-*
-            CALL DORGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, TAU( I ),
-     $                   WORK, IINFO )
-*
-*           Set columns n-k+i+ib:n of current block to zero
-*
-            DO 40 L = N - K + I + IB, N
-               DO 30 J = II, II + IB - 1
-                  A( J, L ) = ZERO
-   30          CONTINUE
-   40       CONTINUE
-   50    CONTINUE
-      END IF
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of DORGRQ
-*
-      END
diff --git a/src/lib/lapack/dorgtr.f b/src/lib/lapack/dorgtr.f
deleted file mode 100644
index 4c72d031..00000000
--- a/src/lib/lapack/dorgtr.f
+++ /dev/null
@@ -1,183 +0,0 @@
-      SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORGTR generates a real orthogonal matrix Q which is defined as the
-*  product of n-1 elementary reflectors of order N, as returned by
-*  DSYTRD:
-*
-*  if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
-*
-*  if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U': Upper triangle of A contains elementary reflectors
-*                 from DSYTRD;
-*          = 'L': Lower triangle of A contains elementary reflectors
-*                 from DSYTRD.
-*
-*  N       (input) INTEGER
-*          The order of the matrix Q. N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the vectors which define the elementary reflectors,
-*          as returned by DSYTRD.
-*          On exit, the N-by-N orthogonal matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (N-1)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DSYTRD.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= max(1,N-1).
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, UPPER
-      INTEGER            I, IINFO, J, LWKOPT, NB
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DORGQL, DORGQR, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      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( LWORK.LT.MAX( 1, N-1 ) .AND. .NOT.LQUERY ) THEN
-         INFO = -7
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( UPPER ) THEN
-            NB = ILAENV( 1, 'DORGQL', ' ', N-1, N-1, N-1, -1 )
-         ELSE
-            NB = ILAENV( 1, 'DORGQR', ' ', N-1, N-1, N-1, -1 )
-         END IF
-         LWKOPT = MAX( 1, N-1 )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORGTR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      IF( UPPER ) THEN
-*
-*        Q was determined by a call to DSYTRD with UPLO = 'U'
-*
-*        Shift the vectors which define the elementary reflectors one
-*        column to the left, and set the last row and column of Q to
-*        those of the unit matrix
-*
-         DO 20 J = 1, N - 1
-            DO 10 I = 1, J - 1
-               A( I, J ) = A( I, J+1 )
-   10       CONTINUE
-            A( N, J ) = ZERO
-   20    CONTINUE
-         DO 30 I = 1, N - 1
-            A( I, N ) = ZERO
-   30    CONTINUE
-         A( N, N ) = ONE
-*
-*        Generate Q(1:n-1,1:n-1)
-*
-         CALL DORGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO )
-*
-      ELSE
-*
-*        Q was determined by a call to DSYTRD with UPLO = 'L'.
-*
-*        Shift the vectors which define the elementary reflectors one
-*        column to the right, and set the first row and column of Q to
-*        those of the unit matrix
-*
-         DO 50 J = N, 2, -1
-            A( 1, J ) = ZERO
-            DO 40 I = J + 1, N
-               A( I, J ) = A( I, J-1 )
-   40       CONTINUE
-   50    CONTINUE
-         A( 1, 1 ) = ONE
-         DO 60 I = 2, N
-            A( I, 1 ) = ZERO
-   60    CONTINUE
-         IF( N.GT.1 ) THEN
-*
-*           Generate Q(2:n,2:n)
-*
-            CALL DORGQR( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
-     $                   LWORK, IINFO )
-         END IF
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DORGTR
-*
-      END
diff --git a/src/lib/lapack/dorm2l.f b/src/lib/lapack/dorm2l.f
deleted file mode 100644
index 27120075..00000000
--- a/src/lib/lapack/dorm2l.f
+++ /dev/null
@@ -1,193 +0,0 @@
-      SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORM2L overwrites the general real m by n matrix C with
-*
-*        Q * C  if SIDE = 'L' and TRANS = 'N', or
-*
-*        Q'* C  if SIDE = 'L' and TRANS = 'T', or
-*
-*        C * Q  if SIDE = 'R' and TRANS = 'N', or
-*
-*        C * Q' if SIDE = 'R' and TRANS = 'T',
-*
-*  where Q is a real orthogonal matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(k) . . . H(2) H(1)
-*
-*  as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q' from the Left
-*          = 'R': apply Q or Q' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply Q  (No transpose)
-*          = 'T': apply Q' (Transpose)
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,K)
-*          The i-th column must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          DGEQLF in the last k columns of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*          If SIDE = 'L', LDA >= max(1,M);
-*          if SIDE = 'R', LDA >= max(1,N).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGEQLF.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the m by n matrix C.
-*          On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension
-*                                   (N) if SIDE = 'L',
-*                                   (M) if SIDE = 'R'
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
-      INTEGER            I, I1, I2, I3, MI, NI, NQ
-      DOUBLE PRECISION   AII
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-*
-*     NQ is the order of Q
-*
-      IF( LEFT ) THEN
-         NQ = M
-      ELSE
-         NQ = N
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORM2L', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
-     $   RETURN
-*
-      IF( ( LEFT .AND. NOTRAN ) .OR. ( .NOT.LEFT .AND. .NOT.NOTRAN ) )
-     $     THEN
-         I1 = 1
-         I2 = K
-         I3 = 1
-      ELSE
-         I1 = K
-         I2 = 1
-         I3 = -1
-      END IF
-*
-      IF( LEFT ) THEN
-         NI = N
-      ELSE
-         MI = M
-      END IF
-*
-      DO 10 I = I1, I2, I3
-         IF( LEFT ) THEN
-*
-*           H(i) is applied to C(1:m-k+i,1:n)
-*
-            MI = M - K + I
-         ELSE
-*
-*           H(i) is applied to C(1:m,1:n-k+i)
-*
-            NI = N - K + I
-         END IF
-*
-*        Apply H(i)
-*
-         AII = A( NQ-K+I, I )
-         A( NQ-K+I, I ) = ONE
-         CALL DLARF( SIDE, MI, NI, A( 1, I ), 1, TAU( I ), C, LDC,
-     $               WORK )
-         A( NQ-K+I, I ) = AII
-   10 CONTINUE
-      RETURN
-*
-*     End of DORM2L
-*
-      END
diff --git a/src/lib/lapack/dorm2r.f b/src/lib/lapack/dorm2r.f
deleted file mode 100644
index 79c9ef35..00000000
--- a/src/lib/lapack/dorm2r.f
+++ /dev/null
@@ -1,197 +0,0 @@
-      SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORM2R overwrites the general real m by n matrix C with
-*
-*        Q * C  if SIDE = 'L' and TRANS = 'N', or
-*
-*        Q'* C  if SIDE = 'L' and TRANS = 'T', or
-*
-*        C * Q  if SIDE = 'R' and TRANS = 'N', or
-*
-*        C * Q' if SIDE = 'R' and TRANS = 'T',
-*
-*  where Q is a real orthogonal matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(1) H(2) . . . H(k)
-*
-*  as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q' from the Left
-*          = 'R': apply Q or Q' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply Q  (No transpose)
-*          = 'T': apply Q' (Transpose)
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,K)
-*          The i-th column must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          DGEQRF in the first k columns of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*          If SIDE = 'L', LDA >= max(1,M);
-*          if SIDE = 'R', LDA >= max(1,N).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGEQRF.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the m by n matrix C.
-*          On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension
-*                                   (N) if SIDE = 'L',
-*                                   (M) if SIDE = 'R'
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
-      INTEGER            I, I1, I2, I3, IC, JC, MI, NI, NQ
-      DOUBLE PRECISION   AII
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-*
-*     NQ is the order of Q
-*
-      IF( LEFT ) THEN
-         NQ = M
-      ELSE
-         NQ = N
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORM2R', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
-     $   RETURN
-*
-      IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
-     $     THEN
-         I1 = 1
-         I2 = K
-         I3 = 1
-      ELSE
-         I1 = K
-         I2 = 1
-         I3 = -1
-      END IF
-*
-      IF( LEFT ) THEN
-         NI = N
-         JC = 1
-      ELSE
-         MI = M
-         IC = 1
-      END IF
-*
-      DO 10 I = I1, I2, I3
-         IF( LEFT ) THEN
-*
-*           H(i) is applied to C(i:m,1:n)
-*
-            MI = M - I + 1
-            IC = I
-         ELSE
-*
-*           H(i) is applied to C(1:m,i:n)
-*
-            NI = N - I + 1
-            JC = I
-         END IF
-*
-*        Apply H(i)
-*
-         AII = A( I, I )
-         A( I, I ) = ONE
-         CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ),
-     $               LDC, WORK )
-         A( I, I ) = AII
-   10 CONTINUE
-      RETURN
-*
-*     End of DORM2R
-*
-      END
diff --git a/src/lib/lapack/dormbr.f b/src/lib/lapack/dormbr.f
deleted file mode 100644
index 8066b893..00000000
--- a/src/lib/lapack/dormbr.f
+++ /dev/null
@@ -1,281 +0,0 @@
-      SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
-     $                   LDC, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS, VECT
-      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  If VECT = 'Q', DORMBR overwrites the general real M-by-N matrix C
-*  with
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'T':      Q**T * C       C * Q**T
-*
-*  If VECT = 'P', DORMBR overwrites the general real M-by-N matrix C
-*  with
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      P * C          C * P
-*  TRANS = 'T':      P**T * C       C * P**T
-*
-*  Here Q and P**T are the orthogonal matrices determined by DGEBRD when
-*  reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and
-*  P**T are defined as products of elementary reflectors H(i) and G(i)
-*  respectively.
-*
-*  Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
-*  order of the orthogonal matrix Q or P**T that is applied.
-*
-*  If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
-*  if nq >= k, Q = H(1) H(2) . . . H(k);
-*  if nq < k, Q = H(1) H(2) . . . H(nq-1).
-*
-*  If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
-*  if k < nq, P = G(1) G(2) . . . G(k);
-*  if k >= nq, P = G(1) G(2) . . . G(nq-1).
-*
-*  Arguments
-*  =========
-*
-*  VECT    (input) CHARACTER*1
-*          = 'Q': apply Q or Q**T;
-*          = 'P': apply P or P**T.
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q, Q**T, P or P**T from the Left;
-*          = 'R': apply Q, Q**T, P or P**T from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q  or P;
-*          = 'T':  Transpose, apply Q**T or P**T.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          If VECT = 'Q', the number of columns in the original
-*          matrix reduced by DGEBRD.
-*          If VECT = 'P', the number of rows in the original
-*          matrix reduced by DGEBRD.
-*          K >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension
-*                                (LDA,min(nq,K)) if VECT = 'Q'
-*                                (LDA,nq)        if VECT = 'P'
-*          The vectors which define the elementary reflectors H(i) and
-*          G(i), whose products determine the matrices Q and P, as
-*          returned by DGEBRD.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*          If VECT = 'Q', LDA >= max(1,nq);
-*          if VECT = 'P', LDA >= max(1,min(nq,K)).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (min(nq,K))
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i) or G(i) which determines Q or P, as returned
-*          by DGEBRD in the array argument TAUQ or TAUP.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q
-*          or P*C or P**T*C or C*P or C*P**T.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M).
-*          For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*          LWORK >= M*NB if SIDE = 'R', 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            APPLYQ, LEFT, LQUERY, NOTRAN
-      CHARACTER          TRANST
-      INTEGER            I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DORMLQ, DORMQR, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      APPLYQ = LSAME( VECT, 'Q' )
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q or P and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = N
-      ELSE
-         NQ = N
-         NW = M
-      END IF
-      IF( .NOT.APPLYQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -2
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -3
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( K.LT.0 ) THEN
-         INFO = -6
-      ELSE IF( ( APPLYQ .AND. LDA.LT.MAX( 1, NQ ) ) .OR.
-     $         ( .NOT.APPLYQ .AND. LDA.LT.MAX( 1, MIN( NQ, K ) ) ) )
-     $          THEN
-         INFO = -8
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -11
-      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
-         INFO = -13
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( APPLYQ ) THEN
-            IF( LEFT ) THEN
-               NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M-1, N, M-1,
-     $              -1 )
-            ELSE
-               NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N-1, N-1,
-     $              -1 )
-            END IF
-         ELSE
-            IF( LEFT ) THEN
-               NB = ILAENV( 1, 'DORMLQ', SIDE // TRANS, M-1, N, M-1,
-     $              -1 )
-            ELSE
-               NB = ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N-1, N-1,
-     $              -1 )
-            END IF
-         END IF
-         LWKOPT = MAX( 1, NW )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORMBR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      WORK( 1 ) = 1
-      IF( M.EQ.0 .OR. N.EQ.0 )
-     $   RETURN
-*
-      IF( APPLYQ ) THEN
-*
-*        Apply Q
-*
-         IF( NQ.GE.K ) THEN
-*
-*           Q was determined by a call to DGEBRD with nq >= k
-*
-            CALL DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, IINFO )
-         ELSE IF( NQ.GT.1 ) THEN
-*
-*           Q was determined by a call to DGEBRD with nq < k
-*
-            IF( LEFT ) THEN
-               MI = M - 1
-               NI = N
-               I1 = 2
-               I2 = 1
-            ELSE
-               MI = M
-               NI = N - 1
-               I1 = 1
-               I2 = 2
-            END IF
-            CALL DORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU,
-     $                   C( I1, I2 ), LDC, WORK, LWORK, IINFO )
-         END IF
-      ELSE
-*
-*        Apply P
-*
-         IF( NOTRAN ) THEN
-            TRANST = 'T'
-         ELSE
-            TRANST = 'N'
-         END IF
-         IF( NQ.GT.K ) THEN
-*
-*           P was determined by a call to DGEBRD with nq > k
-*
-            CALL DORMLQ( SIDE, TRANST, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, IINFO )
-         ELSE IF( NQ.GT.1 ) THEN
-*
-*           P was determined by a call to DGEBRD with nq <= k
-*
-            IF( LEFT ) THEN
-               MI = M - 1
-               NI = N
-               I1 = 2
-               I2 = 1
-            ELSE
-               MI = M
-               NI = N - 1
-               I1 = 1
-               I2 = 2
-            END IF
-            CALL DORMLQ( SIDE, TRANST, MI, NI, NQ-1, A( 1, 2 ), LDA,
-     $                   TAU, C( I1, I2 ), LDC, WORK, LWORK, IINFO )
-         END IF
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DORMBR
-*
-      END
diff --git a/src/lib/lapack/dormhr.f b/src/lib/lapack/dormhr.f
deleted file mode 100644
index 5862538e..00000000
--- a/src/lib/lapack/dormhr.f
+++ /dev/null
@@ -1,201 +0,0 @@
-      SUBROUTINE DORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
-     $                   LDC, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            IHI, ILO, INFO, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORMHR overwrites the general real M-by-N matrix C with
-*
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'T':      Q**T * C       C * Q**T
-*
-*  where Q is a real orthogonal matrix of order nq, with nq = m if
-*  SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
-*  IHI-ILO elementary reflectors, as returned by DGEHRD:
-*
-*  Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q**T from the Left;
-*          = 'R': apply Q or Q**T from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q;
-*          = 'T':  Transpose, apply Q**T.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          ILO and IHI must have the same values as in the previous call
-*          of DGEHRD. Q is equal to the unit matrix except in the
-*          submatrix Q(ilo+1:ihi,ilo+1:ihi).
-*          If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
-*          ILO = 1 and IHI = 0, if M = 0;
-*          if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
-*          ILO = 1 and IHI = 0, if N = 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension
-*                               (LDA,M) if SIDE = 'L'
-*                               (LDA,N) if SIDE = 'R'
-*          The vectors which define the elementary reflectors, as
-*          returned by DGEHRD.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*          LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension
-*                               (M-1) if SIDE = 'L'
-*                               (N-1) if SIDE = 'R'
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGEHRD.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M).
-*          For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*          LWORK >= M*NB if SIDE = 'R', 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LEFT, LQUERY
-      INTEGER            I1, I2, IINFO, LWKOPT, MI, NB, NH, NI, NQ, NW
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DORMQR, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NH = IHI - ILO
-      LEFT = LSAME( SIDE, 'L' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = N
-      ELSE
-         NQ = N
-         NW = M
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) )
-     $          THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, NQ ) ) THEN
-         INFO = -5
-      ELSE IF( IHI.LT.MIN( ILO, NQ ) .OR. IHI.GT.NQ ) THEN
-         INFO = -6
-      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
-         INFO = -8
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -11
-      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
-         INFO = -13
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( LEFT ) THEN
-            NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, NH, N, NH, -1 )
-         ELSE
-            NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M, NH, NH, -1 )
-         END IF
-         LWKOPT = MAX( 1, NW )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORMHR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      IF( LEFT ) THEN
-         MI = NH
-         NI = N
-         I1 = ILO + 1
-         I2 = 1
-      ELSE
-         MI = M
-         NI = NH
-         I1 = 1
-         I2 = ILO + 1
-      END IF
-*
-      CALL DORMQR( SIDE, TRANS, MI, NI, NH, A( ILO+1, ILO ), LDA,
-     $             TAU( ILO ), C( I1, I2 ), LDC, WORK, LWORK, IINFO )
-*
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DORMHR
-*
-      END
diff --git a/src/lib/lapack/dorml2.f b/src/lib/lapack/dorml2.f
deleted file mode 100644
index d3941c9a..00000000
--- a/src/lib/lapack/dorml2.f
+++ /dev/null
@@ -1,197 +0,0 @@
-      SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORML2 overwrites the general real m by n matrix C with
-*
-*        Q * C  if SIDE = 'L' and TRANS = 'N', or
-*
-*        Q'* C  if SIDE = 'L' and TRANS = 'T', or
-*
-*        C * Q  if SIDE = 'R' and TRANS = 'N', or
-*
-*        C * Q' if SIDE = 'R' and TRANS = 'T',
-*
-*  where Q is a real orthogonal matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(k) . . . H(2) H(1)
-*
-*  as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q' from the Left
-*          = 'R': apply Q or Q' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply Q  (No transpose)
-*          = 'T': apply Q' (Transpose)
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension
-*                               (LDA,M) if SIDE = 'L',
-*                               (LDA,N) if SIDE = 'R'
-*          The i-th row must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          DGELQF in the first k rows of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,K).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGELQF.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the m by n matrix C.
-*          On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension
-*                                   (N) if SIDE = 'L',
-*                                   (M) if SIDE = 'R'
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
-      INTEGER            I, I1, I2, I3, IC, JC, MI, NI, NQ
-      DOUBLE PRECISION   AII
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-*
-*     NQ is the order of Q
-*
-      IF( LEFT ) THEN
-         NQ = M
-      ELSE
-         NQ = N
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORML2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
-     $   RETURN
-*
-      IF( ( LEFT .AND. NOTRAN ) .OR. ( .NOT.LEFT .AND. .NOT.NOTRAN ) )
-     $     THEN
-         I1 = 1
-         I2 = K
-         I3 = 1
-      ELSE
-         I1 = K
-         I2 = 1
-         I3 = -1
-      END IF
-*
-      IF( LEFT ) THEN
-         NI = N
-         JC = 1
-      ELSE
-         MI = M
-         IC = 1
-      END IF
-*
-      DO 10 I = I1, I2, I3
-         IF( LEFT ) THEN
-*
-*           H(i) is applied to C(i:m,1:n)
-*
-            MI = M - I + 1
-            IC = I
-         ELSE
-*
-*           H(i) is applied to C(1:m,i:n)
-*
-            NI = N - I + 1
-            JC = I
-         END IF
-*
-*        Apply H(i)
-*
-         AII = A( I, I )
-         A( I, I ) = ONE
-         CALL DLARF( SIDE, MI, NI, A( I, I ), LDA, TAU( I ),
-     $               C( IC, JC ), LDC, WORK )
-         A( I, I ) = AII
-   10 CONTINUE
-      RETURN
-*
-*     End of DORML2
-*
-      END
diff --git a/src/lib/lapack/dormlq.f b/src/lib/lapack/dormlq.f
deleted file mode 100644
index f0c68ef2..00000000
--- a/src/lib/lapack/dormlq.f
+++ /dev/null
@@ -1,267 +0,0 @@
-      SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORMLQ overwrites the general real M-by-N matrix C with
-*
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'T':      Q**T * C       C * Q**T
-*
-*  where Q is a real orthogonal matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(k) . . . H(2) H(1)
-*
-*  as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q**T from the Left;
-*          = 'R': apply Q or Q**T from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q;
-*          = 'T':  Transpose, apply Q**T.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension
-*                               (LDA,M) if SIDE = 'L',
-*                               (LDA,N) if SIDE = 'R'
-*          The i-th row must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          DGELQF in the first k rows of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,K).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGELQF.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M).
-*          For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*          LWORK >= M*NB if SIDE = 'R', 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            NBMAX, LDT
-      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, LQUERY, NOTRAN
-      CHARACTER          TRANST
-      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
-     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   T( LDT, NBMAX )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORML2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = N
-      ELSE
-         NQ = N
-         NW = M
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
-         INFO = -12
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-*
-*        Determine the block size.  NB may be at most NBMAX, where NBMAX
-*        is used to define the local array T.
-*
-         NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, K,
-     $        -1 ) )
-         LWKOPT = MAX( 1, NW )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORMLQ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      LDWORK = NW
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-         IWS = NW*NB
-         IF( LWORK.LT.IWS ) THEN
-            NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'DORMLQ', SIDE // TRANS, M, N, K,
-     $              -1 ) )
-         END IF
-      ELSE
-         IWS = NW
-      END IF
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-*        Use unblocked code
-*
-         CALL DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
-     $                IINFO )
-      ELSE
-*
-*        Use blocked code
-*
-         IF( ( LEFT .AND. NOTRAN ) .OR.
-     $       ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
-            I1 = 1
-            I2 = K
-            I3 = NB
-         ELSE
-            I1 = ( ( K-1 ) / NB )*NB + 1
-            I2 = 1
-            I3 = -NB
-         END IF
-*
-         IF( LEFT ) THEN
-            NI = N
-            JC = 1
-         ELSE
-            MI = M
-            IC = 1
-         END IF
-*
-         IF( NOTRAN ) THEN
-            TRANST = 'T'
-         ELSE
-            TRANST = 'N'
-         END IF
-*
-         DO 10 I = I1, I2, I3
-            IB = MIN( NB, K-I+1 )
-*
-*           Form the triangular factor of the block reflector
-*           H = H(i) H(i+1) . . . H(i+ib-1)
-*
-            CALL DLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ),
-     $                   LDA, TAU( I ), T, LDT )
-            IF( LEFT ) THEN
-*
-*              H or H' is applied to C(i:m,1:n)
-*
-               MI = M - I + 1
-               IC = I
-            ELSE
-*
-*              H or H' is applied to C(1:m,i:n)
-*
-               NI = N - I + 1
-               JC = I
-            END IF
-*
-*           Apply H or H'
-*
-            CALL DLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB,
-     $                   A( I, I ), LDA, T, LDT, C( IC, JC ), LDC, WORK,
-     $                   LDWORK )
-   10    CONTINUE
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DORMLQ
-*
-      END
diff --git a/src/lib/lapack/dormql.f b/src/lib/lapack/dormql.f
deleted file mode 100644
index f3370f10..00000000
--- a/src/lib/lapack/dormql.f
+++ /dev/null
@@ -1,261 +0,0 @@
-      SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORMQL overwrites the general real M-by-N matrix C with
-*
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'T':      Q**T * C       C * Q**T
-*
-*  where Q is a real orthogonal matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(k) . . . H(2) H(1)
-*
-*  as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q**T from the Left;
-*          = 'R': apply Q or Q**T from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q;
-*          = 'T':  Transpose, apply Q**T.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,K)
-*          The i-th column must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          DGEQLF in the last k columns of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*          If SIDE = 'L', LDA >= max(1,M);
-*          if SIDE = 'R', LDA >= max(1,N).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGEQLF.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M).
-*          For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*          LWORK >= M*NB if SIDE = 'R', 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            NBMAX, LDT
-      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, LQUERY, NOTRAN
-      INTEGER            I, I1, I2, I3, IB, IINFO, IWS, LDWORK, LWKOPT,
-     $                   MI, NB, NBMIN, NI, NQ, NW
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   T( LDT, NBMAX )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORM2L, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = MAX( 1, N )
-      ELSE
-         NQ = N
-         NW = MAX( 1, M )
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-            LWKOPT = 1
-         ELSE
-*
-*           Determine the block size.  NB may be at most NBMAX, where
-*           NBMAX is used to define the local array T.
-*
-            NB = MIN( NBMAX, ILAENV( 1, 'DORMQL', SIDE // TRANS, M, N,
-     $                               K, -1 ) )
-            LWKOPT = NW*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN
-            INFO = -12
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORMQL', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      LDWORK = NW
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-         IWS = NW*NB
-         IF( LWORK.LT.IWS ) THEN
-            NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'DORMQL', SIDE // TRANS, M, N, K,
-     $              -1 ) )
-         END IF
-      ELSE
-         IWS = NW
-      END IF
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-*        Use unblocked code
-*
-         CALL DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
-     $                IINFO )
-      ELSE
-*
-*        Use blocked code
-*
-         IF( ( LEFT .AND. NOTRAN ) .OR.
-     $       ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
-            I1 = 1
-            I2 = K
-            I3 = NB
-         ELSE
-            I1 = ( ( K-1 ) / NB )*NB + 1
-            I2 = 1
-            I3 = -NB
-         END IF
-*
-         IF( LEFT ) THEN
-            NI = N
-         ELSE
-            MI = M
-         END IF
-*
-         DO 10 I = I1, I2, I3
-            IB = MIN( NB, K-I+1 )
-*
-*           Form the triangular factor of the block reflector
-*           H = H(i+ib-1) . . . H(i+1) H(i)
-*
-            CALL DLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB,
-     $                   A( 1, I ), LDA, TAU( I ), T, LDT )
-            IF( LEFT ) THEN
-*
-*              H or H' is applied to C(1:m-k+i+ib-1,1:n)
-*
-               MI = M - K + I + IB - 1
-            ELSE
-*
-*              H or H' is applied to C(1:m,1:n-k+i+ib-1)
-*
-               NI = N - K + I + IB - 1
-            END IF
-*
-*           Apply H or H'
-*
-            CALL DLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI,
-     $                   IB, A( 1, I ), LDA, T, LDT, C, LDC, WORK,
-     $                   LDWORK )
-   10    CONTINUE
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DORMQL
-*
-      END
diff --git a/src/lib/lapack/dormqr.f b/src/lib/lapack/dormqr.f
deleted file mode 100644
index ee372695..00000000
--- a/src/lib/lapack/dormqr.f
+++ /dev/null
@@ -1,260 +0,0 @@
-      SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORMQR overwrites the general real M-by-N matrix C with
-*
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'T':      Q**T * C       C * Q**T
-*
-*  where Q is a real orthogonal matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(1) H(2) . . . H(k)
-*
-*  as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q**T from the Left;
-*          = 'R': apply Q or Q**T from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q;
-*          = 'T':  Transpose, apply Q**T.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,K)
-*          The i-th column must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          DGEQRF in the first k columns of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*          If SIDE = 'L', LDA >= max(1,M);
-*          if SIDE = 'R', LDA >= max(1,N).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGEQRF.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M).
-*          For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*          LWORK >= M*NB if SIDE = 'R', 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            NBMAX, LDT
-      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, LQUERY, NOTRAN
-      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
-     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   T( LDT, NBMAX )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORM2R, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = N
-      ELSE
-         NQ = N
-         NW = M
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
-         INFO = -12
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-*
-*        Determine the block size.  NB may be at most NBMAX, where NBMAX
-*        is used to define the local array T.
-*
-         NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K,
-     $        -1 ) )
-         LWKOPT = MAX( 1, NW )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORMQR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      LDWORK = NW
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-         IWS = NW*NB
-         IF( LWORK.LT.IWS ) THEN
-            NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS, M, N, K,
-     $              -1 ) )
-         END IF
-      ELSE
-         IWS = NW
-      END IF
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-*        Use unblocked code
-*
-         CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
-     $                IINFO )
-      ELSE
-*
-*        Use blocked code
-*
-         IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
-     $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN
-            I1 = 1
-            I2 = K
-            I3 = NB
-         ELSE
-            I1 = ( ( K-1 ) / NB )*NB + 1
-            I2 = 1
-            I3 = -NB
-         END IF
-*
-         IF( LEFT ) THEN
-            NI = N
-            JC = 1
-         ELSE
-            MI = M
-            IC = 1
-         END IF
-*
-         DO 10 I = I1, I2, I3
-            IB = MIN( NB, K-I+1 )
-*
-*           Form the triangular factor of the block reflector
-*           H = H(i) H(i+1) . . . H(i+ib-1)
-*
-            CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ),
-     $                   LDA, TAU( I ), T, LDT )
-            IF( LEFT ) THEN
-*
-*              H or H' is applied to C(i:m,1:n)
-*
-               MI = M - I + 1
-               IC = I
-            ELSE
-*
-*              H or H' is applied to C(1:m,i:n)
-*
-               NI = N - I + 1
-               JC = I
-            END IF
-*
-*           Apply H or H'
-*
-            CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI,
-     $                   IB, A( I, I ), LDA, T, LDT, C( IC, JC ), LDC,
-     $                   WORK, LDWORK )
-   10    CONTINUE
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DORMQR
-*
-      END
diff --git a/src/lib/lapack/dormr2.f b/src/lib/lapack/dormr2.f
deleted file mode 100644
index 994552fb..00000000
--- a/src/lib/lapack/dormr2.f
+++ /dev/null
@@ -1,193 +0,0 @@
-      SUBROUTINE DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORMR2 overwrites the general real m by n matrix C with
-*
-*        Q * C  if SIDE = 'L' and TRANS = 'N', or
-*
-*        Q'* C  if SIDE = 'L' and TRANS = 'T', or
-*
-*        C * Q  if SIDE = 'R' and TRANS = 'N', or
-*
-*        C * Q' if SIDE = 'R' and TRANS = 'T',
-*
-*  where Q is a real orthogonal matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(1) H(2) . . . H(k)
-*
-*  as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q' from the Left
-*          = 'R': apply Q or Q' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply Q  (No transpose)
-*          = 'T': apply Q' (Transpose)
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension
-*                               (LDA,M) if SIDE = 'L',
-*                               (LDA,N) if SIDE = 'R'
-*          The i-th row must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          DGERQF in the last k rows of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,K).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGERQF.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the m by n matrix C.
-*          On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension
-*                                   (N) if SIDE = 'L',
-*                                   (M) if SIDE = 'R'
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
-      INTEGER            I, I1, I2, I3, MI, NI, NQ
-      DOUBLE PRECISION   AII
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARF, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-*
-*     NQ is the order of Q
-*
-      IF( LEFT ) THEN
-         NQ = M
-      ELSE
-         NQ = N
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORMR2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
-     $   RETURN
-*
-      IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
-     $     THEN
-         I1 = 1
-         I2 = K
-         I3 = 1
-      ELSE
-         I1 = K
-         I2 = 1
-         I3 = -1
-      END IF
-*
-      IF( LEFT ) THEN
-         NI = N
-      ELSE
-         MI = M
-      END IF
-*
-      DO 10 I = I1, I2, I3
-         IF( LEFT ) THEN
-*
-*           H(i) is applied to C(1:m-k+i,1:n)
-*
-            MI = M - K + I
-         ELSE
-*
-*           H(i) is applied to C(1:m,1:n-k+i)
-*
-            NI = N - K + I
-         END IF
-*
-*        Apply H(i)
-*
-         AII = A( I, NQ-K+I )
-         A( I, NQ-K+I ) = ONE
-         CALL DLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAU( I ), C, LDC,
-     $               WORK )
-         A( I, NQ-K+I ) = AII
-   10 CONTINUE
-      RETURN
-*
-*     End of DORMR2
-*
-      END
diff --git a/src/lib/lapack/dormr3.f b/src/lib/lapack/dormr3.f
deleted file mode 100644
index 7bdcb856..00000000
--- a/src/lib/lapack/dormr3.f
+++ /dev/null
@@ -1,206 +0,0 @@
-      SUBROUTINE DORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
-     $                   WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, L, LDA, LDC, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORMR3 overwrites the general real m by n matrix C with
-*
-*        Q * C  if SIDE = 'L' and TRANS = 'N', or
-*
-*        Q'* C  if SIDE = 'L' and TRANS = 'T', or
-*
-*        C * Q  if SIDE = 'R' and TRANS = 'N', or
-*
-*        C * Q' if SIDE = 'R' and TRANS = 'T',
-*
-*  where Q is a real orthogonal matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(1) H(2) . . . H(k)
-*
-*  as returned by DTZRZF. Q is of order m if SIDE = 'L' and of order n
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q' from the Left
-*          = 'R': apply Q or Q' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply Q  (No transpose)
-*          = 'T': apply Q' (Transpose)
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  L       (input) INTEGER
-*          The number of columns of the matrix A containing
-*          the meaningful part of the Householder reflectors.
-*          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension
-*                               (LDA,M) if SIDE = 'L',
-*                               (LDA,N) if SIDE = 'R'
-*          The i-th row must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          DTZRZF in the last k rows of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,K).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DTZRZF.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the m-by-n matrix C.
-*          On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension
-*                                   (N) if SIDE = 'L',
-*                                   (M) if SIDE = 'R'
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
-      INTEGER            I, I1, I2, I3, IC, JA, JC, MI, NI, NQ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARZ, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-*
-*     NQ is the order of Q
-*
-      IF( LEFT ) THEN
-         NQ = M
-      ELSE
-         NQ = N
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
-     $         ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
-         INFO = -6
-      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
-         INFO = -8
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -11
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORMR3', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
-     $   RETURN
-*
-      IF( ( LEFT .AND. .NOT.NOTRAN .OR. .NOT.LEFT .AND. NOTRAN ) ) THEN
-         I1 = 1
-         I2 = K
-         I3 = 1
-      ELSE
-         I1 = K
-         I2 = 1
-         I3 = -1
-      END IF
-*
-      IF( LEFT ) THEN
-         NI = N
-         JA = M - L + 1
-         JC = 1
-      ELSE
-         MI = M
-         JA = N - L + 1
-         IC = 1
-      END IF
-*
-      DO 10 I = I1, I2, I3
-         IF( LEFT ) THEN
-*
-*           H(i) or H(i)' is applied to C(i:m,1:n)
-*
-            MI = M - I + 1
-            IC = I
-         ELSE
-*
-*           H(i) or H(i)' is applied to C(1:m,i:n)
-*
-            NI = N - I + 1
-            JC = I
-         END IF
-*
-*        Apply H(i) or H(i)'
-*
-         CALL DLARZ( SIDE, MI, NI, L, A( I, JA ), LDA, TAU( I ),
-     $               C( IC, JC ), LDC, WORK )
-*
-   10 CONTINUE
-*
-      RETURN
-*
-*     End of DORMR3
-*
-      END
diff --git a/src/lib/lapack/dormrq.f b/src/lib/lapack/dormrq.f
deleted file mode 100644
index 522c1392..00000000
--- a/src/lib/lapack/dormrq.f
+++ /dev/null
@@ -1,268 +0,0 @@
-      SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORMRQ overwrites the general real M-by-N matrix C with
-*
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'T':      Q**T * C       C * Q**T
-*
-*  where Q is a real orthogonal matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(1) H(2) . . . H(k)
-*
-*  as returned by DGERQF. Q is of order M if SIDE = 'L' and of order N
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q**T from the Left;
-*          = 'R': apply Q or Q**T from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q;
-*          = 'T':  Transpose, apply Q**T.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension
-*                               (LDA,M) if SIDE = 'L',
-*                               (LDA,N) if SIDE = 'R'
-*          The i-th row must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          DGERQF in the last k rows of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,K).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DGERQF.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M).
-*          For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*          LWORK >= M*NB if SIDE = 'R', 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            NBMAX, LDT
-      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, LQUERY, NOTRAN
-      CHARACTER          TRANST
-      INTEGER            I, I1, I2, I3, IB, IINFO, IWS, LDWORK, LWKOPT,
-     $                   MI, NB, NBMIN, NI, NQ, NW
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   T( LDT, NBMAX )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORMR2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = MAX( 1, N )
-      ELSE
-         NQ = N
-         NW = MAX( 1, M )
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-            LWKOPT = 1
-         ELSE
-*
-*           Determine the block size.  NB may be at most NBMAX, where
-*           NBMAX is used to define the local array T.
-*
-            NB = MIN( NBMAX, ILAENV( 1, 'DORMRQ', SIDE // TRANS, M, N,
-     $                               K, -1 ) )
-            LWKOPT = NW*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN
-            INFO = -12
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORMRQ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      LDWORK = NW
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-         IWS = NW*NB
-         IF( LWORK.LT.IWS ) THEN
-            NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'DORMRQ', SIDE // TRANS, M, N, K,
-     $              -1 ) )
-         END IF
-      ELSE
-         IWS = NW
-      END IF
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-*        Use unblocked code
-*
-         CALL DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
-     $                IINFO )
-      ELSE
-*
-*        Use blocked code
-*
-         IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
-     $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN
-            I1 = 1
-            I2 = K
-            I3 = NB
-         ELSE
-            I1 = ( ( K-1 ) / NB )*NB + 1
-            I2 = 1
-            I3 = -NB
-         END IF
-*
-         IF( LEFT ) THEN
-            NI = N
-         ELSE
-            MI = M
-         END IF
-*
-         IF( NOTRAN ) THEN
-            TRANST = 'T'
-         ELSE
-            TRANST = 'N'
-         END IF
-*
-         DO 10 I = I1, I2, I3
-            IB = MIN( NB, K-I+1 )
-*
-*           Form the triangular factor of the block reflector
-*           H = H(i+ib-1) . . . H(i+1) H(i)
-*
-            CALL DLARFT( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB,
-     $                   A( I, 1 ), LDA, TAU( I ), T, LDT )
-            IF( LEFT ) THEN
-*
-*              H or H' is applied to C(1:m-k+i+ib-1,1:n)
-*
-               MI = M - K + I + IB - 1
-            ELSE
-*
-*              H or H' is applied to C(1:m,1:n-k+i+ib-1)
-*
-               NI = N - K + I + IB - 1
-            END IF
-*
-*           Apply H or H'
-*
-            CALL DLARFB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,
-     $                   IB, A( I, 1 ), LDA, T, LDT, C, LDC, WORK,
-     $                   LDWORK )
-   10    CONTINUE
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DORMRQ
-*
-      END
diff --git a/src/lib/lapack/dormrz.f b/src/lib/lapack/dormrz.f
deleted file mode 100644
index 9e14acce..00000000
--- a/src/lib/lapack/dormrz.f
+++ /dev/null
@@ -1,292 +0,0 @@
-      SUBROUTINE DORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, L, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DORMRZ overwrites the general real M-by-N matrix C with
-*
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'T':      Q**T * C       C * Q**T
-*
-*  where Q is a real orthogonal matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(1) H(2) . . . H(k)
-*
-*  as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q**T from the Left;
-*          = 'R': apply Q or Q**T from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q;
-*          = 'T':  Transpose, apply Q**T.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  L       (input) INTEGER
-*          The number of columns of the matrix A containing
-*          the meaningful part of the Householder reflectors.
-*          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension
-*                               (LDA,M) if SIDE = 'L',
-*                               (LDA,N) if SIDE = 'R'
-*          The i-th row must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          DTZRZF in the last k rows of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,K).
-*
-*  TAU     (input) DOUBLE PRECISION array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by DTZRZF.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M).
-*          For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*          LWORK >= M*NB if SIDE = 'R', 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            NBMAX, LDT
-      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, LQUERY, NOTRAN
-      CHARACTER          TRANST
-      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JA, JC,
-     $                   LDWORK, LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   T( LDT, NBMAX )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARZB, DLARZT, DORMR3, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = MAX( 1, N )
-      ELSE
-         NQ = N
-         NW = MAX( 1, M )
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
-     $         ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
-         INFO = -6
-      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
-         INFO = -8
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -11
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-            LWKOPT = 1
-*
-*           Determine the block size.  NB may be at most NBMAX, where
-*           NBMAX is used to define the local array T.
-*
-            NB = MIN( NBMAX, ILAENV( 1, 'DORMRQ', SIDE // TRANS, M, N,
-     $                               K, -1 ) )
-            LWKOPT = NW*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
-            INFO = -13
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DORMRZ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      LDWORK = NW
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-         IWS = NW*NB
-         IF( LWORK.LT.IWS ) THEN
-            NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'DORMRQ', SIDE // TRANS, M, N, K,
-     $              -1 ) )
-         END IF
-      ELSE
-         IWS = NW
-      END IF
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-*        Use unblocked code
-*
-         CALL DORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
-     $                WORK, IINFO )
-      ELSE
-*
-*        Use blocked code
-*
-         IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
-     $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN
-            I1 = 1
-            I2 = K
-            I3 = NB
-         ELSE
-            I1 = ( ( K-1 ) / NB )*NB + 1
-            I2 = 1
-            I3 = -NB
-         END IF
-*
-         IF( LEFT ) THEN
-            NI = N
-            JC = 1
-            JA = M - L + 1
-         ELSE
-            MI = M
-            IC = 1
-            JA = N - L + 1
-         END IF
-*
-         IF( NOTRAN ) THEN
-            TRANST = 'T'
-         ELSE
-            TRANST = 'N'
-         END IF
-*
-         DO 10 I = I1, I2, I3
-            IB = MIN( NB, K-I+1 )
-*
-*           Form the triangular factor of the block reflector
-*           H = H(i+ib-1) . . . H(i+1) H(i)
-*
-            CALL DLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), LDA,
-     $                   TAU( I ), T, LDT )
-*
-            IF( LEFT ) THEN
-*
-*              H or H' is applied to C(i:m,1:n)
-*
-               MI = M - I + 1
-               IC = I
-            ELSE
-*
-*              H or H' is applied to C(1:m,i:n)
-*
-               NI = N - I + 1
-               JC = I
-            END IF
-*
-*           Apply H or H'
-*
-            CALL DLARZB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,
-     $                   IB, L, A( I, JA ), LDA, T, LDT, C( IC, JC ),
-     $                   LDC, WORK, LDWORK )
-   10    CONTINUE
-*
-      END IF
-*
-      WORK( 1 ) = LWKOPT
-*
-      RETURN
-*
-*     End of DORMRZ
-*
-      END
diff --git a/src/lib/lapack/dpocon.f b/src/lib/lapack/dpocon.f
deleted file mode 100644
index c28af374..00000000
--- a/src/lib/lapack/dpocon.f
+++ /dev/null
@@ -1,177 +0,0 @@
-      SUBROUTINE DPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     Modified to call DLACN2 in place of DLACON, 5 Feb 03, SJH.
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, N
-      DOUBLE PRECISION   ANORM, RCOND
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DPOCON estimates the reciprocal of the condition number (in the
-*  1-norm) of a real symmetric positive definite matrix using the
-*  Cholesky factorization A = U**T*U or A = L*L**T computed by DPOTRF.
-*
-*  An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*  condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The triangular factor U or L from the Cholesky factorization
-*          A = U**T*U or A = L*L**T, as computed by DPOTRF.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  ANORM   (input) DOUBLE PRECISION
-*          The 1-norm (or infinity-norm) of the symmetric matrix A.
-*
-*  RCOND   (output) 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.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (3*N)
-*
-*  IWORK   (workspace) INTEGER array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      CHARACTER          NORMIN
-      INTEGER            IX, KASE
-      DOUBLE PRECISION   AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
-*     ..
-*     .. Local Arrays ..
-      INTEGER            ISAVE( 3 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, IDAMAX, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLACN2, DLATRS, DRSCL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, 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 = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DPOCON', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      RCOND = ZERO
-      IF( N.EQ.0 ) THEN
-         RCOND = ONE
-         RETURN
-      ELSE IF( ANORM.EQ.ZERO ) THEN
-         RETURN
-      END IF
-*
-      SMLNUM = DLAMCH( 'Safe minimum' )
-*
-*     Estimate the 1-norm of inv(A).
-*
-      KASE = 0
-      NORMIN = 'N'
-   10 CONTINUE
-      CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
-      IF( KASE.NE.0 ) THEN
-         IF( UPPER ) THEN
-*
-*           Multiply by inv(U').
-*
-            CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A,
-     $                   LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO )
-            NORMIN = 'Y'
-*
-*           Multiply by inv(U).
-*
-            CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
-     $                   A, LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO )
-         ELSE
-*
-*           Multiply by inv(L).
-*
-            CALL DLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N,
-     $                   A, LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO )
-            NORMIN = 'Y'
-*
-*           Multiply by inv(L').
-*
-            CALL DLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, A,
-     $                   LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO )
-         END IF
-*
-*        Multiply by 1/SCALE if doing so will not cause overflow.
-*
-         SCALE = SCALEL*SCALEU
-         IF( SCALE.NE.ONE ) THEN
-            IX = IDAMAX( N, WORK, 1 )
-            IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
-     $         GO TO 20
-            CALL DRSCL( N, SCALE, WORK, 1 )
-         END IF
-         GO TO 10
-      END IF
-*
-*     Compute the estimate of the reciprocal condition number.
-*
-      IF( AINVNM.NE.ZERO )
-     $   RCOND = ( ONE / AINVNM ) / ANORM
-*
-   20 CONTINUE
-      RETURN
-*
-*     End of DPOCON
-*
-      END
diff --git a/src/lib/lapack/dpotf2.f b/src/lib/lapack/dpotf2.f
deleted file mode 100644
index b7d65e91..00000000
--- a/src/lib/lapack/dpotf2.f
+++ /dev/null
@@ -1,167 +0,0 @@
-      SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DPOTF2 computes the Cholesky factorization of a real symmetric
-*  positive definite matrix A.
-*
-*  The factorization has the form
-*     A = U' * U ,  if UPLO = 'U', or
-*     A = L  * L',  if UPLO = 'L',
-*  where U is an upper triangular matrix and L is lower triangular.
-*
-*  This is the unblocked version of the algorithm, calling Level 2 BLAS.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          symmetric matrix A is stored.
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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, the factor U or L from the Cholesky
-*          factorization A = U'*U  or A = L*L'.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -k, the k-th argument had an illegal value
-*          > 0: if INFO = k, the leading minor of order k is not
-*               positive definite, and the factorization could not be
-*               completed.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            J
-      DOUBLE PRECISION   AJJ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DDOT
-      EXTERNAL           LSAME, DDOT
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMV, DSCAL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          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( 'DPOTF2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      IF( UPPER ) THEN
-*
-*        Compute the Cholesky factorization A = U'*U.
-*
-         DO 10 J = 1, N
-*
-*           Compute U(J,J) and test for non-positive-definiteness.
-*
-            AJJ = A( J, J ) - DDOT( J-1, A( 1, J ), 1, A( 1, J ), 1 )
-            IF( AJJ.LE.ZERO ) THEN
-               A( J, J ) = AJJ
-               GO TO 30
-            END IF
-            AJJ = SQRT( AJJ )
-            A( J, J ) = AJJ
-*
-*           Compute elements J+1:N of row J.
-*
-            IF( J.LT.N ) THEN
-               CALL DGEMV( 'Transpose', J-1, N-J, -ONE, A( 1, J+1 ),
-     $                     LDA, A( 1, J ), 1, ONE, A( J, J+1 ), LDA )
-               CALL DSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
-            END IF
-   10    CONTINUE
-      ELSE
-*
-*        Compute the Cholesky factorization A = L*L'.
-*
-         DO 20 J = 1, N
-*
-*           Compute L(J,J) and test for non-positive-definiteness.
-*
-            AJJ = A( J, J ) - DDOT( J-1, A( J, 1 ), LDA, A( J, 1 ),
-     $            LDA )
-            IF( AJJ.LE.ZERO ) THEN
-               A( J, J ) = AJJ
-               GO TO 30
-            END IF
-            AJJ = SQRT( AJJ )
-            A( J, J ) = AJJ
-*
-*           Compute elements J+1:N of column J.
-*
-            IF( J.LT.N ) THEN
-               CALL DGEMV( 'No transpose', N-J, J-1, -ONE, A( J+1, 1 ),
-     $                     LDA, A( J, 1 ), LDA, ONE, A( J+1, J ), 1 )
-               CALL DSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
-            END IF
-   20    CONTINUE
-      END IF
-      GO TO 40
-*
-   30 CONTINUE
-      INFO = J
-*
-   40 CONTINUE
-      RETURN
-*
-*     End of DPOTF2
-*
-      END
diff --git a/src/lib/lapack/dpotrf.f b/src/lib/lapack/dpotrf.f
deleted file mode 100644
index 8449df6d..00000000
--- a/src/lib/lapack/dpotrf.f
+++ /dev/null
@@ -1,183 +0,0 @@
-      SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DPOTRF computes the Cholesky factorization of a real symmetric
-*  positive definite matrix A.
-*
-*  The factorization has the form
-*     A = U**T * U,  if UPLO = 'U', or
-*     A = L  * L**T,  if UPLO = 'L',
-*  where U is an upper triangular matrix and L is lower triangular.
-*
-*  This is the block version of the algorithm, calling Level 3 BLAS.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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, the factor U or L from the Cholesky
-*          factorization A = U**T*U or A = L*L**T.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, the leading minor of order i is not
-*                positive definite, and the factorization could not be
-*                completed.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            J, JB, NB
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMM, DPOTF2, DSYRK, DTRSM, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. 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( 'DPOTRF', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Determine the block size for this environment.
-*
-      NB = ILAENV( 1, 'DPOTRF', UPLO, N, -1, -1, -1 )
-      IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-*        Use unblocked code.
-*
-         CALL DPOTF2( UPLO, N, A, LDA, INFO )
-      ELSE
-*
-*        Use blocked code.
-*
-         IF( UPPER ) THEN
-*
-*           Compute the Cholesky factorization A = U'*U.
-*
-            DO 10 J = 1, N, NB
-*
-*              Update and factorize the current diagonal block and test
-*              for non-positive-definiteness.
-*
-               JB = MIN( NB, N-J+1 )
-               CALL DSYRK( 'Upper', 'Transpose', JB, J-1, -ONE,
-     $                     A( 1, J ), LDA, ONE, A( J, J ), LDA )
-               CALL DPOTF2( 'Upper', JB, A( J, J ), LDA, INFO )
-               IF( INFO.NE.0 )
-     $            GO TO 30
-               IF( J+JB.LE.N ) THEN
-*
-*                 Compute the current block row.
-*
-                  CALL DGEMM( 'Transpose', 'No transpose', JB, N-J-JB+1,
-     $                        J-1, -ONE, A( 1, J ), LDA, A( 1, J+JB ),
-     $                        LDA, ONE, A( J, J+JB ), LDA )
-                  CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit',
-     $                        JB, N-J-JB+1, ONE, A( J, J ), LDA,
-     $                        A( J, J+JB ), LDA )
-               END IF
-   10       CONTINUE
-*
-         ELSE
-*
-*           Compute the Cholesky factorization A = L*L'.
-*
-            DO 20 J = 1, N, NB
-*
-*              Update and factorize the current diagonal block and test
-*              for non-positive-definiteness.
-*
-               JB = MIN( NB, N-J+1 )
-               CALL DSYRK( 'Lower', 'No transpose', JB, J-1, -ONE,
-     $                     A( J, 1 ), LDA, ONE, A( J, J ), LDA )
-               CALL DPOTF2( 'Lower', JB, A( J, J ), LDA, INFO )
-               IF( INFO.NE.0 )
-     $            GO TO 30
-               IF( J+JB.LE.N ) THEN
-*
-*                 Compute the current block column.
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
-     $                        J-1, -ONE, A( J+JB, 1 ), LDA, A( J, 1 ),
-     $                        LDA, ONE, A( J+JB, J ), LDA )
-                  CALL DTRSM( 'Right', 'Lower', 'Transpose', 'Non-unit',
-     $                        N-J-JB+1, JB, ONE, A( J, J ), LDA,
-     $                        A( J+JB, J ), LDA )
-               END IF
-   20       CONTINUE
-         END IF
-      END IF
-      GO TO 40
-*
-   30 CONTINUE
-      INFO = INFO + J - 1
-*
-   40 CONTINUE
-      RETURN
-*
-*     End of DPOTRF
-*
-      END
diff --git a/src/lib/lapack/dpotrs.f b/src/lib/lapack/dpotrs.f
deleted file mode 100644
index 0273655e..00000000
--- a/src/lib/lapack/dpotrs.f
+++ /dev/null
@@ -1,132 +0,0 @@
-      SUBROUTINE DPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, LDB, N, NRHS
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DPOTRS solves a system of linear equations A*X = B with a symmetric
-*  positive definite matrix A using the Cholesky factorization
-*  A = U**T*U or A = L*L**T computed by DPOTRF.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of columns
-*          of the matrix B.  NRHS >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The triangular factor U or L from the Cholesky factorization
-*          A = U**T*U or A = L*L**T, as computed by DPOTRF.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the right hand side matrix B.
-*          On exit, the solution matrix X.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DTRSM, 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( 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 = -7
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DPOTRS', -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'*U.
-*
-*        Solve U'*X = B, overwriting B with X.
-*
-         CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
-     $               ONE, A, LDA, B, LDB )
-*
-*        Solve U*X = B, overwriting B with X.
-*
-         CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
-     $               NRHS, ONE, A, LDA, B, LDB )
-      ELSE
-*
-*        Solve A*X = B where A = L*L'.
-*
-*        Solve L*X = B, overwriting B with X.
-*
-         CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', N,
-     $               NRHS, ONE, A, LDA, B, LDB )
-*
-*        Solve L'*X = B, overwriting B with X.
-*
-         CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Non-unit', N, NRHS,
-     $               ONE, A, LDA, B, LDB )
-      END IF
-*
-      RETURN
-*
-*     End of DPOTRS
-*
-      END
diff --git a/src/lib/lapack/dpptrf.f b/src/lib/lapack/dpptrf.f
deleted file mode 100644
index a5e2a596..00000000
--- a/src/lib/lapack/dpptrf.f
+++ /dev/null
@@ -1,177 +0,0 @@
-      SUBROUTINE DPPTRF( UPLO, N, AP, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   AP( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DPPTRF computes the Cholesky factorization of a real symmetric
-*  positive definite matrix A stored in packed format.
-*
-*  The factorization has the form
-*     A = U**T * U,  if UPLO = 'U', or
-*     A = L  * L**T,  if UPLO = 'L',
-*  where U is an upper triangular matrix and L is lower triangular.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  AP      (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*          On entry, the upper or lower triangle of the symmetric matrix
-*          A, packed columnwise in a linear array.  The j-th column of A
-*          is stored in the array AP as follows:
-*          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*          See below for further details.
-*
-*          On exit, if INFO = 0, the triangular factor U or L from the
-*          Cholesky factorization A = U**T*U or A = L*L**T, in the same
-*          storage format as A.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, the leading minor of order i is not
-*                positive definite, and the factorization could not be
-*                completed.
-*
-*  Further Details
-*  ======= =======
-*
-*  The packed storage scheme is illustrated by the following example
-*  when N = 4, UPLO = 'U':
-*
-*  Two-dimensional storage of the symmetric matrix A:
-*
-*     a11 a12 a13 a14
-*         a22 a23 a24
-*             a33 a34     (aij = aji)
-*                 a44
-*
-*  Packed storage of the upper triangle of A:
-*
-*  AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            J, JC, JJ
-      DOUBLE PRECISION   AJJ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DDOT
-      EXTERNAL           LSAME, DDOT
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSCAL, DSPR, DTPSV, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          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
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DPPTRF', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      IF( UPPER ) THEN
-*
-*        Compute the Cholesky factorization A = U'*U.
-*
-         JJ = 0
-         DO 10 J = 1, N
-            JC = JJ + 1
-            JJ = JJ + J
-*
-*           Compute elements 1:J-1 of column J.
-*
-            IF( J.GT.1 )
-     $         CALL DTPSV( 'Upper', 'Transpose', 'Non-unit', J-1, AP,
-     $                     AP( JC ), 1 )
-*
-*           Compute U(J,J) and test for non-positive-definiteness.
-*
-            AJJ = AP( JJ ) - DDOT( J-1, AP( JC ), 1, AP( JC ), 1 )
-            IF( AJJ.LE.ZERO ) THEN
-               AP( JJ ) = AJJ
-               GO TO 30
-            END IF
-            AP( JJ ) = SQRT( AJJ )
-   10    CONTINUE
-      ELSE
-*
-*        Compute the Cholesky factorization A = L*L'.
-*
-         JJ = 1
-         DO 20 J = 1, N
-*
-*           Compute L(J,J) and test for non-positive-definiteness.
-*
-            AJJ = AP( JJ )
-            IF( AJJ.LE.ZERO ) THEN
-               AP( JJ ) = AJJ
-               GO TO 30
-            END IF
-            AJJ = SQRT( AJJ )
-            AP( JJ ) = AJJ
-*
-*           Compute elements J+1:N of column J and update the trailing
-*           submatrix.
-*
-            IF( J.LT.N ) THEN
-               CALL DSCAL( N-J, ONE / AJJ, AP( JJ+1 ), 1 )
-               CALL DSPR( 'Lower', N-J, -ONE, AP( JJ+1 ), 1,
-     $                    AP( JJ+N-J+1 ) )
-               JJ = JJ + N - J + 1
-            END IF
-   20    CONTINUE
-      END IF
-      GO TO 40
-*
-   30 CONTINUE
-      INFO = J
-*
-   40 CONTINUE
-      RETURN
-*
-*     End of DPPTRF
-*
-      END
diff --git a/src/lib/lapack/drscl.f b/src/lib/lapack/drscl.f
deleted file mode 100644
index a13e96d8..00000000
--- a/src/lib/lapack/drscl.f
+++ /dev/null
@@ -1,114 +0,0 @@
-      SUBROUTINE DRSCL( N, SA, SX, INCX )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-      DOUBLE PRECISION   SA
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   SX( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DRSCL multiplies an n-element real vector x by the real scalar 1/a.
-*  This is done without overflow or underflow as long as
-*  the final result x/a does not overflow or underflow.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of components of the vector x.
-*
-*  SA      (input) DOUBLE PRECISION
-*          The scalar a which is used to divide each component of x.
-*          SA must be >= 0, or the subroutine will divide by zero.
-*
-*  SX      (input/output) DOUBLE PRECISION array, dimension
-*                         (1+(N-1)*abs(INCX))
-*          The n-element vector x.
-*
-*  INCX    (input) INTEGER
-*          The increment between successive values of the vector SX.
-*          > 0:  SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i),     1< i<= n
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            DONE
-      DOUBLE PRECISION   BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSCAL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-*     Get machine parameters
-*
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Initialize the denominator to SA and the numerator to 1.
-*
-      CDEN = SA
-      CNUM = ONE
-*
-   10 CONTINUE
-      CDEN1 = CDEN*SMLNUM
-      CNUM1 = CNUM / BIGNUM
-      IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
-*
-*        Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
-*
-         MUL = SMLNUM
-         DONE = .FALSE.
-         CDEN = CDEN1
-      ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
-*
-*        Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
-*
-         MUL = BIGNUM
-         DONE = .FALSE.
-         CNUM = CNUM1
-      ELSE
-*
-*        Multiply X by CNUM / CDEN and return.
-*
-         MUL = CNUM / CDEN
-         DONE = .TRUE.
-      END IF
-*
-*     Scale the vector X by MUL
-*
-      CALL DSCAL( N, MUL, SX, INCX )
-*
-      IF( .NOT.DONE )
-     $   GO TO 10
-*
-      RETURN
-*
-*     End of DRSCL
-*
-      END
diff --git a/src/lib/lapack/dspev.f b/src/lib/lapack/dspev.f
deleted file mode 100644
index 64582c99..00000000
--- a/src/lib/lapack/dspev.f
+++ /dev/null
@@ -1,187 +0,0 @@
-      SUBROUTINE DSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBZ, UPLO
-      INTEGER            INFO, LDZ, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   AP( * ), W( * ), WORK( * ), Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSPEV computes all the eigenvalues and, optionally, eigenvectors of a
-*  real symmetric matrix A in packed storage.
-*
-*  Arguments
-*  =========
-*
-*  JOBZ    (input) CHARACTER*1
-*          = 'N':  Compute eigenvalues only;
-*          = 'V':  Compute eigenvalues and eigenvectors.
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  AP      (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*          On entry, the upper or lower triangle of the symmetric matrix
-*          A, packed columnwise in a linear array.  The j-th column of A
-*          is stored in the array AP as follows:
-*          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*          if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*
-*          On exit, AP is overwritten by values generated during the
-*          reduction to tridiagonal form.  If UPLO = 'U', the diagonal
-*          and first superdiagonal of the tridiagonal matrix T overwrite
-*          the corresponding elements of A, and if UPLO = 'L', the
-*          diagonal and first subdiagonal of T overwrite the
-*          corresponding elements of A.
-*
-*  W       (output) DOUBLE PRECISION array, dimension (N)
-*          If INFO = 0, the eigenvalues in ascending order.
-*
-*  Z       (output) 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.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z.  LDZ >= 1, and if
-*          JOBZ = 'V', LDZ >= max(1,N).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (3*N)
-*
-*  INFO    (output) 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.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            WANTZ
-      INTEGER            IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE
-      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
-     $                   SMLNUM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH, DLANSP
-      EXTERNAL           LSAME, DLAMCH, DLANSP
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DOPGTR, DSCAL, DSPTRD, DSTEQR, DSTERF, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      WANTZ = LSAME( JOBZ, 'V' )
-*
-      INFO = 0
-      IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) )
-     $          THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
-         INFO = -7
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSPEV ', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      IF( N.EQ.1 ) THEN
-         W( 1 ) = AP( 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 = DLANSP( 'M', UPLO, N, AP, 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
-         CALL DSCAL( ( N*( N+1 ) ) / 2, SIGMA, AP, 1 )
-      END IF
-*
-*     Call DSPTRD to reduce symmetric packed matrix to tridiagonal form.
-*
-      INDE = 1
-      INDTAU = INDE + N
-      CALL DSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), IINFO )
-*
-*     For eigenvalues only, call DSTERF.  For eigenvectors, first call
-*     DOPGTR to generate the orthogonal matrix, then call DSTEQR.
-*
-      IF( .NOT.WANTZ ) THEN
-         CALL DSTERF( N, W, WORK( INDE ), INFO )
-      ELSE
-         INDWRK = INDTAU + N
-         CALL DOPGTR( UPLO, N, AP, WORK( INDTAU ), Z, LDZ,
-     $                WORK( INDWRK ), IINFO )
-         CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, 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
-*
-      RETURN
-*
-*     End of DSPEV
-*
-      END
diff --git a/src/lib/lapack/dspgst.f b/src/lib/lapack/dspgst.f
deleted file mode 100644
index 8e121a94..00000000
--- a/src/lib/lapack/dspgst.f
+++ /dev/null
@@ -1,208 +0,0 @@
-      SUBROUTINE DSPGST( ITYPE, UPLO, N, AP, BP, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, ITYPE, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   AP( * ), BP( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSPGST reduces a real symmetric-definite generalized eigenproblem
-*  to standard form, using packed storage.
-*
-*  If ITYPE = 1, the problem is A*x = lambda*B*x,
-*  and A is overwritten by inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T)
-*
-*  If ITYPE = 2 or 3, the problem is A*B*x = lambda*x or
-*  B*A*x = lambda*x, and A is overwritten by U*A*U**T or L**T*A*L.
-*
-*  B must have been previously factorized as U**T*U or L*L**T by DPPTRF.
-*
-*  Arguments
-*  =========
-*
-*  ITYPE   (input) INTEGER
-*          = 1: compute inv(U**T)*A*inv(U) or inv(L)*A*inv(L**T);
-*          = 2 or 3: compute U*A*U**T or L**T*A*L.
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored and B is factored as
-*                  U**T*U;
-*          = 'L':  Lower triangle of A is stored and B is factored as
-*                  L*L**T.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B.  N >= 0.
-*
-*  AP      (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*          On entry, the upper or lower triangle of the symmetric matrix
-*          A, packed columnwise in a linear array.  The j-th column of A
-*          is stored in the array AP as follows:
-*          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*
-*          On exit, if INFO = 0, the transformed matrix, stored in the
-*          same format as A.
-*
-*  BP      (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*          The triangular factor from the Cholesky factorization of B,
-*          stored in the same format as A, as returned by DPPTRF.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, HALF
-      PARAMETER          ( ONE = 1.0D0, HALF = 0.5D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            J, J1, J1J1, JJ, K, K1, K1K1, KK
-      DOUBLE PRECISION   AJJ, AKK, BJJ, BKK, CT
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DSCAL, DSPMV, DSPR2, DTPMV, DTPSV,
-     $                   XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DDOT
-      EXTERNAL           LSAME, DDOT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      UPPER = LSAME( UPLO, 'U' )
-      IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
-         INFO = -1
-      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSPGST', -INFO )
-         RETURN
-      END IF
-*
-      IF( ITYPE.EQ.1 ) THEN
-         IF( UPPER ) THEN
-*
-*           Compute inv(U')*A*inv(U)
-*
-*           J1 and JJ are the indices of A(1,j) and A(j,j)
-*
-            JJ = 0
-            DO 10 J = 1, N
-               J1 = JJ + 1
-               JJ = JJ + J
-*
-*              Compute the j-th column of the upper triangle of A
-*
-               BJJ = BP( JJ )
-               CALL DTPSV( UPLO, 'Transpose', 'Nonunit', J, BP,
-     $                     AP( J1 ), 1 )
-               CALL DSPMV( UPLO, J-1, -ONE, AP, BP( J1 ), 1, ONE,
-     $                     AP( J1 ), 1 )
-               CALL DSCAL( J-1, ONE / BJJ, AP( J1 ), 1 )
-               AP( JJ ) = ( AP( JJ )-DDOT( J-1, AP( J1 ), 1, BP( J1 ),
-     $                    1 ) ) / BJJ
-   10       CONTINUE
-         ELSE
-*
-*           Compute inv(L)*A*inv(L')
-*
-*           KK and K1K1 are the indices of A(k,k) and A(k+1,k+1)
-*
-            KK = 1
-            DO 20 K = 1, N
-               K1K1 = KK + N - K + 1
-*
-*              Update the lower triangle of A(k:n,k:n)
-*
-               AKK = AP( KK )
-               BKK = BP( KK )
-               AKK = AKK / BKK**2
-               AP( KK ) = AKK
-               IF( K.LT.N ) THEN
-                  CALL DSCAL( N-K, ONE / BKK, AP( KK+1 ), 1 )
-                  CT = -HALF*AKK
-                  CALL DAXPY( N-K, CT, BP( KK+1 ), 1, AP( KK+1 ), 1 )
-                  CALL DSPR2( UPLO, N-K, -ONE, AP( KK+1 ), 1,
-     $                        BP( KK+1 ), 1, AP( K1K1 ) )
-                  CALL DAXPY( N-K, CT, BP( KK+1 ), 1, AP( KK+1 ), 1 )
-                  CALL DTPSV( UPLO, 'No transpose', 'Non-unit', N-K,
-     $                        BP( K1K1 ), AP( KK+1 ), 1 )
-               END IF
-               KK = K1K1
-   20       CONTINUE
-         END IF
-      ELSE
-         IF( UPPER ) THEN
-*
-*           Compute U*A*U'
-*
-*           K1 and KK are the indices of A(1,k) and A(k,k)
-*
-            KK = 0
-            DO 30 K = 1, N
-               K1 = KK + 1
-               KK = KK + K
-*
-*              Update the upper triangle of A(1:k,1:k)
-*
-               AKK = AP( KK )
-               BKK = BP( KK )
-               CALL DTPMV( UPLO, 'No transpose', 'Non-unit', K-1, BP,
-     $                     AP( K1 ), 1 )
-               CT = HALF*AKK
-               CALL DAXPY( K-1, CT, BP( K1 ), 1, AP( K1 ), 1 )
-               CALL DSPR2( UPLO, K-1, ONE, AP( K1 ), 1, BP( K1 ), 1,
-     $                     AP )
-               CALL DAXPY( K-1, CT, BP( K1 ), 1, AP( K1 ), 1 )
-               CALL DSCAL( K-1, BKK, AP( K1 ), 1 )
-               AP( KK ) = AKK*BKK**2
-   30       CONTINUE
-         ELSE
-*
-*           Compute L'*A*L
-*
-*           JJ and J1J1 are the indices of A(j,j) and A(j+1,j+1)
-*
-            JJ = 1
-            DO 40 J = 1, N
-               J1J1 = JJ + N - J + 1
-*
-*              Compute the j-th column of the lower triangle of A
-*
-               AJJ = AP( JJ )
-               BJJ = BP( JJ )
-               AP( JJ ) = AJJ*BJJ + DDOT( N-J, AP( JJ+1 ), 1,
-     $                    BP( JJ+1 ), 1 )
-               CALL DSCAL( N-J, BJJ, AP( JJ+1 ), 1 )
-               CALL DSPMV( UPLO, N-J, ONE, AP( J1J1 ), BP( JJ+1 ), 1,
-     $                     ONE, AP( JJ+1 ), 1 )
-               CALL DTPMV( UPLO, 'Transpose', 'Non-unit', N-J+1,
-     $                     BP( JJ ), AP( JJ ), 1 )
-               JJ = J1J1
-   40       CONTINUE
-         END IF
-      END IF
-      RETURN
-*
-*     End of DSPGST
-*
-      END
diff --git a/src/lib/lapack/dspgv.f b/src/lib/lapack/dspgv.f
deleted file mode 100644
index 737a1ee3..00000000
--- a/src/lib/lapack/dspgv.f
+++ /dev/null
@@ -1,195 +0,0 @@
-      SUBROUTINE DSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
-     $                  INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBZ, UPLO
-      INTEGER            INFO, ITYPE, LDZ, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   AP( * ), BP( * ), W( * ), WORK( * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSPGV 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, stored in packed format,
-*  and B is also positive definite.
-*
-*  Arguments
-*  =========
-*
-*  ITYPE   (input) 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
-*
-*  JOBZ    (input) CHARACTER*1
-*          = 'N':  Compute eigenvalues only;
-*          = 'V':  Compute eigenvalues and eigenvectors.
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangles of A and B are stored;
-*          = 'L':  Lower triangles of A and B are stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B.  N >= 0.
-*
-*  AP      (input/output) DOUBLE PRECISION array, dimension
-*                            (N*(N+1)/2)
-*          On entry, the upper or lower triangle of the symmetric matrix
-*          A, packed columnwise in a linear array.  The j-th column of A
-*          is stored in the array AP as follows:
-*          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*          if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*
-*          On exit, the contents of AP are destroyed.
-*
-*  BP      (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*          On entry, the upper or lower triangle of the symmetric matrix
-*          B, packed columnwise in a linear array.  The j-th column of B
-*          is stored in the array BP as follows:
-*          if UPLO = 'U', BP(i + (j-1)*j/2) = B(i,j) for 1<=i<=j;
-*          if UPLO = 'L', BP(i + (j-1)*(2*n-j)/2) = B(i,j) for j<=i<=n.
-*
-*          On exit, the triangular factor U or L from the Cholesky
-*          factorization B = U**T*U or B = L*L**T, in the same storage
-*          format as B.
-*
-*  W       (output) DOUBLE PRECISION array, dimension (N)
-*          If INFO = 0, the eigenvalues in ascending order.
-*
-*  Z       (output) DOUBLE PRECISION array, dimension (LDZ, N)
-*          If JOBZ = 'V', then if INFO = 0, Z 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 Z is not referenced.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z.  LDZ >= 1, and if
-*          JOBZ = 'V', LDZ >= max(1,N).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (3*N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  DPPTRF or DSPEV returned an error code:
-*             <= N:  if INFO = i, DSPEV 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.
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            UPPER, WANTZ
-      CHARACTER          TRANS
-      INTEGER            J, NEIG
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DPPTRF, DSPEV, DSPGST, DTPMV, DTPSV, XERBLA
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      WANTZ = LSAME( JOBZ, 'V' )
-      UPPER = LSAME( UPLO, 'U' )
-*
-      INFO = 0
-      IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
-         INFO = -1
-      ELSE IF( .NOT.( WANTZ .OR. 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( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
-         INFO = -9
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSPGV ', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Form a Cholesky factorization of B.
-*
-      CALL DPPTRF( UPLO, N, BP, INFO )
-      IF( INFO.NE.0 ) THEN
-         INFO = N + INFO
-         RETURN
-      END IF
-*
-*     Transform problem to standard eigenvalue problem and solve.
-*
-      CALL DSPGST( ITYPE, UPLO, N, AP, BP, INFO )
-      CALL DSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, 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)'*y or inv(U)*y
-*
-            IF( UPPER ) THEN
-               TRANS = 'N'
-            ELSE
-               TRANS = 'T'
-            END IF
-*
-            DO 10 J = 1, NEIG
-               CALL DTPSV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
-     $                     1 )
-   10       CONTINUE
-*
-         ELSE IF( ITYPE.EQ.3 ) THEN
-*
-*           For B*A*x=(lambda)*x;
-*           backtransform eigenvectors: x = L*y or U'*y
-*
-            IF( UPPER ) THEN
-               TRANS = 'T'
-            ELSE
-               TRANS = 'N'
-            END IF
-*
-            DO 20 J = 1, NEIG
-               CALL DTPMV( UPLO, TRANS, 'Non-unit', N, BP, Z( 1, J ),
-     $                     1 )
-   20       CONTINUE
-         END IF
-      END IF
-      RETURN
-*
-*     End of DSPGV
-*
-      END
diff --git a/src/lib/lapack/dsptrd.f b/src/lib/lapack/dsptrd.f
deleted file mode 100644
index 6d3390e3..00000000
--- a/src/lib/lapack/dsptrd.f
+++ /dev/null
@@ -1,228 +0,0 @@
-      SUBROUTINE DSPTRD( UPLO, N, AP, D, E, TAU, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   AP( * ), D( * ), E( * ), TAU( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSPTRD reduces a real symmetric matrix A stored in packed form to
-*  symmetric tridiagonal form T by an orthogonal similarity
-*  transformation: Q**T * A * Q = T.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  AP      (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*          On entry, the upper or lower triangle of the symmetric matrix
-*          A, packed columnwise in a linear array.  The j-th column of A
-*          is stored in the array AP as follows:
-*          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*          if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
-*          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.
-*
-*  D       (output) DOUBLE PRECISION array, dimension (N)
-*          The diagonal elements of the tridiagonal matrix T:
-*          D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (N-1)
-*          The off-diagonal elements of the tridiagonal matrix T:
-*          E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (N-1)
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  If UPLO = 'U', the matrix Q is represented as a product of elementary
-*  reflectors
-*
-*     Q = H(n-1) . . . H(2) H(1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in AP,
-*  overwriting A(1:i-1,i+1), and tau is stored in TAU(i).
-*
-*  If UPLO = 'L', the matrix Q is represented as a product of elementary
-*  reflectors
-*
-*     Q = H(1) H(2) . . . H(n-1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in AP,
-*  overwriting A(i+2:n,i), and tau is stored in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO, HALF
-      PARAMETER          ( ONE = 1.0D0, ZERO = 0.0D0,
-     $                   HALF = 1.0D0 / 2.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            I, I1, I1I1, II
-      DOUBLE PRECISION   ALPHA, TAUI
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DLARFG, DSPMV, DSPR2, XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DDOT
-      EXTERNAL           LSAME, DDOT
-*     ..
-*     .. 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
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSPTRD', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-      IF( UPPER ) THEN
-*
-*        Reduce the upper triangle of A.
-*        I1 is the index in AP of A(1,I+1).
-*
-         I1 = N*( N-1 ) / 2 + 1
-         DO 10 I = N - 1, 1, -1
-*
-*           Generate elementary reflector H(i) = I - tau * v * v'
-*           to annihilate A(1:i-1,i+1)
-*
-            CALL DLARFG( I, AP( I1+I-1 ), AP( I1 ), 1, TAUI )
-            E( I ) = AP( I1+I-1 )
-*
-            IF( TAUI.NE.ZERO ) THEN
-*
-*              Apply H(i) from both sides to A(1:i,1:i)
-*
-               AP( I1+I-1 ) = ONE
-*
-*              Compute  y := tau * A * v  storing y in TAU(1:i)
-*
-               CALL DSPMV( UPLO, I, TAUI, AP, AP( I1 ), 1, ZERO, TAU,
-     $                     1 )
-*
-*              Compute  w := y - 1/2 * tau * (y'*v) * v
-*
-               ALPHA = -HALF*TAUI*DDOT( I, TAU, 1, AP( I1 ), 1 )
-               CALL DAXPY( I, ALPHA, AP( I1 ), 1, TAU, 1 )
-*
-*              Apply the transformation as a rank-2 update:
-*                 A := A - v * w' - w * v'
-*
-               CALL DSPR2( UPLO, I, -ONE, AP( I1 ), 1, TAU, 1, AP )
-*
-               AP( I1+I-1 ) = E( I )
-            END IF
-            D( I+1 ) = AP( I1+I )
-            TAU( I ) = TAUI
-            I1 = I1 - I
-   10    CONTINUE
-         D( 1 ) = AP( 1 )
-      ELSE
-*
-*        Reduce the lower triangle of A. II is the index in AP of
-*        A(i,i) and I1I1 is the index of A(i+1,i+1).
-*
-         II = 1
-         DO 20 I = 1, N - 1
-            I1I1 = II + N - I + 1
-*
-*           Generate elementary reflector H(i) = I - tau * v * v'
-*           to annihilate A(i+2:n,i)
-*
-            CALL DLARFG( N-I, AP( II+1 ), AP( II+2 ), 1, TAUI )
-            E( I ) = AP( II+1 )
-*
-            IF( TAUI.NE.ZERO ) THEN
-*
-*              Apply H(i) from both sides to A(i+1:n,i+1:n)
-*
-               AP( II+1 ) = ONE
-*
-*              Compute  y := tau * A * v  storing y in TAU(i:n-1)
-*
-               CALL DSPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), 1,
-     $                     ZERO, TAU( I ), 1 )
-*
-*              Compute  w := y - 1/2 * tau * (y'*v) * v
-*
-               ALPHA = -HALF*TAUI*DDOT( N-I, TAU( I ), 1, AP( II+1 ),
-     $                 1 )
-               CALL DAXPY( N-I, ALPHA, AP( II+1 ), 1, TAU( I ), 1 )
-*
-*              Apply the transformation as a rank-2 update:
-*                 A := A - v * w' - w * v'
-*
-               CALL DSPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), 1,
-     $                     AP( I1I1 ) )
-*
-               AP( II+1 ) = E( I )
-            END IF
-            D( I ) = AP( II )
-            TAU( I ) = TAUI
-            II = I1I1
-   20    CONTINUE
-         D( N ) = AP( II )
-      END IF
-*
-      RETURN
-*
-*     End of DSPTRD
-*
-      END
diff --git a/src/lib/lapack/dsptrf.f b/src/lib/lapack/dsptrf.f
deleted file mode 100644
index 8b8a9185..00000000
--- a/src/lib/lapack/dsptrf.f
+++ /dev/null
@@ -1,547 +0,0 @@
-      SUBROUTINE DSPTRF( UPLO, N, AP, IPIV, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   AP( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSPTRF computes the factorization of a real symmetric matrix A stored
-*  in packed format using the Bunch-Kaufman diagonal pivoting method:
-*
-*     A = U*D*U**T  or  A = L*D*L**T
-*
-*  where U (or L) is a product of permutation and unit upper (lower)
-*  triangular matrices, and D is symmetric and block diagonal with
-*  1-by-1 and 2-by-2 diagonal blocks.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  AP      (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2)
-*          On entry, the upper or lower triangle of the symmetric matrix
-*          A, packed columnwise in a linear array.  The j-th column of A
-*          is stored in the array AP as follows:
-*          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
-*          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
-*
-*          On exit, the block diagonal matrix D and the multipliers used
-*          to obtain the factor U or L, stored as a packed triangular
-*          matrix overwriting A (see below for further details).
-*
-*  IPIV    (output) INTEGER array, dimension (N)
-*          Details of the interchanges and the block structure of D.
-*          If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*          interchanged and D(k,k) is a 1-by-1 diagonal block.
-*          If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*          columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*          is a 2-by-2 diagonal block.  If UPLO = 'L' and IPIV(k) =
-*          IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*          interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*
-*  INFO    (output) 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.
-*
-*  Further Details
-*  ===============
-*
-*  5-96 - Based on modifications by J. Lewis, Boeing Computer Services
-*         Company
-*
-*  If UPLO = 'U', then A = U*D*U', where
-*     U = P(n)*U(n)* ... *P(k)U(k)* ...,
-*  i.e., U is a product of terms P(k)*U(k), where k decreases from n to
-*  1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*  and 2-by-2 diagonal blocks D(k).  P(k) is a permutation matrix as
-*  defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
-*  that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*
-*             (   I    v    0   )   k-s
-*     U(k) =  (   0    I    0   )   s
-*             (   0    0    I   )   n-k
-*                k-s   s   n-k
-*
-*  If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
-*  If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
-*  and A(k,k), and v overwrites A(1:k-2,k-1:k).
-*
-*  If UPLO = 'L', then A = L*D*L', where
-*     L = P(1)*L(1)* ... *P(k)*L(k)* ...,
-*  i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
-*  n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*  and 2-by-2 diagonal blocks D(k).  P(k) is a permutation matrix as
-*  defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
-*  that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*
-*             (   I    0     0   )  k-1
-*     L(k) =  (   0    I     0   )  s
-*             (   0    v     I   )  n-k-s+1
-*                k-1   s  n-k-s+1
-*
-*  If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
-*  If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
-*  and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
-*
-*  =====================================================================
-*
-*     .. 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
-      INTEGER            I, IMAX, J, JMAX, K, KC, KK, KNC, KP, KPC,
-     $                   KSTEP, KX, NPP
-      DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22, R1,
-     $                   ROWMAX, T, WK, WKM1, WKP1
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX
-      EXTERNAL           LSAME, IDAMAX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSCAL, DSPR, DSWAP, 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
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSPTRF', -INFO )
-         RETURN
-      END IF
-*
-*     Initialize ALPHA for use in choosing pivot block size.
-*
-      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
-*
-      IF( UPPER ) THEN
-*
-*        Factorize A as U*D*U' using the upper triangle of A
-*
-*        K is the main loop index, decreasing from N to 1 in steps of
-*        1 or 2
-*
-         K = N
-         KC = ( N-1 )*N / 2 + 1
-   10    CONTINUE
-         KNC = KC
-*
-*        If K < 1, exit from loop
-*
-         IF( K.LT.1 )
-     $      GO TO 110
-         KSTEP = 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( AP( KC+K-1 ) )
-*
-*        IMAX is the row-index of the largest off-diagonal element in
-*        column K, and COLMAX is its absolute value
-*
-         IF( K.GT.1 ) THEN
-            IMAX = IDAMAX( K-1, AP( KC ), 1 )
-            COLMAX = ABS( AP( KC+IMAX-1 ) )
-         ELSE
-            COLMAX = ZERO
-         END IF
-*
-         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*
-*           Column K is zero: set INFO and continue
-*
-            IF( INFO.EQ.0 )
-     $         INFO = K
-            KP = K
-         ELSE
-            IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-*              no interchange, use 1-by-1 pivot block
-*
-               KP = K
-            ELSE
-*
-*              JMAX is the column-index of the largest off-diagonal
-*              element in row IMAX, and ROWMAX is its absolute value
-*
-               ROWMAX = ZERO
-               JMAX = IMAX
-               KX = IMAX*( IMAX+1 ) / 2 + IMAX
-               DO 20 J = IMAX + 1, K
-                  IF( ABS( AP( KX ) ).GT.ROWMAX ) THEN
-                     ROWMAX = ABS( AP( KX ) )
-                     JMAX = J
-                  END IF
-                  KX = KX + J
-   20          CONTINUE
-               KPC = ( IMAX-1 )*IMAX / 2 + 1
-               IF( IMAX.GT.1 ) THEN
-                  JMAX = IDAMAX( IMAX-1, AP( KPC ), 1 )
-                  ROWMAX = MAX( ROWMAX, ABS( AP( KPC+JMAX-1 ) ) )
-               END IF
-*
-               IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-*                 no interchange, use 1-by-1 pivot block
-*
-                  KP = K
-               ELSE IF( ABS( AP( KPC+IMAX-1 ) ).GE.ALPHA*ROWMAX ) THEN
-*
-*                 interchange rows and columns K and IMAX, use 1-by-1
-*                 pivot block
-*
-                  KP = IMAX
-               ELSE
-*
-*                 interchange rows and columns K-1 and IMAX, use 2-by-2
-*                 pivot block
-*
-                  KP = IMAX
-                  KSTEP = 2
-               END IF
-            END IF
-*
-            KK = K - KSTEP + 1
-            IF( KSTEP.EQ.2 )
-     $         KNC = KNC - K + 1
-            IF( KP.NE.KK ) THEN
-*
-*              Interchange rows and columns KK and KP in the leading
-*              submatrix A(1:k,1:k)
-*
-               CALL DSWAP( KP-1, AP( KNC ), 1, AP( KPC ), 1 )
-               KX = KPC + KP - 1
-               DO 30 J = KP + 1, KK - 1
-                  KX = KX + J - 1
-                  T = AP( KNC+J-1 )
-                  AP( KNC+J-1 ) = AP( KX )
-                  AP( KX ) = T
-   30          CONTINUE
-               T = AP( KNC+KK-1 )
-               AP( KNC+KK-1 ) = AP( KPC+KP-1 )
-               AP( KPC+KP-1 ) = T
-               IF( KSTEP.EQ.2 ) THEN
-                  T = AP( KC+K-2 )
-                  AP( KC+K-2 ) = AP( KC+KP-1 )
-                  AP( KC+KP-1 ) = T
-               END IF
-            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
-*
-*              Perform a rank-1 update of A(1:k-1,1:k-1) as
-*
-*              A := A - U(k)*D(k)*U(k)' = A - W(k)*1/D(k)*W(k)'
-*
-               R1 = ONE / AP( KC+K-1 )
-               CALL DSPR( UPLO, K-1, -R1, AP( KC ), 1, AP )
-*
-*              Store U(k) in column k
-*
-               CALL DSCAL( K-1, R1, AP( KC ), 1 )
-            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) )'
-*                 = A - ( W(k-1) W(k) )*inv(D(k))*( W(k-1) W(k) )'
-*
-               IF( K.GT.2 ) THEN
-*
-                  D12 = AP( K-1+( K-1 )*K / 2 )
-                  D22 = AP( K-1+( K-2 )*( K-1 ) / 2 ) / D12
-                  D11 = AP( K+( K-1 )*K / 2 ) / D12
-                  T = ONE / ( D11*D22-ONE )
-                  D12 = T / D12
-*
-                  DO 50 J = K - 2, 1, -1
-                     WKM1 = D12*( D11*AP( J+( K-2 )*( K-1 ) / 2 )-
-     $                      AP( J+( K-1 )*K / 2 ) )
-                     WK = D12*( D22*AP( J+( K-1 )*K / 2 )-
-     $                    AP( J+( K-2 )*( K-1 ) / 2 ) )
-                     DO 40 I = J, 1, -1
-                        AP( I+( J-1 )*J / 2 ) = AP( I+( J-1 )*J / 2 ) -
-     $                     AP( I+( K-1 )*K / 2 )*WK -
-     $                     AP( I+( K-2 )*( K-1 ) / 2 )*WKM1
-   40                CONTINUE
-                     AP( J+( K-1 )*K / 2 ) = WK
-                     AP( J+( K-2 )*( K-1 ) / 2 ) = WKM1
-   50             CONTINUE
-*
-               END IF
-*
-            END IF
-         END IF
-*
-*        Store details of the interchanges in IPIV
-*
-         IF( KSTEP.EQ.1 ) THEN
-            IPIV( K ) = KP
-         ELSE
-            IPIV( K ) = -KP
-            IPIV( K-1 ) = -KP
-         END IF
-*
-*        Decrease K and return to the start of the main loop
-*
-         K = K - KSTEP
-         KC = KNC - K
-         GO TO 10
-*
-      ELSE
-*
-*        Factorize A as L*D*L' using the lower triangle of A
-*
-*        K is the main loop index, increasing from 1 to N in steps of
-*        1 or 2
-*
-         K = 1
-         KC = 1
-         NPP = N*( N+1 ) / 2
-   60    CONTINUE
-         KNC = KC
-*
-*        If K > N, exit from loop
-*
-         IF( K.GT.N )
-     $      GO TO 110
-         KSTEP = 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( AP( KC ) )
-*
-*        IMAX is the row-index of the largest off-diagonal element in
-*        column K, and COLMAX is its absolute value
-*
-         IF( K.LT.N ) THEN
-            IMAX = K + IDAMAX( N-K, AP( KC+1 ), 1 )
-            COLMAX = ABS( AP( KC+IMAX-K ) )
-         ELSE
-            COLMAX = ZERO
-         END IF
-*
-         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*
-*           Column K is zero: set INFO and continue
-*
-            IF( INFO.EQ.0 )
-     $         INFO = K
-            KP = K
-         ELSE
-            IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-*              no interchange, use 1-by-1 pivot block
-*
-               KP = K
-            ELSE
-*
-*              JMAX is the column-index of the largest off-diagonal
-*              element in row IMAX, and ROWMAX is its absolute value
-*
-               ROWMAX = ZERO
-               KX = KC + IMAX - K
-               DO 70 J = K, IMAX - 1
-                  IF( ABS( AP( KX ) ).GT.ROWMAX ) THEN
-                     ROWMAX = ABS( AP( KX ) )
-                     JMAX = J
-                  END IF
-                  KX = KX + N - J
-   70          CONTINUE
-               KPC = NPP - ( N-IMAX+1 )*( N-IMAX+2 ) / 2 + 1
-               IF( IMAX.LT.N ) THEN
-                  JMAX = IMAX + IDAMAX( N-IMAX, AP( KPC+1 ), 1 )
-                  ROWMAX = MAX( ROWMAX, ABS( AP( KPC+JMAX-IMAX ) ) )
-               END IF
-*
-               IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-*                 no interchange, use 1-by-1 pivot block
-*
-                  KP = K
-               ELSE IF( ABS( AP( KPC ) ).GE.ALPHA*ROWMAX ) THEN
-*
-*                 interchange rows and columns K and IMAX, use 1-by-1
-*                 pivot block
-*
-                  KP = IMAX
-               ELSE
-*
-*                 interchange rows and columns K+1 and IMAX, use 2-by-2
-*                 pivot block
-*
-                  KP = IMAX
-                  KSTEP = 2
-               END IF
-            END IF
-*
-            KK = K + KSTEP - 1
-            IF( KSTEP.EQ.2 )
-     $         KNC = KNC + N - K + 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, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ),
-     $                        1 )
-               KX = KNC + KP - KK
-               DO 80 J = KK + 1, KP - 1
-                  KX = KX + N - J + 1
-                  T = AP( KNC+J-KK )
-                  AP( KNC+J-KK ) = AP( KX )
-                  AP( KX ) = T
-   80          CONTINUE
-               T = AP( KNC )
-               AP( KNC ) = AP( KPC )
-               AP( KPC ) = T
-               IF( KSTEP.EQ.2 ) THEN
-                  T = AP( KC+1 )
-                  AP( KC+1 ) = AP( KC+KP-K )
-                  AP( KC+KP-K ) = T
-               END IF
-            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) as
-*
-*                 A := A - L(k)*D(k)*L(k)' = A - W(k)*(1/D(k))*W(k)'
-*
-                  R1 = ONE / AP( KC )
-                  CALL DSPR( UPLO, N-K, -R1, AP( KC+1 ), 1,
-     $                       AP( KC+N-K+1 ) )
-*
-*                 Store L(k) in column K
-*
-                  CALL DSCAL( N-K, R1, AP( KC+1 ), 1 )
-               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
-*
-               IF( K.LT.N-1 ) THEN
-*
-*                 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) )'
-*                    = A - ( W(k) W(k+1) )*inv(D(k))*( W(k) W(k+1) )'
-*
-                  D21 = AP( K+1+( K-1 )*( 2*N-K ) / 2 )
-                  D11 = AP( K+1+K*( 2*N-K-1 ) / 2 ) / D21
-                  D22 = AP( K+( K-1 )*( 2*N-K ) / 2 ) / D21
-                  T = ONE / ( D11*D22-ONE )
-                  D21 = T / D21
-*
-                  DO 100 J = K + 2, N
-                     WK = D21*( D11*AP( J+( K-1 )*( 2*N-K ) / 2 )-
-     $                    AP( J+K*( 2*N-K-1 ) / 2 ) )
-                     WKP1 = D21*( D22*AP( J+K*( 2*N-K-1 ) / 2 )-
-     $                      AP( J+( K-1 )*( 2*N-K ) / 2 ) )
-*
-                     DO 90 I = J, N
-                        AP( I+( J-1 )*( 2*N-J ) / 2 ) = AP( I+( J-1 )*
-     $                     ( 2*N-J ) / 2 ) - AP( I+( K-1 )*( 2*N-K ) /
-     $                     2 )*WK - AP( I+K*( 2*N-K-1 ) / 2 )*WKP1
-   90                CONTINUE
-*
-                     AP( J+( K-1 )*( 2*N-K ) / 2 ) = WK
-                     AP( J+K*( 2*N-K-1 ) / 2 ) = WKP1
-*
-  100             CONTINUE
-               END IF
-            END IF
-         END IF
-*
-*        Store details of the interchanges in IPIV
-*
-         IF( KSTEP.EQ.1 ) THEN
-            IPIV( K ) = KP
-         ELSE
-            IPIV( K ) = -KP
-            IPIV( K+1 ) = -KP
-         END IF
-*
-*        Increase K and return to the start of the main loop
-*
-         K = K + KSTEP
-         KC = KNC + N - K + 2
-         GO TO 60
-*
-      END IF
-*
-  110 CONTINUE
-      RETURN
-*
-*     End of DSPTRF
-*
-      END
diff --git a/src/lib/lapack/dsteqr.f b/src/lib/lapack/dsteqr.f
deleted file mode 100644
index 0afd7957..00000000
--- a/src/lib/lapack/dsteqr.f
+++ /dev/null
@@ -1,500 +0,0 @@
-      SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          COMPZ
-      INTEGER            INFO, LDZ, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * ), WORK( * ), Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSTEQR computes all eigenvalues and, optionally, eigenvectors of a
-*  symmetric tridiagonal matrix using the implicit QL or QR method.
-*  The eigenvectors of a full or band symmetric matrix can also be found
-*  if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to
-*  tridiagonal form.
-*
-*  Arguments
-*  =========
-*
-*  COMPZ   (input) CHARACTER*1
-*          = 'N':  Compute eigenvalues only.
-*          = 'V':  Compute eigenvalues and eigenvectors of the original
-*                  symmetric matrix.  On entry, Z must contain the
-*                  orthogonal matrix used to reduce the original matrix
-*                  to tridiagonal form.
-*          = 'I':  Compute eigenvalues and eigenvectors of the
-*                  tridiagonal matrix.  Z is initialized to the identity
-*                  matrix.
-*
-*  N       (input) INTEGER
-*          The order of the matrix.  N >= 0.
-*
-*  D       (input/output) DOUBLE PRECISION array, dimension (N)
-*          On entry, the diagonal elements of the tridiagonal matrix.
-*          On exit, if INFO = 0, the eigenvalues in ascending order.
-*
-*  E       (input/output) DOUBLE PRECISION array, dimension (N-1)
-*          On entry, the (n-1) subdiagonal elements of the tridiagonal
-*          matrix.
-*          On exit, E has been destroyed.
-*
-*  Z       (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
-*          On entry, if  COMPZ = 'V', then Z contains the orthogonal
-*          matrix used in the reduction to tridiagonal form.
-*          On exit, if INFO = 0, then if  COMPZ = 'V', Z contains the
-*          orthonormal eigenvectors of the original symmetric matrix,
-*          and if COMPZ = 'I', Z contains the orthonormal eigenvectors
-*          of the symmetric tridiagonal matrix.
-*          If COMPZ = 'N', then Z is not referenced.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z.  LDZ >= 1, and if
-*          eigenvectors are desired, then  LDZ >= max(1,N).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (max(1,2*N-2))
-*          If COMPZ = 'N', then WORK is not referenced.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  the algorithm has failed to find all the eigenvalues in
-*                a total of 30*N iterations; if INFO = i, then i
-*                elements of E have not converged to zero; on exit, D
-*                and E contain the elements of a symmetric tridiagonal
-*                matrix which is orthogonally similar to the original
-*                matrix.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE, TWO, THREE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
-     $                   THREE = 3.0D0 )
-      INTEGER            MAXIT
-      PARAMETER          ( MAXIT = 30 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ICOMPZ, II, ISCALE, J, JTOT, K, L, L1, LEND,
-     $                   LENDM1, LENDP1, LENDSV, LM1, LSV, M, MM, MM1,
-     $                   NM1, NMAXIT
-      DOUBLE PRECISION   ANORM, B, C, EPS, EPS2, F, G, P, R, RT1, RT2,
-     $                   S, SAFMAX, SAFMIN, SSFMAX, SSFMIN, TST
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH, DLANST, DLAPY2
-      EXTERNAL           LSAME, DLAMCH, DLANST, DLAPY2
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLAE2, DLAEV2, DLARTG, DLASCL, DLASET, DLASR,
-     $                   DLASRT, DSWAP, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SIGN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-*
-      IF( LSAME( COMPZ, 'N' ) ) THEN
-         ICOMPZ = 0
-      ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
-         ICOMPZ = 1
-      ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
-         ICOMPZ = 2
-      ELSE
-         ICOMPZ = -1
-      END IF
-      IF( ICOMPZ.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
-     $         N ) ) ) THEN
-         INFO = -6
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSTEQR', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      IF( N.EQ.1 ) THEN
-         IF( ICOMPZ.EQ.2 )
-     $      Z( 1, 1 ) = ONE
-         RETURN
-      END IF
-*
-*     Determine the unit roundoff and over/underflow thresholds.
-*
-      EPS = DLAMCH( 'E' )
-      EPS2 = EPS**2
-      SAFMIN = DLAMCH( 'S' )
-      SAFMAX = ONE / SAFMIN
-      SSFMAX = SQRT( SAFMAX ) / THREE
-      SSFMIN = SQRT( SAFMIN ) / EPS2
-*
-*     Compute the eigenvalues and eigenvectors of the tridiagonal
-*     matrix.
-*
-      IF( ICOMPZ.EQ.2 )
-     $   CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
-*
-      NMAXIT = N*MAXIT
-      JTOT = 0
-*
-*     Determine where the matrix splits and choose QL or QR iteration
-*     for each block, according to whether top or bottom diagonal
-*     element is smaller.
-*
-      L1 = 1
-      NM1 = N - 1
-*
-   10 CONTINUE
-      IF( L1.GT.N )
-     $   GO TO 160
-      IF( L1.GT.1 )
-     $   E( L1-1 ) = ZERO
-      IF( L1.LE.NM1 ) THEN
-         DO 20 M = L1, NM1
-            TST = ABS( E( M ) )
-            IF( TST.EQ.ZERO )
-     $         GO TO 30
-            IF( TST.LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
-     $          1 ) ) ) )*EPS ) THEN
-               E( M ) = ZERO
-               GO TO 30
-            END IF
-   20    CONTINUE
-      END IF
-      M = N
-*
-   30 CONTINUE
-      L = L1
-      LSV = L
-      LEND = M
-      LENDSV = LEND
-      L1 = M + 1
-      IF( LEND.EQ.L )
-     $   GO TO 10
-*
-*     Scale submatrix in rows and columns L to LEND
-*
-      ANORM = DLANST( 'I', LEND-L+1, D( L ), E( L ) )
-      ISCALE = 0
-      IF( ANORM.EQ.ZERO )
-     $   GO TO 10
-      IF( ANORM.GT.SSFMAX ) THEN
-         ISCALE = 1
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N,
-     $                INFO )
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N,
-     $                INFO )
-      ELSE IF( ANORM.LT.SSFMIN ) THEN
-         ISCALE = 2
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N,
-     $                INFO )
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N,
-     $                INFO )
-      END IF
-*
-*     Choose between QL and QR iteration
-*
-      IF( ABS( D( LEND ) ).LT.ABS( D( L ) ) ) THEN
-         LEND = LSV
-         L = LENDSV
-      END IF
-*
-      IF( LEND.GT.L ) THEN
-*
-*        QL Iteration
-*
-*        Look for small subdiagonal element.
-*
-   40    CONTINUE
-         IF( L.NE.LEND ) THEN
-            LENDM1 = LEND - 1
-            DO 50 M = L, LENDM1
-               TST = ABS( E( M ) )**2
-               IF( TST.LE.( EPS2*ABS( D( M ) ) )*ABS( D( M+1 ) )+
-     $             SAFMIN )GO TO 60
-   50       CONTINUE
-         END IF
-*
-         M = LEND
-*
-   60    CONTINUE
-         IF( M.LT.LEND )
-     $      E( M ) = ZERO
-         P = D( L )
-         IF( M.EQ.L )
-     $      GO TO 80
-*
-*        If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
-*        to compute its eigensystem.
-*
-         IF( M.EQ.L+1 ) THEN
-            IF( ICOMPZ.GT.0 ) THEN
-               CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, S )
-               WORK( L ) = C
-               WORK( N-1+L ) = S
-               CALL DLASR( 'R', 'V', 'B', N, 2, WORK( L ),
-     $                     WORK( N-1+L ), Z( 1, L ), LDZ )
-            ELSE
-               CALL DLAE2( D( L ), E( L ), D( L+1 ), RT1, RT2 )
-            END IF
-            D( L ) = RT1
-            D( L+1 ) = RT2
-            E( L ) = ZERO
-            L = L + 2
-            IF( L.LE.LEND )
-     $         GO TO 40
-            GO TO 140
-         END IF
-*
-         IF( JTOT.EQ.NMAXIT )
-     $      GO TO 140
-         JTOT = JTOT + 1
-*
-*        Form shift.
-*
-         G = ( D( L+1 )-P ) / ( TWO*E( L ) )
-         R = DLAPY2( G, ONE )
-         G = D( M ) - P + ( E( L ) / ( G+SIGN( R, G ) ) )
-*
-         S = ONE
-         C = ONE
-         P = ZERO
-*
-*        Inner loop
-*
-         MM1 = M - 1
-         DO 70 I = MM1, L, -1
-            F = S*E( I )
-            B = C*E( I )
-            CALL DLARTG( G, F, C, S, R )
-            IF( I.NE.M-1 )
-     $         E( I+1 ) = R
-            G = D( I+1 ) - P
-            R = ( D( I )-G )*S + TWO*C*B
-            P = S*R
-            D( I+1 ) = G + P
-            G = C*R - B
-*
-*           If eigenvectors are desired, then save rotations.
-*
-            IF( ICOMPZ.GT.0 ) THEN
-               WORK( I ) = C
-               WORK( N-1+I ) = -S
-            END IF
-*
-   70    CONTINUE
-*
-*        If eigenvectors are desired, then apply saved rotations.
-*
-         IF( ICOMPZ.GT.0 ) THEN
-            MM = M - L + 1
-            CALL DLASR( 'R', 'V', 'B', N, MM, WORK( L ), WORK( N-1+L ),
-     $                  Z( 1, L ), LDZ )
-         END IF
-*
-         D( L ) = D( L ) - P
-         E( L ) = G
-         GO TO 40
-*
-*        Eigenvalue found.
-*
-   80    CONTINUE
-         D( L ) = P
-*
-         L = L + 1
-         IF( L.LE.LEND )
-     $      GO TO 40
-         GO TO 140
-*
-      ELSE
-*
-*        QR Iteration
-*
-*        Look for small superdiagonal element.
-*
-   90    CONTINUE
-         IF( L.NE.LEND ) THEN
-            LENDP1 = LEND + 1
-            DO 100 M = L, LENDP1, -1
-               TST = ABS( E( M-1 ) )**2
-               IF( TST.LE.( EPS2*ABS( D( M ) ) )*ABS( D( M-1 ) )+
-     $             SAFMIN )GO TO 110
-  100       CONTINUE
-         END IF
-*
-         M = LEND
-*
-  110    CONTINUE
-         IF( M.GT.LEND )
-     $      E( M-1 ) = ZERO
-         P = D( L )
-         IF( M.EQ.L )
-     $      GO TO 130
-*
-*        If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
-*        to compute its eigensystem.
-*
-         IF( M.EQ.L-1 ) THEN
-            IF( ICOMPZ.GT.0 ) THEN
-               CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, S )
-               WORK( M ) = C
-               WORK( N-1+M ) = S
-               CALL DLASR( 'R', 'V', 'F', N, 2, WORK( M ),
-     $                     WORK( N-1+M ), Z( 1, L-1 ), LDZ )
-            ELSE
-               CALL DLAE2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2 )
-            END IF
-            D( L-1 ) = RT1
-            D( L ) = RT2
-            E( L-1 ) = ZERO
-            L = L - 2
-            IF( L.GE.LEND )
-     $         GO TO 90
-            GO TO 140
-         END IF
-*
-         IF( JTOT.EQ.NMAXIT )
-     $      GO TO 140
-         JTOT = JTOT + 1
-*
-*        Form shift.
-*
-         G = ( D( L-1 )-P ) / ( TWO*E( L-1 ) )
-         R = DLAPY2( G, ONE )
-         G = D( M ) - P + ( E( L-1 ) / ( G+SIGN( R, G ) ) )
-*
-         S = ONE
-         C = ONE
-         P = ZERO
-*
-*        Inner loop
-*
-         LM1 = L - 1
-         DO 120 I = M, LM1
-            F = S*E( I )
-            B = C*E( I )
-            CALL DLARTG( G, F, C, S, R )
-            IF( I.NE.M )
-     $         E( I-1 ) = R
-            G = D( I ) - P
-            R = ( D( I+1 )-G )*S + TWO*C*B
-            P = S*R
-            D( I ) = G + P
-            G = C*R - B
-*
-*           If eigenvectors are desired, then save rotations.
-*
-            IF( ICOMPZ.GT.0 ) THEN
-               WORK( I ) = C
-               WORK( N-1+I ) = S
-            END IF
-*
-  120    CONTINUE
-*
-*        If eigenvectors are desired, then apply saved rotations.
-*
-         IF( ICOMPZ.GT.0 ) THEN
-            MM = L - M + 1
-            CALL DLASR( 'R', 'V', 'F', N, MM, WORK( M ), WORK( N-1+M ),
-     $                  Z( 1, M ), LDZ )
-         END IF
-*
-         D( L ) = D( L ) - P
-         E( LM1 ) = G
-         GO TO 90
-*
-*        Eigenvalue found.
-*
-  130    CONTINUE
-         D( L ) = P
-*
-         L = L - 1
-         IF( L.GE.LEND )
-     $      GO TO 90
-         GO TO 140
-*
-      END IF
-*
-*     Undo scaling if necessary
-*
-  140 CONTINUE
-      IF( ISCALE.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1,
-     $                D( LSV ), N, INFO )
-         CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E( LSV ),
-     $                N, INFO )
-      ELSE IF( ISCALE.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1,
-     $                D( LSV ), N, INFO )
-         CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E( LSV ),
-     $                N, INFO )
-      END IF
-*
-*     Check for no convergence to an eigenvalue after a total
-*     of N*MAXIT iterations.
-*
-      IF( JTOT.LT.NMAXIT )
-     $   GO TO 10
-      DO 150 I = 1, N - 1
-         IF( E( I ).NE.ZERO )
-     $      INFO = INFO + 1
-  150 CONTINUE
-      GO TO 190
-*
-*     Order eigenvalues and eigenvectors.
-*
-  160 CONTINUE
-      IF( ICOMPZ.EQ.0 ) THEN
-*
-*        Use Quick Sort
-*
-         CALL DLASRT( 'I', N, D, INFO )
-*
-      ELSE
-*
-*        Use Selection Sort to minimize swaps of eigenvectors
-*
-         DO 180 II = 2, N
-            I = II - 1
-            K = I
-            P = D( I )
-            DO 170 J = II, N
-               IF( D( J ).LT.P ) THEN
-                  K = J
-                  P = D( J )
-               END IF
-  170       CONTINUE
-            IF( K.NE.I ) THEN
-               D( K ) = D( I )
-               D( I ) = P
-               CALL DSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 )
-            END IF
-  180    CONTINUE
-      END IF
-*
-  190 CONTINUE
-      RETURN
-*
-*     End of DSTEQR
-*
-      END
diff --git a/src/lib/lapack/dsterf.f b/src/lib/lapack/dsterf.f
deleted file mode 100644
index c17ea23a..00000000
--- a/src/lib/lapack/dsterf.f
+++ /dev/null
@@ -1,364 +0,0 @@
-      SUBROUTINE DSTERF( N, D, E, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSTERF computes all eigenvalues of a symmetric tridiagonal matrix
-*  using the Pal-Walker-Kahan variant of the QL or QR algorithm.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix.  N >= 0.
-*
-*  D       (input/output) DOUBLE PRECISION array, dimension (N)
-*          On entry, the n diagonal elements of the tridiagonal matrix.
-*          On exit, if INFO = 0, the eigenvalues in ascending order.
-*
-*  E       (input/output) DOUBLE PRECISION array, dimension (N-1)
-*          On entry, the (n-1) subdiagonal elements of the tridiagonal
-*          matrix.
-*          On exit, E has been destroyed.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  the algorithm failed to find all of the eigenvalues in
-*                a total of 30*N iterations; if INFO = i, then i
-*                elements of E have not converged to zero.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE, TWO, THREE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
-     $                   THREE = 3.0D0 )
-      INTEGER            MAXIT
-      PARAMETER          ( MAXIT = 30 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ISCALE, JTOT, L, L1, LEND, LENDSV, LSV, M,
-     $                   NMAXIT
-      DOUBLE PRECISION   ALPHA, ANORM, BB, C, EPS, EPS2, GAMMA, OLDC,
-     $                   OLDGAM, P, R, RT1, RT2, RTE, S, SAFMAX, SAFMIN,
-     $                   SIGMA, SSFMAX, SSFMIN
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH, DLANST, DLAPY2
-      EXTERNAL           DLAMCH, DLANST, DLAPY2
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLAE2, DLASCL, DLASRT, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, SIGN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-*
-*     Quick return if possible
-*
-      IF( N.LT.0 ) THEN
-         INFO = -1
-         CALL XERBLA( 'DSTERF', -INFO )
-         RETURN
-      END IF
-      IF( N.LE.1 )
-     $   RETURN
-*
-*     Determine the unit roundoff for this environment.
-*
-      EPS = DLAMCH( 'E' )
-      EPS2 = EPS**2
-      SAFMIN = DLAMCH( 'S' )
-      SAFMAX = ONE / SAFMIN
-      SSFMAX = SQRT( SAFMAX ) / THREE
-      SSFMIN = SQRT( SAFMIN ) / EPS2
-*
-*     Compute the eigenvalues of the tridiagonal matrix.
-*
-      NMAXIT = N*MAXIT
-      SIGMA = ZERO
-      JTOT = 0
-*
-*     Determine where the matrix splits and choose QL or QR iteration
-*     for each block, according to whether top or bottom diagonal
-*     element is smaller.
-*
-      L1 = 1
-*
-   10 CONTINUE
-      IF( L1.GT.N )
-     $   GO TO 170
-      IF( L1.GT.1 )
-     $   E( L1-1 ) = ZERO
-      DO 20 M = L1, N - 1
-         IF( ABS( E( M ) ).LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
-     $       1 ) ) ) )*EPS ) THEN
-            E( M ) = ZERO
-            GO TO 30
-         END IF
-   20 CONTINUE
-      M = N
-*
-   30 CONTINUE
-      L = L1
-      LSV = L
-      LEND = M
-      LENDSV = LEND
-      L1 = M + 1
-      IF( LEND.EQ.L )
-     $   GO TO 10
-*
-*     Scale submatrix in rows and columns L to LEND
-*
-      ANORM = DLANST( 'I', LEND-L+1, D( L ), E( L ) )
-      ISCALE = 0
-      IF( ANORM.GT.SSFMAX ) THEN
-         ISCALE = 1
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N,
-     $                INFO )
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N,
-     $                INFO )
-      ELSE IF( ANORM.LT.SSFMIN ) THEN
-         ISCALE = 2
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N,
-     $                INFO )
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N,
-     $                INFO )
-      END IF
-*
-      DO 40 I = L, LEND - 1
-         E( I ) = E( I )**2
-   40 CONTINUE
-*
-*     Choose between QL and QR iteration
-*
-      IF( ABS( D( LEND ) ).LT.ABS( D( L ) ) ) THEN
-         LEND = LSV
-         L = LENDSV
-      END IF
-*
-      IF( LEND.GE.L ) THEN
-*
-*        QL Iteration
-*
-*        Look for small subdiagonal element.
-*
-   50    CONTINUE
-         IF( L.NE.LEND ) THEN
-            DO 60 M = L, LEND - 1
-               IF( ABS( E( M ) ).LE.EPS2*ABS( D( M )*D( M+1 ) ) )
-     $            GO TO 70
-   60       CONTINUE
-         END IF
-         M = LEND
-*
-   70    CONTINUE
-         IF( M.LT.LEND )
-     $      E( M ) = ZERO
-         P = D( L )
-         IF( M.EQ.L )
-     $      GO TO 90
-*
-*        If remaining matrix is 2 by 2, use DLAE2 to compute its
-*        eigenvalues.
-*
-         IF( M.EQ.L+1 ) THEN
-            RTE = SQRT( E( L ) )
-            CALL DLAE2( D( L ), RTE, D( L+1 ), RT1, RT2 )
-            D( L ) = RT1
-            D( L+1 ) = RT2
-            E( L ) = ZERO
-            L = L + 2
-            IF( L.LE.LEND )
-     $         GO TO 50
-            GO TO 150
-         END IF
-*
-         IF( JTOT.EQ.NMAXIT )
-     $      GO TO 150
-         JTOT = JTOT + 1
-*
-*        Form shift.
-*
-         RTE = SQRT( E( L ) )
-         SIGMA = ( D( L+1 )-P ) / ( TWO*RTE )
-         R = DLAPY2( SIGMA, ONE )
-         SIGMA = P - ( RTE / ( SIGMA+SIGN( R, SIGMA ) ) )
-*
-         C = ONE
-         S = ZERO
-         GAMMA = D( M ) - SIGMA
-         P = GAMMA*GAMMA
-*
-*        Inner loop
-*
-         DO 80 I = M - 1, L, -1
-            BB = E( I )
-            R = P + BB
-            IF( I.NE.M-1 )
-     $         E( I+1 ) = S*R
-            OLDC = C
-            C = P / R
-            S = BB / R
-            OLDGAM = GAMMA
-            ALPHA = D( I )
-            GAMMA = C*( ALPHA-SIGMA ) - S*OLDGAM
-            D( I+1 ) = OLDGAM + ( ALPHA-GAMMA )
-            IF( C.NE.ZERO ) THEN
-               P = ( GAMMA*GAMMA ) / C
-            ELSE
-               P = OLDC*BB
-            END IF
-   80    CONTINUE
-*
-         E( L ) = S*P
-         D( L ) = SIGMA + GAMMA
-         GO TO 50
-*
-*        Eigenvalue found.
-*
-   90    CONTINUE
-         D( L ) = P
-*
-         L = L + 1
-         IF( L.LE.LEND )
-     $      GO TO 50
-         GO TO 150
-*
-      ELSE
-*
-*        QR Iteration
-*
-*        Look for small superdiagonal element.
-*
-  100    CONTINUE
-         DO 110 M = L, LEND + 1, -1
-            IF( ABS( E( M-1 ) ).LE.EPS2*ABS( D( M )*D( M-1 ) ) )
-     $         GO TO 120
-  110    CONTINUE
-         M = LEND
-*
-  120    CONTINUE
-         IF( M.GT.LEND )
-     $      E( M-1 ) = ZERO
-         P = D( L )
-         IF( M.EQ.L )
-     $      GO TO 140
-*
-*        If remaining matrix is 2 by 2, use DLAE2 to compute its
-*        eigenvalues.
-*
-         IF( M.EQ.L-1 ) THEN
-            RTE = SQRT( E( L-1 ) )
-            CALL DLAE2( D( L ), RTE, D( L-1 ), RT1, RT2 )
-            D( L ) = RT1
-            D( L-1 ) = RT2
-            E( L-1 ) = ZERO
-            L = L - 2
-            IF( L.GE.LEND )
-     $         GO TO 100
-            GO TO 150
-         END IF
-*
-         IF( JTOT.EQ.NMAXIT )
-     $      GO TO 150
-         JTOT = JTOT + 1
-*
-*        Form shift.
-*
-         RTE = SQRT( E( L-1 ) )
-         SIGMA = ( D( L-1 )-P ) / ( TWO*RTE )
-         R = DLAPY2( SIGMA, ONE )
-         SIGMA = P - ( RTE / ( SIGMA+SIGN( R, SIGMA ) ) )
-*
-         C = ONE
-         S = ZERO
-         GAMMA = D( M ) - SIGMA
-         P = GAMMA*GAMMA
-*
-*        Inner loop
-*
-         DO 130 I = M, L - 1
-            BB = E( I )
-            R = P + BB
-            IF( I.NE.M )
-     $         E( I-1 ) = S*R
-            OLDC = C
-            C = P / R
-            S = BB / R
-            OLDGAM = GAMMA
-            ALPHA = D( I+1 )
-            GAMMA = C*( ALPHA-SIGMA ) - S*OLDGAM
-            D( I ) = OLDGAM + ( ALPHA-GAMMA )
-            IF( C.NE.ZERO ) THEN
-               P = ( GAMMA*GAMMA ) / C
-            ELSE
-               P = OLDC*BB
-            END IF
-  130    CONTINUE
-*
-         E( L-1 ) = S*P
-         D( L ) = SIGMA + GAMMA
-         GO TO 100
-*
-*        Eigenvalue found.
-*
-  140    CONTINUE
-         D( L ) = P
-*
-         L = L - 1
-         IF( L.GE.LEND )
-     $      GO TO 100
-         GO TO 150
-*
-      END IF
-*
-*     Undo scaling if necessary
-*
-  150 CONTINUE
-      IF( ISCALE.EQ.1 )
-     $   CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1,
-     $                D( LSV ), N, INFO )
-      IF( ISCALE.EQ.2 )
-     $   CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1,
-     $                D( LSV ), N, INFO )
-*
-*     Check for no convergence to an eigenvalue after a total
-*     of N*MAXIT iterations.
-*
-      IF( JTOT.LT.NMAXIT )
-     $   GO TO 10
-      DO 160 I = 1, N - 1
-         IF( E( I ).NE.ZERO )
-     $      INFO = INFO + 1
-  160 CONTINUE
-      GO TO 180
-*
-*     Sort eigenvalues in increasing order.
-*
-  170 CONTINUE
-      CALL DLASRT( 'I', N, D, INFO )
-*
-  180 CONTINUE
-      RETURN
-*
-*     End of DSTERF
-*
-      END
diff --git a/src/lib/lapack/dsycon.f b/src/lib/lapack/dsycon.f
deleted file mode 100644
index 711b48ca..00000000
--- a/src/lib/lapack/dsycon.f
+++ /dev/null
@@ -1,165 +0,0 @@
-      SUBROUTINE DSYCON( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK,
-     $                   IWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     Modified to call DLACN2 in place of DLACON, 5 Feb 03, SJH.
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, N
-      DOUBLE PRECISION   ANORM, RCOND
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * ), IWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSYCON estimates the reciprocal of the condition number (in the
-*  1-norm) of a real symmetric matrix A using the factorization
-*  A = U*D*U**T or A = L*D*L**T computed by DSYTRF.
-*
-*  An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*  condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) 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*D*U**T;
-*          = 'L':  Lower triangular, form is A = L*D*L**T.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The block diagonal matrix D and the multipliers used to
-*          obtain the factor U or L as computed by DSYTRF.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (input) INTEGER array, dimension (N)
-*          Details of the interchanges and the block structure of D
-*          as determined by DSYTRF.
-*
-*  ANORM   (input) DOUBLE PRECISION
-*          The 1-norm of the original matrix A.
-*
-*  RCOND   (output) 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.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (2*N)
-*
-*  IWORK    (workspace) INTEGER array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. 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, 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 = -6
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSYCON', -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 10 I = N, 1, -1
-            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
-     $         RETURN
-   10    CONTINUE
-      ELSE
-*
-*        Lower triangular storage: examine D from top to bottom.
-*
-         DO 20 I = 1, N
-            IF( IPIV( I ).GT.0 .AND. A( I, I ).EQ.ZERO )
-     $         RETURN
-   20    CONTINUE
-      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') or inv(U*D*U').
-*
-         CALL DSYTRS( UPLO, N, 1, A, LDA, 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
-*
-      END
diff --git a/src/lib/lapack/dsyev.f b/src/lib/lapack/dsyev.f
deleted file mode 100644
index d73600a2..00000000
--- a/src/lib/lapack/dsyev.f
+++ /dev/null
@@ -1,211 +0,0 @@
-      SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBZ, UPLO
-      INTEGER            INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSYEV computes all eigenvalues and, optionally, eigenvectors of a
-*  real symmetric matrix A.
-*
-*  Arguments
-*  =========
-*
-*  JOBZ    (input) CHARACTER*1
-*          = 'N':  Compute eigenvalues only;
-*          = 'V':  Compute eigenvalues and eigenvectors.
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  W       (output) DOUBLE PRECISION array, dimension (N)
-*          If INFO = 0, the eigenvalues in ascending order.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The length of the array WORK.  LWORK >= max(1,3*N-1).
-*          For optimal efficiency, LWORK >= (NB+2)*N,
-*          where NB is the blocksize for DSYTRD 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.
-*
-*  INFO    (output) 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.
-*
-*  =====================================================================
-*
-*     .. 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, LWKOPT, NB
-      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, DSYTRD,
-     $                   XERBLA
-*     ..
-*     .. 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.( WANTZ .OR. 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
-         NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
-         LWKOPT = MAX( 1, ( NB+2 )*N )
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, 3*N-1 ) .AND. .NOT.LQUERY )
-     $      INFO = -8
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSYEV ', -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 to reduce symmetric matrix to tridiagonal form.
-*
-      INDE = 1
-      INDTAU = INDE + N
-      INDWRK = INDTAU + N
-      LLWORK = LWORK - INDWRK + 1
-      CALL DSYTRD( UPLO, N, A, LDA, W, WORK( INDE ), WORK( INDTAU ),
-     $             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
-         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 ) = LWKOPT
-*
-      RETURN
-*
-*     End of DSYEV
-*
-      END
diff --git a/src/lib/lapack/dsysv.f b/src/lib/lapack/dsysv.f
deleted file mode 100644
index add53850..00000000
--- a/src/lib/lapack/dsysv.f
+++ /dev/null
@@ -1,174 +0,0 @@
-      SUBROUTINE DSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
-     $                  LWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, LDB, LWORK, N, NRHS
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSYSV 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 diagonal pivoting method is used to factor A as
-*     A = U * D * U**T,  if UPLO = 'U', or
-*     A = L * D * L**T,  if UPLO = 'L',
-*  where U (or L) is a product of permutation and unit upper (lower)
-*  triangular matrices, and D is symmetric and block diagonal with
-*  1-by-1 and 2-by-2 diagonal blocks.  The factored form of A is then
-*  used to solve the system of equations A * X = B.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The number of linear equations, i.e., the order of the
-*          matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of columns
-*          of the matrix B.  NRHS >= 0.
-*
-*  A       (input/output) 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, the block diagonal matrix D and the
-*          multipliers used to obtain the factor U or L from the
-*          factorization A = U*D*U**T or A = L*D*L**T as computed by
-*          DSYTRF.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (output) INTEGER array, dimension (N)
-*          Details of the interchanges and the block structure of D, as
-*          determined by DSYTRF.  If IPIV(k) > 0, then rows and columns
-*          k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
-*          diagonal block.  If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
-*          then rows and columns k-1 and -IPIV(k) were interchanged and
-*          D(k-1:k,k-1:k) is a 2-by-2 diagonal block.  If UPLO = 'L' and
-*          IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
-*          -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
-*          diagonal block.
-*
-*  B       (input/output) 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.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The length of WORK.  LWORK >= 1, and for best performance
-*          LWORK >= max(1,N*NB), where NB is the optimal blocksize for
-*          DSYTRF.
-*
-*          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.
-*
-*  INFO    (output) 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.
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            LWKOPT, NB
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSYTRF, DSYTRS, XERBLA
-*     ..
-*     .. 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.1 .AND. .NOT.LQUERY ) THEN
-         INFO = -10
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( N.EQ.0 ) THEN
-            LWKOPT = 1
-         ELSE
-            NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 )
-            LWKOPT = N*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSYSV ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Compute the factorization A = U*D*U' or A = L*D*L'.
-*
-      CALL DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
-      IF( INFO.EQ.0 ) THEN
-*
-*        Solve the system A*X = B, overwriting B with X.
-*
-         CALL DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-      END IF
-*
-      WORK( 1 ) = LWKOPT
-*
-      RETURN
-*
-*     End of DSYSV
-*
-      END
diff --git a/src/lib/lapack/dsytd2.f b/src/lib/lapack/dsytd2.f
deleted file mode 100644
index c696818e..00000000
--- a/src/lib/lapack/dsytd2.f
+++ /dev/null
@@ -1,248 +0,0 @@
-      SUBROUTINE DSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), D( * ), E( * ), TAU( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal
-*  form T by an orthogonal similarity transformation: Q' * A * Q = T.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          symmetric matrix A is stored:
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  D       (output) DOUBLE PRECISION array, dimension (N)
-*          The diagonal elements of the tridiagonal matrix T:
-*          D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (N-1)
-*          The off-diagonal elements of the tridiagonal matrix T:
-*          E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (N-1)
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  If UPLO = 'U', the matrix Q is represented as a product of elementary
-*  reflectors
-*
-*     Q = H(n-1) . . . H(2) H(1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
-*  A(1:i-1,i+1), 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(n-1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+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':
-*
-*    (  d   e   v2  v3  v4 )              (  d                  )
-*    (      d   e   v3  v4 )              (  e   d              )
-*    (          d   e   v4 )              (  v1  e   d          )
-*    (              d   e  )              (  v1  v2  e   d      )
-*    (                  d  )              (  v1  v2  v3  e   d  )
-*
-*  where d and e denote diagonal and off-diagonal elements of T, and vi
-*  denotes an element of the vector defining H(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO, HALF
-      PARAMETER          ( ONE = 1.0D0, ZERO = 0.0D0,
-     $                   HALF = 1.0D0 / 2.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            I
-      DOUBLE PRECISION   ALPHA, TAUI
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DLARFG, DSYMV, DSYR2, XERBLA
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DDOT
-      EXTERNAL           LSAME, DDOT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. 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( 'DSYTD2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-      IF( UPPER ) THEN
-*
-*        Reduce the upper triangle of A
-*
-         DO 10 I = N - 1, 1, -1
-*
-*           Generate elementary reflector H(i) = I - tau * v * v'
-*           to annihilate A(1:i-1,i+1)
-*
-            CALL DLARFG( I, A( I, I+1 ), A( 1, I+1 ), 1, TAUI )
-            E( I ) = A( I, I+1 )
-*
-            IF( TAUI.NE.ZERO ) THEN
-*
-*              Apply H(i) from both sides to A(1:i,1:i)
-*
-               A( I, I+1 ) = ONE
-*
-*              Compute  x := tau * A * v  storing x in TAU(1:i)
-*
-               CALL DSYMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO,
-     $                     TAU, 1 )
-*
-*              Compute  w := x - 1/2 * tau * (x'*v) * v
-*
-               ALPHA = -HALF*TAUI*DDOT( I, TAU, 1, A( 1, I+1 ), 1 )
-               CALL DAXPY( I, ALPHA, A( 1, I+1 ), 1, TAU, 1 )
-*
-*              Apply the transformation as a rank-2 update:
-*                 A := A - v * w' - w * v'
-*
-               CALL DSYR2( UPLO, I, -ONE, A( 1, I+1 ), 1, TAU, 1, A,
-     $                     LDA )
-*
-               A( I, I+1 ) = E( I )
-            END IF
-            D( I+1 ) = A( I+1, I+1 )
-            TAU( I ) = TAUI
-   10    CONTINUE
-         D( 1 ) = A( 1, 1 )
-      ELSE
-*
-*        Reduce the lower triangle of A
-*
-         DO 20 I = 1, N - 1
-*
-*           Generate elementary reflector H(i) = I - tau * v * v'
-*           to annihilate A(i+2:n,i)
-*
-            CALL DLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
-     $                   TAUI )
-            E( I ) = A( I+1, I )
-*
-            IF( TAUI.NE.ZERO ) THEN
-*
-*              Apply H(i) from both sides to A(i+1:n,i+1:n)
-*
-               A( I+1, I ) = ONE
-*
-*              Compute  x := tau * A * v  storing y in TAU(i:n-1)
-*
-               CALL DSYMV( UPLO, N-I, TAUI, A( I+1, I+1 ), LDA,
-     $                     A( I+1, I ), 1, ZERO, TAU( I ), 1 )
-*
-*              Compute  w := x - 1/2 * tau * (x'*v) * v
-*
-               ALPHA = -HALF*TAUI*DDOT( N-I, TAU( I ), 1, A( I+1, I ),
-     $                 1 )
-               CALL DAXPY( N-I, ALPHA, A( I+1, I ), 1, TAU( I ), 1 )
-*
-*              Apply the transformation as a rank-2 update:
-*                 A := A - v * w' - w * v'
-*
-               CALL DSYR2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1,
-     $                     A( I+1, I+1 ), LDA )
-*
-               A( I+1, I ) = E( I )
-            END IF
-            D( I ) = A( I, I )
-            TAU( I ) = TAUI
-   20    CONTINUE
-         D( N ) = A( N, N )
-      END IF
-*
-      RETURN
-*
-*     End of DSYTD2
-*
-      END
diff --git a/src/lib/lapack/dsytf2.f b/src/lib/lapack/dsytf2.f
deleted file mode 100644
index d5234625..00000000
--- a/src/lib/lapack/dsytf2.f
+++ /dev/null
@@ -1,521 +0,0 @@
-      SUBROUTINE DSYTF2( UPLO, N, A, LDA, IPIV, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSYTF2 computes the factorization of a real symmetric matrix A using
-*  the Bunch-Kaufman diagonal pivoting method:
-*
-*     A = U*D*U'  or  A = L*D*L'
-*
-*  where U (or L) is a product of permutation and unit upper (lower)
-*  triangular matrices, U' is the transpose of U, 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.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          symmetric matrix A is stored:
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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, the block diagonal matrix D and the multipliers used
-*          to obtain the factor U or L (see below for further details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (output) INTEGER array, dimension (N)
-*          Details of the interchanges and the block structure of D.
-*          If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*          interchanged and D(k,k) is a 1-by-1 diagonal block.
-*          If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*          columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*          is a 2-by-2 diagonal block.  If UPLO = 'L' and IPIV(k) =
-*          IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*          interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -k, the k-th argument had an illegal value
-*          > 0: if INFO = k, D(k,k) 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.
-*
-*  Further Details
-*  ===============
-*
-*  09-29-06 - patch from
-*    Bobby Cheng, MathWorks
-*
-*    Replace l.204 and l.372
-*         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN
-*    by
-*         IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN
-*
-*  01-01-96 - Based on modifications by
-*    J. Lewis, Boeing Computer Services Company
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*  1-96 - Based on modifications by J. Lewis, Boeing Computer Services
-*         Company
-*
-*  If UPLO = 'U', then A = U*D*U', where
-*     U = P(n)*U(n)* ... *P(k)U(k)* ...,
-*  i.e., U is a product of terms P(k)*U(k), where k decreases from n to
-*  1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*  and 2-by-2 diagonal blocks D(k).  P(k) is a permutation matrix as
-*  defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
-*  that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*
-*             (   I    v    0   )   k-s
-*     U(k) =  (   0    I    0   )   s
-*             (   0    0    I   )   n-k
-*                k-s   s   n-k
-*
-*  If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
-*  If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
-*  and A(k,k), and v overwrites A(1:k-2,k-1:k).
-*
-*  If UPLO = 'L', then A = L*D*L', where
-*     L = P(1)*L(1)* ... *P(k)*L(k)* ...,
-*  i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
-*  n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*  and 2-by-2 diagonal blocks D(k).  P(k) is a permutation matrix as
-*  defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
-*  that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*
-*             (   I    0     0   )  k-1
-*     L(k) =  (   0    I     0   )  s
-*             (   0    v     I   )  n-k-s+1
-*                k-1   s  n-k-s+1
-*
-*  If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
-*  If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
-*  and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
-*
-*  =====================================================================
-*
-*     .. 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
-      INTEGER            I, IMAX, J, JMAX, K, KK, KP, KSTEP
-      DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22, R1,
-     $                   ROWMAX, T, WK, WKM1, WKP1
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME, DISNAN
-      INTEGER            IDAMAX
-      EXTERNAL           LSAME, IDAMAX, DISNAN
-*     ..
-*     .. 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', -INFO )
-         RETURN
-      END IF
-*
-*     Initialize ALPHA for use in choosing pivot block size.
-*
-      ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT
-*
-      IF( UPPER ) THEN
-*
-*        Factorize A as U*D*U' using the upper triangle of A
-*
-*        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 70
-         KSTEP = 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( A( K, K ) )
-*
-*        IMAX is the row-index of the largest off-diagonal element in
-*        column K, and COLMAX is its absolute value
-*
-         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) .OR. DISNAN(ABSAKK) ) THEN
-*
-*           Column K is zero or contains a NaN: set INFO and continue
-*
-            IF( INFO.EQ.0 )
-     $         INFO = K
-            KP = K
-         ELSE
-            IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-*              no interchange, use 1-by-1 pivot block
-*
-               KP = K
-            ELSE
-*
-*              JMAX is the column-index of the largest off-diagonal
-*              element in row IMAX, and ROWMAX is its absolute value
-*
-               JMAX = IMAX + IDAMAX( K-IMAX, A( IMAX, IMAX+1 ), LDA )
-               ROWMAX = ABS( A( IMAX, JMAX ) )
-               IF( IMAX.GT.1 ) THEN
-                  JMAX = IDAMAX( IMAX-1, A( 1, IMAX ), 1 )
-                  ROWMAX = MAX( ROWMAX, ABS( A( JMAX, IMAX ) ) )
-               END IF
-*
-               IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-*                 no interchange, use 1-by-1 pivot block
-*
-                  KP = K
-               ELSE IF( ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX ) THEN
-*
-*                 interchange rows and columns K and IMAX, use 1-by-1
-*                 pivot block
-*
-                  KP = IMAX
-               ELSE
-*
-*                 interchange rows and columns K-1 and IMAX, use 2-by-2
-*                 pivot block
-*
-                  KP = IMAX
-                  KSTEP = 2
-               END IF
-            END IF
-*
-            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)
-*
-               CALL DSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 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
-            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
-*
-*              Perform a rank-1 update of A(1:k-1,1:k-1) as
-*
-*              A := A - U(k)*D(k)*U(k)' = A - W(k)*1/D(k)*W(k)'
-*
-               R1 = ONE / A( K, K )
-               CALL DSYR( UPLO, K-1, -R1, A( 1, K ), 1, A, LDA )
-*
-*              Store U(k) in column k
-*
-               CALL DSCAL( K-1, R1, A( 1, K ), 1 )
-            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) )'
-*                 = A - ( W(k-1) W(k) )*inv(D(k))*( W(k-1) W(k) )'
-*
-               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 )
-                  D12 = T / D12
-*
-                  DO 30 J = K - 2, 1, -1
-                     WKM1 = D12*( D11*A( J, K-1 )-A( J, K ) )
-                     WK = D12*( D22*A( J, K )-A( J, K-1 ) )
-                     DO 20 I = J, 1, -1
-                        A( I, J ) = A( I, J ) - A( I, K )*WK -
-     $                              A( I, K-1 )*WKM1
-   20                CONTINUE
-                     A( J, K ) = WK
-                     A( J, K-1 ) = WKM1
-   30             CONTINUE
-*
-               END IF
-*
-            END IF
-         END IF
-*
-*        Store details of the interchanges in IPIV
-*
-         IF( KSTEP.EQ.1 ) THEN
-            IPIV( K ) = KP
-         ELSE
-            IPIV( K ) = -KP
-            IPIV( K-1 ) = -KP
-         END IF
-*
-*        Decrease K and return to the start of the main loop
-*
-         K = K - KSTEP
-         GO TO 10
-*
-      ELSE
-*
-*        Factorize A as L*D*L' using the lower triangle of A
-*
-*        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 70
-         KSTEP = 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( A( K, K ) )
-*
-*        IMAX is the row-index of the largest off-diagonal element in
-*        column K, and COLMAX is its absolute value
-*
-         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) .OR. DISNAN(ABSAKK) ) THEN
-*
-*           Column K is zero or contains a NaN: set INFO and continue
-*
-            IF( INFO.EQ.0 )
-     $         INFO = K
-            KP = K
-         ELSE
-            IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
-*
-*              no interchange, use 1-by-1 pivot block
-*
-               KP = K
-            ELSE
-*
-*              JMAX is the column-index of the largest off-diagonal
-*              element in row IMAX, and ROWMAX is its absolute value
-*
-               JMAX = K - 1 + IDAMAX( IMAX-K, A( IMAX, K ), LDA )
-               ROWMAX = ABS( A( IMAX, JMAX ) )
-               IF( IMAX.LT.N ) THEN
-                  JMAX = IMAX + IDAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 )
-                  ROWMAX = MAX( ROWMAX, ABS( A( JMAX, IMAX ) ) )
-               END IF
-*
-               IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
-*
-*                 no interchange, use 1-by-1 pivot block
-*
-                  KP = K
-               ELSE IF( ABS( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX ) THEN
-*
-*                 interchange rows and columns K and IMAX, use 1-by-1
-*                 pivot block
-*
-                  KP = IMAX
-               ELSE
-*
-*                 interchange rows and columns K+1 and IMAX, use 2-by-2
-*                 pivot block
-*
-                  KP = IMAX
-                  KSTEP = 2
-               END IF
-            END IF
-*
-            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 )
-               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
-            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) as
-*
-*                 A := A - L(k)*D(k)*L(k)' = A - W(k)*(1/D(k))*W(k)'
-*
-                  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 )
-               END IF
-            ELSE
-*
-*              2-by-2 pivot block D(k)
-*
-               IF( K.LT.N-1 ) THEN
-*
-*                 Perform a rank-2 update of A(k+2:n,k+2:n) as
-*
-*                 A := A - ( (A(k) A(k+1))*D(k)**(-1) ) * (A(k) A(k+1))'
-*
-*                 where L(k) and L(k+1) are the k-th and (k+1)-th
-*                 columns of L
-*
-                  D21 = A( K+1, K )
-                  D11 = A( K+1, K+1 ) / D21
-                  D22 = A( K, K ) / D21
-                  T = ONE / ( D11*D22-ONE )
-                  D21 = T / D21
-*
-                  DO 60 J = K + 2, N
-*
-                     WK = D21*( D11*A( J, K )-A( J, K+1 ) )
-                     WKP1 = D21*( D22*A( J, K+1 )-A( J, K ) )
-*
-                     DO 50 I = J, N
-                        A( I, J ) = A( I, J ) - A( I, K )*WK -
-     $                              A( I, K+1 )*WKP1
-   50                CONTINUE
-*
-                     A( J, K ) = WK
-                     A( J, K+1 ) = WKP1
-*
-   60             CONTINUE
-               END IF
-            END IF
-         END IF
-*
-*        Store details of the interchanges in IPIV
-*
-         IF( KSTEP.EQ.1 ) THEN
-            IPIV( K ) = KP
-         ELSE
-            IPIV( K ) = -KP
-            IPIV( K+1 ) = -KP
-         END IF
-*
-*        Increase K and return to the start of the main loop
-*
-         K = K + KSTEP
-         GO TO 40
-*
-      END IF
-*
-   70 CONTINUE
-*
-      RETURN
-*
-*     End of DSYTF2
-*
-      END
diff --git a/src/lib/lapack/dsytrd.f b/src/lib/lapack/dsytrd.f
deleted file mode 100644
index 569ee35b..00000000
--- a/src/lib/lapack/dsytrd.f
+++ /dev/null
@@ -1,294 +0,0 @@
-      SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), D( * ), E( * ), TAU( * ),
-     $                   WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSYTRD reduces a real symmetric matrix A to real symmetric
-*  tridiagonal form T by an orthogonal similarity transformation:
-*  Q**T * A * Q = T.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  D       (output) DOUBLE PRECISION array, dimension (N)
-*          The diagonal elements of the tridiagonal matrix T:
-*          D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (N-1)
-*          The off-diagonal elements of the tridiagonal matrix T:
-*          E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (N-1)
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= 1.
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  If UPLO = 'U', the matrix Q is represented as a product of elementary
-*  reflectors
-*
-*     Q = H(n-1) . . . H(2) H(1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
-*  A(1:i-1,i+1), 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(n-1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real scalar, and v is a real vector with
-*  v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+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':
-*
-*    (  d   e   v2  v3  v4 )              (  d                  )
-*    (      d   e   v3  v4 )              (  e   d              )
-*    (          d   e   v4 )              (  v1  e   d          )
-*    (              d   e  )              (  v1  v2  e   d      )
-*    (                  d  )              (  v1  v2  v3  e   d  )
-*
-*  where d and e denote diagonal and off-diagonal elements of T, and vi
-*  denotes an element of the vector defining H(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, UPPER
-      INTEGER            I, IINFO, IWS, J, KK, LDWORK, LWKOPT, NB,
-     $                   NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLATRD, DSYR2K, DSYTD2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. 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 = -9
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-*
-*        Determine the block size.
-*
-         NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 )
-         LWKOPT = N*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSYTRD', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NX = N
-      IWS = 1
-      IF( NB.GT.1 .AND. NB.LT.N ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code
-*        (last block is always handled by unblocked code).
-*
-         NX = MAX( NB, ILAENV( 3, 'DSYTRD', UPLO, N, -1, -1, -1 ) )
-         IF( NX.LT.N ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = N
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  determine the
-*              minimum value of NB, and reduce NB or force use of
-*              unblocked code by setting NX = N.
-*
-               NB = MAX( LWORK / LDWORK, 1 )
-               NBMIN = ILAENV( 2, 'DSYTRD', UPLO, N, -1, -1, -1 )
-               IF( NB.LT.NBMIN )
-     $            NX = N
-            END IF
-         ELSE
-            NX = N
-         END IF
-      ELSE
-         NB = 1
-      END IF
-*
-      IF( UPPER ) THEN
-*
-*        Reduce the upper triangle of A.
-*        Columns 1:kk are handled by the unblocked method.
-*
-         KK = N - ( ( N-NX+NB-1 ) / NB )*NB
-         DO 20 I = N - NB + 1, KK + 1, -NB
-*
-*           Reduce columns i:i+nb-1 to tridiagonal form and form the
-*           matrix W which is needed to update the unreduced part of
-*           the matrix
-*
-            CALL DLATRD( UPLO, I+NB-1, NB, A, LDA, E, TAU, WORK,
-     $                   LDWORK )
-*
-*           Update the unreduced submatrix A(1:i-1,1:i-1), using an
-*           update of the form:  A := A - V*W' - W*V'
-*
-            CALL DSYR2K( UPLO, 'No transpose', I-1, NB, -ONE, A( 1, I ),
-     $                   LDA, WORK, LDWORK, ONE, A, LDA )
-*
-*           Copy superdiagonal elements back into A, and diagonal
-*           elements into D
-*
-            DO 10 J = I, I + NB - 1
-               A( J-1, J ) = E( J-1 )
-               D( J ) = A( J, J )
-   10       CONTINUE
-   20    CONTINUE
-*
-*        Use unblocked code to reduce the last or only block
-*
-         CALL DSYTD2( UPLO, KK, A, LDA, D, E, TAU, IINFO )
-      ELSE
-*
-*        Reduce the lower triangle of A
-*
-         DO 40 I = 1, N - NX, NB
-*
-*           Reduce columns i:i+nb-1 to tridiagonal form and form the
-*           matrix W which is needed to update the unreduced part of
-*           the matrix
-*
-            CALL DLATRD( UPLO, N-I+1, NB, A( I, I ), LDA, E( I ),
-     $                   TAU( I ), WORK, LDWORK )
-*
-*           Update the unreduced submatrix A(i+ib:n,i+ib:n), using
-*           an update of the form:  A := A - V*W' - W*V'
-*
-            CALL DSYR2K( UPLO, 'No transpose', N-I-NB+1, NB, -ONE,
-     $                   A( I+NB, I ), LDA, WORK( NB+1 ), LDWORK, ONE,
-     $                   A( I+NB, I+NB ), LDA )
-*
-*           Copy subdiagonal elements back into A, and diagonal
-*           elements into D
-*
-            DO 30 J = I, I + NB - 1
-               A( J+1, J ) = E( J )
-               D( J ) = A( J, J )
-   30       CONTINUE
-   40    CONTINUE
-*
-*        Use unblocked code to reduce the last or only block
-*
-         CALL DSYTD2( UPLO, N-I+1, A( I, I ), LDA, D( I ), E( I ),
-     $                TAU( I ), IINFO )
-      END IF
-*
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DSYTRD
-*
-      END
diff --git a/src/lib/lapack/dsytrf.f b/src/lib/lapack/dsytrf.f
deleted file mode 100644
index 43a31248..00000000
--- a/src/lib/lapack/dsytrf.f
+++ /dev/null
@@ -1,287 +0,0 @@
-      SUBROUTINE DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSYTRF computes the factorization of a real symmetric matrix A using
-*  the Bunch-Kaufman diagonal pivoting method.  The form of the
-*  factorization is
-*
-*     A = U*D*U**T  or  A = L*D*L**T
-*
-*  where U (or L) is a product of permutation and unit upper (lower)
-*  triangular matrices, 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.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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, the block diagonal matrix D and the multipliers used
-*          to obtain the factor U or L (see below for further details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (output) INTEGER array, dimension (N)
-*          Details of the interchanges and the block structure of D.
-*          If IPIV(k) > 0, then rows and columns k and IPIV(k) were
-*          interchanged and D(k,k) is a 1-by-1 diagonal block.
-*          If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and
-*          columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k)
-*          is a 2-by-2 diagonal block.  If UPLO = 'L' and IPIV(k) =
-*          IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were
-*          interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) 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.
-*
-*  INFO    (output) 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.
-*
-*  Further Details
-*  ===============
-*
-*  If UPLO = 'U', then A = U*D*U', where
-*     U = P(n)*U(n)* ... *P(k)U(k)* ...,
-*  i.e., U is a product of terms P(k)*U(k), where k decreases from n to
-*  1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*  and 2-by-2 diagonal blocks D(k).  P(k) is a permutation matrix as
-*  defined by IPIV(k), and U(k) is a unit upper triangular matrix, such
-*  that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*
-*             (   I    v    0   )   k-s
-*     U(k) =  (   0    I    0   )   s
-*             (   0    0    I   )   n-k
-*                k-s   s   n-k
-*
-*  If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k).
-*  If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k),
-*  and A(k,k), and v overwrites A(1:k-2,k-1:k).
-*
-*  If UPLO = 'L', then A = L*D*L', where
-*     L = P(1)*L(1)* ... *P(k)*L(k)* ...,
-*  i.e., L is a product of terms P(k)*L(k), where k increases from 1 to
-*  n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1
-*  and 2-by-2 diagonal blocks D(k).  P(k) is a permutation matrix as
-*  defined by IPIV(k), and L(k) is a unit lower triangular matrix, such
-*  that if the diagonal block D(k) is of order s (s = 1 or 2), then
-*
-*             (   I    0     0   )  k-1
-*     L(k) =  (   0    I     0   )  s
-*             (   0    v     I   )  n-k-s+1
-*                k-1   s  n-k-s+1
-*
-*  If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k).
-*  If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k),
-*  and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1).
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, UPPER
-      INTEGER            IINFO, IWS, J, K, KB, LDWORK, LWKOPT, NB, NBMIN
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASYF, DSYTF2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          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 = -7
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-*
-*        Determine the block size
-*
-         NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 )
-         LWKOPT = N*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSYTRF', -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', 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' 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;
-*        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 40
-*
-         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( UPLO, K, NB, KB, A, LDA, IPIV, WORK, LDWORK,
-     $                   IINFO )
-         ELSE
-*
-*           Use unblocked code to factorize columns 1:k of A
-*
-            CALL DSYTF2( UPLO, K, A, LDA, 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
-*
-*        Decrease K and return to the start of the main loop
-*
-         K = K - KB
-         GO TO 10
-*
-      ELSE
-*
-*        Factorize A as L*D*L' 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;
-*        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 40
-*
-         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( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ),
-     $                   WORK, LDWORK, IINFO )
-         ELSE
-*
-*           Use unblocked code to factorize columns k:n of A
-*
-            CALL DSYTF2( UPLO, N-K+1, A( K, K ), LDA, 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 30 J = K, K + KB - 1
-            IF( IPIV( J ).GT.0 ) THEN
-               IPIV( J ) = IPIV( J ) + K - 1
-            ELSE
-               IPIV( J ) = IPIV( J ) - K + 1
-            END IF
-   30    CONTINUE
-*
-*        Increase K and return to the start of the main loop
-*
-         K = K + KB
-         GO TO 20
-*
-      END IF
-*
-   40 CONTINUE
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of DSYTRF
-*
-      END
diff --git a/src/lib/lapack/dsytri.f b/src/lib/lapack/dsytri.f
deleted file mode 100644
index 361de9a3..00000000
--- a/src/lib/lapack/dsytri.f
+++ /dev/null
@@ -1,312 +0,0 @@
-      SUBROUTINE DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSYTRI computes the inverse of a real symmetric indefinite matrix
-*  A using the factorization A = U*D*U**T or A = L*D*L**T computed by
-*  DSYTRF.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) 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*D*U**T;
-*          = 'L':  Lower triangular, form is A = L*D*L**T.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the block diagonal matrix D and the multipliers
-*          used to obtain the factor U or L as computed by DSYTRF.
-*
-*          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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (input) INTEGER array, dimension (N)
-*          Details of the interchanges and the block structure of D
-*          as determined by DSYTRF.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  INFO    (output) 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.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            K, KP, KSTEP
-      DOUBLE PRECISION   AK, AKKP1, AKP1, D, T, TEMP
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DDOT
-      EXTERNAL           LSAME, DDOT
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DSWAP, DSYMV, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, 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
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSYTRI', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Check that the diagonal matrix D is nonsingular.
-*
-      IF( UPPER ) THEN
-*
-*        Upper triangular storage: examine D from bottom to top
-*
-         DO 10 INFO = N, 1, -1
-            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
-     $         RETURN
-   10    CONTINUE
-      ELSE
-*
-*        Lower triangular storage: examine D from top to bottom.
-*
-         DO 20 INFO = 1, N
-            IF( IPIV( INFO ).GT.0 .AND. A( INFO, INFO ).EQ.ZERO )
-     $         RETURN
-   20    CONTINUE
-      END IF
-      INFO = 0
-*
-      IF( UPPER ) THEN
-*
-*        Compute inv(A) from the factorization A = U*D*U'.
-*
-*        K is the main loop index, increasing from 1 to N in steps of
-*        1 or 2, depending on the size of the diagonal blocks.
-*
-         K = 1
-   30    CONTINUE
-*
-*        If K > N, exit from loop.
-*
-         IF( K.GT.N )
-     $      GO TO 40
-*
-         IF( IPIV( K ).GT.0 ) THEN
-*
-*           1 x 1 diagonal block
-*
-*           Invert the diagonal block.
-*
-            A( K, K ) = ONE / A( K, K )
-*
-*           Compute column K of the inverse.
-*
-            IF( K.GT.1 ) THEN
-               CALL DCOPY( K-1, A( 1, K ), 1, WORK, 1 )
-               CALL DSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
-     $                     A( 1, K ), 1 )
-               A( K, K ) = A( K, K ) - DDOT( K-1, WORK, 1, A( 1, K ),
-     $                     1 )
-            END IF
-            KSTEP = 1
-         ELSE
-*
-*           2 x 2 diagonal block
-*
-*           Invert the diagonal block.
-*
-            T = ABS( A( K, K+1 ) )
-            AK = A( K, K ) / T
-            AKP1 = A( K+1, K+1 ) / T
-            AKKP1 = A( K, K+1 ) / T
-            D = T*( AK*AKP1-ONE )
-            A( K, K ) = AKP1 / D
-            A( K+1, K+1 ) = AK / D
-            A( K, K+1 ) = -AKKP1 / D
-*
-*           Compute columns K and K+1 of the inverse.
-*
-            IF( K.GT.1 ) THEN
-               CALL DCOPY( K-1, A( 1, K ), 1, WORK, 1 )
-               CALL DSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
-     $                     A( 1, K ), 1 )
-               A( K, K ) = A( K, K ) - DDOT( K-1, WORK, 1, A( 1, K ),
-     $                     1 )
-               A( K, K+1 ) = A( K, K+1 ) -
-     $                       DDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 )
-               CALL DCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 )
-               CALL DSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
-     $                     A( 1, K+1 ), 1 )
-               A( K+1, K+1 ) = A( K+1, K+1 ) -
-     $                         DDOT( K-1, WORK, 1, A( 1, K+1 ), 1 )
-            END IF
-            KSTEP = 2
-         END IF
-*
-         KP = ABS( IPIV( K ) )
-         IF( KP.NE.K ) THEN
-*
-*           Interchange rows and columns K and KP in the leading
-*           submatrix A(1:k+1,1:k+1)
-*
-            CALL DSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 )
-            CALL DSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA )
-            TEMP = A( K, K )
-            A( K, K ) = A( KP, KP )
-            A( KP, KP ) = TEMP
-            IF( KSTEP.EQ.2 ) THEN
-               TEMP = A( K, K+1 )
-               A( K, K+1 ) = A( KP, K+1 )
-               A( KP, K+1 ) = TEMP
-            END IF
-         END IF
-*
-         K = K + KSTEP
-         GO TO 30
-   40    CONTINUE
-*
-      ELSE
-*
-*        Compute inv(A) from the factorization A = L*D*L'.
-*
-*        K is the main loop index, increasing from 1 to N in steps of
-*        1 or 2, depending on the size of the diagonal blocks.
-*
-         K = N
-   50    CONTINUE
-*
-*        If K < 1, exit from loop.
-*
-         IF( K.LT.1 )
-     $      GO TO 60
-*
-         IF( IPIV( K ).GT.0 ) THEN
-*
-*           1 x 1 diagonal block
-*
-*           Invert the diagonal block.
-*
-            A( K, K ) = ONE / A( K, K )
-*
-*           Compute column K of the inverse.
-*
-            IF( K.LT.N ) THEN
-               CALL DCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
-               CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
-     $                     ZERO, A( K+1, K ), 1 )
-               A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, K ),
-     $                     1 )
-            END IF
-            KSTEP = 1
-         ELSE
-*
-*           2 x 2 diagonal block
-*
-*           Invert the diagonal block.
-*
-            T = ABS( A( K, K-1 ) )
-            AK = A( K-1, K-1 ) / T
-            AKP1 = A( K, K ) / T
-            AKKP1 = A( K, K-1 ) / T
-            D = T*( AK*AKP1-ONE )
-            A( K-1, K-1 ) = AKP1 / D
-            A( K, K ) = AK / D
-            A( K, K-1 ) = -AKKP1 / D
-*
-*           Compute columns K-1 and K of the inverse.
-*
-            IF( K.LT.N ) THEN
-               CALL DCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
-               CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
-     $                     ZERO, A( K+1, K ), 1 )
-               A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, K ),
-     $                     1 )
-               A( K, K-1 ) = A( K, K-1 ) -
-     $                       DDOT( N-K, A( K+1, K ), 1, A( K+1, K-1 ),
-     $                       1 )
-               CALL DCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 )
-               CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
-     $                     ZERO, A( K+1, K-1 ), 1 )
-               A( K-1, K-1 ) = A( K-1, K-1 ) -
-     $                         DDOT( N-K, WORK, 1, A( K+1, K-1 ), 1 )
-            END IF
-            KSTEP = 2
-         END IF
-*
-         KP = ABS( IPIV( K ) )
-         IF( KP.NE.K ) THEN
-*
-*           Interchange rows and columns K and KP in the trailing
-*           submatrix A(k-1:n,k-1:n)
-*
-            IF( KP.LT.N )
-     $         CALL DSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 )
-            CALL DSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA )
-            TEMP = A( K, K )
-            A( K, K ) = A( KP, KP )
-            A( KP, KP ) = TEMP
-            IF( KSTEP.EQ.2 ) THEN
-               TEMP = A( K, K-1 )
-               A( K, K-1 ) = A( KP, K-1 )
-               A( KP, K-1 ) = TEMP
-            END IF
-         END IF
-*
-         K = K - KSTEP
-         GO TO 50
-   60    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of DSYTRI
-*
-      END
diff --git a/src/lib/lapack/dsytrs.f b/src/lib/lapack/dsytrs.f
deleted file mode 100644
index 163ed5b9..00000000
--- a/src/lib/lapack/dsytrs.f
+++ /dev/null
@@ -1,369 +0,0 @@
-      SUBROUTINE DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, LDB, N, NRHS
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DSYTRS solves a system of linear equations A*X = B with a real
-*  symmetric matrix A using the factorization A = U*D*U**T or
-*  A = L*D*L**T computed by DSYTRF.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) 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*D*U**T;
-*          = 'L':  Lower triangular, form is A = L*D*L**T.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of columns
-*          of the matrix B.  NRHS >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The block diagonal matrix D and the multipliers used to
-*          obtain the factor U or L as computed by DSYTRF.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (input) INTEGER array, dimension (N)
-*          Details of the interchanges and the block structure of D
-*          as determined by DSYTRF.
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the right hand side matrix B.
-*          On exit, the solution matrix X.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            J, K, KP
-      DOUBLE PRECISION   AK, AKM1, AKM1K, BK, BKM1, DENOM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMV, DGER, DSCAL, DSWAP, 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
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DSYTRS', -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*D*U'.
-*
-*        First solve U*D*X = B, overwriting B with X.
-*
-*        K is the main loop index, decreasing from N to 1 in steps of
-*        1 or 2, depending on the size of the diagonal blocks.
-*
-         K = N
-   10    CONTINUE
-*
-*        If K < 1, exit from loop.
-*
-         IF( K.LT.1 )
-     $      GO TO 30
-*
-         IF( IPIV( K ).GT.0 ) THEN
-*
-*           1 x 1 diagonal block
-*
-*           Interchange rows K and IPIV(K).
-*
-            KP = IPIV( K )
-            IF( KP.NE.K )
-     $         CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-*
-*           Multiply by inv(U(K)), where U(K) is the transformation
-*           stored in column K of A.
-*
-            CALL DGER( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
-     $                 B( 1, 1 ), LDB )
-*
-*           Multiply by the inverse of the diagonal block.
-*
-            CALL DSCAL( NRHS, ONE / A( K, K ), B( K, 1 ), LDB )
-            K = K - 1
-         ELSE
-*
-*           2 x 2 diagonal block
-*
-*           Interchange rows K-1 and -IPIV(K).
-*
-            KP = -IPIV( K )
-            IF( KP.NE.K-1 )
-     $         CALL DSWAP( NRHS, B( K-1, 1 ), LDB, B( KP, 1 ), LDB )
-*
-*           Multiply by inv(U(K)), where U(K) is the transformation
-*           stored in columns K-1 and K of A.
-*
-            CALL DGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
-     $                 B( 1, 1 ), LDB )
-            CALL DGER( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ),
-     $                 LDB, B( 1, 1 ), LDB )
-*
-*           Multiply by the inverse of the diagonal block.
-*
-            AKM1K = A( K-1, K )
-            AKM1 = A( K-1, K-1 ) / AKM1K
-            AK = A( K, K ) / AKM1K
-            DENOM = AKM1*AK - ONE
-            DO 20 J = 1, NRHS
-               BKM1 = B( K-1, J ) / AKM1K
-               BK = B( K, J ) / AKM1K
-               B( K-1, J ) = ( AK*BKM1-BK ) / DENOM
-               B( K, J ) = ( AKM1*BK-BKM1 ) / DENOM
-   20       CONTINUE
-            K = K - 2
-         END IF
-*
-         GO TO 10
-   30    CONTINUE
-*
-*        Next solve U'*X = B, overwriting B with X.
-*
-*        K is the main loop index, increasing from 1 to N in steps of
-*        1 or 2, depending on the size of the diagonal blocks.
-*
-         K = 1
-   40    CONTINUE
-*
-*        If K > N, exit from loop.
-*
-         IF( K.GT.N )
-     $      GO TO 50
-*
-         IF( IPIV( K ).GT.0 ) THEN
-*
-*           1 x 1 diagonal block
-*
-*           Multiply by inv(U'(K)), where U(K) is the transformation
-*           stored in column K of A.
-*
-            CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ),
-     $                  1, ONE, B( K, 1 ), LDB )
-*
-*           Interchange rows K and IPIV(K).
-*
-            KP = IPIV( K )
-            IF( KP.NE.K )
-     $         CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K + 1
-         ELSE
-*
-*           2 x 2 diagonal block
-*
-*           Multiply by inv(U'(K+1)), where U(K+1) is the transformation
-*           stored in columns K and K+1 of A.
-*
-            CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ),
-     $                  1, ONE, B( K, 1 ), LDB )
-            CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB,
-     $                  A( 1, K+1 ), 1, ONE, B( K+1, 1 ), LDB )
-*
-*           Interchange rows K and -IPIV(K).
-*
-            KP = -IPIV( K )
-            IF( KP.NE.K )
-     $         CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K + 2
-         END IF
-*
-         GO TO 40
-   50    CONTINUE
-*
-      ELSE
-*
-*        Solve A*X = B, where A = L*D*L'.
-*
-*        First solve L*D*X = B, overwriting B with X.
-*
-*        K is the main loop index, increasing from 1 to N in steps of
-*        1 or 2, depending on the size of the diagonal blocks.
-*
-         K = 1
-   60    CONTINUE
-*
-*        If K > N, exit from loop.
-*
-         IF( K.GT.N )
-     $      GO TO 80
-*
-         IF( IPIV( K ).GT.0 ) THEN
-*
-*           1 x 1 diagonal block
-*
-*           Interchange rows K and IPIV(K).
-*
-            KP = IPIV( K )
-            IF( KP.NE.K )
-     $         CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-*
-*           Multiply by inv(L(K)), where L(K) is the transformation
-*           stored in column K of A.
-*
-            IF( K.LT.N )
-     $         CALL DGER( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ),
-     $                    LDB, B( K+1, 1 ), LDB )
-*
-*           Multiply by the inverse of the diagonal block.
-*
-            CALL DSCAL( NRHS, ONE / A( K, K ), B( K, 1 ), LDB )
-            K = K + 1
-         ELSE
-*
-*           2 x 2 diagonal block
-*
-*           Interchange rows K+1 and -IPIV(K).
-*
-            KP = -IPIV( K )
-            IF( KP.NE.K+1 )
-     $         CALL DSWAP( NRHS, B( K+1, 1 ), LDB, B( KP, 1 ), LDB )
-*
-*           Multiply by inv(L(K)), where L(K) is the transformation
-*           stored in columns K and K+1 of A.
-*
-            IF( K.LT.N-1 ) THEN
-               CALL DGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ),
-     $                    LDB, B( K+2, 1 ), LDB )
-               CALL DGER( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1,
-     $                    B( K+1, 1 ), LDB, B( K+2, 1 ), LDB )
-            END IF
-*
-*           Multiply by the inverse of the diagonal block.
-*
-            AKM1K = A( K+1, K )
-            AKM1 = A( K, K ) / AKM1K
-            AK = A( K+1, K+1 ) / AKM1K
-            DENOM = AKM1*AK - ONE
-            DO 70 J = 1, NRHS
-               BKM1 = B( K, J ) / AKM1K
-               BK = B( K+1, J ) / AKM1K
-               B( K, J ) = ( AK*BKM1-BK ) / DENOM
-               B( K+1, J ) = ( AKM1*BK-BKM1 ) / DENOM
-   70       CONTINUE
-            K = K + 2
-         END IF
-*
-         GO TO 60
-   80    CONTINUE
-*
-*        Next solve L'*X = B, overwriting B with X.
-*
-*        K is the main loop index, decreasing from N to 1 in steps of
-*        1 or 2, depending on the size of the diagonal blocks.
-*
-         K = N
-   90    CONTINUE
-*
-*        If K < 1, exit from loop.
-*
-         IF( K.LT.1 )
-     $      GO TO 100
-*
-         IF( IPIV( K ).GT.0 ) THEN
-*
-*           1 x 1 diagonal block
-*
-*           Multiply by inv(L'(K)), where L(K) is the transformation
-*           stored in column K of A.
-*
-            IF( K.LT.N )
-     $         CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
-     $                     LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
-*
-*           Interchange rows K and IPIV(K).
-*
-            KP = IPIV( K )
-            IF( KP.NE.K )
-     $         CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K - 1
-         ELSE
-*
-*           2 x 2 diagonal block
-*
-*           Multiply by inv(L'(K-1)), where L(K-1) is the transformation
-*           stored in columns K-1 and K of A.
-*
-            IF( K.LT.N ) THEN
-               CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
-     $                     LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
-               CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
-     $                     LDB, A( K+1, K-1 ), 1, ONE, B( K-1, 1 ),
-     $                     LDB )
-            END IF
-*
-*           Interchange rows K and -IPIV(K).
-*
-            KP = -IPIV( K )
-            IF( KP.NE.K )
-     $         CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
-            K = K - 2
-         END IF
-*
-         GO TO 90
-  100    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of DSYTRS
-*
-      END
diff --git a/src/lib/lapack/dtgevc.f b/src/lib/lapack/dtgevc.f
deleted file mode 100644
index 091c3f65..00000000
--- a/src/lib/lapack/dtgevc.f
+++ /dev/null
@@ -1,1147 +0,0 @@
-      SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
-     $                   LDVL, VR, LDVR, MM, M, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          HOWMNY, SIDE
-      INTEGER            INFO, LDP, LDS, LDVL, LDVR, M, MM, N
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            SELECT( * )
-      DOUBLE PRECISION   P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
-     $                   VR( LDVR, * ), WORK( * )
-*     ..
-*
-*
-*  Purpose
-*  =======
-*
-*  DTGEVC computes some or all of the right and/or left eigenvectors of
-*  a pair of real matrices (S,P), where S is a quasi-triangular matrix
-*  and P is upper triangular.  Matrix pairs of this type are produced by
-*  the generalized Schur factorization of a matrix pair (A,B):
-*
-*     A = Q*S*Z**T,  B = Q*P*Z**T
-*
-*  as computed by DGGHRD + DHGEQZ.
-*
-*  The right eigenvector x and the left eigenvector y of (S,P)
-*  corresponding to an eigenvalue w are defined by:
-*  
-*     S*x = w*P*x,  (y**H)*S = w*(y**H)*P,
-*  
-*  where y**H denotes the conjugate tranpose of y.
-*  The eigenvalues are not input to this routine, but are computed
-*  directly from the diagonal blocks of S and P.
-*  
-*  This routine returns the matrices X and/or Y of right and left
-*  eigenvectors of (S,P), or the products Z*X and/or Q*Y,
-*  where Z and Q are input matrices.
-*  If Q and Z are the orthogonal factors from the generalized Schur
-*  factorization of a matrix pair (A,B), then Z*X and Q*Y
-*  are the matrices of right and left eigenvectors of (A,B).
-* 
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'R': compute right eigenvectors only;
-*          = 'L': compute left eigenvectors only;
-*          = 'B': compute both right and left eigenvectors.
-*
-*  HOWMNY  (input) CHARACTER*1
-*          = 'A': compute all right and/or left eigenvectors;
-*          = 'B': compute all right and/or left eigenvectors,
-*                 backtransformed by the matrices in VR and/or VL;
-*          = 'S': compute selected right and/or left eigenvectors,
-*                 specified by the logical array SELECT.
-*
-*  SELECT  (input) LOGICAL array, dimension (N)
-*          If HOWMNY='S', SELECT specifies the eigenvectors to be
-*          computed.  If w(j) is a real eigenvalue, the corresponding
-*          real eigenvector is computed if SELECT(j) is .TRUE..
-*          If w(j) and w(j+1) are the real and imaginary parts of a
-*          complex eigenvalue, the corresponding complex eigenvector
-*          is computed if either SELECT(j) or SELECT(j+1) is .TRUE.,
-*          and on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is
-*          set to .FALSE..
-*          Not referenced if HOWMNY = 'A' or 'B'.
-*
-*  N       (input) INTEGER
-*          The order of the matrices S and P.  N >= 0.
-*
-*  S       (input) DOUBLE PRECISION array, dimension (LDS,N)
-*          The upper quasi-triangular matrix S from a generalized Schur
-*          factorization, as computed by DHGEQZ.
-*
-*  LDS     (input) INTEGER
-*          The leading dimension of array S.  LDS >= max(1,N).
-*
-*  P       (input) DOUBLE PRECISION array, dimension (LDP,N)
-*          The upper triangular matrix P from a generalized Schur
-*          factorization, as computed by DHGEQZ.
-*          2-by-2 diagonal blocks of P corresponding to 2-by-2 blocks
-*          of S must be in positive diagonal form.
-*
-*  LDP     (input) INTEGER
-*          The leading dimension of array P.  LDP >= max(1,N).
-*
-*  VL      (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
-*          On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
-*          contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*          of left Schur vectors returned by DHGEQZ).
-*          On exit, if SIDE = 'L' or 'B', VL contains:
-*          if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
-*          if HOWMNY = 'B', the matrix Q*Y;
-*          if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
-*                      SELECT, stored consecutively in the columns of
-*                      VL, in the same order as their eigenvalues.
-*
-*          A complex eigenvector corresponding to a complex eigenvalue
-*          is stored in two consecutive columns, the first holding the
-*          real part, and the second the imaginary part.
-*
-*          Not referenced if SIDE = 'R'.
-*
-*  LDVL    (input) INTEGER
-*          The leading dimension of array VL.  LDVL >= 1, and if
-*          SIDE = 'L' or 'B', LDVL >= N.
-*
-*  VR      (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
-*          On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-*          contain an N-by-N matrix Z (usually the orthogonal matrix Z
-*          of right Schur vectors returned by DHGEQZ).
-*
-*          On exit, if SIDE = 'R' or 'B', VR contains:
-*          if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
-*          if HOWMNY = 'B' or 'b', the matrix Z*X;
-*          if HOWMNY = 'S' or 's', the right eigenvectors of (S,P)
-*                      specified by SELECT, stored consecutively in the
-*                      columns of VR, in the same order as their
-*                      eigenvalues.
-*
-*          A complex eigenvector corresponding to a complex eigenvalue
-*          is stored in two consecutive columns, the first holding the
-*          real part and the second the imaginary part.
-*          
-*          Not referenced if SIDE = 'L'.
-*
-*  LDVR    (input) INTEGER
-*          The leading dimension of the array VR.  LDVR >= 1, and if
-*          SIDE = 'R' or 'B', LDVR >= N.
-*
-*  MM      (input) INTEGER
-*          The number of columns in the arrays VL and/or VR. MM >= M.
-*
-*  M       (output) INTEGER
-*          The number of columns in the arrays VL and/or VR actually
-*          used to store the eigenvectors.  If HOWMNY = 'A' or 'B', M
-*          is set to N.  Each selected real eigenvector occupies one
-*          column and each selected complex eigenvector occupies two
-*          columns.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (6*N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          > 0:  the 2-by-2 block (INFO:INFO+1) does not have a complex
-*                eigenvalue.
-*
-*  Further Details
-*  ===============
-*
-*  Allocation of workspace:
-*  ---------- -- ---------
-*
-*     WORK( j ) = 1-norm of j-th column of A, above the diagonal
-*     WORK( N+j ) = 1-norm of j-th column of B, above the diagonal
-*     WORK( 2*N+1:3*N ) = real part of eigenvector
-*     WORK( 3*N+1:4*N ) = imaginary part of eigenvector
-*     WORK( 4*N+1:5*N ) = real part of back-transformed eigenvector
-*     WORK( 5*N+1:6*N ) = imaginary part of back-transformed eigenvector
-*
-*  Rowwise vs. columnwise solution methods:
-*  ------- --  ---------- -------- -------
-*
-*  Finding a generalized eigenvector consists basically of solving the
-*  singular triangular system
-*
-*   (A - w B) x = 0     (for right) or:   (A - w B)**H y = 0  (for left)
-*
-*  Consider finding the i-th right eigenvector (assume all eigenvalues
-*  are real). The equation to be solved is:
-*       n                   i
-*  0 = sum  C(j,k) v(k)  = sum  C(j,k) v(k)     for j = i,. . .,1
-*      k=j                 k=j
-*
-*  where  C = (A - w B)  (The components v(i+1:n) are 0.)
-*
-*  The "rowwise" method is:
-*
-*  (1)  v(i) := 1
-*  for j = i-1,. . .,1:
-*                          i
-*      (2) compute  s = - sum C(j,k) v(k)   and
-*                        k=j+1
-*
-*      (3) v(j) := s / C(j,j)
-*
-*  Step 2 is sometimes called the "dot product" step, since it is an
-*  inner product between the j-th row and the portion of the eigenvector
-*  that has been computed so far.
-*
-*  The "columnwise" method consists basically in doing the sums
-*  for all the rows in parallel.  As each v(j) is computed, the
-*  contribution of v(j) times the j-th column of C is added to the
-*  partial sums.  Since FORTRAN arrays are stored columnwise, this has
-*  the advantage that at each step, the elements of C that are accessed
-*  are adjacent to one another, whereas with the rowwise method, the
-*  elements accessed at a step are spaced LDS (and LDP) words apart.
-*
-*  When finding left eigenvectors, the matrix in question is the
-*  transpose of the one in storage, so the rowwise method then
-*  actually accesses columns of A and B at each step, and so is the
-*  preferred method.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE, SAFETY
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0,
-     $                   SAFETY = 1.0D+2 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            COMPL, COMPR, IL2BY2, ILABAD, ILALL, ILBACK,
-     $                   ILBBAD, ILCOMP, ILCPLX, LSA, LSB
-      INTEGER            I, IBEG, IEIG, IEND, IHWMNY, IINFO, IM, ISIDE,
-     $                   J, JA, JC, JE, JR, JW, NA, NW
-      DOUBLE PRECISION   ACOEF, ACOEFA, ANORM, ASCALE, BCOEFA, BCOEFI,
-     $                   BCOEFR, BIG, BIGNUM, BNORM, BSCALE, CIM2A,
-     $                   CIM2B, CIMAGA, CIMAGB, CRE2A, CRE2B, CREALA,
-     $                   CREALB, DMIN, SAFMIN, SALFAR, SBETA, SCALE,
-     $                   SMALL, TEMP, TEMP2, TEMP2I, TEMP2R, ULP, XMAX,
-     $                   XSCALE
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   BDIAG( 2 ), SUM( 2, 2 ), SUMS( 2, 2 ),
-     $                   SUMP( 2, 2 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMV, DLABAD, DLACPY, DLAG2, DLALN2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and Test the input parameters
-*
-      IF( LSAME( HOWMNY, 'A' ) ) THEN
-         IHWMNY = 1
-         ILALL = .TRUE.
-         ILBACK = .FALSE.
-      ELSE IF( LSAME( HOWMNY, 'S' ) ) THEN
-         IHWMNY = 2
-         ILALL = .FALSE.
-         ILBACK = .FALSE.
-      ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
-         IHWMNY = 3
-         ILALL = .TRUE.
-         ILBACK = .TRUE.
-      ELSE
-         IHWMNY = -1
-         ILALL = .TRUE.
-      END IF
-*
-      IF( LSAME( SIDE, 'R' ) ) THEN
-         ISIDE = 1
-         COMPL = .FALSE.
-         COMPR = .TRUE.
-      ELSE IF( LSAME( SIDE, 'L' ) ) THEN
-         ISIDE = 2
-         COMPL = .TRUE.
-         COMPR = .FALSE.
-      ELSE IF( LSAME( SIDE, 'B' ) ) THEN
-         ISIDE = 3
-         COMPL = .TRUE.
-         COMPR = .TRUE.
-      ELSE
-         ISIDE = -1
-      END IF
-*
-      INFO = 0
-      IF( ISIDE.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( IHWMNY.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
-         INFO = -8
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTGEVC', -INFO )
-         RETURN
-      END IF
-*
-*     Count the number of eigenvectors to be computed
-*
-      IF( .NOT.ILALL ) THEN
-         IM = 0
-         ILCPLX = .FALSE.
-         DO 10 J = 1, N
-            IF( ILCPLX ) THEN
-               ILCPLX = .FALSE.
-               GO TO 10
-            END IF
-            IF( J.LT.N ) THEN
-               IF( S( J+1, J ).NE.ZERO )
-     $            ILCPLX = .TRUE.
-            END IF
-            IF( ILCPLX ) THEN
-               IF( SELECT( J ) .OR. SELECT( J+1 ) )
-     $            IM = IM + 2
-            ELSE
-               IF( SELECT( J ) )
-     $            IM = IM + 1
-            END IF
-   10    CONTINUE
-      ELSE
-         IM = N
-      END IF
-*
-*     Check 2-by-2 diagonal blocks of A, B
-*
-      ILABAD = .FALSE.
-      ILBBAD = .FALSE.
-      DO 20 J = 1, N - 1
-         IF( S( J+1, J ).NE.ZERO ) THEN
-            IF( P( J, J ).EQ.ZERO .OR. P( J+1, J+1 ).EQ.ZERO .OR.
-     $          P( J, J+1 ).NE.ZERO )ILBBAD = .TRUE.
-            IF( J.LT.N-1 ) THEN
-               IF( S( J+2, J+1 ).NE.ZERO )
-     $            ILABAD = .TRUE.
-            END IF
-         END IF
-   20 CONTINUE
-*
-      IF( ILABAD ) THEN
-         INFO = -5
-      ELSE IF( ILBBAD ) THEN
-         INFO = -7
-      ELSE IF( COMPL .AND. LDVL.LT.N .OR. LDVL.LT.1 ) THEN
-         INFO = -10
-      ELSE IF( COMPR .AND. LDVR.LT.N .OR. LDVR.LT.1 ) THEN
-         INFO = -12
-      ELSE IF( MM.LT.IM ) THEN
-         INFO = -13
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTGEVC', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      M = IM
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Machine Constants
-*
-      SAFMIN = DLAMCH( 'Safe minimum' )
-      BIG = ONE / SAFMIN
-      CALL DLABAD( SAFMIN, BIG )
-      ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
-      SMALL = SAFMIN*N / ULP
-      BIG = ONE / SMALL
-      BIGNUM = ONE / ( SAFMIN*N )
-*
-*     Compute the 1-norm of each column of the strictly upper triangular
-*     part (i.e., excluding all elements belonging to the diagonal
-*     blocks) of A and B to check for possible overflow in the
-*     triangular solver.
-*
-      ANORM = ABS( S( 1, 1 ) )
-      IF( N.GT.1 )
-     $   ANORM = ANORM + ABS( S( 2, 1 ) )
-      BNORM = ABS( P( 1, 1 ) )
-      WORK( 1 ) = ZERO
-      WORK( N+1 ) = ZERO
-*
-      DO 50 J = 2, N
-         TEMP = ZERO
-         TEMP2 = ZERO
-         IF( S( J, J-1 ).EQ.ZERO ) THEN
-            IEND = J - 1
-         ELSE
-            IEND = J - 2
-         END IF
-         DO 30 I = 1, IEND
-            TEMP = TEMP + ABS( S( I, J ) )
-            TEMP2 = TEMP2 + ABS( P( I, J ) )
-   30    CONTINUE
-         WORK( J ) = TEMP
-         WORK( N+J ) = TEMP2
-         DO 40 I = IEND + 1, MIN( J+1, N )
-            TEMP = TEMP + ABS( S( I, J ) )
-            TEMP2 = TEMP2 + ABS( P( I, J ) )
-   40    CONTINUE
-         ANORM = MAX( ANORM, TEMP )
-         BNORM = MAX( BNORM, TEMP2 )
-   50 CONTINUE
-*
-      ASCALE = ONE / MAX( ANORM, SAFMIN )
-      BSCALE = ONE / MAX( BNORM, SAFMIN )
-*
-*     Left eigenvectors
-*
-      IF( COMPL ) THEN
-         IEIG = 0
-*
-*        Main loop over eigenvalues
-*
-         ILCPLX = .FALSE.
-         DO 220 JE = 1, N
-*
-*           Skip this iteration if (a) HOWMNY='S' and SELECT=.FALSE., or
-*           (b) this would be the second of a complex pair.
-*           Check for complex eigenvalue, so as to be sure of which
-*           entry(-ies) of SELECT to look at.
-*
-            IF( ILCPLX ) THEN
-               ILCPLX = .FALSE.
-               GO TO 220
-            END IF
-            NW = 1
-            IF( JE.LT.N ) THEN
-               IF( S( JE+1, JE ).NE.ZERO ) THEN
-                  ILCPLX = .TRUE.
-                  NW = 2
-               END IF
-            END IF
-            IF( ILALL ) THEN
-               ILCOMP = .TRUE.
-            ELSE IF( ILCPLX ) THEN
-               ILCOMP = SELECT( JE ) .OR. SELECT( JE+1 )
-            ELSE
-               ILCOMP = SELECT( JE )
-            END IF
-            IF( .NOT.ILCOMP )
-     $         GO TO 220
-*
-*           Decide if (a) singular pencil, (b) real eigenvalue, or
-*           (c) complex eigenvalue.
-*
-            IF( .NOT.ILCPLX ) THEN
-               IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
-     $             ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
-*
-*                 Singular matrix pencil -- return unit eigenvector
-*
-                  IEIG = IEIG + 1
-                  DO 60 JR = 1, N
-                     VL( JR, IEIG ) = ZERO
-   60             CONTINUE
-                  VL( IEIG, IEIG ) = ONE
-                  GO TO 220
-               END IF
-            END IF
-*
-*           Clear vector
-*
-            DO 70 JR = 1, NW*N
-               WORK( 2*N+JR ) = ZERO
-   70       CONTINUE
-*                                                 T
-*           Compute coefficients in  ( a A - b B )  y = 0
-*              a  is  ACOEF
-*              b  is  BCOEFR + i*BCOEFI
-*
-            IF( .NOT.ILCPLX ) THEN
-*
-*              Real eigenvalue
-*
-               TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
-     $                ABS( P( JE, JE ) )*BSCALE, SAFMIN )
-               SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
-               SBETA = ( TEMP*P( JE, JE ) )*BSCALE
-               ACOEF = SBETA*ASCALE
-               BCOEFR = SALFAR*BSCALE
-               BCOEFI = ZERO
-*
-*              Scale to avoid underflow
-*
-               SCALE = ONE
-               LSA = ABS( SBETA ).GE.SAFMIN .AND. ABS( ACOEF ).LT.SMALL
-               LSB = ABS( SALFAR ).GE.SAFMIN .AND. ABS( BCOEFR ).LT.
-     $               SMALL
-               IF( LSA )
-     $            SCALE = ( SMALL / ABS( SBETA ) )*MIN( ANORM, BIG )
-               IF( LSB )
-     $            SCALE = MAX( SCALE, ( SMALL / ABS( SALFAR ) )*
-     $                    MIN( BNORM, BIG ) )
-               IF( LSA .OR. LSB ) THEN
-                  SCALE = MIN( SCALE, ONE /
-     $                    ( SAFMIN*MAX( ONE, ABS( ACOEF ),
-     $                    ABS( BCOEFR ) ) ) )
-                  IF( LSA ) THEN
-                     ACOEF = ASCALE*( SCALE*SBETA )
-                  ELSE
-                     ACOEF = SCALE*ACOEF
-                  END IF
-                  IF( LSB ) THEN
-                     BCOEFR = BSCALE*( SCALE*SALFAR )
-                  ELSE
-                     BCOEFR = SCALE*BCOEFR
-                  END IF
-               END IF
-               ACOEFA = ABS( ACOEF )
-               BCOEFA = ABS( BCOEFR )
-*
-*              First component is 1
-*
-               WORK( 2*N+JE ) = ONE
-               XMAX = ONE
-            ELSE
-*
-*              Complex eigenvalue
-*
-               CALL DLAG2( S( JE, JE ), LDS, P( JE, JE ), LDP,
-     $                     SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
-     $                     BCOEFI )
-               BCOEFI = -BCOEFI
-               IF( BCOEFI.EQ.ZERO ) THEN
-                  INFO = JE
-                  RETURN
-               END IF
-*
-*              Scale to avoid over/underflow
-*
-               ACOEFA = ABS( ACOEF )
-               BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
-               SCALE = ONE
-               IF( ACOEFA*ULP.LT.SAFMIN .AND. ACOEFA.GE.SAFMIN )
-     $            SCALE = ( SAFMIN / ULP ) / ACOEFA
-               IF( BCOEFA*ULP.LT.SAFMIN .AND. BCOEFA.GE.SAFMIN )
-     $            SCALE = MAX( SCALE, ( SAFMIN / ULP ) / BCOEFA )
-               IF( SAFMIN*ACOEFA.GT.ASCALE )
-     $            SCALE = ASCALE / ( SAFMIN*ACOEFA )
-               IF( SAFMIN*BCOEFA.GT.BSCALE )
-     $            SCALE = MIN( SCALE, BSCALE / ( SAFMIN*BCOEFA ) )
-               IF( SCALE.NE.ONE ) THEN
-                  ACOEF = SCALE*ACOEF
-                  ACOEFA = ABS( ACOEF )
-                  BCOEFR = SCALE*BCOEFR
-                  BCOEFI = SCALE*BCOEFI
-                  BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
-               END IF
-*
-*              Compute first two components of eigenvector
-*
-               TEMP = ACOEF*S( JE+1, JE )
-               TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
-               TEMP2I = -BCOEFI*P( JE, JE )
-               IF( ABS( TEMP ).GT.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
-                  WORK( 2*N+JE ) = ONE
-                  WORK( 3*N+JE ) = ZERO
-                  WORK( 2*N+JE+1 ) = -TEMP2R / TEMP
-                  WORK( 3*N+JE+1 ) = -TEMP2I / TEMP
-               ELSE
-                  WORK( 2*N+JE+1 ) = ONE
-                  WORK( 3*N+JE+1 ) = ZERO
-                  TEMP = ACOEF*S( JE, JE+1 )
-                  WORK( 2*N+JE ) = ( BCOEFR*P( JE+1, JE+1 )-ACOEF*
-     $                             S( JE+1, JE+1 ) ) / TEMP
-                  WORK( 3*N+JE ) = BCOEFI*P( JE+1, JE+1 ) / TEMP
-               END IF
-               XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
-     $                ABS( WORK( 2*N+JE+1 ) )+ABS( WORK( 3*N+JE+1 ) ) )
-            END IF
-*
-            DMIN = MAX( ULP*ACOEFA*ANORM, ULP*BCOEFA*BNORM, SAFMIN )
-*
-*                                           T
-*           Triangular solve of  (a A - b B)  y = 0
-*
-*                                   T
-*           (rowwise in  (a A - b B) , or columnwise in (a A - b B) )
-*
-            IL2BY2 = .FALSE.
-*
-            DO 160 J = JE + NW, N
-               IF( IL2BY2 ) THEN
-                  IL2BY2 = .FALSE.
-                  GO TO 160
-               END IF
-*
-               NA = 1
-               BDIAG( 1 ) = P( J, J )
-               IF( J.LT.N ) THEN
-                  IF( S( J+1, J ).NE.ZERO ) THEN
-                     IL2BY2 = .TRUE.
-                     BDIAG( 2 ) = P( J+1, J+1 )
-                     NA = 2
-                  END IF
-               END IF
-*
-*              Check whether scaling is necessary for dot products
-*
-               XSCALE = ONE / MAX( ONE, XMAX )
-               TEMP = MAX( WORK( J ), WORK( N+J ),
-     $                ACOEFA*WORK( J )+BCOEFA*WORK( N+J ) )
-               IF( IL2BY2 )
-     $            TEMP = MAX( TEMP, WORK( J+1 ), WORK( N+J+1 ),
-     $                   ACOEFA*WORK( J+1 )+BCOEFA*WORK( N+J+1 ) )
-               IF( TEMP.GT.BIGNUM*XSCALE ) THEN
-                  DO 90 JW = 0, NW - 1
-                     DO 80 JR = JE, J - 1
-                        WORK( ( JW+2 )*N+JR ) = XSCALE*
-     $                     WORK( ( JW+2 )*N+JR )
-   80                CONTINUE
-   90             CONTINUE
-                  XMAX = XMAX*XSCALE
-               END IF
-*
-*              Compute dot products
-*
-*                    j-1
-*              SUM = sum  conjg( a*S(k,j) - b*P(k,j) )*x(k)
-*                    k=je
-*
-*              To reduce the op count, this is done as
-*
-*              _        j-1                  _        j-1
-*              a*conjg( sum  S(k,j)*x(k) ) - b*conjg( sum  P(k,j)*x(k) )
-*                       k=je                          k=je
-*
-*              which may cause underflow problems if A or B are close
-*              to underflow.  (E.g., less than SMALL.)
-*
-*
-*              A series of compiler directives to defeat vectorization
-*              for the next loop
-*
-*$PL$ CMCHAR=' '
-CDIR$          NEXTSCALAR
-C$DIR          SCALAR
-CDIR$          NEXT SCALAR
-CVD$L          NOVECTOR
-CDEC$          NOVECTOR
-CVD$           NOVECTOR
-*VDIR          NOVECTOR
-*VOCL          LOOP,SCALAR
-CIBM           PREFER SCALAR
-*$PL$ CMCHAR='*'
-*
-               DO 120 JW = 1, NW
-*
-*$PL$ CMCHAR=' '
-CDIR$             NEXTSCALAR
-C$DIR             SCALAR
-CDIR$             NEXT SCALAR
-CVD$L             NOVECTOR
-CDEC$             NOVECTOR
-CVD$              NOVECTOR
-*VDIR             NOVECTOR
-*VOCL             LOOP,SCALAR
-CIBM              PREFER SCALAR
-*$PL$ CMCHAR='*'
-*
-                  DO 110 JA = 1, NA
-                     SUMS( JA, JW ) = ZERO
-                     SUMP( JA, JW ) = ZERO
-*
-                     DO 100 JR = JE, J - 1
-                        SUMS( JA, JW ) = SUMS( JA, JW ) +
-     $                                   S( JR, J+JA-1 )*
-     $                                   WORK( ( JW+1 )*N+JR )
-                        SUMP( JA, JW ) = SUMP( JA, JW ) +
-     $                                   P( JR, J+JA-1 )*
-     $                                   WORK( ( JW+1 )*N+JR )
-  100                CONTINUE
-  110             CONTINUE
-  120          CONTINUE
-*
-*$PL$ CMCHAR=' '
-CDIR$          NEXTSCALAR
-C$DIR          SCALAR
-CDIR$          NEXT SCALAR
-CVD$L          NOVECTOR
-CDEC$          NOVECTOR
-CVD$           NOVECTOR
-*VDIR          NOVECTOR
-*VOCL          LOOP,SCALAR
-CIBM           PREFER SCALAR
-*$PL$ CMCHAR='*'
-*
-               DO 130 JA = 1, NA
-                  IF( ILCPLX ) THEN
-                     SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
-     $                              BCOEFR*SUMP( JA, 1 ) -
-     $                              BCOEFI*SUMP( JA, 2 )
-                     SUM( JA, 2 ) = -ACOEF*SUMS( JA, 2 ) +
-     $                              BCOEFR*SUMP( JA, 2 ) +
-     $                              BCOEFI*SUMP( JA, 1 )
-                  ELSE
-                     SUM( JA, 1 ) = -ACOEF*SUMS( JA, 1 ) +
-     $                              BCOEFR*SUMP( JA, 1 )
-                  END IF
-  130          CONTINUE
-*
-*                                  T
-*              Solve  ( a A - b B )  y = SUM(,)
-*              with scaling and perturbation of the denominator
-*
-               CALL DLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), LDS,
-     $                      BDIAG( 1 ), BDIAG( 2 ), SUM, 2, BCOEFR,
-     $                      BCOEFI, WORK( 2*N+J ), N, SCALE, TEMP,
-     $                      IINFO )
-               IF( SCALE.LT.ONE ) THEN
-                  DO 150 JW = 0, NW - 1
-                     DO 140 JR = JE, J - 1
-                        WORK( ( JW+2 )*N+JR ) = SCALE*
-     $                     WORK( ( JW+2 )*N+JR )
-  140                CONTINUE
-  150             CONTINUE
-                  XMAX = SCALE*XMAX
-               END IF
-               XMAX = MAX( XMAX, TEMP )
-  160       CONTINUE
-*
-*           Copy eigenvector to VL, back transforming if
-*           HOWMNY='B'.
-*
-            IEIG = IEIG + 1
-            IF( ILBACK ) THEN
-               DO 170 JW = 0, NW - 1
-                  CALL DGEMV( 'N', N, N+1-JE, ONE, VL( 1, JE ), LDVL,
-     $                        WORK( ( JW+2 )*N+JE ), 1, ZERO,
-     $                        WORK( ( JW+4 )*N+1 ), 1 )
-  170          CONTINUE
-               CALL DLACPY( ' ', N, NW, WORK( 4*N+1 ), N, VL( 1, JE ),
-     $                      LDVL )
-               IBEG = 1
-            ELSE
-               CALL DLACPY( ' ', N, NW, WORK( 2*N+1 ), N, VL( 1, IEIG ),
-     $                      LDVL )
-               IBEG = JE
-            END IF
-*
-*           Scale eigenvector
-*
-            XMAX = ZERO
-            IF( ILCPLX ) THEN
-               DO 180 J = IBEG, N
-                  XMAX = MAX( XMAX, ABS( VL( J, IEIG ) )+
-     $                   ABS( VL( J, IEIG+1 ) ) )
-  180          CONTINUE
-            ELSE
-               DO 190 J = IBEG, N
-                  XMAX = MAX( XMAX, ABS( VL( J, IEIG ) ) )
-  190          CONTINUE
-            END IF
-*
-            IF( XMAX.GT.SAFMIN ) THEN
-               XSCALE = ONE / XMAX
-*
-               DO 210 JW = 0, NW - 1
-                  DO 200 JR = IBEG, N
-                     VL( JR, IEIG+JW ) = XSCALE*VL( JR, IEIG+JW )
-  200             CONTINUE
-  210          CONTINUE
-            END IF
-            IEIG = IEIG + NW - 1
-*
-  220    CONTINUE
-      END IF
-*
-*     Right eigenvectors
-*
-      IF( COMPR ) THEN
-         IEIG = IM + 1
-*
-*        Main loop over eigenvalues
-*
-         ILCPLX = .FALSE.
-         DO 500 JE = N, 1, -1
-*
-*           Skip this iteration if (a) HOWMNY='S' and SELECT=.FALSE., or
-*           (b) this would be the second of a complex pair.
-*           Check for complex eigenvalue, so as to be sure of which
-*           entry(-ies) of SELECT to look at -- if complex, SELECT(JE)
-*           or SELECT(JE-1).
-*           If this is a complex pair, the 2-by-2 diagonal block
-*           corresponding to the eigenvalue is in rows/columns JE-1:JE
-*
-            IF( ILCPLX ) THEN
-               ILCPLX = .FALSE.
-               GO TO 500
-            END IF
-            NW = 1
-            IF( JE.GT.1 ) THEN
-               IF( S( JE, JE-1 ).NE.ZERO ) THEN
-                  ILCPLX = .TRUE.
-                  NW = 2
-               END IF
-            END IF
-            IF( ILALL ) THEN
-               ILCOMP = .TRUE.
-            ELSE IF( ILCPLX ) THEN
-               ILCOMP = SELECT( JE ) .OR. SELECT( JE-1 )
-            ELSE
-               ILCOMP = SELECT( JE )
-            END IF
-            IF( .NOT.ILCOMP )
-     $         GO TO 500
-*
-*           Decide if (a) singular pencil, (b) real eigenvalue, or
-*           (c) complex eigenvalue.
-*
-            IF( .NOT.ILCPLX ) THEN
-               IF( ABS( S( JE, JE ) ).LE.SAFMIN .AND.
-     $             ABS( P( JE, JE ) ).LE.SAFMIN ) THEN
-*
-*                 Singular matrix pencil -- unit eigenvector
-*
-                  IEIG = IEIG - 1
-                  DO 230 JR = 1, N
-                     VR( JR, IEIG ) = ZERO
-  230             CONTINUE
-                  VR( IEIG, IEIG ) = ONE
-                  GO TO 500
-               END IF
-            END IF
-*
-*           Clear vector
-*
-            DO 250 JW = 0, NW - 1
-               DO 240 JR = 1, N
-                  WORK( ( JW+2 )*N+JR ) = ZERO
-  240          CONTINUE
-  250       CONTINUE
-*
-*           Compute coefficients in  ( a A - b B ) x = 0
-*              a  is  ACOEF
-*              b  is  BCOEFR + i*BCOEFI
-*
-            IF( .NOT.ILCPLX ) THEN
-*
-*              Real eigenvalue
-*
-               TEMP = ONE / MAX( ABS( S( JE, JE ) )*ASCALE,
-     $                ABS( P( JE, JE ) )*BSCALE, SAFMIN )
-               SALFAR = ( TEMP*S( JE, JE ) )*ASCALE
-               SBETA = ( TEMP*P( JE, JE ) )*BSCALE
-               ACOEF = SBETA*ASCALE
-               BCOEFR = SALFAR*BSCALE
-               BCOEFI = ZERO
-*
-*              Scale to avoid underflow
-*
-               SCALE = ONE
-               LSA = ABS( SBETA ).GE.SAFMIN .AND. ABS( ACOEF ).LT.SMALL
-               LSB = ABS( SALFAR ).GE.SAFMIN .AND. ABS( BCOEFR ).LT.
-     $               SMALL
-               IF( LSA )
-     $            SCALE = ( SMALL / ABS( SBETA ) )*MIN( ANORM, BIG )
-               IF( LSB )
-     $            SCALE = MAX( SCALE, ( SMALL / ABS( SALFAR ) )*
-     $                    MIN( BNORM, BIG ) )
-               IF( LSA .OR. LSB ) THEN
-                  SCALE = MIN( SCALE, ONE /
-     $                    ( SAFMIN*MAX( ONE, ABS( ACOEF ),
-     $                    ABS( BCOEFR ) ) ) )
-                  IF( LSA ) THEN
-                     ACOEF = ASCALE*( SCALE*SBETA )
-                  ELSE
-                     ACOEF = SCALE*ACOEF
-                  END IF
-                  IF( LSB ) THEN
-                     BCOEFR = BSCALE*( SCALE*SALFAR )
-                  ELSE
-                     BCOEFR = SCALE*BCOEFR
-                  END IF
-               END IF
-               ACOEFA = ABS( ACOEF )
-               BCOEFA = ABS( BCOEFR )
-*
-*              First component is 1
-*
-               WORK( 2*N+JE ) = ONE
-               XMAX = ONE
-*
-*              Compute contribution from column JE of A and B to sum
-*              (See "Further Details", above.)
-*
-               DO 260 JR = 1, JE - 1
-                  WORK( 2*N+JR ) = BCOEFR*P( JR, JE ) -
-     $                             ACOEF*S( JR, JE )
-  260          CONTINUE
-            ELSE
-*
-*              Complex eigenvalue
-*
-               CALL DLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), LDP,
-     $                     SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2,
-     $                     BCOEFI )
-               IF( BCOEFI.EQ.ZERO ) THEN
-                  INFO = JE - 1
-                  RETURN
-               END IF
-*
-*              Scale to avoid over/underflow
-*
-               ACOEFA = ABS( ACOEF )
-               BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
-               SCALE = ONE
-               IF( ACOEFA*ULP.LT.SAFMIN .AND. ACOEFA.GE.SAFMIN )
-     $            SCALE = ( SAFMIN / ULP ) / ACOEFA
-               IF( BCOEFA*ULP.LT.SAFMIN .AND. BCOEFA.GE.SAFMIN )
-     $            SCALE = MAX( SCALE, ( SAFMIN / ULP ) / BCOEFA )
-               IF( SAFMIN*ACOEFA.GT.ASCALE )
-     $            SCALE = ASCALE / ( SAFMIN*ACOEFA )
-               IF( SAFMIN*BCOEFA.GT.BSCALE )
-     $            SCALE = MIN( SCALE, BSCALE / ( SAFMIN*BCOEFA ) )
-               IF( SCALE.NE.ONE ) THEN
-                  ACOEF = SCALE*ACOEF
-                  ACOEFA = ABS( ACOEF )
-                  BCOEFR = SCALE*BCOEFR
-                  BCOEFI = SCALE*BCOEFI
-                  BCOEFA = ABS( BCOEFR ) + ABS( BCOEFI )
-               END IF
-*
-*              Compute first two components of eigenvector
-*              and contribution to sums
-*
-               TEMP = ACOEF*S( JE, JE-1 )
-               TEMP2R = ACOEF*S( JE, JE ) - BCOEFR*P( JE, JE )
-               TEMP2I = -BCOEFI*P( JE, JE )
-               IF( ABS( TEMP ).GE.ABS( TEMP2R )+ABS( TEMP2I ) ) THEN
-                  WORK( 2*N+JE ) = ONE
-                  WORK( 3*N+JE ) = ZERO
-                  WORK( 2*N+JE-1 ) = -TEMP2R / TEMP
-                  WORK( 3*N+JE-1 ) = -TEMP2I / TEMP
-               ELSE
-                  WORK( 2*N+JE-1 ) = ONE
-                  WORK( 3*N+JE-1 ) = ZERO
-                  TEMP = ACOEF*S( JE-1, JE )
-                  WORK( 2*N+JE ) = ( BCOEFR*P( JE-1, JE-1 )-ACOEF*
-     $                             S( JE-1, JE-1 ) ) / TEMP
-                  WORK( 3*N+JE ) = BCOEFI*P( JE-1, JE-1 ) / TEMP
-               END IF
-*
-               XMAX = MAX( ABS( WORK( 2*N+JE ) )+ABS( WORK( 3*N+JE ) ),
-     $                ABS( WORK( 2*N+JE-1 ) )+ABS( WORK( 3*N+JE-1 ) ) )
-*
-*              Compute contribution from columns JE and JE-1
-*              of A and B to the sums.
-*
-               CREALA = ACOEF*WORK( 2*N+JE-1 )
-               CIMAGA = ACOEF*WORK( 3*N+JE-1 )
-               CREALB = BCOEFR*WORK( 2*N+JE-1 ) -
-     $                  BCOEFI*WORK( 3*N+JE-1 )
-               CIMAGB = BCOEFI*WORK( 2*N+JE-1 ) +
-     $                  BCOEFR*WORK( 3*N+JE-1 )
-               CRE2A = ACOEF*WORK( 2*N+JE )
-               CIM2A = ACOEF*WORK( 3*N+JE )
-               CRE2B = BCOEFR*WORK( 2*N+JE ) - BCOEFI*WORK( 3*N+JE )
-               CIM2B = BCOEFI*WORK( 2*N+JE ) + BCOEFR*WORK( 3*N+JE )
-               DO 270 JR = 1, JE - 2
-                  WORK( 2*N+JR ) = -CREALA*S( JR, JE-1 ) +
-     $                             CREALB*P( JR, JE-1 ) -
-     $                             CRE2A*S( JR, JE ) + CRE2B*P( JR, JE )
-                  WORK( 3*N+JR ) = -CIMAGA*S( JR, JE-1 ) +
-     $                             CIMAGB*P( JR, JE-1 ) -
-     $                             CIM2A*S( JR, JE ) + CIM2B*P( JR, JE )
-  270          CONTINUE
-            END IF
-*
-            DMIN = MAX( ULP*ACOEFA*ANORM, ULP*BCOEFA*BNORM, SAFMIN )
-*
-*           Columnwise triangular solve of  (a A - b B)  x = 0
-*
-            IL2BY2 = .FALSE.
-            DO 370 J = JE - NW, 1, -1
-*
-*              If a 2-by-2 block, is in position j-1:j, wait until
-*              next iteration to process it (when it will be j:j+1)
-*
-               IF( .NOT.IL2BY2 .AND. J.GT.1 ) THEN
-                  IF( S( J, J-1 ).NE.ZERO ) THEN
-                     IL2BY2 = .TRUE.
-                     GO TO 370
-                  END IF
-               END IF
-               BDIAG( 1 ) = P( J, J )
-               IF( IL2BY2 ) THEN
-                  NA = 2
-                  BDIAG( 2 ) = P( J+1, J+1 )
-               ELSE
-                  NA = 1
-               END IF
-*
-*              Compute x(j) (and x(j+1), if 2-by-2 block)
-*
-               CALL DLALN2( .FALSE., NA, NW, DMIN, ACOEF, S( J, J ),
-     $                      LDS, BDIAG( 1 ), BDIAG( 2 ), WORK( 2*N+J ),
-     $                      N, BCOEFR, BCOEFI, SUM, 2, SCALE, TEMP,
-     $                      IINFO )
-               IF( SCALE.LT.ONE ) THEN
-*
-                  DO 290 JW = 0, NW - 1
-                     DO 280 JR = 1, JE
-                        WORK( ( JW+2 )*N+JR ) = SCALE*
-     $                     WORK( ( JW+2 )*N+JR )
-  280                CONTINUE
-  290             CONTINUE
-               END IF
-               XMAX = MAX( SCALE*XMAX, TEMP )
-*
-               DO 310 JW = 1, NW
-                  DO 300 JA = 1, NA
-                     WORK( ( JW+1 )*N+J+JA-1 ) = SUM( JA, JW )
-  300             CONTINUE
-  310          CONTINUE
-*
-*              w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
-*
-               IF( J.GT.1 ) THEN
-*
-*                 Check whether scaling is necessary for sum.
-*
-                  XSCALE = ONE / MAX( ONE, XMAX )
-                  TEMP = ACOEFA*WORK( J ) + BCOEFA*WORK( N+J )
-                  IF( IL2BY2 )
-     $               TEMP = MAX( TEMP, ACOEFA*WORK( J+1 )+BCOEFA*
-     $                      WORK( N+J+1 ) )
-                  TEMP = MAX( TEMP, ACOEFA, BCOEFA )
-                  IF( TEMP.GT.BIGNUM*XSCALE ) THEN
-*
-                     DO 330 JW = 0, NW - 1
-                        DO 320 JR = 1, JE
-                           WORK( ( JW+2 )*N+JR ) = XSCALE*
-     $                        WORK( ( JW+2 )*N+JR )
-  320                   CONTINUE
-  330                CONTINUE
-                     XMAX = XMAX*XSCALE
-                  END IF
-*
-*                 Compute the contributions of the off-diagonals of
-*                 column j (and j+1, if 2-by-2 block) of A and B to the
-*                 sums.
-*
-*
-                  DO 360 JA = 1, NA
-                     IF( ILCPLX ) THEN
-                        CREALA = ACOEF*WORK( 2*N+J+JA-1 )
-                        CIMAGA = ACOEF*WORK( 3*N+J+JA-1 )
-                        CREALB = BCOEFR*WORK( 2*N+J+JA-1 ) -
-     $                           BCOEFI*WORK( 3*N+J+JA-1 )
-                        CIMAGB = BCOEFI*WORK( 2*N+J+JA-1 ) +
-     $                           BCOEFR*WORK( 3*N+J+JA-1 )
-                        DO 340 JR = 1, J - 1
-                           WORK( 2*N+JR ) = WORK( 2*N+JR ) -
-     $                                      CREALA*S( JR, J+JA-1 ) +
-     $                                      CREALB*P( JR, J+JA-1 )
-                           WORK( 3*N+JR ) = WORK( 3*N+JR ) -
-     $                                      CIMAGA*S( JR, J+JA-1 ) +
-     $                                      CIMAGB*P( JR, J+JA-1 )
-  340                   CONTINUE
-                     ELSE
-                        CREALA = ACOEF*WORK( 2*N+J+JA-1 )
-                        CREALB = BCOEFR*WORK( 2*N+J+JA-1 )
-                        DO 350 JR = 1, J - 1
-                           WORK( 2*N+JR ) = WORK( 2*N+JR ) -
-     $                                      CREALA*S( JR, J+JA-1 ) +
-     $                                      CREALB*P( JR, J+JA-1 )
-  350                   CONTINUE
-                     END IF
-  360             CONTINUE
-               END IF
-*
-               IL2BY2 = .FALSE.
-  370       CONTINUE
-*
-*           Copy eigenvector to VR, back transforming if
-*           HOWMNY='B'.
-*
-            IEIG = IEIG - NW
-            IF( ILBACK ) THEN
-*
-               DO 410 JW = 0, NW - 1
-                  DO 380 JR = 1, N
-                     WORK( ( JW+4 )*N+JR ) = WORK( ( JW+2 )*N+1 )*
-     $                                       VR( JR, 1 )
-  380             CONTINUE
-*
-*                 A series of compiler directives to defeat
-*                 vectorization for the next loop
-*
-*
-                  DO 400 JC = 2, JE
-                     DO 390 JR = 1, N
-                        WORK( ( JW+4 )*N+JR ) = WORK( ( JW+4 )*N+JR ) +
-     $                     WORK( ( JW+2 )*N+JC )*VR( JR, JC )
-  390                CONTINUE
-  400             CONTINUE
-  410          CONTINUE
-*
-               DO 430 JW = 0, NW - 1
-                  DO 420 JR = 1, N
-                     VR( JR, IEIG+JW ) = WORK( ( JW+4 )*N+JR )
-  420             CONTINUE
-  430          CONTINUE
-*
-               IEND = N
-            ELSE
-               DO 450 JW = 0, NW - 1
-                  DO 440 JR = 1, N
-                     VR( JR, IEIG+JW ) = WORK( ( JW+2 )*N+JR )
-  440             CONTINUE
-  450          CONTINUE
-*
-               IEND = JE
-            END IF
-*
-*           Scale eigenvector
-*
-            XMAX = ZERO
-            IF( ILCPLX ) THEN
-               DO 460 J = 1, IEND
-                  XMAX = MAX( XMAX, ABS( VR( J, IEIG ) )+
-     $                   ABS( VR( J, IEIG+1 ) ) )
-  460          CONTINUE
-            ELSE
-               DO 470 J = 1, IEND
-                  XMAX = MAX( XMAX, ABS( VR( J, IEIG ) ) )
-  470          CONTINUE
-            END IF
-*
-            IF( XMAX.GT.SAFMIN ) THEN
-               XSCALE = ONE / XMAX
-               DO 490 JW = 0, NW - 1
-                  DO 480 JR = 1, IEND
-                     VR( JR, IEIG+JW ) = XSCALE*VR( JR, IEIG+JW )
-  480             CONTINUE
-  490          CONTINUE
-            END IF
-  500    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of DTGEVC
-*
-      END
diff --git a/src/lib/lapack/dtgex2.f b/src/lib/lapack/dtgex2.f
deleted file mode 100644
index 8351b7fd..00000000
--- a/src/lib/lapack/dtgex2.f
+++ /dev/null
@@ -1,581 +0,0 @@
-      SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                   LDZ, J1, N1, N2, WORK, LWORK, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            WANTQ, WANTZ
-      INTEGER            INFO, J1, LDA, LDB, LDQ, LDZ, LWORK, N, N1, N2
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-     $                   WORK( * ), Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22)
-*  of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair
-*  (A, B) by an orthogonal equivalence transformation.
-*
-*  (A, B) must be in generalized real Schur canonical form (as returned
-*  by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
-*  diagonal blocks. B is upper triangular.
-*
-*  Optionally, the matrices Q and Z of generalized Schur vectors are
-*  updated.
-*
-*         Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
-*         Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
-*
-*
-*  Arguments
-*  =========
-*
-*  WANTQ   (input) LOGICAL
-*          .TRUE. : update the left transformation matrix Q;
-*          .FALSE.: do not update Q.
-*
-*  WANTZ   (input) LOGICAL
-*          .TRUE. : update the right transformation matrix Z;
-*          .FALSE.: do not update Z.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B. N >= 0.
-*
-*  A      (input/output) DOUBLE PRECISION arrays, dimensions (LDA,N)
-*          On entry, the matrix A in the pair (A, B).
-*          On exit, the updated matrix A.
-*
-*  LDA     (input)  INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  B      (input/output) DOUBLE PRECISION arrays, dimensions (LDB,N)
-*          On entry, the matrix B in the pair (A, B).
-*          On exit, the updated matrix B.
-*
-*  LDB     (input)  INTEGER
-*          The leading dimension of the array B. LDB >= max(1,N).
-*
-*  Q       (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
-*          On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
-*          On exit, the updated matrix Q.
-*          Not referenced if WANTQ = .FALSE..
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q. LDQ >= 1.
-*          If WANTQ = .TRUE., LDQ >= N.
-*
-*  Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
-*          On entry, if WANTZ =.TRUE., the orthogonal matrix Z.
-*          On exit, the updated matrix Z.
-*          Not referenced if WANTZ = .FALSE..
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z. LDZ >= 1.
-*          If WANTZ = .TRUE., LDZ >= N.
-*
-*  J1      (input) INTEGER
-*          The index to the first block (A11, B11). 1 <= J1 <= N.
-*
-*  N1      (input) INTEGER
-*          The order of the first block (A11, B11). N1 = 0, 1 or 2.
-*
-*  N2      (input) INTEGER
-*          The order of the second block (A22, B22). N2 = 0, 1 or 2.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)).
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          LWORK >=  MAX( 1, N*(N2+N1), (N2+N1)*(N2+N1)*2 )
-*
-*  INFO    (output) INTEGER
-*            =0: Successful exit
-*            >0: If INFO = 1, the transformed matrix (A, B) would be
-*                too far from generalized Schur form; the blocks are
-*                not swapped and (A, B) and (Q, Z) are unchanged.
-*                The problem of swapping is too ill-conditioned.
-*            <0: If INFO = -16: LWORK is too small. Appropriate value
-*                for LWORK is returned in WORK(1).
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  In the current code both weak and strong stability tests are
-*  performed. The user can omit the strong stability test by changing
-*  the internal logical parameter WANDS to .FALSE.. See ref. [2] for
-*  details.
-*
-*  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*
-*  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*      Estimation: Theory, Algorithms and Software,
-*      Report UMINF - 94.04, Department of Computing Science, Umea
-*      University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
-*      Note 87. To appear in Numerical Algorithms, 1996.
-*
-*  =====================================================================
-*  Replaced various illegal calls to DCOPY by calls to DLASET, or by DO
-*  loops. Sven Hammarling, 1/5/02.
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-      DOUBLE PRECISION   TEN
-      PARAMETER          ( TEN = 1.0D+01 )
-      INTEGER            LDST
-      PARAMETER          ( LDST = 4 )
-      LOGICAL            WANDS
-      PARAMETER          ( WANDS = .TRUE. )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            DTRONG, WEAK
-      INTEGER            I, IDUM, LINFO, M
-      DOUBLE PRECISION   BQRA21, BRQA21, DDUM, DNORM, DSCALE, DSUM, EPS,
-     $                   F, G, SA, SB, SCALE, SMLNUM, SS, THRESH, WS
-*     ..
-*     .. Local Arrays ..
-      INTEGER            IWORK( LDST )
-      DOUBLE PRECISION   AI( 2 ), AR( 2 ), BE( 2 ), IR( LDST, LDST ),
-     $                   IRCOP( LDST, LDST ), LI( LDST, LDST ),
-     $                   LICOP( LDST, LDST ), S( LDST, LDST ),
-     $                   SCPY( LDST, LDST ), T( LDST, LDST ),
-     $                   TAUL( LDST ), TAUR( LDST ), TCPY( LDST, LDST )
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMM, DGEQR2, DGERQ2, DLACPY, DLAGV2, DLARTG,
-     $                   DLASET, DLASSQ, DORG2R, DORGR2, DORM2R, DORMR2,
-     $                   DROT, DSCAL, DTGSY2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 .OR. N1.LE.0 .OR. N2.LE.0 )
-     $   RETURN
-      IF( N1.GT.N .OR. ( J1+N1 ).GT.N )
-     $   RETURN
-      M = N1 + N2
-      IF( LWORK.LT.MAX( 1, N*M, M*M*2 ) ) THEN
-         INFO = -16
-         WORK( 1 ) = MAX( 1, N*M, M*M*2 )
-         RETURN
-      END IF
-*
-      WEAK = .FALSE.
-      DTRONG = .FALSE.
-*
-*     Make a local copy of selected block
-*
-      CALL DLASET( 'Full', LDST, LDST, ZERO, ZERO, LI, LDST )
-      CALL DLASET( 'Full', LDST, LDST, ZERO, ZERO, IR, LDST )
-      CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, S, LDST )
-      CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, T, LDST )
-*
-*     Compute threshold for testing acceptance of swapping.
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' ) / EPS
-      DSCALE = ZERO
-      DSUM = ONE
-      CALL DLACPY( 'Full', M, M, S, LDST, WORK, M )
-      CALL DLASSQ( M*M, WORK, 1, DSCALE, DSUM )
-      CALL DLACPY( 'Full', M, M, T, LDST, WORK, M )
-      CALL DLASSQ( M*M, WORK, 1, DSCALE, DSUM )
-      DNORM = DSCALE*SQRT( DSUM )
-      THRESH = MAX( TEN*EPS*DNORM, SMLNUM )
-*
-      IF( M.EQ.2 ) THEN
-*
-*        CASE 1: Swap 1-by-1 and 1-by-1 blocks.
-*
-*        Compute orthogonal QL and RQ that swap 1-by-1 and 1-by-1 blocks
-*        using Givens rotations and perform the swap tentatively.
-*
-         F = S( 2, 2 )*T( 1, 1 ) - T( 2, 2 )*S( 1, 1 )
-         G = S( 2, 2 )*T( 1, 2 ) - T( 2, 2 )*S( 1, 2 )
-         SB = ABS( T( 2, 2 ) )
-         SA = ABS( S( 2, 2 ) )
-         CALL DLARTG( F, G, IR( 1, 2 ), IR( 1, 1 ), DDUM )
-         IR( 2, 1 ) = -IR( 1, 2 )
-         IR( 2, 2 ) = IR( 1, 1 )
-         CALL DROT( 2, S( 1, 1 ), 1, S( 1, 2 ), 1, IR( 1, 1 ),
-     $              IR( 2, 1 ) )
-         CALL DROT( 2, T( 1, 1 ), 1, T( 1, 2 ), 1, IR( 1, 1 ),
-     $              IR( 2, 1 ) )
-         IF( SA.GE.SB ) THEN
-            CALL DLARTG( S( 1, 1 ), S( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ),
-     $                   DDUM )
-         ELSE
-            CALL DLARTG( T( 1, 1 ), T( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ),
-     $                   DDUM )
-         END IF
-         CALL DROT( 2, S( 1, 1 ), LDST, S( 2, 1 ), LDST, LI( 1, 1 ),
-     $              LI( 2, 1 ) )
-         CALL DROT( 2, T( 1, 1 ), LDST, T( 2, 1 ), LDST, LI( 1, 1 ),
-     $              LI( 2, 1 ) )
-         LI( 2, 2 ) = LI( 1, 1 )
-         LI( 1, 2 ) = -LI( 2, 1 )
-*
-*        Weak stability test:
-*           |S21| + |T21| <= O(EPS * F-norm((S, T)))
-*
-         WS = ABS( S( 2, 1 ) ) + ABS( T( 2, 1 ) )
-         WEAK = WS.LE.THRESH
-         IF( .NOT.WEAK )
-     $      GO TO 70
-*
-         IF( WANDS ) THEN
-*
-*           Strong stability test:
-*             F-norm((A-QL'*S*QR, B-QL'*T*QR)) <= O(EPS*F-norm((A,B)))
-*
-            CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ),
-     $                   M )
-            CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
-     $                  WORK, M )
-            CALL DGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
-     $                  WORK( M*M+1 ), M )
-            DSCALE = ZERO
-            DSUM = ONE
-            CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
-*
-            CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ),
-     $                   M )
-            CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
-     $                  WORK, M )
-            CALL DGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
-     $                  WORK( M*M+1 ), M )
-            CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
-            SS = DSCALE*SQRT( DSUM )
-            DTRONG = SS.LE.THRESH
-            IF( .NOT.DTRONG )
-     $         GO TO 70
-         END IF
-*
-*        Update (A(J1:J1+M-1, M+J1:N), B(J1:J1+M-1, M+J1:N)) and
-*               (A(1:J1-1, J1:J1+M), B(1:J1-1, J1:J1+M)).
-*
-         CALL DROT( J1+1, A( 1, J1 ), 1, A( 1, J1+1 ), 1, IR( 1, 1 ),
-     $              IR( 2, 1 ) )
-         CALL DROT( J1+1, B( 1, J1 ), 1, B( 1, J1+1 ), 1, IR( 1, 1 ),
-     $              IR( 2, 1 ) )
-         CALL DROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA,
-     $              LI( 1, 1 ), LI( 2, 1 ) )
-         CALL DROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB,
-     $              LI( 1, 1 ), LI( 2, 1 ) )
-*
-*        Set  N1-by-N2 (2,1) - blocks to ZERO.
-*
-         A( J1+1, J1 ) = ZERO
-         B( J1+1, J1 ) = ZERO
-*
-*        Accumulate transformations into Q and Z if requested.
-*
-         IF( WANTZ )
-     $      CALL DROT( N, Z( 1, J1 ), 1, Z( 1, J1+1 ), 1, IR( 1, 1 ),
-     $                 IR( 2, 1 ) )
-         IF( WANTQ )
-     $      CALL DROT( N, Q( 1, J1 ), 1, Q( 1, J1+1 ), 1, LI( 1, 1 ),
-     $                 LI( 2, 1 ) )
-*
-*        Exit with INFO = 0 if swap was successfully performed.
-*
-         RETURN
-*
-      ELSE
-*
-*        CASE 2: Swap 1-by-1 and 2-by-2 blocks, or 2-by-2
-*                and 2-by-2 blocks.
-*
-*        Solve the generalized Sylvester equation
-*                 S11 * R - L * S22 = SCALE * S12
-*                 T11 * R - L * T22 = SCALE * T12
-*        for R and L. Solutions in LI and IR.
-*
-         CALL DLACPY( 'Full', N1, N2, T( 1, N1+1 ), LDST, LI, LDST )
-         CALL DLACPY( 'Full', N1, N2, S( 1, N1+1 ), LDST,
-     $                IR( N2+1, N1+1 ), LDST )
-         CALL DTGSY2( 'N', 0, N1, N2, S, LDST, S( N1+1, N1+1 ), LDST,
-     $                IR( N2+1, N1+1 ), LDST, T, LDST, T( N1+1, N1+1 ),
-     $                LDST, LI, LDST, SCALE, DSUM, DSCALE, IWORK, IDUM,
-     $                LINFO )
-*
-*        Compute orthogonal matrix QL:
-*
-*                    QL' * LI = [ TL ]
-*                               [ 0  ]
-*        where
-*                    LI =  [      -L              ]
-*                          [ SCALE * identity(N2) ]
-*
-         DO 10 I = 1, N2
-            CALL DSCAL( N1, -ONE, LI( 1, I ), 1 )
-            LI( N1+I, I ) = SCALE
-   10    CONTINUE
-         CALL DGEQR2( M, N2, LI, LDST, TAUL, WORK, LINFO )
-         IF( LINFO.NE.0 )
-     $      GO TO 70
-         CALL DORG2R( M, M, N2, LI, LDST, TAUL, WORK, LINFO )
-         IF( LINFO.NE.0 )
-     $      GO TO 70
-*
-*        Compute orthogonal matrix RQ:
-*
-*                    IR * RQ' =   [ 0  TR],
-*
-*         where IR = [ SCALE * identity(N1), R ]
-*
-         DO 20 I = 1, N1
-            IR( N2+I, I ) = SCALE
-   20    CONTINUE
-         CALL DGERQ2( N1, M, IR( N2+1, 1 ), LDST, TAUR, WORK, LINFO )
-         IF( LINFO.NE.0 )
-     $      GO TO 70
-         CALL DORGR2( M, M, N1, IR, LDST, TAUR, WORK, LINFO )
-         IF( LINFO.NE.0 )
-     $      GO TO 70
-*
-*        Perform the swapping tentatively:
-*
-         CALL DGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
-     $               WORK, M )
-         CALL DGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, S,
-     $               LDST )
-         CALL DGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
-     $               WORK, M )
-         CALL DGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, T,
-     $               LDST )
-         CALL DLACPY( 'F', M, M, S, LDST, SCPY, LDST )
-         CALL DLACPY( 'F', M, M, T, LDST, TCPY, LDST )
-         CALL DLACPY( 'F', M, M, IR, LDST, IRCOP, LDST )
-         CALL DLACPY( 'F', M, M, LI, LDST, LICOP, LDST )
-*
-*        Triangularize the B-part by an RQ factorization.
-*        Apply transformation (from left) to A-part, giving S.
-*
-         CALL DGERQ2( M, M, T, LDST, TAUR, WORK, LINFO )
-         IF( LINFO.NE.0 )
-     $      GO TO 70
-         CALL DORMR2( 'R', 'T', M, M, M, T, LDST, TAUR, S, LDST, WORK,
-     $                LINFO )
-         IF( LINFO.NE.0 )
-     $      GO TO 70
-         CALL DORMR2( 'L', 'N', M, M, M, T, LDST, TAUR, IR, LDST, WORK,
-     $                LINFO )
-         IF( LINFO.NE.0 )
-     $      GO TO 70
-*
-*        Compute F-norm(S21) in BRQA21. (T21 is 0.)
-*
-         DSCALE = ZERO
-         DSUM = ONE
-         DO 30 I = 1, N2
-            CALL DLASSQ( N1, S( N2+1, I ), 1, DSCALE, DSUM )
-   30    CONTINUE
-         BRQA21 = DSCALE*SQRT( DSUM )
-*
-*        Triangularize the B-part by a QR factorization.
-*        Apply transformation (from right) to A-part, giving S.
-*
-         CALL DGEQR2( M, M, TCPY, LDST, TAUL, WORK, LINFO )
-         IF( LINFO.NE.0 )
-     $      GO TO 70
-         CALL DORM2R( 'L', 'T', M, M, M, TCPY, LDST, TAUL, SCPY, LDST,
-     $                WORK, INFO )
-         CALL DORM2R( 'R', 'N', M, M, M, TCPY, LDST, TAUL, LICOP, LDST,
-     $                WORK, INFO )
-         IF( LINFO.NE.0 )
-     $      GO TO 70
-*
-*        Compute F-norm(S21) in BQRA21. (T21 is 0.)
-*
-         DSCALE = ZERO
-         DSUM = ONE
-         DO 40 I = 1, N2
-            CALL DLASSQ( N1, SCPY( N2+1, I ), 1, DSCALE, DSUM )
-   40    CONTINUE
-         BQRA21 = DSCALE*SQRT( DSUM )
-*
-*        Decide which method to use.
-*          Weak stability test:
-*             F-norm(S21) <= O(EPS * F-norm((S, T)))
-*
-         IF( BQRA21.LE.BRQA21 .AND. BQRA21.LE.THRESH ) THEN
-            CALL DLACPY( 'F', M, M, SCPY, LDST, S, LDST )
-            CALL DLACPY( 'F', M, M, TCPY, LDST, T, LDST )
-            CALL DLACPY( 'F', M, M, IRCOP, LDST, IR, LDST )
-            CALL DLACPY( 'F', M, M, LICOP, LDST, LI, LDST )
-         ELSE IF( BRQA21.GE.THRESH ) THEN
-            GO TO 70
-         END IF
-*
-*        Set lower triangle of B-part to zero
-*
-         CALL DLASET( 'Lower', M-1, M-1, ZERO, ZERO, T(2,1), LDST )
-*
-         IF( WANDS ) THEN
-*
-*           Strong stability test:
-*              F-norm((A-QL*S*QR', B-QL*T*QR')) <= O(EPS*F-norm((A,B)))
-*
-            CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ),
-     $                   M )
-            CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
-     $                  WORK, M )
-            CALL DGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
-     $                  WORK( M*M+1 ), M )
-            DSCALE = ZERO
-            DSUM = ONE
-            CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
-*
-            CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ),
-     $                   M )
-            CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
-     $                  WORK, M )
-            CALL DGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
-     $                  WORK( M*M+1 ), M )
-            CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
-            SS = DSCALE*SQRT( DSUM )
-            DTRONG = ( SS.LE.THRESH )
-            IF( .NOT.DTRONG )
-     $         GO TO 70
-*
-         END IF
-*
-*        If the swap is accepted ("weakly" and "strongly"), apply the
-*        transformations and set N1-by-N2 (2,1)-block to zero.
-*
-         CALL DLASET( 'Full', N1, N2, ZERO, ZERO, S(N2+1,1), LDST )
-*
-*        copy back M-by-M diagonal block starting at index J1 of (A, B)
-*
-         CALL DLACPY( 'F', M, M, S, LDST, A( J1, J1 ), LDA )
-         CALL DLACPY( 'F', M, M, T, LDST, B( J1, J1 ), LDB )
-         CALL DLASET( 'Full', LDST, LDST, ZERO, ZERO, T, LDST )
-*
-*        Standardize existing 2-by-2 blocks.
-*
-         DO 50 I = 1, M*M
-            WORK(I) = ZERO
-   50    CONTINUE
-         WORK( 1 ) = ONE
-         T( 1, 1 ) = ONE
-         IDUM = LWORK - M*M - 2
-         IF( N2.GT.1 ) THEN
-            CALL DLAGV2( A( J1, J1 ), LDA, B( J1, J1 ), LDB, AR, AI, BE,
-     $                   WORK( 1 ), WORK( 2 ), T( 1, 1 ), T( 2, 1 ) )
-            WORK( M+1 ) = -WORK( 2 )
-            WORK( M+2 ) = WORK( 1 )
-            T( N2, N2 ) = T( 1, 1 )
-            T( 1, 2 ) = -T( 2, 1 )
-         END IF
-         WORK( M*M ) = ONE
-         T( M, M ) = ONE
-*
-         IF( N1.GT.1 ) THEN
-            CALL DLAGV2( A( J1+N2, J1+N2 ), LDA, B( J1+N2, J1+N2 ), LDB,
-     $                   TAUR, TAUL, WORK( M*M+1 ), WORK( N2*M+N2+1 ),
-     $                   WORK( N2*M+N2+2 ), T( N2+1, N2+1 ),
-     $                   T( M, M-1 ) )
-            WORK( M*M ) = WORK( N2*M+N2+1 )
-            WORK( M*M-1 ) = -WORK( N2*M+N2+2 )
-            T( M, M ) = T( N2+1, N2+1 )
-            T( M-1, M ) = -T( M, M-1 )
-         END IF
-         CALL DGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, A( J1, J1+N2 ),
-     $               LDA, ZERO, WORK( M*M+1 ), N2 )
-         CALL DLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, A( J1, J1+N2 ),
-     $                LDA )
-         CALL DGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, B( J1, J1+N2 ),
-     $               LDB, ZERO, WORK( M*M+1 ), N2 )
-         CALL DLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, B( J1, J1+N2 ),
-     $                LDB )
-         CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, WORK, M, ZERO,
-     $               WORK( M*M+1 ), M )
-         CALL DLACPY( 'Full', M, M, WORK( M*M+1 ), M, LI, LDST )
-         CALL DGEMM( 'N', 'N', N2, N1, N1, ONE, A( J1, J1+N2 ), LDA,
-     $               T( N2+1, N2+1 ), LDST, ZERO, WORK, N2 )
-         CALL DLACPY( 'Full', N2, N1, WORK, N2, A( J1, J1+N2 ), LDA )
-         CALL DGEMM( 'N', 'N', N2, N1, N1, ONE, B( J1, J1+N2 ), LDB,
-     $               T( N2+1, N2+1 ), LDST, ZERO, WORK, N2 )
-         CALL DLACPY( 'Full', N2, N1, WORK, N2, B( J1, J1+N2 ), LDB )
-         CALL DGEMM( 'T', 'N', M, M, M, ONE, IR, LDST, T, LDST, ZERO,
-     $               WORK, M )
-         CALL DLACPY( 'Full', M, M, WORK, M, IR, LDST )
-*
-*        Accumulate transformations into Q and Z if requested.
-*
-         IF( WANTQ ) THEN
-            CALL DGEMM( 'N', 'N', N, M, M, ONE, Q( 1, J1 ), LDQ, LI,
-     $                  LDST, ZERO, WORK, N )
-            CALL DLACPY( 'Full', N, M, WORK, N, Q( 1, J1 ), LDQ )
-*
-         END IF
-*
-         IF( WANTZ ) THEN
-            CALL DGEMM( 'N', 'N', N, M, M, ONE, Z( 1, J1 ), LDZ, IR,
-     $                  LDST, ZERO, WORK, N )
-            CALL DLACPY( 'Full', N, M, WORK, N, Z( 1, J1 ), LDZ )
-*
-         END IF
-*
-*        Update (A(J1:J1+M-1, M+J1:N), B(J1:J1+M-1, M+J1:N)) and
-*                (A(1:J1-1, J1:J1+M), B(1:J1-1, J1:J1+M)).
-*
-         I = J1 + M
-         IF( I.LE.N ) THEN
-            CALL DGEMM( 'T', 'N', M, N-I+1, M, ONE, LI, LDST,
-     $                  A( J1, I ), LDA, ZERO, WORK, M )
-            CALL DLACPY( 'Full', M, N-I+1, WORK, M, A( J1, I ), LDA )
-            CALL DGEMM( 'T', 'N', M, N-I+1, M, ONE, LI, LDST,
-     $                  B( J1, I ), LDA, ZERO, WORK, M )
-            CALL DLACPY( 'Full', M, N-I+1, WORK, M, B( J1, I ), LDB )
-         END IF
-         I = J1 - 1
-         IF( I.GT.0 ) THEN
-            CALL DGEMM( 'N', 'N', I, M, M, ONE, A( 1, J1 ), LDA, IR,
-     $                  LDST, ZERO, WORK, I )
-            CALL DLACPY( 'Full', I, M, WORK, I, A( 1, J1 ), LDA )
-            CALL DGEMM( 'N', 'N', I, M, M, ONE, B( 1, J1 ), LDB, IR,
-     $                  LDST, ZERO, WORK, I )
-            CALL DLACPY( 'Full', I, M, WORK, I, B( 1, J1 ), LDB )
-         END IF
-*
-*        Exit with INFO = 0 if swap was successfully performed.
-*
-         RETURN
-*
-      END IF
-*
-*     Exit with INFO = 1 if swap was rejected.
-*
-   70 CONTINUE
-*
-      INFO = 1
-      RETURN
-*
-*     End of DTGEX2
-*
-      END
diff --git a/src/lib/lapack/dtgexc.f b/src/lib/lapack/dtgexc.f
deleted file mode 100644
index bafefea2..00000000
--- a/src/lib/lapack/dtgexc.f
+++ /dev/null
@@ -1,440 +0,0 @@
-      SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                   LDZ, IFST, ILST, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            WANTQ, WANTZ
-      INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-     $                   WORK( * ), Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTGEXC reorders the generalized real Schur decomposition of a real
-*  matrix pair (A,B) using an orthogonal equivalence transformation
-*
-*                 (A, B) = Q * (A, B) * Z',
-*
-*  so that the diagonal block of (A, B) with row index IFST is moved
-*  to row ILST.
-*
-*  (A, B) must be in generalized real Schur canonical form (as returned
-*  by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
-*  diagonal blocks. B is upper triangular.
-*
-*  Optionally, the matrices Q and Z of generalized Schur vectors are
-*  updated.
-*
-*         Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
-*         Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
-*
-*
-*  Arguments
-*  =========
-*
-*  WANTQ   (input) LOGICAL
-*          .TRUE. : update the left transformation matrix Q;
-*          .FALSE.: do not update Q.
-*
-*  WANTZ   (input) LOGICAL
-*          .TRUE. : update the right transformation matrix Z;
-*          .FALSE.: do not update Z.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B. N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the matrix A in generalized real Schur canonical
-*          form.
-*          On exit, the updated matrix A, again in generalized
-*          real Schur canonical form.
-*
-*  LDA     (input)  INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,N)
-*          On entry, the matrix B in generalized real Schur canonical
-*          form (A,B).
-*          On exit, the updated matrix B, again in generalized
-*          real Schur canonical form (A,B).
-*
-*  LDB     (input)  INTEGER
-*          The leading dimension of the array B. LDB >= max(1,N).
-*
-*  Q       (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
-*          On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
-*          On exit, the updated matrix Q.
-*          If WANTQ = .FALSE., Q is not referenced.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q. LDQ >= 1.
-*          If WANTQ = .TRUE., LDQ >= N.
-*
-*  Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
-*          On entry, if WANTZ = .TRUE., the orthogonal matrix Z.
-*          On exit, the updated matrix Z.
-*          If WANTZ = .FALSE., Z is not referenced.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z. LDZ >= 1.
-*          If WANTZ = .TRUE., LDZ >= N.
-*
-*  IFST    (input/output) INTEGER
-*  ILST    (input/output) INTEGER
-*          Specify the reordering of the diagonal blocks of (A, B).
-*          The block with row index IFST is moved to row ILST, by a
-*          sequence of swapping between adjacent blocks.
-*          On exit, if IFST pointed on entry to the second row of
-*          a 2-by-2 block, it is changed to point to the first row;
-*          ILST always points to the first row of the block in its
-*          final position (which may differ from its input value by
-*          +1 or -1). 1 <= IFST, ILST <= N.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          LWORK >= 1 when N <= 1, otherwise LWORK >= 4*N + 16.
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*           =0:  successful exit.
-*           <0:  if INFO = -i, the i-th argument had an illegal value.
-*           =1:  The transformed matrix pair (A, B) would be too far
-*                from generalized Schur form; the problem is ill-
-*                conditioned. (A, B) may have been partially reordered,
-*                and ILST points to the first row of the current
-*                position of the block being moved.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            HERE, LWMIN, NBF, NBL, NBNEXT
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DTGEX2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test input arguments.
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN
-         INFO = -9
-      ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN
-         INFO = -11
-      ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
-         INFO = -12
-      ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
-         INFO = -13
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( N.LE.1 ) THEN
-            LWMIN = 1
-         ELSE
-            LWMIN = 4*N + 16
-         END IF
-         WORK(1) = LWMIN
-*
-         IF (LWORK.LT.LWMIN .AND. .NOT.LQUERY) THEN
-            INFO = -15
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTGEXC', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-*     Determine the first row of the specified block and find out
-*     if it is 1-by-1 or 2-by-2.
-*
-      IF( IFST.GT.1 ) THEN
-         IF( A( IFST, IFST-1 ).NE.ZERO )
-     $      IFST = IFST - 1
-      END IF
-      NBF = 1
-      IF( IFST.LT.N ) THEN
-         IF( A( IFST+1, IFST ).NE.ZERO )
-     $      NBF = 2
-      END IF
-*
-*     Determine the first row of the final block
-*     and find out if it is 1-by-1 or 2-by-2.
-*
-      IF( ILST.GT.1 ) THEN
-         IF( A( ILST, ILST-1 ).NE.ZERO )
-     $      ILST = ILST - 1
-      END IF
-      NBL = 1
-      IF( ILST.LT.N ) THEN
-         IF( A( ILST+1, ILST ).NE.ZERO )
-     $      NBL = 2
-      END IF
-      IF( IFST.EQ.ILST )
-     $   RETURN
-*
-      IF( IFST.LT.ILST ) THEN
-*
-*        Update ILST.
-*
-         IF( NBF.EQ.2 .AND. NBL.EQ.1 )
-     $      ILST = ILST - 1
-         IF( NBF.EQ.1 .AND. NBL.EQ.2 )
-     $      ILST = ILST + 1
-*
-         HERE = IFST
-*
-   10    CONTINUE
-*
-*        Swap with next one below.
-*
-         IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-*           Current block either 1-by-1 or 2-by-2.
-*
-            NBNEXT = 1
-            IF( HERE+NBF+1.LE.N ) THEN
-               IF( A( HERE+NBF+1, HERE+NBF ).NE.ZERO )
-     $            NBNEXT = 2
-            END IF
-            CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                   LDZ, HERE, NBF, NBNEXT, WORK, LWORK, INFO )
-            IF( INFO.NE.0 ) THEN
-               ILST = HERE
-               RETURN
-            END IF
-            HERE = HERE + NBNEXT
-*
-*           Test if 2-by-2 block breaks into two 1-by-1 blocks.
-*
-            IF( NBF.EQ.2 ) THEN
-               IF( A( HERE+1, HERE ).EQ.ZERO )
-     $            NBF = 3
-            END IF
-*
-         ELSE
-*
-*           Current block consists of two 1-by-1 blocks, each of which
-*           must be swapped individually.
-*
-            NBNEXT = 1
-            IF( HERE+3.LE.N ) THEN
-               IF( A( HERE+3, HERE+2 ).NE.ZERO )
-     $            NBNEXT = 2
-            END IF
-            CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                   LDZ, HERE+1, 1, NBNEXT, WORK, LWORK, INFO )
-            IF( INFO.NE.0 ) THEN
-               ILST = HERE
-               RETURN
-            END IF
-            IF( NBNEXT.EQ.1 ) THEN
-*
-*              Swap two 1-by-1 blocks.
-*
-               CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                      LDZ, HERE, 1, 1, WORK, LWORK, INFO )
-               IF( INFO.NE.0 ) THEN
-                  ILST = HERE
-                  RETURN
-               END IF
-               HERE = HERE + 1
-*
-            ELSE
-*
-*              Recompute NBNEXT in case of 2-by-2 split.
-*
-               IF( A( HERE+2, HERE+1 ).EQ.ZERO )
-     $            NBNEXT = 1
-               IF( NBNEXT.EQ.2 ) THEN
-*
-*                 2-by-2 block did not split.
-*
-                  CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
-     $                         Z, LDZ, HERE, 1, NBNEXT, WORK, LWORK,
-     $                         INFO )
-                  IF( INFO.NE.0 ) THEN
-                     ILST = HERE
-                     RETURN
-                  END IF
-                  HERE = HERE + 2
-               ELSE
-*
-*                 2-by-2 block did split.
-*
-                  CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
-     $                         Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
-                  IF( INFO.NE.0 ) THEN
-                     ILST = HERE
-                     RETURN
-                  END IF
-                  HERE = HERE + 1
-                  CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
-     $                         Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
-                  IF( INFO.NE.0 ) THEN
-                     ILST = HERE
-                     RETURN
-                  END IF
-                  HERE = HERE + 1
-               END IF
-*
-            END IF
-         END IF
-         IF( HERE.LT.ILST )
-     $      GO TO 10
-      ELSE
-         HERE = IFST
-*
-   20    CONTINUE
-*
-*        Swap with next one below.
-*
-         IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-*           Current block either 1-by-1 or 2-by-2.
-*
-            NBNEXT = 1
-            IF( HERE.GE.3 ) THEN
-               IF( A( HERE-1, HERE-2 ).NE.ZERO )
-     $            NBNEXT = 2
-            END IF
-            CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                   LDZ, HERE-NBNEXT, NBNEXT, NBF, WORK, LWORK,
-     $                   INFO )
-            IF( INFO.NE.0 ) THEN
-               ILST = HERE
-               RETURN
-            END IF
-            HERE = HERE - NBNEXT
-*
-*           Test if 2-by-2 block breaks into two 1-by-1 blocks.
-*
-            IF( NBF.EQ.2 ) THEN
-               IF( A( HERE+1, HERE ).EQ.ZERO )
-     $            NBF = 3
-            END IF
-*
-         ELSE
-*
-*           Current block consists of two 1-by-1 blocks, each of which
-*           must be swapped individually.
-*
-            NBNEXT = 1
-            IF( HERE.GE.3 ) THEN
-               IF( A( HERE-1, HERE-2 ).NE.ZERO )
-     $            NBNEXT = 2
-            END IF
-            CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                   LDZ, HERE-NBNEXT, NBNEXT, 1, WORK, LWORK,
-     $                   INFO )
-            IF( INFO.NE.0 ) THEN
-               ILST = HERE
-               RETURN
-            END IF
-            IF( NBNEXT.EQ.1 ) THEN
-*
-*              Swap two 1-by-1 blocks.
-*
-               CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                      LDZ, HERE, NBNEXT, 1, WORK, LWORK, INFO )
-               IF( INFO.NE.0 ) THEN
-                  ILST = HERE
-                  RETURN
-               END IF
-               HERE = HERE - 1
-            ELSE
-*
-*             Recompute NBNEXT in case of 2-by-2 split.
-*
-               IF( A( HERE, HERE-1 ).EQ.ZERO )
-     $            NBNEXT = 1
-               IF( NBNEXT.EQ.2 ) THEN
-*
-*                 2-by-2 block did not split.
-*
-                  CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
-     $                         Z, LDZ, HERE-1, 2, 1, WORK, LWORK, INFO )
-                  IF( INFO.NE.0 ) THEN
-                     ILST = HERE
-                     RETURN
-                  END IF
-                  HERE = HERE - 2
-               ELSE
-*
-*                 2-by-2 block did split.
-*
-                  CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
-     $                         Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
-                  IF( INFO.NE.0 ) THEN
-                     ILST = HERE
-                     RETURN
-                  END IF
-                  HERE = HERE - 1
-                  CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
-     $                         Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
-                  IF( INFO.NE.0 ) THEN
-                     ILST = HERE
-                     RETURN
-                  END IF
-                  HERE = HERE - 1
-               END IF
-            END IF
-         END IF
-         IF( HERE.GT.ILST )
-     $      GO TO 20
-      END IF
-      ILST = HERE
-      WORK( 1 ) = LWMIN
-      RETURN
-*
-*     End of DTGEXC
-*
-      END
diff --git a/src/lib/lapack/dtgsen.f b/src/lib/lapack/dtgsen.f
deleted file mode 100644
index 917a7b0f..00000000
--- a/src/lib/lapack/dtgsen.f
+++ /dev/null
@@ -1,723 +0,0 @@
-      SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB,
-     $                   ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL,
-     $                   PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     Modified to call DLACN2 in place of DLACON, 5 Feb 03, SJH.
-*
-*     .. Scalar Arguments ..
-      LOGICAL            WANTQ, WANTZ
-      INTEGER            IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
-     $                   M, N
-      DOUBLE PRECISION   PL, PR
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            SELECT( * )
-      INTEGER            IWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
-     $                   B( LDB, * ), BETA( * ), DIF( * ), Q( LDQ, * ),
-     $                   WORK( * ), Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTGSEN reorders the generalized real Schur decomposition of a real
-*  matrix pair (A, B) (in terms of an orthonormal equivalence trans-
-*  formation Q' * (A, B) * Z), so that a selected cluster of eigenvalues
-*  appears in the leading diagonal blocks of the upper quasi-triangular
-*  matrix A and the upper triangular B. The leading columns of Q and
-*  Z form orthonormal bases of the corresponding left and right eigen-
-*  spaces (deflating subspaces). (A, B) must be in generalized real
-*  Schur canonical form (as returned by DGGES), i.e. A is block upper
-*  triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper
-*  triangular.
-*
-*  DTGSEN also computes the generalized eigenvalues
-*
-*              w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j)
-*
-*  of the reordered matrix pair (A, B).
-*
-*  Optionally, DTGSEN computes the estimates of reciprocal condition
-*  numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
-*  (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
-*  between the matrix pairs (A11, B11) and (A22,B22) that correspond to
-*  the selected cluster and the eigenvalues outside the cluster, resp.,
-*  and norms of "projections" onto left and right eigenspaces w.r.t.
-*  the selected cluster in the (1,1)-block.
-*
-*  Arguments
-*  =========
-*
-*  IJOB    (input) INTEGER
-*          Specifies whether condition numbers are required for the
-*          cluster of eigenvalues (PL and PR) or the deflating subspaces
-*          (Difu and Difl):
-*           =0: Only reorder w.r.t. SELECT. No extras.
-*           =1: Reciprocal of norms of "projections" onto left and right
-*               eigenspaces w.r.t. the selected cluster (PL and PR).
-*           =2: Upper bounds on Difu and Difl. F-norm-based estimate
-*               (DIF(1:2)).
-*           =3: Estimate of Difu and Difl. 1-norm-based estimate
-*               (DIF(1:2)).
-*               About 5 times as expensive as IJOB = 2.
-*           =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
-*               version to get it all.
-*           =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
-*
-*  WANTQ   (input) LOGICAL
-*          .TRUE. : update the left transformation matrix Q;
-*          .FALSE.: do not update Q.
-*
-*  WANTZ   (input) LOGICAL
-*          .TRUE. : update the right transformation matrix Z;
-*          .FALSE.: do not update Z.
-*
-*  SELECT  (input) LOGICAL array, dimension (N)
-*          SELECT specifies the eigenvalues in the selected cluster.
-*          To select a real eigenvalue w(j), SELECT(j) must be set to
-*          .TRUE.. To select a complex conjugate pair of eigenvalues
-*          w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
-*          either SELECT(j) or SELECT(j+1) or both must be set to
-*          .TRUE.; a complex conjugate pair of eigenvalues must be
-*          either both included in the cluster or both excluded.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B. N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension(LDA,N)
-*          On entry, the upper quasi-triangular matrix A, with (A, B) in
-*          generalized real Schur canonical form.
-*          On exit, A is overwritten by the reordered matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension(LDB,N)
-*          On entry, the upper triangular matrix B, with (A, B) in
-*          generalized real Schur canonical form.
-*          On exit, B is overwritten by the reordered matrix B.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1,N).
-*
-*  ALPHAR  (output) DOUBLE PRECISION array, dimension (N)
-*  ALPHAI  (output) DOUBLE PRECISION array, dimension (N)
-*  BETA    (output) DOUBLE PRECISION array, dimension (N)
-*          On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
-*          be the generalized eigenvalues.  ALPHAR(j) + ALPHAI(j)*i
-*          and BETA(j),j=1,...,N  are the diagonals of the complex Schur
-*          form (S,T) that would result if the 2-by-2 diagonal blocks of
-*          the real generalized Schur form of (A,B) were further reduced
-*          to triangular form using complex unitary transformations.
-*          If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
-*          positive, then the j-th and (j+1)-st eigenvalues are a
-*          complex conjugate pair, with ALPHAI(j+1) negative.
-*
-*  Q       (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
-*          On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
-*          On exit, Q has been postmultiplied by the left orthogonal
-*          transformation matrix which reorder (A, B); The leading M
-*          columns of Q form orthonormal bases for the specified pair of
-*          left eigenspaces (deflating subspaces).
-*          If WANTQ = .FALSE., Q is not referenced.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q.  LDQ >= 1;
-*          and if WANTQ = .TRUE., LDQ >= N.
-*
-*  Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
-*          On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
-*          On exit, Z has been postmultiplied by the left orthogonal
-*          transformation matrix which reorder (A, B); The leading M
-*          columns of Z form orthonormal bases for the specified pair of
-*          left eigenspaces (deflating subspaces).
-*          If WANTZ = .FALSE., Z is not referenced.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z. LDZ >= 1;
-*          If WANTZ = .TRUE., LDZ >= N.
-*
-*  M       (output) INTEGER
-*          The dimension of the specified pair of left and right eigen-
-*          spaces (deflating subspaces). 0 <= M <= N.
-*
-*  PL      (output) DOUBLE PRECISION
-*  PR      (output) DOUBLE PRECISION
-*          If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
-*          reciprocal of the norm of "projections" onto left and right
-*          eigenspaces with respect to the selected cluster.
-*          0 < PL, PR <= 1.
-*          If M = 0 or M = N, PL = PR  = 1.
-*          If IJOB = 0, 2 or 3, PL and PR are not referenced.
-*
-*  DIF     (output) DOUBLE PRECISION array, dimension (2).
-*          If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl.
-*          If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
-*          Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
-*          estimates of Difu and Difl.
-*          If M = 0 or N, DIF(1:2) = F-norm([A, B]).
-*          If IJOB = 0 or 1, DIF is not referenced.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          IF IJOB = 0, WORK is not referenced.  Otherwise,
-*          on exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >=  4*N+16.
-*          If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)).
-*          If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)).
-*
-*          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.
-*
-*  IWORK   (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
-*          IF IJOB = 0, IWORK is not referenced.  Otherwise,
-*          on exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*
-*  LIWORK  (input) INTEGER
-*          The dimension of the array IWORK. LIWORK >= 1.
-*          If IJOB = 1, 2 or 4, LIWORK >=  N+6.
-*          If IJOB = 3 or 5, LIWORK >= MAX(2*M*(N-M), N+6).
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*            =0: Successful exit.
-*            <0: If INFO = -i, the i-th argument had an illegal value.
-*            =1: Reordering of (A, B) failed because the transformed
-*                matrix pair (A, B) would be too far from generalized
-*                Schur form; the problem is very ill-conditioned.
-*                (A, B) may have been partially reordered.
-*                If requested, 0 is returned in DIF(*), PL and PR.
-*
-*  Further Details
-*  ===============
-*
-*  DTGSEN first collects the selected eigenvalues by computing
-*  orthogonal U and W that move them to the top left corner of (A, B).
-*  In other words, the selected eigenvalues are the eigenvalues of
-*  (A11, B11) in:
-*
-*                U'*(A, B)*W = (A11 A12) (B11 B12) n1
-*                              ( 0  A22),( 0  B22) n2
-*                                n1  n2    n1  n2
-*
-*  where N = n1+n2 and U' means the transpose of U. The first n1 columns
-*  of U and W span the specified pair of left and right eigenspaces
-*  (deflating subspaces) of (A, B).
-*
-*  If (A, B) has been obtained from the generalized real Schur
-*  decomposition of a matrix pair (C, D) = Q*(A, B)*Z', then the
-*  reordered generalized real Schur form of (C, D) is given by
-*
-*           (C, D) = (Q*U)*(U'*(A, B)*W)*(Z*W)',
-*
-*  and the first n1 columns of Q*U and Z*W span the corresponding
-*  deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
-*
-*  Note that if the selected eigenvalue is sufficiently ill-conditioned,
-*  then its value may differ significantly from its value before
-*  reordering.
-*
-*  The reciprocal condition numbers of the left and right eigenspaces
-*  spanned by the first n1 columns of U and W (or Q*U and Z*W) may
-*  be returned in DIF(1:2), corresponding to Difu and Difl, resp.
-*
-*  The Difu and Difl are defined as:
-*
-*       Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
-*  and
-*       Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
-*
-*  where sigma-min(Zu) is the smallest singular value of the
-*  (2*n1*n2)-by-(2*n1*n2) matrix
-*
-*       Zu = [ kron(In2, A11)  -kron(A22', In1) ]
-*            [ kron(In2, B11)  -kron(B22', In1) ].
-*
-*  Here, Inx is the identity matrix of size nx and A22' is the
-*  transpose of A22. kron(X, Y) is the Kronecker product between
-*  the matrices X and Y.
-*
-*  When DIF(2) is small, small changes in (A, B) can cause large changes
-*  in the deflating subspace. An approximate (asymptotic) bound on the
-*  maximum angular error in the computed deflating subspaces is
-*
-*       EPS * norm((A, B)) / DIF(2),
-*
-*  where EPS is the machine precision.
-*
-*  The reciprocal norm of the projectors on the left and right
-*  eigenspaces associated with (A11, B11) may be returned in PL and PR.
-*  They are computed as follows. First we compute L and R so that
-*  P*(A, B)*Q is block diagonal, where
-*
-*       P = ( I -L ) n1           Q = ( I R ) n1
-*           ( 0  I ) n2    and        ( 0 I ) n2
-*             n1 n2                    n1 n2
-*
-*  and (L, R) is the solution to the generalized Sylvester equation
-*
-*       A11*R - L*A22 = -A12
-*       B11*R - L*B22 = -B12
-*
-*  Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
-*  An approximate (asymptotic) bound on the average absolute error of
-*  the selected eigenvalues is
-*
-*       EPS * norm((A, B)) / PL.
-*
-*  There are also global error bounds which valid for perturbations up
-*  to a certain restriction:  A lower bound (x) on the smallest
-*  F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
-*  coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
-*  (i.e. (A + E, B + F), is
-*
-*   x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
-*
-*  An approximate bound on x can be computed from DIF(1:2), PL and PR.
-*
-*  If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed
-*  (L', R') and unperturbed (L, R) left and right deflating subspaces
-*  associated with the selected cluster in the (1,1)-blocks can be
-*  bounded as
-*
-*   max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
-*   max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
-*
-*  See LAPACK User's Guide section 4.11 or the following references
-*  for more information.
-*
-*  Note that if the default method for computing the Frobenius-norm-
-*  based estimate DIF is not wanted (see DLATDF), then the parameter
-*  IDIFJB (see below) should be changed from 3 to 4 (routine DLATDF
-*  (IJOB = 2 will be used)). See DTGSYL for more details.
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  References
-*  ==========
-*
-*  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*
-*  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*      Estimation: Theory, Algorithms and Software,
-*      Report UMINF - 94.04, Department of Computing Science, Umea
-*      University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
-*      Note 87. To appear in Numerical Algorithms, 1996.
-*
-*  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*      for Solving the Generalized Sylvester Equation and Estimating the
-*      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*      Department of Computing Science, Umea University, S-901 87 Umea,
-*      Sweden, December 1993, Revised April 1994, Also as LAPACK Working
-*      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
-*      1996.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            IDIFJB
-      PARAMETER          ( IDIFJB = 3 )
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, PAIR, SWAP, WANTD, WANTD1, WANTD2,
-     $                   WANTP
-      INTEGER            I, IERR, IJB, K, KASE, KK, KS, LIWMIN, LWMIN,
-     $                   MN2, N1, N2
-      DOUBLE PRECISION   DSCALE, DSUM, EPS, RDSCAL, SMLNUM
-*     ..
-*     .. Local Arrays ..
-      INTEGER            ISAVE( 3 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLACN2, DLACPY, DLAG2, DLASSQ, DTGEXC, DTGSYL,
-     $                   XERBLA
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, SIGN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test the input parameters
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
-      IF( IJOB.LT.0 .OR. IJOB.GT.5 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
-         INFO = -14
-      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
-         INFO = -16
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTGSEN', -INFO )
-         RETURN
-      END IF
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' ) / EPS
-      IERR = 0
-*
-      WANTP = IJOB.EQ.1 .OR. IJOB.GE.4
-      WANTD1 = IJOB.EQ.2 .OR. IJOB.EQ.4
-      WANTD2 = IJOB.EQ.3 .OR. IJOB.EQ.5
-      WANTD = WANTD1 .OR. WANTD2
-*
-*     Set M to the dimension of the specified pair of deflating
-*     subspaces.
-*
-      M = 0
-      PAIR = .FALSE.
-      DO 10 K = 1, N
-         IF( PAIR ) THEN
-            PAIR = .FALSE.
-         ELSE
-            IF( K.LT.N ) THEN
-               IF( A( K+1, K ).EQ.ZERO ) THEN
-                  IF( SELECT( K ) )
-     $               M = M + 1
-               ELSE
-                  PAIR = .TRUE.
-                  IF( SELECT( K ) .OR. SELECT( K+1 ) )
-     $               M = M + 2
-               END IF
-            ELSE
-               IF( SELECT( N ) )
-     $            M = M + 1
-            END IF
-         END IF
-   10 CONTINUE
-*
-      IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN
-         LWMIN = MAX( 1, 4*N+16, 2*M*( N-M ) )
-         LIWMIN = MAX( 1, N+6 )
-      ELSE IF( IJOB.EQ.3 .OR. IJOB.EQ.5 ) THEN
-         LWMIN = MAX( 1, 4*N+16, 4*M*( N-M ) )
-         LIWMIN = MAX( 1, 2*M*( N-M ), N+6 )
-      ELSE
-         LWMIN = MAX( 1, 4*N+16 )
-         LIWMIN = 1
-      END IF
-*
-      WORK( 1 ) = LWMIN
-      IWORK( 1 ) = LIWMIN
-*
-      IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
-         INFO = -22
-      ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
-         INFO = -24
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTGSEN', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( M.EQ.N .OR. M.EQ.0 ) THEN
-         IF( WANTP ) THEN
-            PL = ONE
-            PR = ONE
-         END IF
-         IF( WANTD ) THEN
-            DSCALE = ZERO
-            DSUM = ONE
-            DO 20 I = 1, N
-               CALL DLASSQ( N, A( 1, I ), 1, DSCALE, DSUM )
-               CALL DLASSQ( N, B( 1, I ), 1, DSCALE, DSUM )
-   20       CONTINUE
-            DIF( 1 ) = DSCALE*SQRT( DSUM )
-            DIF( 2 ) = DIF( 1 )
-         END IF
-         GO TO 60
-      END IF
-*
-*     Collect the selected blocks at the top-left corner of (A, B).
-*
-      KS = 0
-      PAIR = .FALSE.
-      DO 30 K = 1, N
-         IF( PAIR ) THEN
-            PAIR = .FALSE.
-         ELSE
-*
-            SWAP = SELECT( K )
-            IF( K.LT.N ) THEN
-               IF( A( K+1, K ).NE.ZERO ) THEN
-                  PAIR = .TRUE.
-                  SWAP = SWAP .OR. SELECT( K+1 )
-               END IF
-            END IF
-*
-            IF( SWAP ) THEN
-               KS = KS + 1
-*
-*              Swap the K-th block to position KS.
-*              Perform the reordering of diagonal blocks in (A, B)
-*              by orthogonal transformation matrices and update
-*              Q and Z accordingly (if requested):
-*
-               KK = K
-               IF( K.NE.KS )
-     $            CALL DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
-     $                         Z, LDZ, KK, KS, WORK, LWORK, IERR )
-*
-               IF( IERR.GT.0 ) THEN
-*
-*                 Swap is rejected: exit.
-*
-                  INFO = 1
-                  IF( WANTP ) THEN
-                     PL = ZERO
-                     PR = ZERO
-                  END IF
-                  IF( WANTD ) THEN
-                     DIF( 1 ) = ZERO
-                     DIF( 2 ) = ZERO
-                  END IF
-                  GO TO 60
-               END IF
-*
-               IF( PAIR )
-     $            KS = KS + 1
-            END IF
-         END IF
-   30 CONTINUE
-      IF( WANTP ) THEN
-*
-*        Solve generalized Sylvester equation for R and L
-*        and compute PL and PR.
-*
-         N1 = M
-         N2 = N - M
-         I = N1 + 1
-         IJB = 0
-         CALL DLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 )
-         CALL DLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ),
-     $                N1 )
-         CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
-     $                N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1,
-     $                DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ),
-     $                LWORK-2*N1*N2, IWORK, IERR )
-*
-*        Estimate the reciprocal of norms of "projections" onto left
-*        and right eigenspaces.
-*
-         RDSCAL = ZERO
-         DSUM = ONE
-         CALL DLASSQ( N1*N2, WORK, 1, RDSCAL, DSUM )
-         PL = RDSCAL*SQRT( DSUM )
-         IF( PL.EQ.ZERO ) THEN
-            PL = ONE
-         ELSE
-            PL = DSCALE / ( SQRT( DSCALE*DSCALE / PL+PL )*SQRT( PL ) )
-         END IF
-         RDSCAL = ZERO
-         DSUM = ONE
-         CALL DLASSQ( N1*N2, WORK( N1*N2+1 ), 1, RDSCAL, DSUM )
-         PR = RDSCAL*SQRT( DSUM )
-         IF( PR.EQ.ZERO ) THEN
-            PR = ONE
-         ELSE
-            PR = DSCALE / ( SQRT( DSCALE*DSCALE / PR+PR )*SQRT( PR ) )
-         END IF
-      END IF
-*
-      IF( WANTD ) THEN
-*
-*        Compute estimates of Difu and Difl.
-*
-         IF( WANTD1 ) THEN
-            N1 = M
-            N2 = N - M
-            I = N1 + 1
-            IJB = IDIFJB
-*
-*           Frobenius norm-based Difu-estimate.
-*
-            CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
-     $                   N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ),
-     $                   N1, DSCALE, DIF( 1 ), WORK( 2*N1*N2+1 ),
-     $                   LWORK-2*N1*N2, IWORK, IERR )
-*
-*           Frobenius norm-based Difl-estimate.
-*
-            CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK,
-     $                   N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ),
-     $                   N2, DSCALE, DIF( 2 ), WORK( 2*N1*N2+1 ),
-     $                   LWORK-2*N1*N2, IWORK, IERR )
-         ELSE
-*
-*
-*           Compute 1-norm-based estimates of Difu and Difl using
-*           reversed communication with DLACN2. In each step a
-*           generalized Sylvester equation or a transposed variant
-*           is solved.
-*
-            KASE = 0
-            N1 = M
-            N2 = N - M
-            I = N1 + 1
-            IJB = 0
-            MN2 = 2*N1*N2
-*
-*           1-norm-based estimate of Difu.
-*
-   40       CONTINUE
-            CALL DLACN2( MN2, WORK( MN2+1 ), WORK, IWORK, DIF( 1 ),
-     $                   KASE, ISAVE )
-            IF( KASE.NE.0 ) THEN
-               IF( KASE.EQ.1 ) THEN
-*
-*                 Solve generalized Sylvester equation.
-*
-                  CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA,
-     $                         WORK, N1, B, LDB, B( I, I ), LDB,
-     $                         WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
-     $                         WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
-     $                         IERR )
-               ELSE
-*
-*                 Solve the transposed variant.
-*
-                  CALL DTGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), LDA,
-     $                         WORK, N1, B, LDB, B( I, I ), LDB,
-     $                         WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
-     $                         WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
-     $                         IERR )
-               END IF
-               GO TO 40
-            END IF
-            DIF( 1 ) = DSCALE / DIF( 1 )
-*
-*           1-norm-based estimate of Difl.
-*
-   50       CONTINUE
-            CALL DLACN2( MN2, WORK( MN2+1 ), WORK, IWORK, DIF( 2 ),
-     $                   KASE, ISAVE )
-            IF( KASE.NE.0 ) THEN
-               IF( KASE.EQ.1 ) THEN
-*
-*                 Solve generalized Sylvester equation.
-*
-                  CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA,
-     $                         WORK, N2, B( I, I ), LDB, B, LDB,
-     $                         WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
-     $                         WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
-     $                         IERR )
-               ELSE
-*
-*                 Solve the transposed variant.
-*
-                  CALL DTGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, LDA,
-     $                         WORK, N2, B( I, I ), LDB, B, LDB,
-     $                         WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
-     $                         WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
-     $                         IERR )
-               END IF
-               GO TO 50
-            END IF
-            DIF( 2 ) = DSCALE / DIF( 2 )
-*
-         END IF
-      END IF
-*
-   60 CONTINUE
-*
-*     Compute generalized eigenvalues of reordered pair (A, B) and
-*     normalize the generalized Schur form.
-*
-      PAIR = .FALSE.
-      DO 80 K = 1, N
-         IF( PAIR ) THEN
-            PAIR = .FALSE.
-         ELSE
-*
-            IF( K.LT.N ) THEN
-               IF( A( K+1, K ).NE.ZERO ) THEN
-                  PAIR = .TRUE.
-               END IF
-            END IF
-*
-            IF( PAIR ) THEN
-*
-*             Compute the eigenvalue(s) at position K.
-*
-               WORK( 1 ) = A( K, K )
-               WORK( 2 ) = A( K+1, K )
-               WORK( 3 ) = A( K, K+1 )
-               WORK( 4 ) = A( K+1, K+1 )
-               WORK( 5 ) = B( K, K )
-               WORK( 6 ) = B( K+1, K )
-               WORK( 7 ) = B( K, K+1 )
-               WORK( 8 ) = B( K+1, K+1 )
-               CALL DLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA( K ),
-     $                     BETA( K+1 ), ALPHAR( K ), ALPHAR( K+1 ),
-     $                     ALPHAI( K ) )
-               ALPHAI( K+1 ) = -ALPHAI( K )
-*
-            ELSE
-*
-               IF( SIGN( ONE, B( K, K ) ).LT.ZERO ) THEN
-*
-*                 If B(K,K) is negative, make it positive
-*
-                  DO 70 I = 1, N
-                     A( K, I ) = -A( K, I )
-                     B( K, I ) = -B( K, I )
-                     Q( I, K ) = -Q( I, K )
-   70             CONTINUE
-               END IF
-*
-               ALPHAR( K ) = A( K, K )
-               ALPHAI( K ) = ZERO
-               BETA( K ) = B( K, K )
-*
-            END IF
-         END IF
-   80 CONTINUE
-*
-      WORK( 1 ) = LWMIN
-      IWORK( 1 ) = LIWMIN
-*
-      RETURN
-*
-*     End of DTGSEN
-*
-      END
diff --git a/src/lib/lapack/dtgsy2.f b/src/lib/lapack/dtgsy2.f
deleted file mode 100644
index 3ebc912f..00000000
--- a/src/lib/lapack/dtgsy2.f
+++ /dev/null
@@ -1,956 +0,0 @@
-      SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
-     $                   LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL,
-     $                   IWORK, PQ, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TRANS
-      INTEGER            IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF, M, N,
-     $                   PQ
-      DOUBLE PRECISION   RDSCAL, RDSUM, SCALE
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * ),
-     $                   D( LDD, * ), E( LDE, * ), F( LDF, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTGSY2 solves the generalized Sylvester equation:
-*
-*              A * R - L * B = scale * C                (1)
-*              D * R - L * E = scale * F,
-*
-*  using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices,
-*  (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M,
-*  N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E)
-*  must be in generalized Schur canonical form, i.e. A, B are upper
-*  quasi triangular and D, E are upper triangular. The solution (R, L)
-*  overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor
-*  chosen to avoid overflow.
-*
-*  In matrix notation solving equation (1) corresponds to solve
-*  Z*x = scale*b, where Z is defined as
-*
-*         Z = [ kron(In, A)  -kron(B', Im) ]             (2)
-*             [ kron(In, D)  -kron(E', Im) ],
-*
-*  Ik is the identity matrix of size k and X' is the transpose of X.
-*  kron(X, Y) is the Kronecker product between the matrices X and Y.
-*  In the process of solving (1), we solve a number of such systems
-*  where Dim(In), Dim(In) = 1 or 2.
-*
-*  If TRANS = 'T', solve the transposed system Z'*y = scale*b for y,
-*  which is equivalent to solve for R and L in
-*
-*              A' * R  + D' * L   = scale *  C           (3)
-*              R  * B' + L  * E'  = scale * -F
-*
-*  This case is used to compute an estimate of Dif[(A, D), (B, E)] =
-*  sigma_min(Z) using reverse communicaton with DLACON.
-*
-*  DTGSY2 also (IJOB >= 1) contributes to the computation in STGSYL
-*  of an upper bound on the separation between to matrix pairs. Then
-*  the input (A, D), (B, E) are sub-pencils of the matrix pair in
-*  DTGSYL. See STGSYL for details.
-*
-*  Arguments
-*  =========
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N', solve the generalized Sylvester equation (1).
-*          = 'T': solve the 'transposed' system (3).
-*
-*  IJOB    (input) INTEGER
-*          Specifies what kind of functionality to be performed.
-*          = 0: solve (1) only.
-*          = 1: A contribution from this subsystem to a Frobenius
-*               norm-based estimate of the separation between two matrix
-*               pairs is computed. (look ahead strategy is used).
-*          = 2: A contribution from this subsystem to a Frobenius
-*               norm-based estimate of the separation between two matrix
-*               pairs is computed. (DGECON on sub-systems is used.)
-*          Not referenced if TRANS = 'T'.
-*
-*  M       (input) INTEGER
-*          On entry, M specifies the order of A and D, and the row
-*          dimension of C, F, R and L.
-*
-*  N       (input) INTEGER
-*          On entry, N specifies the order of B and E, and the column
-*          dimension of C, F, R and L.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA, M)
-*          On entry, A contains an upper quasi triangular matrix.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the matrix A. LDA >= max(1, M).
-*
-*  B       (input) DOUBLE PRECISION array, dimension (LDB, N)
-*          On entry, B contains an upper quasi triangular matrix.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the matrix B. LDB >= max(1, N).
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC, N)
-*          On entry, C contains the right-hand-side of the first matrix
-*          equation in (1).
-*          On exit, if IJOB = 0, C has been overwritten by the
-*          solution R.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the matrix C. LDC >= max(1, M).
-*
-*  D       (input) DOUBLE PRECISION array, dimension (LDD, M)
-*          On entry, D contains an upper triangular matrix.
-*
-*  LDD     (input) INTEGER
-*          The leading dimension of the matrix D. LDD >= max(1, M).
-*
-*  E       (input) DOUBLE PRECISION array, dimension (LDE, N)
-*          On entry, E contains an upper triangular matrix.
-*
-*  LDE     (input) INTEGER
-*          The leading dimension of the matrix E. LDE >= max(1, N).
-*
-*  F       (input/output) DOUBLE PRECISION array, dimension (LDF, N)
-*          On entry, F contains the right-hand-side of the second matrix
-*          equation in (1).
-*          On exit, if IJOB = 0, F has been overwritten by the
-*          solution L.
-*
-*  LDF     (input) INTEGER
-*          The leading dimension of the matrix F. LDF >= max(1, M).
-*
-*  SCALE   (output) DOUBLE PRECISION
-*          On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions
-*          R and L (C and F on entry) will hold the solutions to a
-*          slightly perturbed system but the input matrices A, B, D and
-*          E have not been changed. If SCALE = 0, R and L will hold the
-*          solutions to the homogeneous system with C = F = 0. Normally,
-*          SCALE = 1.
-*
-*  RDSUM   (input/output) DOUBLE PRECISION
-*          On entry, the sum of squares of computed contributions to
-*          the Dif-estimate under computation by DTGSYL, where the
-*          scaling factor RDSCAL (see below) has been factored out.
-*          On exit, the corresponding sum of squares updated with the
-*          contributions from the current sub-system.
-*          If TRANS = 'T' RDSUM is not touched.
-*          NOTE: RDSUM only makes sense when DTGSY2 is called by STGSYL.
-*
-*  RDSCAL  (input/output) DOUBLE PRECISION
-*          On entry, scaling factor used to prevent overflow in RDSUM.
-*          On exit, RDSCAL is updated w.r.t. the current contributions
-*          in RDSUM.
-*          If TRANS = 'T', RDSCAL is not touched.
-*          NOTE: RDSCAL only makes sense when DTGSY2 is called by
-*                DTGSYL.
-*
-*  IWORK   (workspace) INTEGER array, dimension (M+N+2)
-*
-*  PQ      (output) INTEGER
-*          On exit, the number of subsystems (of size 2-by-2, 4-by-4 and
-*          8-by-8) solved by this routine.
-*
-*  INFO    (output) INTEGER
-*          On exit, if INFO is set to
-*            =0: Successful exit
-*            <0: If INFO = -i, the i-th argument had an illegal value.
-*            >0: The matrix pairs (A, D) and (B, E) have common or very
-*                close eigenvalues.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  =====================================================================
-*  Replaced various illegal calls to DCOPY by calls to DLASET.
-*  Sven Hammarling, 27/5/02.
-*
-*     .. Parameters ..
-      INTEGER            LDZ
-      PARAMETER          ( LDZ = 8 )
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOTRAN
-      INTEGER            I, IE, IERR, II, IS, ISP1, J, JE, JJ, JS, JSP1,
-     $                   K, MB, NB, P, Q, ZDIM
-      DOUBLE PRECISION   ALPHA, SCALOC
-*     ..
-*     .. Local Arrays ..
-      INTEGER            IPIV( LDZ ), JPIV( LDZ )
-      DOUBLE PRECISION   RHS( LDZ ), Z( LDZ, LDZ )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DCOPY, DGEMM, DGEMV, DGER, DGESC2,
-     $                   DGETC2, DLASET, DLATDF, DSCAL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test input parameters
-*
-      INFO = 0
-      IERR = 0
-      NOTRAN = LSAME( TRANS, 'N' )
-      IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -1
-      ELSE IF( NOTRAN ) THEN
-         IF( ( IJOB.LT.0 ) .OR. ( IJOB.GT.2 ) ) THEN
-            INFO = -2
-         END IF
-      END IF
-      IF( INFO.EQ.0 ) THEN
-         IF( M.LE.0 ) THEN
-            INFO = -3
-         ELSE IF( N.LE.0 ) THEN
-            INFO = -4
-         ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-            INFO = -5
-         ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-            INFO = -8
-         ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-            INFO = -10
-         ELSE IF( LDD.LT.MAX( 1, M ) ) THEN
-            INFO = -12
-         ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
-            INFO = -14
-         ELSE IF( LDF.LT.MAX( 1, M ) ) THEN
-            INFO = -16
-         END IF
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTGSY2', -INFO )
-         RETURN
-      END IF
-*
-*     Determine block structure of A
-*
-      PQ = 0
-      P = 0
-      I = 1
-   10 CONTINUE
-      IF( I.GT.M )
-     $   GO TO 20
-      P = P + 1
-      IWORK( P ) = I
-      IF( I.EQ.M )
-     $   GO TO 20
-      IF( A( I+1, I ).NE.ZERO ) THEN
-         I = I + 2
-      ELSE
-         I = I + 1
-      END IF
-      GO TO 10
-   20 CONTINUE
-      IWORK( P+1 ) = M + 1
-*
-*     Determine block structure of B
-*
-      Q = P + 1
-      J = 1
-   30 CONTINUE
-      IF( J.GT.N )
-     $   GO TO 40
-      Q = Q + 1
-      IWORK( Q ) = J
-      IF( J.EQ.N )
-     $   GO TO 40
-      IF( B( J+1, J ).NE.ZERO ) THEN
-         J = J + 2
-      ELSE
-         J = J + 1
-      END IF
-      GO TO 30
-   40 CONTINUE
-      IWORK( Q+1 ) = N + 1
-      PQ = P*( Q-P-1 )
-*
-      IF( NOTRAN ) THEN
-*
-*        Solve (I, J) - subsystem
-*           A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J)
-*           D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J)
-*        for I = P, P - 1, ..., 1; J = 1, 2, ..., Q
-*
-         SCALE = ONE
-         SCALOC = ONE
-         DO 120 J = P + 2, Q
-            JS = IWORK( J )
-            JSP1 = JS + 1
-            JE = IWORK( J+1 ) - 1
-            NB = JE - JS + 1
-            DO 110 I = P, 1, -1
-*
-               IS = IWORK( I )
-               ISP1 = IS + 1
-               IE = IWORK( I+1 ) - 1
-               MB = IE - IS + 1
-               ZDIM = MB*NB*2
-*
-               IF( ( MB.EQ.1 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-*                 Build a 2-by-2 system Z * x = RHS
-*
-                  Z( 1, 1 ) = A( IS, IS )
-                  Z( 2, 1 ) = D( IS, IS )
-                  Z( 1, 2 ) = -B( JS, JS )
-                  Z( 2, 2 ) = -E( JS, JS )
-*
-*                 Set up right hand side(s)
-*
-                  RHS( 1 ) = C( IS, JS )
-                  RHS( 2 ) = F( IS, JS )
-*
-*                 Solve Z * x = RHS
-*
-                  CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
-                  IF( IERR.GT.0 )
-     $               INFO = IERR
-*
-                  IF( IJOB.EQ.0 ) THEN
-                     CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
-     $                            SCALOC )
-                     IF( SCALOC.NE.ONE ) THEN
-                        DO 50 K = 1, N
-                           CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                           CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-   50                   CONTINUE
-                        SCALE = SCALE*SCALOC
-                     END IF
-                  ELSE
-                     CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
-     $                            RDSCAL, IPIV, JPIV )
-                  END IF
-*
-*                 Unpack solution vector(s)
-*
-                  C( IS, JS ) = RHS( 1 )
-                  F( IS, JS ) = RHS( 2 )
-*
-*                 Substitute R(I, J) and L(I, J) into remaining
-*                 equation.
-*
-                  IF( I.GT.1 ) THEN
-                     ALPHA = -RHS( 1 )
-                     CALL DAXPY( IS-1, ALPHA, A( 1, IS ), 1, C( 1, JS ),
-     $                           1 )
-                     CALL DAXPY( IS-1, ALPHA, D( 1, IS ), 1, F( 1, JS ),
-     $                           1 )
-                  END IF
-                  IF( J.LT.Q ) THEN
-                     CALL DAXPY( N-JE, RHS( 2 ), B( JS, JE+1 ), LDB,
-     $                           C( IS, JE+1 ), LDC )
-                     CALL DAXPY( N-JE, RHS( 2 ), E( JS, JE+1 ), LDE,
-     $                           F( IS, JE+1 ), LDF )
-                  END IF
-*
-               ELSE IF( ( MB.EQ.1 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-*                 Build a 4-by-4 system Z * x = RHS
-*
-                  Z( 1, 1 ) = A( IS, IS )
-                  Z( 2, 1 ) = ZERO
-                  Z( 3, 1 ) = D( IS, IS )
-                  Z( 4, 1 ) = ZERO
-*
-                  Z( 1, 2 ) = ZERO
-                  Z( 2, 2 ) = A( IS, IS )
-                  Z( 3, 2 ) = ZERO
-                  Z( 4, 2 ) = D( IS, IS )
-*
-                  Z( 1, 3 ) = -B( JS, JS )
-                  Z( 2, 3 ) = -B( JS, JSP1 )
-                  Z( 3, 3 ) = -E( JS, JS )
-                  Z( 4, 3 ) = -E( JS, JSP1 )
-*
-                  Z( 1, 4 ) = -B( JSP1, JS )
-                  Z( 2, 4 ) = -B( JSP1, JSP1 )
-                  Z( 3, 4 ) = ZERO
-                  Z( 4, 4 ) = -E( JSP1, JSP1 )
-*
-*                 Set up right hand side(s)
-*
-                  RHS( 1 ) = C( IS, JS )
-                  RHS( 2 ) = C( IS, JSP1 )
-                  RHS( 3 ) = F( IS, JS )
-                  RHS( 4 ) = F( IS, JSP1 )
-*
-*                 Solve Z * x = RHS
-*
-                  CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
-                  IF( IERR.GT.0 )
-     $               INFO = IERR
-*
-                  IF( IJOB.EQ.0 ) THEN
-                     CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
-     $                            SCALOC )
-                     IF( SCALOC.NE.ONE ) THEN
-                        DO 60 K = 1, N
-                           CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                           CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-   60                   CONTINUE
-                        SCALE = SCALE*SCALOC
-                     END IF
-                  ELSE
-                     CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
-     $                            RDSCAL, IPIV, JPIV )
-                  END IF
-*
-*                 Unpack solution vector(s)
-*
-                  C( IS, JS ) = RHS( 1 )
-                  C( IS, JSP1 ) = RHS( 2 )
-                  F( IS, JS ) = RHS( 3 )
-                  F( IS, JSP1 ) = RHS( 4 )
-*
-*                 Substitute R(I, J) and L(I, J) into remaining
-*                 equation.
-*
-                  IF( I.GT.1 ) THEN
-                     CALL DGER( IS-1, NB, -ONE, A( 1, IS ), 1, RHS( 1 ),
-     $                          1, C( 1, JS ), LDC )
-                     CALL DGER( IS-1, NB, -ONE, D( 1, IS ), 1, RHS( 1 ),
-     $                          1, F( 1, JS ), LDF )
-                  END IF
-                  IF( J.LT.Q ) THEN
-                     CALL DAXPY( N-JE, RHS( 3 ), B( JS, JE+1 ), LDB,
-     $                           C( IS, JE+1 ), LDC )
-                     CALL DAXPY( N-JE, RHS( 3 ), E( JS, JE+1 ), LDE,
-     $                           F( IS, JE+1 ), LDF )
-                     CALL DAXPY( N-JE, RHS( 4 ), B( JSP1, JE+1 ), LDB,
-     $                           C( IS, JE+1 ), LDC )
-                     CALL DAXPY( N-JE, RHS( 4 ), E( JSP1, JE+1 ), LDE,
-     $                           F( IS, JE+1 ), LDF )
-                  END IF
-*
-               ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-*                 Build a 4-by-4 system Z * x = RHS
-*
-                  Z( 1, 1 ) = A( IS, IS )
-                  Z( 2, 1 ) = A( ISP1, IS )
-                  Z( 3, 1 ) = D( IS, IS )
-                  Z( 4, 1 ) = ZERO
-*
-                  Z( 1, 2 ) = A( IS, ISP1 )
-                  Z( 2, 2 ) = A( ISP1, ISP1 )
-                  Z( 3, 2 ) = D( IS, ISP1 )
-                  Z( 4, 2 ) = D( ISP1, ISP1 )
-*
-                  Z( 1, 3 ) = -B( JS, JS )
-                  Z( 2, 3 ) = ZERO
-                  Z( 3, 3 ) = -E( JS, JS )
-                  Z( 4, 3 ) = ZERO
-*
-                  Z( 1, 4 ) = ZERO
-                  Z( 2, 4 ) = -B( JS, JS )
-                  Z( 3, 4 ) = ZERO
-                  Z( 4, 4 ) = -E( JS, JS )
-*
-*                 Set up right hand side(s)
-*
-                  RHS( 1 ) = C( IS, JS )
-                  RHS( 2 ) = C( ISP1, JS )
-                  RHS( 3 ) = F( IS, JS )
-                  RHS( 4 ) = F( ISP1, JS )
-*
-*                 Solve Z * x = RHS
-*
-                  CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
-                  IF( IERR.GT.0 )
-     $               INFO = IERR
-                  IF( IJOB.EQ.0 ) THEN
-                     CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
-     $                            SCALOC )
-                     IF( SCALOC.NE.ONE ) THEN
-                        DO 70 K = 1, N
-                           CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                           CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-   70                   CONTINUE
-                        SCALE = SCALE*SCALOC
-                     END IF
-                  ELSE
-                     CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
-     $                            RDSCAL, IPIV, JPIV )
-                  END IF
-*
-*                 Unpack solution vector(s)
-*
-                  C( IS, JS ) = RHS( 1 )
-                  C( ISP1, JS ) = RHS( 2 )
-                  F( IS, JS ) = RHS( 3 )
-                  F( ISP1, JS ) = RHS( 4 )
-*
-*                 Substitute R(I, J) and L(I, J) into remaining
-*                 equation.
-*
-                  IF( I.GT.1 ) THEN
-                     CALL DGEMV( 'N', IS-1, MB, -ONE, A( 1, IS ), LDA,
-     $                           RHS( 1 ), 1, ONE, C( 1, JS ), 1 )
-                     CALL DGEMV( 'N', IS-1, MB, -ONE, D( 1, IS ), LDD,
-     $                           RHS( 1 ), 1, ONE, F( 1, JS ), 1 )
-                  END IF
-                  IF( J.LT.Q ) THEN
-                     CALL DGER( MB, N-JE, ONE, RHS( 3 ), 1,
-     $                          B( JS, JE+1 ), LDB, C( IS, JE+1 ), LDC )
-                     CALL DGER( MB, N-JE, ONE, RHS( 3 ), 1,
-     $                          E( JS, JE+1 ), LDB, F( IS, JE+1 ), LDC )
-                  END IF
-*
-               ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-*                 Build an 8-by-8 system Z * x = RHS
-*
-                  CALL DLASET( 'F', LDZ, LDZ, ZERO, ZERO, Z, LDZ )
-*
-                  Z( 1, 1 ) = A( IS, IS )
-                  Z( 2, 1 ) = A( ISP1, IS )
-                  Z( 5, 1 ) = D( IS, IS )
-*
-                  Z( 1, 2 ) = A( IS, ISP1 )
-                  Z( 2, 2 ) = A( ISP1, ISP1 )
-                  Z( 5, 2 ) = D( IS, ISP1 )
-                  Z( 6, 2 ) = D( ISP1, ISP1 )
-*
-                  Z( 3, 3 ) = A( IS, IS )
-                  Z( 4, 3 ) = A( ISP1, IS )
-                  Z( 7, 3 ) = D( IS, IS )
-*
-                  Z( 3, 4 ) = A( IS, ISP1 )
-                  Z( 4, 4 ) = A( ISP1, ISP1 )
-                  Z( 7, 4 ) = D( IS, ISP1 )
-                  Z( 8, 4 ) = D( ISP1, ISP1 )
-*
-                  Z( 1, 5 ) = -B( JS, JS )
-                  Z( 3, 5 ) = -B( JS, JSP1 )
-                  Z( 5, 5 ) = -E( JS, JS )
-                  Z( 7, 5 ) = -E( JS, JSP1 )
-*
-                  Z( 2, 6 ) = -B( JS, JS )
-                  Z( 4, 6 ) = -B( JS, JSP1 )
-                  Z( 6, 6 ) = -E( JS, JS )
-                  Z( 8, 6 ) = -E( JS, JSP1 )
-*
-                  Z( 1, 7 ) = -B( JSP1, JS )
-                  Z( 3, 7 ) = -B( JSP1, JSP1 )
-                  Z( 7, 7 ) = -E( JSP1, JSP1 )
-*
-                  Z( 2, 8 ) = -B( JSP1, JS )
-                  Z( 4, 8 ) = -B( JSP1, JSP1 )
-                  Z( 8, 8 ) = -E( JSP1, JSP1 )
-*
-*                 Set up right hand side(s)
-*
-                  K = 1
-                  II = MB*NB + 1
-                  DO 80 JJ = 0, NB - 1
-                     CALL DCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 )
-                     CALL DCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 )
-                     K = K + MB
-                     II = II + MB
-   80             CONTINUE
-*
-*                 Solve Z * x = RHS
-*
-                  CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
-                  IF( IERR.GT.0 )
-     $               INFO = IERR
-                  IF( IJOB.EQ.0 ) THEN
-                     CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
-     $                            SCALOC )
-                     IF( SCALOC.NE.ONE ) THEN
-                        DO 90 K = 1, N
-                           CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                           CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-   90                   CONTINUE
-                        SCALE = SCALE*SCALOC
-                     END IF
-                  ELSE
-                     CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
-     $                            RDSCAL, IPIV, JPIV )
-                  END IF
-*
-*                 Unpack solution vector(s)
-*
-                  K = 1
-                  II = MB*NB + 1
-                  DO 100 JJ = 0, NB - 1
-                     CALL DCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 )
-                     CALL DCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 )
-                     K = K + MB
-                     II = II + MB
-  100             CONTINUE
-*
-*                 Substitute R(I, J) and L(I, J) into remaining
-*                 equation.
-*
-                  IF( I.GT.1 ) THEN
-                     CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
-     $                           A( 1, IS ), LDA, RHS( 1 ), MB, ONE,
-     $                           C( 1, JS ), LDC )
-                     CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
-     $                           D( 1, IS ), LDD, RHS( 1 ), MB, ONE,
-     $                           F( 1, JS ), LDF )
-                  END IF
-                  IF( J.LT.Q ) THEN
-                     K = MB*NB + 1
-                     CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ),
-     $                           MB, B( JS, JE+1 ), LDB, ONE,
-     $                           C( IS, JE+1 ), LDC )
-                     CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ),
-     $                           MB, E( JS, JE+1 ), LDE, ONE,
-     $                           F( IS, JE+1 ), LDF )
-                  END IF
-*
-               END IF
-*
-  110       CONTINUE
-  120    CONTINUE
-      ELSE
-*
-*        Solve (I, J) - subsystem
-*             A(I, I)' * R(I, J) + D(I, I)' * L(J, J)  =  C(I, J)
-*             R(I, I)  * B(J, J) + L(I, J)  * E(J, J)  = -F(I, J)
-*        for I = 1, 2, ..., P, J = Q, Q - 1, ..., 1
-*
-         SCALE = ONE
-         SCALOC = ONE
-         DO 200 I = 1, P
-*
-            IS = IWORK( I )
-            ISP1 = IS + 1
-            IE = ( I+1 ) - 1
-            MB = IE - IS + 1
-            DO 190 J = Q, P + 2, -1
-*
-               JS = IWORK( J )
-               JSP1 = JS + 1
-               JE = IWORK( J+1 ) - 1
-               NB = JE - JS + 1
-               ZDIM = MB*NB*2
-               IF( ( MB.EQ.1 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-*                 Build a 2-by-2 system Z' * x = RHS
-*
-                  Z( 1, 1 ) = A( IS, IS )
-                  Z( 2, 1 ) = -B( JS, JS )
-                  Z( 1, 2 ) = D( IS, IS )
-                  Z( 2, 2 ) = -E( JS, JS )
-*
-*                 Set up right hand side(s)
-*
-                  RHS( 1 ) = C( IS, JS )
-                  RHS( 2 ) = F( IS, JS )
-*
-*                 Solve Z' * x = RHS
-*
-                  CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
-                  IF( IERR.GT.0 )
-     $               INFO = IERR
-*
-                  CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 130 K = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                        CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-  130                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-*
-*                 Unpack solution vector(s)
-*
-                  C( IS, JS ) = RHS( 1 )
-                  F( IS, JS ) = RHS( 2 )
-*
-*                 Substitute R(I, J) and L(I, J) into remaining
-*                 equation.
-*
-                  IF( J.GT.P+2 ) THEN
-                     ALPHA = RHS( 1 )
-                     CALL DAXPY( JS-1, ALPHA, B( 1, JS ), 1, F( IS, 1 ),
-     $                           LDF )
-                     ALPHA = RHS( 2 )
-                     CALL DAXPY( JS-1, ALPHA, E( 1, JS ), 1, F( IS, 1 ),
-     $                           LDF )
-                  END IF
-                  IF( I.LT.P ) THEN
-                     ALPHA = -RHS( 1 )
-                     CALL DAXPY( M-IE, ALPHA, A( IS, IE+1 ), LDA,
-     $                           C( IE+1, JS ), 1 )
-                     ALPHA = -RHS( 2 )
-                     CALL DAXPY( M-IE, ALPHA, D( IS, IE+1 ), LDD,
-     $                           C( IE+1, JS ), 1 )
-                  END IF
-*
-               ELSE IF( ( MB.EQ.1 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-*                 Build a 4-by-4 system Z' * x = RHS
-*
-                  Z( 1, 1 ) = A( IS, IS )
-                  Z( 2, 1 ) = ZERO
-                  Z( 3, 1 ) = -B( JS, JS )
-                  Z( 4, 1 ) = -B( JSP1, JS )
-*
-                  Z( 1, 2 ) = ZERO
-                  Z( 2, 2 ) = A( IS, IS )
-                  Z( 3, 2 ) = -B( JS, JSP1 )
-                  Z( 4, 2 ) = -B( JSP1, JSP1 )
-*
-                  Z( 1, 3 ) = D( IS, IS )
-                  Z( 2, 3 ) = ZERO
-                  Z( 3, 3 ) = -E( JS, JS )
-                  Z( 4, 3 ) = ZERO
-*
-                  Z( 1, 4 ) = ZERO
-                  Z( 2, 4 ) = D( IS, IS )
-                  Z( 3, 4 ) = -E( JS, JSP1 )
-                  Z( 4, 4 ) = -E( JSP1, JSP1 )
-*
-*                 Set up right hand side(s)
-*
-                  RHS( 1 ) = C( IS, JS )
-                  RHS( 2 ) = C( IS, JSP1 )
-                  RHS( 3 ) = F( IS, JS )
-                  RHS( 4 ) = F( IS, JSP1 )
-*
-*                 Solve Z' * x = RHS
-*
-                  CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
-                  IF( IERR.GT.0 )
-     $               INFO = IERR
-                  CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 140 K = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                        CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-  140                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-*
-*                 Unpack solution vector(s)
-*
-                  C( IS, JS ) = RHS( 1 )
-                  C( IS, JSP1 ) = RHS( 2 )
-                  F( IS, JS ) = RHS( 3 )
-                  F( IS, JSP1 ) = RHS( 4 )
-*
-*                 Substitute R(I, J) and L(I, J) into remaining
-*                 equation.
-*
-                  IF( J.GT.P+2 ) THEN
-                     CALL DAXPY( JS-1, RHS( 1 ), B( 1, JS ), 1,
-     $                           F( IS, 1 ), LDF )
-                     CALL DAXPY( JS-1, RHS( 2 ), B( 1, JSP1 ), 1,
-     $                           F( IS, 1 ), LDF )
-                     CALL DAXPY( JS-1, RHS( 3 ), E( 1, JS ), 1,
-     $                           F( IS, 1 ), LDF )
-                     CALL DAXPY( JS-1, RHS( 4 ), E( 1, JSP1 ), 1,
-     $                           F( IS, 1 ), LDF )
-                  END IF
-                  IF( I.LT.P ) THEN
-                     CALL DGER( M-IE, NB, -ONE, A( IS, IE+1 ), LDA,
-     $                          RHS( 1 ), 1, C( IE+1, JS ), LDC )
-                     CALL DGER( M-IE, NB, -ONE, D( IS, IE+1 ), LDD,
-     $                          RHS( 3 ), 1, C( IE+1, JS ), LDC )
-                  END IF
-*
-               ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.1 ) ) THEN
-*
-*                 Build a 4-by-4 system Z' * x = RHS
-*
-                  Z( 1, 1 ) = A( IS, IS )
-                  Z( 2, 1 ) = A( IS, ISP1 )
-                  Z( 3, 1 ) = -B( JS, JS )
-                  Z( 4, 1 ) = ZERO
-*
-                  Z( 1, 2 ) = A( ISP1, IS )
-                  Z( 2, 2 ) = A( ISP1, ISP1 )
-                  Z( 3, 2 ) = ZERO
-                  Z( 4, 2 ) = -B( JS, JS )
-*
-                  Z( 1, 3 ) = D( IS, IS )
-                  Z( 2, 3 ) = D( IS, ISP1 )
-                  Z( 3, 3 ) = -E( JS, JS )
-                  Z( 4, 3 ) = ZERO
-*
-                  Z( 1, 4 ) = ZERO
-                  Z( 2, 4 ) = D( ISP1, ISP1 )
-                  Z( 3, 4 ) = ZERO
-                  Z( 4, 4 ) = -E( JS, JS )
-*
-*                 Set up right hand side(s)
-*
-                  RHS( 1 ) = C( IS, JS )
-                  RHS( 2 ) = C( ISP1, JS )
-                  RHS( 3 ) = F( IS, JS )
-                  RHS( 4 ) = F( ISP1, JS )
-*
-*                 Solve Z' * x = RHS
-*
-                  CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
-                  IF( IERR.GT.0 )
-     $               INFO = IERR
-*
-                  CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 150 K = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                        CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-  150                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-*
-*                 Unpack solution vector(s)
-*
-                  C( IS, JS ) = RHS( 1 )
-                  C( ISP1, JS ) = RHS( 2 )
-                  F( IS, JS ) = RHS( 3 )
-                  F( ISP1, JS ) = RHS( 4 )
-*
-*                 Substitute R(I, J) and L(I, J) into remaining
-*                 equation.
-*
-                  IF( J.GT.P+2 ) THEN
-                     CALL DGER( MB, JS-1, ONE, RHS( 1 ), 1, B( 1, JS ),
-     $                          1, F( IS, 1 ), LDF )
-                     CALL DGER( MB, JS-1, ONE, RHS( 3 ), 1, E( 1, JS ),
-     $                          1, F( IS, 1 ), LDF )
-                  END IF
-                  IF( I.LT.P ) THEN
-                     CALL DGEMV( 'T', MB, M-IE, -ONE, A( IS, IE+1 ),
-     $                           LDA, RHS( 1 ), 1, ONE, C( IE+1, JS ),
-     $                           1 )
-                     CALL DGEMV( 'T', MB, M-IE, -ONE, D( IS, IE+1 ),
-     $                           LDD, RHS( 3 ), 1, ONE, C( IE+1, JS ),
-     $                           1 )
-                  END IF
-*
-               ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.2 ) ) THEN
-*
-*                 Build an 8-by-8 system Z' * x = RHS
-*
-                  CALL DLASET( 'F', LDZ, LDZ, ZERO, ZERO, Z, LDZ )
-*
-                  Z( 1, 1 ) = A( IS, IS )
-                  Z( 2, 1 ) = A( IS, ISP1 )
-                  Z( 5, 1 ) = -B( JS, JS )
-                  Z( 7, 1 ) = -B( JSP1, JS )
-*
-                  Z( 1, 2 ) = A( ISP1, IS )
-                  Z( 2, 2 ) = A( ISP1, ISP1 )
-                  Z( 6, 2 ) = -B( JS, JS )
-                  Z( 8, 2 ) = -B( JSP1, JS )
-*
-                  Z( 3, 3 ) = A( IS, IS )
-                  Z( 4, 3 ) = A( IS, ISP1 )
-                  Z( 5, 3 ) = -B( JS, JSP1 )
-                  Z( 7, 3 ) = -B( JSP1, JSP1 )
-*
-                  Z( 3, 4 ) = A( ISP1, IS )
-                  Z( 4, 4 ) = A( ISP1, ISP1 )
-                  Z( 6, 4 ) = -B( JS, JSP1 )
-                  Z( 8, 4 ) = -B( JSP1, JSP1 )
-*
-                  Z( 1, 5 ) = D( IS, IS )
-                  Z( 2, 5 ) = D( IS, ISP1 )
-                  Z( 5, 5 ) = -E( JS, JS )
-*
-                  Z( 2, 6 ) = D( ISP1, ISP1 )
-                  Z( 6, 6 ) = -E( JS, JS )
-*
-                  Z( 3, 7 ) = D( IS, IS )
-                  Z( 4, 7 ) = D( IS, ISP1 )
-                  Z( 5, 7 ) = -E( JS, JSP1 )
-                  Z( 7, 7 ) = -E( JSP1, JSP1 )
-*
-                  Z( 4, 8 ) = D( ISP1, ISP1 )
-                  Z( 6, 8 ) = -E( JS, JSP1 )
-                  Z( 8, 8 ) = -E( JSP1, JSP1 )
-*
-*                 Set up right hand side(s)
-*
-                  K = 1
-                  II = MB*NB + 1
-                  DO 160 JJ = 0, NB - 1
-                     CALL DCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 )
-                     CALL DCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 )
-                     K = K + MB
-                     II = II + MB
-  160             CONTINUE
-*
-*
-*                 Solve Z' * x = RHS
-*
-                  CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
-                  IF( IERR.GT.0 )
-     $               INFO = IERR
-*
-                  CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 170 K = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                        CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-  170                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-*
-*                 Unpack solution vector(s)
-*
-                  K = 1
-                  II = MB*NB + 1
-                  DO 180 JJ = 0, NB - 1
-                     CALL DCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 )
-                     CALL DCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 )
-                     K = K + MB
-                     II = II + MB
-  180             CONTINUE
-*
-*                 Substitute R(I, J) and L(I, J) into remaining
-*                 equation.
-*
-                  IF( J.GT.P+2 ) THEN
-                     CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE,
-     $                           C( IS, JS ), LDC, B( 1, JS ), LDB, ONE,
-     $                           F( IS, 1 ), LDF )
-                     CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE,
-     $                           F( IS, JS ), LDF, E( 1, JS ), LDE, ONE,
-     $                           F( IS, 1 ), LDF )
-                  END IF
-                  IF( I.LT.P ) THEN
-                     CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
-     $                           A( IS, IE+1 ), LDA, C( IS, JS ), LDC,
-     $                           ONE, C( IE+1, JS ), LDC )
-                     CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
-     $                           D( IS, IE+1 ), LDD, F( IS, JS ), LDF,
-     $                           ONE, C( IE+1, JS ), LDC )
-                  END IF
-*
-               END IF
-*
-  190       CONTINUE
-  200    CONTINUE
-*
-      END IF
-      RETURN
-*
-*     End of DTGSY2
-*
-      END
diff --git a/src/lib/lapack/dtgsyl.f b/src/lib/lapack/dtgsyl.f
deleted file mode 100644
index 01866717..00000000
--- a/src/lib/lapack/dtgsyl.f
+++ /dev/null
@@ -1,556 +0,0 @@
-      SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
-     $                   LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK,
-     $                   IWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TRANS
-      INTEGER            IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF,
-     $                   LWORK, M, N
-      DOUBLE PRECISION   DIF, SCALE
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * ),
-     $                   D( LDD, * ), E( LDE, * ), F( LDF, * ),
-     $                   WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTGSYL solves the generalized Sylvester equation:
-*
-*              A * R - L * B = scale * C                 (1)
-*              D * R - L * E = scale * F
-*
-*  where R and L are unknown m-by-n matrices, (A, D), (B, E) and
-*  (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n,
-*  respectively, with real entries. (A, D) and (B, E) must be in
-*  generalized (real) Schur canonical form, i.e. A, B are upper quasi
-*  triangular and D, E are upper triangular.
-*
-*  The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output
-*  scaling factor chosen to avoid overflow.
-*
-*  In matrix notation (1) is equivalent to solve  Zx = scale b, where
-*  Z is defined as
-*
-*             Z = [ kron(In, A)  -kron(B', Im) ]         (2)
-*                 [ kron(In, D)  -kron(E', Im) ].
-*
-*  Here Ik is the identity matrix of size k and X' is the transpose of
-*  X. kron(X, Y) is the Kronecker product between the matrices X and Y.
-*
-*  If TRANS = 'T', DTGSYL solves the transposed system Z'*y = scale*b,
-*  which is equivalent to solve for R and L in
-*
-*              A' * R  + D' * L   = scale *  C           (3)
-*              R  * B' + L  * E'  = scale * (-F)
-*
-*  This case (TRANS = 'T') is used to compute an one-norm-based estimate
-*  of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D)
-*  and (B,E), using DLACON.
-*
-*  If IJOB >= 1, DTGSYL computes a Frobenius norm-based estimate
-*  of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the
-*  reciprocal of the smallest singular value of Z. See [1-2] for more
-*  information.
-*
-*  This is a level 3 BLAS algorithm.
-*
-*  Arguments
-*  =========
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N', solve the generalized Sylvester equation (1).
-*          = 'T', solve the 'transposed' system (3).
-*
-*  IJOB    (input) INTEGER
-*          Specifies what kind of functionality to be performed.
-*           =0: solve (1) only.
-*           =1: The functionality of 0 and 3.
-*           =2: The functionality of 0 and 4.
-*           =3: Only an estimate of Dif[(A,D), (B,E)] is computed.
-*               (look ahead strategy IJOB  = 1 is used).
-*           =4: Only an estimate of Dif[(A,D), (B,E)] is computed.
-*               ( DGECON on sub-systems is used ).
-*          Not referenced if TRANS = 'T'.
-*
-*  M       (input) INTEGER
-*          The order of the matrices A and D, and the row dimension of
-*          the matrices C, F, R and L.
-*
-*  N       (input) INTEGER
-*          The order of the matrices B and E, and the column dimension
-*          of the matrices C, F, R and L.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA, M)
-*          The upper quasi triangular matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1, M).
-*
-*  B       (input) DOUBLE PRECISION array, dimension (LDB, N)
-*          The upper quasi triangular matrix B.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1, N).
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC, N)
-*          On entry, C contains the right-hand-side of the first matrix
-*          equation in (1) or (3).
-*          On exit, if IJOB = 0, 1 or 2, C has been overwritten by
-*          the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R,
-*          the solution achieved during the computation of the
-*          Dif-estimate.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1, M).
-*
-*  D       (input) DOUBLE PRECISION array, dimension (LDD, M)
-*          The upper triangular matrix D.
-*
-*  LDD     (input) INTEGER
-*          The leading dimension of the array D. LDD >= max(1, M).
-*
-*  E       (input) DOUBLE PRECISION array, dimension (LDE, N)
-*          The upper triangular matrix E.
-*
-*  LDE     (input) INTEGER
-*          The leading dimension of the array E. LDE >= max(1, N).
-*
-*  F       (input/output) DOUBLE PRECISION array, dimension (LDF, N)
-*          On entry, F contains the right-hand-side of the second matrix
-*          equation in (1) or (3).
-*          On exit, if IJOB = 0, 1 or 2, F has been overwritten by
-*          the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L,
-*          the solution achieved during the computation of the
-*          Dif-estimate.
-*
-*  LDF     (input) INTEGER
-*          The leading dimension of the array F. LDF >= max(1, M).
-*
-*  DIF     (output) DOUBLE PRECISION
-*          On exit DIF is the reciprocal of a lower bound of the
-*          reciprocal of the Dif-function, i.e. DIF is an upper bound of
-*          Dif[(A,D), (B,E)] = sigma_min(Z), where Z as in (2).
-*          IF IJOB = 0 or TRANS = 'T', DIF is not touched.
-*
-*  SCALE   (output) DOUBLE PRECISION
-*          On exit SCALE is the scaling factor in (1) or (3).
-*          If 0 < SCALE < 1, C and F hold the solutions R and L, resp.,
-*          to a slightly perturbed system but the input matrices A, B, D
-*          and E have not been changed. If SCALE = 0, C and F hold the
-*          solutions R and L, respectively, to the homogeneous system
-*          with C = F = 0. Normally, SCALE = 1.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK > = 1.
-*          If IJOB = 1 or 2 and TRANS = 'N', LWORK >= max(1,2*M*N).
-*
-*          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.
-*
-*  IWORK   (workspace) INTEGER array, dimension (M+N+6)
-*
-*  INFO    (output) INTEGER
-*            =0: successful exit
-*            <0: If INFO = -i, the i-th argument had an illegal value.
-*            >0: (A, D) and (B, E) have common or close eigenvalues.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*      for Solving the Generalized Sylvester Equation and Estimating the
-*      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*      Department of Computing Science, Umea University, S-901 87 Umea,
-*      Sweden, December 1993, Revised April 1994, Also as LAPACK Working
-*      Note 75.  To appear in ACM Trans. on Math. Software, Vol 22,
-*      No 1, 1996.
-*
-*  [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester
-*      Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal.
-*      Appl., 15(4):1045-1060, 1994
-*
-*  [3] B. Kagstrom and L. Westin, Generalized Schur Methods with
-*      Condition Estimators for Solving the Generalized Sylvester
-*      Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,
-*      July 1989, pp 745-751.
-*
-*  =====================================================================
-*  Replaced various illegal calls to DCOPY by calls to DLASET.
-*  Sven Hammarling, 1/5/02.
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, NOTRAN
-      INTEGER            I, IE, IFUNC, IROUND, IS, ISOLVE, J, JE, JS, K,
-     $                   LINFO, LWMIN, MB, NB, P, PPQQ, PQ, Q
-      DOUBLE PRECISION   DSCALE, DSUM, SCALE2, SCALOC
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DGEMM, DLACPY, DLASET, DSCAL, DTGSY2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test input parameters
-*
-      INFO = 0
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-      IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
-         INFO = -1
-      ELSE IF( NOTRAN ) THEN
-         IF( ( IJOB.LT.0 ) .OR. ( IJOB.GT.4 ) ) THEN
-            INFO = -2
-         END IF
-      END IF
-      IF( INFO.EQ.0 ) THEN
-         IF( M.LE.0 ) THEN
-            INFO = -3
-         ELSE IF( N.LE.0 ) THEN
-            INFO = -4
-         ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-            INFO = -6
-         ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-            INFO = -8
-         ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-            INFO = -10
-         ELSE IF( LDD.LT.MAX( 1, M ) ) THEN
-            INFO = -12
-         ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
-            INFO = -14
-         ELSE IF( LDF.LT.MAX( 1, M ) ) THEN
-            INFO = -16
-         END IF
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( NOTRAN ) THEN
-            IF( IJOB.EQ.1 .OR. IJOB.EQ.2 ) THEN
-               LWMIN = MAX( 1, 2*M*N )
-            ELSE
-               LWMIN = 1
-            END IF
-         ELSE
-            LWMIN = 1
-         END IF
-         WORK( 1 ) = LWMIN
-*
-         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
-            INFO = -20
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTGSYL', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         SCALE = 1
-         IF( NOTRAN ) THEN
-            IF( IJOB.NE.0 ) THEN
-               DIF = 0
-            END IF
-         END IF
-         RETURN
-      END IF
-*
-*     Determine optimal block sizes MB and NB
-*
-      MB = ILAENV( 2, 'DTGSYL', TRANS, M, N, -1, -1 )
-      NB = ILAENV( 5, 'DTGSYL', TRANS, M, N, -1, -1 )
-*
-      ISOLVE = 1
-      IFUNC = 0
-      IF( NOTRAN ) THEN
-         IF( IJOB.GE.3 ) THEN
-            IFUNC = IJOB - 2
-            CALL DLASET( 'F', M, N, ZERO, ZERO, C, LDC )
-            CALL DLASET( 'F', M, N, ZERO, ZERO, F, LDF )
-         ELSE IF( IJOB.GE.1 ) THEN
-            ISOLVE = 2
-         END IF
-      END IF
-*
-      IF( ( MB.LE.1 .AND. NB.LE.1 ) .OR. ( MB.GE.M .AND. NB.GE.N ) )
-     $     THEN
-*
-         DO 30 IROUND = 1, ISOLVE
-*
-*           Use unblocked Level 2 solver
-*
-            DSCALE = ZERO
-            DSUM = ONE
-            PQ = 0
-            CALL DTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, D,
-     $                   LDD, E, LDE, F, LDF, SCALE, DSUM, DSCALE,
-     $                   IWORK, PQ, INFO )
-            IF( DSCALE.NE.ZERO ) THEN
-               IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
-                  DIF = SQRT( DBLE( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
-               ELSE
-                  DIF = SQRT( DBLE( PQ ) ) / ( DSCALE*SQRT( DSUM ) )
-               END IF
-            END IF
-*
-            IF( ISOLVE.EQ.2 .AND. IROUND.EQ.1 ) THEN
-               IF( NOTRAN ) THEN
-                  IFUNC = IJOB
-               END IF
-               SCALE2 = SCALE
-               CALL DLACPY( 'F', M, N, C, LDC, WORK, M )
-               CALL DLACPY( 'F', M, N, F, LDF, WORK( M*N+1 ), M )
-               CALL DLASET( 'F', M, N, ZERO, ZERO, C, LDC )
-               CALL DLASET( 'F', M, N, ZERO, ZERO, F, LDF )
-            ELSE IF( ISOLVE.EQ.2 .AND. IROUND.EQ.2 ) THEN
-               CALL DLACPY( 'F', M, N, WORK, M, C, LDC )
-               CALL DLACPY( 'F', M, N, WORK( M*N+1 ), M, F, LDF )
-               SCALE = SCALE2
-            END IF
-   30    CONTINUE
-*
-         RETURN
-      END IF
-*
-*     Determine block structure of A
-*
-      P = 0
-      I = 1
-   40 CONTINUE
-      IF( I.GT.M )
-     $   GO TO 50
-      P = P + 1
-      IWORK( P ) = I
-      I = I + MB
-      IF( I.GE.M )
-     $   GO TO 50
-      IF( A( I, I-1 ).NE.ZERO )
-     $   I = I + 1
-      GO TO 40
-   50 CONTINUE
-*
-      IWORK( P+1 ) = M + 1
-      IF( IWORK( P ).EQ.IWORK( P+1 ) )
-     $   P = P - 1
-*
-*     Determine block structure of B
-*
-      Q = P + 1
-      J = 1
-   60 CONTINUE
-      IF( J.GT.N )
-     $   GO TO 70
-      Q = Q + 1
-      IWORK( Q ) = J
-      J = J + NB
-      IF( J.GE.N )
-     $   GO TO 70
-      IF( B( J, J-1 ).NE.ZERO )
-     $   J = J + 1
-      GO TO 60
-   70 CONTINUE
-*
-      IWORK( Q+1 ) = N + 1
-      IF( IWORK( Q ).EQ.IWORK( Q+1 ) )
-     $   Q = Q - 1
-*
-      IF( NOTRAN ) THEN
-*
-         DO 150 IROUND = 1, ISOLVE
-*
-*           Solve (I, J)-subsystem
-*               A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J)
-*               D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J)
-*           for I = P, P - 1,..., 1; J = 1, 2,..., Q
-*
-            DSCALE = ZERO
-            DSUM = ONE
-            PQ = 0
-            SCALE = ONE
-            DO 130 J = P + 2, Q
-               JS = IWORK( J )
-               JE = IWORK( J+1 ) - 1
-               NB = JE - JS + 1
-               DO 120 I = P, 1, -1
-                  IS = IWORK( I )
-                  IE = IWORK( I+1 ) - 1
-                  MB = IE - IS + 1
-                  PPQQ = 0
-                  CALL DTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
-     $                         B( JS, JS ), LDB, C( IS, JS ), LDC,
-     $                         D( IS, IS ), LDD, E( JS, JS ), LDE,
-     $                         F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
-     $                         IWORK( Q+2 ), PPQQ, LINFO )
-                  IF( LINFO.GT.0 )
-     $               INFO = LINFO
-*
-                  PQ = PQ + PPQQ
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 80 K = 1, JS - 1
-                        CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                        CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-   80                CONTINUE
-                     DO 90 K = JS, JE
-                        CALL DSCAL( IS-1, SCALOC, C( 1, K ), 1 )
-                        CALL DSCAL( IS-1, SCALOC, F( 1, K ), 1 )
-   90                CONTINUE
-                     DO 100 K = JS, JE
-                        CALL DSCAL( M-IE, SCALOC, C( IE+1, K ), 1 )
-                        CALL DSCAL( M-IE, SCALOC, F( IE+1, K ), 1 )
-  100                CONTINUE
-                     DO 110 K = JE + 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                        CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-  110                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-*
-*                 Substitute R(I, J) and L(I, J) into remaining
-*                 equation.
-*
-                  IF( I.GT.1 ) THEN
-                     CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
-     $                           A( 1, IS ), LDA, C( IS, JS ), LDC, ONE,
-     $                           C( 1, JS ), LDC )
-                     CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
-     $                           D( 1, IS ), LDD, C( IS, JS ), LDC, ONE,
-     $                           F( 1, JS ), LDF )
-                  END IF
-                  IF( J.LT.Q ) THEN
-                     CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE,
-     $                           F( IS, JS ), LDF, B( JS, JE+1 ), LDB,
-     $                           ONE, C( IS, JE+1 ), LDC )
-                     CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE,
-     $                           F( IS, JS ), LDF, E( JS, JE+1 ), LDE,
-     $                           ONE, F( IS, JE+1 ), LDF )
-                  END IF
-  120          CONTINUE
-  130       CONTINUE
-            IF( DSCALE.NE.ZERO ) THEN
-               IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
-                  DIF = SQRT( DBLE( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
-               ELSE
-                  DIF = SQRT( DBLE( PQ ) ) / ( DSCALE*SQRT( DSUM ) )
-               END IF
-            END IF
-            IF( ISOLVE.EQ.2 .AND. IROUND.EQ.1 ) THEN
-               IF( NOTRAN ) THEN
-                  IFUNC = IJOB
-               END IF
-               SCALE2 = SCALE
-               CALL DLACPY( 'F', M, N, C, LDC, WORK, M )
-               CALL DLACPY( 'F', M, N, F, LDF, WORK( M*N+1 ), M )
-               CALL DLASET( 'F', M, N, ZERO, ZERO, C, LDC )
-               CALL DLASET( 'F', M, N, ZERO, ZERO, F, LDF )
-            ELSE IF( ISOLVE.EQ.2 .AND. IROUND.EQ.2 ) THEN
-               CALL DLACPY( 'F', M, N, WORK, M, C, LDC )
-               CALL DLACPY( 'F', M, N, WORK( M*N+1 ), M, F, LDF )
-               SCALE = SCALE2
-            END IF
-  150    CONTINUE
-*
-      ELSE
-*
-*        Solve transposed (I, J)-subsystem
-*             A(I, I)' * R(I, J)  + D(I, I)' * L(I, J)  =  C(I, J)
-*             R(I, J)  * B(J, J)' + L(I, J)  * E(J, J)' = -F(I, J)
-*        for I = 1,2,..., P; J = Q, Q-1,..., 1
-*
-         SCALE = ONE
-         DO 210 I = 1, P
-            IS = IWORK( I )
-            IE = IWORK( I+1 ) - 1
-            MB = IE - IS + 1
-            DO 200 J = Q, P + 2, -1
-               JS = IWORK( J )
-               JE = IWORK( J+1 ) - 1
-               NB = JE - JS + 1
-               CALL DTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
-     $                      B( JS, JS ), LDB, C( IS, JS ), LDC,
-     $                      D( IS, IS ), LDD, E( JS, JS ), LDE,
-     $                      F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
-     $                      IWORK( Q+2 ), PPQQ, LINFO )
-               IF( LINFO.GT.0 )
-     $            INFO = LINFO
-               IF( SCALOC.NE.ONE ) THEN
-                  DO 160 K = 1, JS - 1
-                     CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                     CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-  160             CONTINUE
-                  DO 170 K = JS, JE
-                     CALL DSCAL( IS-1, SCALOC, C( 1, K ), 1 )
-                     CALL DSCAL( IS-1, SCALOC, F( 1, K ), 1 )
-  170             CONTINUE
-                  DO 180 K = JS, JE
-                     CALL DSCAL( M-IE, SCALOC, C( IE+1, K ), 1 )
-                     CALL DSCAL( M-IE, SCALOC, F( IE+1, K ), 1 )
-  180             CONTINUE
-                  DO 190 K = JE + 1, N
-                     CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
-                     CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
-  190             CONTINUE
-                  SCALE = SCALE*SCALOC
-               END IF
-*
-*              Substitute R(I, J) and L(I, J) into remaining equation.
-*
-               IF( J.GT.P+2 ) THEN
-                  CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE, C( IS, JS ),
-     $                        LDC, B( 1, JS ), LDB, ONE, F( IS, 1 ),
-     $                        LDF )
-                  CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE, F( IS, JS ),
-     $                        LDF, E( 1, JS ), LDE, ONE, F( IS, 1 ),
-     $                        LDF )
-               END IF
-               IF( I.LT.P ) THEN
-                  CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
-     $                        A( IS, IE+1 ), LDA, C( IS, JS ), LDC, ONE,
-     $                        C( IE+1, JS ), LDC )
-                  CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
-     $                        D( IS, IE+1 ), LDD, F( IS, JS ), LDF, ONE,
-     $                        C( IE+1, JS ), LDC )
-               END IF
-  200       CONTINUE
-  210    CONTINUE
-*
-      END IF
-*
-      WORK( 1 ) = LWMIN
-*
-      RETURN
-*
-*     End of DTGSYL
-*
-      END
diff --git a/src/lib/lapack/dtrcon.f b/src/lib/lapack/dtrcon.f
deleted file mode 100644
index 23da5927..00000000
--- a/src/lib/lapack/dtrcon.f
+++ /dev/null
@@ -1,197 +0,0 @@
-      SUBROUTINE DTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK,
-     $                   IWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     Modified to call DLACN2 in place of DLACON, 5 Feb 03, SJH.
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIAG, NORM, UPLO
-      INTEGER            INFO, LDA, N
-      DOUBLE PRECISION   RCOND
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IWORK( * )
-      DOUBLE PRECISION   A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTRCON estimates the reciprocal of the condition number of a
-*  triangular matrix A, in either the 1-norm or the infinity-norm.
-*
-*  The norm of A is computed and an estimate is obtained for
-*  norm(inv(A)), then the reciprocal of the condition number is
-*  computed as
-*     RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies whether the 1-norm condition number or the
-*          infinity-norm condition number is required:
-*          = '1' or 'O':  1-norm;
-*          = 'I':         Infinity-norm.
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  A is upper triangular;
-*          = 'L':  A is lower triangular.
-*
-*  DIAG    (input) CHARACTER*1
-*          = 'N':  A is non-unit triangular;
-*          = 'U':  A is unit triangular.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The triangular matrix A.  If UPLO = 'U', the leading N-by-N
-*          upper triangular part of the array A contains the upper
-*          triangular matrix, and the strictly lower triangular part of
-*          A is not referenced.  If UPLO = 'L', the leading N-by-N lower
-*          triangular part of the array A contains the lower triangular
-*          matrix, and the strictly upper triangular part of A is not
-*          referenced.  If DIAG = 'U', the diagonal elements of A are
-*          also not referenced and are assumed to be 1.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  RCOND   (output) DOUBLE PRECISION
-*          The reciprocal of the condition number of the matrix A,
-*          computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (3*N)
-*
-*  IWORK   (workspace) INTEGER array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOUNIT, ONENRM, UPPER
-      CHARACTER          NORMIN
-      INTEGER            IX, KASE, KASE1
-      DOUBLE PRECISION   AINVNM, ANORM, SCALE, SMLNUM, XNORM
-*     ..
-*     .. Local Arrays ..
-      INTEGER            ISAVE( 3 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH, DLANTR
-      EXTERNAL           LSAME, IDAMAX, DLAMCH, DLANTR
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLACN2, DLATRS, DRSCL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      UPPER = LSAME( UPLO, 'U' )
-      ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
-      NOUNIT = LSAME( DIAG, 'N' )
-*
-      IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
-         INFO = -2
-      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTRCON', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         RCOND = ONE
-         RETURN
-      END IF
-*
-      RCOND = ZERO
-      SMLNUM = DLAMCH( 'Safe minimum' )*DBLE( MAX( 1, N ) )
-*
-*     Compute the norm of the triangular matrix A.
-*
-      ANORM = DLANTR( NORM, UPLO, DIAG, N, N, A, LDA, WORK )
-*
-*     Continue only if ANORM > 0.
-*
-      IF( ANORM.GT.ZERO ) THEN
-*
-*        Estimate the norm of the inverse of A.
-*
-         AINVNM = ZERO
-         NORMIN = 'N'
-         IF( ONENRM ) THEN
-            KASE1 = 1
-         ELSE
-            KASE1 = 2
-         END IF
-         KASE = 0
-   10    CONTINUE
-         CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
-         IF( KASE.NE.0 ) THEN
-            IF( KASE.EQ.KASE1 ) THEN
-*
-*              Multiply by inv(A).
-*
-               CALL DLATRS( UPLO, 'No transpose', DIAG, NORMIN, N, A,
-     $                      LDA, WORK, SCALE, WORK( 2*N+1 ), INFO )
-            ELSE
-*
-*              Multiply by inv(A').
-*
-               CALL DLATRS( UPLO, 'Transpose', DIAG, NORMIN, N, A, LDA,
-     $                      WORK, SCALE, WORK( 2*N+1 ), INFO )
-            END IF
-            NORMIN = 'Y'
-*
-*           Multiply by 1/SCALE if doing so will not cause overflow.
-*
-            IF( SCALE.NE.ONE ) THEN
-               IX = IDAMAX( N, WORK, 1 )
-               XNORM = ABS( WORK( IX ) )
-               IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO )
-     $            GO TO 20
-               CALL DRSCL( N, SCALE, WORK, 1 )
-            END IF
-            GO TO 10
-         END IF
-*
-*        Compute the estimate of the reciprocal condition number.
-*
-         IF( AINVNM.NE.ZERO )
-     $      RCOND = ( ONE / ANORM ) / AINVNM
-      END IF
-*
-   20 CONTINUE
-      RETURN
-*
-*     End of DTRCON
-*
-      END
diff --git a/src/lib/lapack/dtrevc.f b/src/lib/lapack/dtrevc.f
deleted file mode 100644
index a0215f02..00000000
--- a/src/lib/lapack/dtrevc.f
+++ /dev/null
@@ -1,980 +0,0 @@
-      SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
-     $                   LDVR, MM, M, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          HOWMNY, SIDE
-      INTEGER            INFO, LDT, LDVL, LDVR, M, MM, N
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            SELECT( * )
-      DOUBLE PRECISION   T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
-     $                   WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTREVC computes some or all of the right and/or left eigenvectors of
-*  a real upper quasi-triangular matrix T.
-*  Matrices of this type are produced by the Schur factorization of
-*  a real general matrix:  A = Q*T*Q**T, as computed by DHSEQR.
-*  
-*  The right eigenvector x and the left eigenvector y of T corresponding
-*  to an eigenvalue w are defined by:
-*  
-*     T*x = w*x,     (y**H)*T = w*(y**H)
-*  
-*  where y**H denotes the conjugate transpose of y.
-*  The eigenvalues are not input to this routine, but are read directly
-*  from the diagonal blocks of T.
-*  
-*  This routine returns the matrices X and/or Y of right and left
-*  eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
-*  input matrix.  If Q is the orthogonal factor that reduces a matrix
-*  A to Schur form T, then Q*X and Q*Y are the matrices of right and
-*  left eigenvectors of A.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'R':  compute right eigenvectors only;
-*          = 'L':  compute left eigenvectors only;
-*          = 'B':  compute both right and left eigenvectors.
-*
-*  HOWMNY  (input) CHARACTER*1
-*          = 'A':  compute all right and/or left eigenvectors;
-*          = 'B':  compute all right and/or left eigenvectors,
-*                  backtransformed by the matrices in VR and/or VL;
-*          = 'S':  compute selected right and/or left eigenvectors,
-*                  as indicated by the logical array SELECT.
-*
-*  SELECT  (input/output) LOGICAL array, dimension (N)
-*          If HOWMNY = 'S', SELECT specifies the eigenvectors to be
-*          computed.
-*          If w(j) is a real eigenvalue, the corresponding real
-*          eigenvector is computed if SELECT(j) is .TRUE..
-*          If w(j) and w(j+1) are the real and imaginary parts of a
-*          complex eigenvalue, the corresponding complex eigenvector is
-*          computed if either SELECT(j) or SELECT(j+1) is .TRUE., and
-*          on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to
-*          .FALSE..
-*          Not referenced if HOWMNY = 'A' or 'B'.
-*
-*  N       (input) INTEGER
-*          The order of the matrix T. N >= 0.
-*
-*  T       (input) DOUBLE PRECISION array, dimension (LDT,N)
-*          The upper quasi-triangular matrix T in Schur canonical form.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= max(1,N).
-*
-*  VL      (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
-*          On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
-*          contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*          of Schur vectors returned by DHSEQR).
-*          On exit, if SIDE = 'L' or 'B', VL contains:
-*          if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-*          if HOWMNY = 'B', the matrix Q*Y;
-*          if HOWMNY = 'S', the left eigenvectors of T specified by
-*                           SELECT, stored consecutively in the columns
-*                           of VL, in the same order as their
-*                           eigenvalues.
-*          A complex eigenvector corresponding to a complex eigenvalue
-*          is stored in two consecutive columns, the first holding the
-*          real part, and the second the imaginary part.
-*          Not referenced if SIDE = 'R'.
-*
-*  LDVL    (input) INTEGER
-*          The leading dimension of the array VL.  LDVL >= 1, and if
-*          SIDE = 'L' or 'B', LDVL >= N.
-*
-*  VR      (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
-*          On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-*          contain an N-by-N matrix Q (usually the orthogonal matrix Q
-*          of Schur vectors returned by DHSEQR).
-*          On exit, if SIDE = 'R' or 'B', VR contains:
-*          if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-*          if HOWMNY = 'B', the matrix Q*X;
-*          if HOWMNY = 'S', the right eigenvectors of T specified by
-*                           SELECT, stored consecutively in the columns
-*                           of VR, in the same order as their
-*                           eigenvalues.
-*          A complex eigenvector corresponding to a complex eigenvalue
-*          is stored in two consecutive columns, the first holding the
-*          real part and the second the imaginary part.
-*          Not referenced if SIDE = 'L'.
-*
-*  LDVR    (input) INTEGER
-*          The leading dimension of the array VR.  LDVR >= 1, and if
-*          SIDE = 'R' or 'B', LDVR >= N.
-*
-*  MM      (input) INTEGER
-*          The number of columns in the arrays VL and/or VR. MM >= M.
-*
-*  M       (output) INTEGER
-*          The number of columns in the arrays VL and/or VR actually
-*          used to store the eigenvectors.
-*          If HOWMNY = 'A' or 'B', M is set to N.
-*          Each selected real eigenvector occupies one column and each
-*          selected complex eigenvector occupies two columns.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (3*N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The algorithm used in this program is basically backward (forward)
-*  substitution, with scaling to make the the code robust against
-*  possible overflow.
-*
-*  Each eigenvector is normalized so that the element of largest
-*  magnitude has magnitude 1; here the magnitude of a complex number
-*  (x,y) is taken to be |x| + |y|.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            ALLV, BOTHV, LEFTV, OVER, PAIR, RIGHTV, SOMEV
-      INTEGER            I, IERR, II, IP, IS, J, J1, J2, JNXT, K, KI, N2
-      DOUBLE PRECISION   BETA, BIGNUM, EMAX, OVFL, REC, REMAX, SCALE,
-     $                   SMIN, SMLNUM, ULP, UNFL, VCRIT, VMAX, WI, WR,
-     $                   XNORM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DDOT, DLAMCH
-      EXTERNAL           LSAME, IDAMAX, DDOT, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SQRT
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   X( 2, 2 )
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test the input parameters
-*
-      BOTHV = LSAME( SIDE, 'B' )
-      RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV
-      LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV
-*
-      ALLV = LSAME( HOWMNY, 'A' )
-      OVER = LSAME( HOWMNY, 'B' )
-      SOMEV = LSAME( HOWMNY, 'S' )
-*
-      INFO = 0
-      IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
-         INFO = -1
-      ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN
-         INFO = -8
-      ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN
-         INFO = -10
-      ELSE
-*
-*        Set M to the number of columns required to store the selected
-*        eigenvectors, standardize the array SELECT if necessary, and
-*        test MM.
-*
-         IF( SOMEV ) THEN
-            M = 0
-            PAIR = .FALSE.
-            DO 10 J = 1, N
-               IF( PAIR ) THEN
-                  PAIR = .FALSE.
-                  SELECT( J ) = .FALSE.
-               ELSE
-                  IF( J.LT.N ) THEN
-                     IF( T( J+1, J ).EQ.ZERO ) THEN
-                        IF( SELECT( J ) )
-     $                     M = M + 1
-                     ELSE
-                        PAIR = .TRUE.
-                        IF( SELECT( J ) .OR. SELECT( J+1 ) ) THEN
-                           SELECT( J ) = .TRUE.
-                           M = M + 2
-                        END IF
-                     END IF
-                  ELSE
-                     IF( SELECT( N ) )
-     $                  M = M + 1
-                  END IF
-               END IF
-   10       CONTINUE
-         ELSE
-            M = N
-         END IF
-*
-         IF( MM.LT.M ) THEN
-            INFO = -11
-         END IF
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTREVC', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Set the constants to control overflow.
-*
-      UNFL = DLAMCH( 'Safe minimum' )
-      OVFL = ONE / UNFL
-      CALL DLABAD( UNFL, OVFL )
-      ULP = DLAMCH( 'Precision' )
-      SMLNUM = UNFL*( N / ULP )
-      BIGNUM = ( ONE-ULP ) / SMLNUM
-*
-*     Compute 1-norm of each column of strictly upper triangular
-*     part of T to control overflow in triangular solver.
-*
-      WORK( 1 ) = ZERO
-      DO 30 J = 2, N
-         WORK( J ) = ZERO
-         DO 20 I = 1, J - 1
-            WORK( J ) = WORK( J ) + ABS( T( I, J ) )
-   20    CONTINUE
-   30 CONTINUE
-*
-*     Index IP is used to specify the real or complex eigenvalue:
-*       IP = 0, real eigenvalue,
-*            1, first of conjugate complex pair: (wr,wi)
-*           -1, second of conjugate complex pair: (wr,wi)
-*
-      N2 = 2*N
-*
-      IF( RIGHTV ) THEN
-*
-*        Compute right eigenvectors.
-*
-         IP = 0
-         IS = M
-         DO 140 KI = N, 1, -1
-*
-            IF( IP.EQ.1 )
-     $         GO TO 130
-            IF( KI.EQ.1 )
-     $         GO TO 40
-            IF( T( KI, KI-1 ).EQ.ZERO )
-     $         GO TO 40
-            IP = -1
-*
-   40       CONTINUE
-            IF( SOMEV ) THEN
-               IF( IP.EQ.0 ) THEN
-                  IF( .NOT.SELECT( KI ) )
-     $               GO TO 130
-               ELSE
-                  IF( .NOT.SELECT( KI-1 ) )
-     $               GO TO 130
-               END IF
-            END IF
-*
-*           Compute the KI-th eigenvalue (WR,WI).
-*
-            WR = T( KI, KI )
-            WI = ZERO
-            IF( IP.NE.0 )
-     $         WI = SQRT( ABS( T( KI, KI-1 ) ) )*
-     $              SQRT( ABS( T( KI-1, KI ) ) )
-            SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM )
-*
-            IF( IP.EQ.0 ) THEN
-*
-*              Real right eigenvector
-*
-               WORK( KI+N ) = ONE
-*
-*              Form right-hand side
-*
-               DO 50 K = 1, KI - 1
-                  WORK( K+N ) = -T( K, KI )
-   50          CONTINUE
-*
-*              Solve the upper quasi-triangular system:
-*                 (T(1:KI-1,1:KI-1) - WR)*X = SCALE*WORK.
-*
-               JNXT = KI - 1
-               DO 60 J = KI - 1, 1, -1
-                  IF( J.GT.JNXT )
-     $               GO TO 60
-                  J1 = J
-                  J2 = J
-                  JNXT = J - 1
-                  IF( J.GT.1 ) THEN
-                     IF( T( J, J-1 ).NE.ZERO ) THEN
-                        J1 = J - 1
-                        JNXT = J - 2
-                     END IF
-                  END IF
-*
-                  IF( J1.EQ.J2 ) THEN
-*
-*                    1-by-1 diagonal block
-*
-                     CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
-     $                            LDT, ONE, ONE, WORK( J+N ), N, WR,
-     $                            ZERO, X, 2, SCALE, XNORM, IERR )
-*
-*                    Scale X(1,1) to avoid overflow when updating
-*                    the right-hand side.
-*
-                     IF( XNORM.GT.ONE ) THEN
-                        IF( WORK( J ).GT.BIGNUM / XNORM ) THEN
-                           X( 1, 1 ) = X( 1, 1 ) / XNORM
-                           SCALE = SCALE / XNORM
-                        END IF
-                     END IF
-*
-*                    Scale if necessary
-*
-                     IF( SCALE.NE.ONE )
-     $                  CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
-                     WORK( J+N ) = X( 1, 1 )
-*
-*                    Update right-hand side
-*
-                     CALL DAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1,
-     $                           WORK( 1+N ), 1 )
-*
-                  ELSE
-*
-*                    2-by-2 diagonal block
-*
-                     CALL DLALN2( .FALSE., 2, 1, SMIN, ONE,
-     $                            T( J-1, J-1 ), LDT, ONE, ONE,
-     $                            WORK( J-1+N ), N, WR, ZERO, X, 2,
-     $                            SCALE, XNORM, IERR )
-*
-*                    Scale X(1,1) and X(2,1) to avoid overflow when
-*                    updating the right-hand side.
-*
-                     IF( XNORM.GT.ONE ) THEN
-                        BETA = MAX( WORK( J-1 ), WORK( J ) )
-                        IF( BETA.GT.BIGNUM / XNORM ) THEN
-                           X( 1, 1 ) = X( 1, 1 ) / XNORM
-                           X( 2, 1 ) = X( 2, 1 ) / XNORM
-                           SCALE = SCALE / XNORM
-                        END IF
-                     END IF
-*
-*                    Scale if necessary
-*
-                     IF( SCALE.NE.ONE )
-     $                  CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
-                     WORK( J-1+N ) = X( 1, 1 )
-                     WORK( J+N ) = X( 2, 1 )
-*
-*                    Update right-hand side
-*
-                     CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
-     $                           WORK( 1+N ), 1 )
-                     CALL DAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1,
-     $                           WORK( 1+N ), 1 )
-                  END IF
-   60          CONTINUE
-*
-*              Copy the vector x or Q*x to VR and normalize.
-*
-               IF( .NOT.OVER ) THEN
-                  CALL DCOPY( KI, WORK( 1+N ), 1, VR( 1, IS ), 1 )
-*
-                  II = IDAMAX( KI, VR( 1, IS ), 1 )
-                  REMAX = ONE / ABS( VR( II, IS ) )
-                  CALL DSCAL( KI, REMAX, VR( 1, IS ), 1 )
-*
-                  DO 70 K = KI + 1, N
-                     VR( K, IS ) = ZERO
-   70             CONTINUE
-               ELSE
-                  IF( KI.GT.1 )
-     $               CALL DGEMV( 'N', N, KI-1, ONE, VR, LDVR,
-     $                           WORK( 1+N ), 1, WORK( KI+N ),
-     $                           VR( 1, KI ), 1 )
-*
-                  II = IDAMAX( N, VR( 1, KI ), 1 )
-                  REMAX = ONE / ABS( VR( II, KI ) )
-                  CALL DSCAL( N, REMAX, VR( 1, KI ), 1 )
-               END IF
-*
-            ELSE
-*
-*              Complex right eigenvector.
-*
-*              Initial solve
-*                [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I* WI)]*X = 0.
-*                [ (T(KI,KI-1)   T(KI,KI)   )               ]
-*
-               IF( ABS( T( KI-1, KI ) ).GE.ABS( T( KI, KI-1 ) ) ) THEN
-                  WORK( KI-1+N ) = ONE
-                  WORK( KI+N2 ) = WI / T( KI-1, KI )
-               ELSE
-                  WORK( KI-1+N ) = -WI / T( KI, KI-1 )
-                  WORK( KI+N2 ) = ONE
-               END IF
-               WORK( KI+N ) = ZERO
-               WORK( KI-1+N2 ) = ZERO
-*
-*              Form right-hand side
-*
-               DO 80 K = 1, KI - 2
-                  WORK( K+N ) = -WORK( KI-1+N )*T( K, KI-1 )
-                  WORK( K+N2 ) = -WORK( KI+N2 )*T( K, KI )
-   80          CONTINUE
-*
-*              Solve upper quasi-triangular system:
-*              (T(1:KI-2,1:KI-2) - (WR+i*WI))*X = SCALE*(WORK+i*WORK2)
-*
-               JNXT = KI - 2
-               DO 90 J = KI - 2, 1, -1
-                  IF( J.GT.JNXT )
-     $               GO TO 90
-                  J1 = J
-                  J2 = J
-                  JNXT = J - 1
-                  IF( J.GT.1 ) THEN
-                     IF( T( J, J-1 ).NE.ZERO ) THEN
-                        J1 = J - 1
-                        JNXT = J - 2
-                     END IF
-                  END IF
-*
-                  IF( J1.EQ.J2 ) THEN
-*
-*                    1-by-1 diagonal block
-*
-                     CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ),
-     $                            LDT, ONE, ONE, WORK( J+N ), N, WR, WI,
-     $                            X, 2, SCALE, XNORM, IERR )
-*
-*                    Scale X(1,1) and X(1,2) to avoid overflow when
-*                    updating the right-hand side.
-*
-                     IF( XNORM.GT.ONE ) THEN
-                        IF( WORK( J ).GT.BIGNUM / XNORM ) THEN
-                           X( 1, 1 ) = X( 1, 1 ) / XNORM
-                           X( 1, 2 ) = X( 1, 2 ) / XNORM
-                           SCALE = SCALE / XNORM
-                        END IF
-                     END IF
-*
-*                    Scale if necessary
-*
-                     IF( SCALE.NE.ONE ) THEN
-                        CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
-                        CALL DSCAL( KI, SCALE, WORK( 1+N2 ), 1 )
-                     END IF
-                     WORK( J+N ) = X( 1, 1 )
-                     WORK( J+N2 ) = X( 1, 2 )
-*
-*                    Update the right-hand side
-*
-                     CALL DAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1,
-     $                           WORK( 1+N ), 1 )
-                     CALL DAXPY( J-1, -X( 1, 2 ), T( 1, J ), 1,
-     $                           WORK( 1+N2 ), 1 )
-*
-                  ELSE
-*
-*                    2-by-2 diagonal block
-*
-                     CALL DLALN2( .FALSE., 2, 2, SMIN, ONE,
-     $                            T( J-1, J-1 ), LDT, ONE, ONE,
-     $                            WORK( J-1+N ), N, WR, WI, X, 2, SCALE,
-     $                            XNORM, IERR )
-*
-*                    Scale X to avoid overflow when updating
-*                    the right-hand side.
-*
-                     IF( XNORM.GT.ONE ) THEN
-                        BETA = MAX( WORK( J-1 ), WORK( J ) )
-                        IF( BETA.GT.BIGNUM / XNORM ) THEN
-                           REC = ONE / XNORM
-                           X( 1, 1 ) = X( 1, 1 )*REC
-                           X( 1, 2 ) = X( 1, 2 )*REC
-                           X( 2, 1 ) = X( 2, 1 )*REC
-                           X( 2, 2 ) = X( 2, 2 )*REC
-                           SCALE = SCALE*REC
-                        END IF
-                     END IF
-*
-*                    Scale if necessary
-*
-                     IF( SCALE.NE.ONE ) THEN
-                        CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
-                        CALL DSCAL( KI, SCALE, WORK( 1+N2 ), 1 )
-                     END IF
-                     WORK( J-1+N ) = X( 1, 1 )
-                     WORK( J+N ) = X( 2, 1 )
-                     WORK( J-1+N2 ) = X( 1, 2 )
-                     WORK( J+N2 ) = X( 2, 2 )
-*
-*                    Update the right-hand side
-*
-                     CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
-     $                           WORK( 1+N ), 1 )
-                     CALL DAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1,
-     $                           WORK( 1+N ), 1 )
-                     CALL DAXPY( J-2, -X( 1, 2 ), T( 1, J-1 ), 1,
-     $                           WORK( 1+N2 ), 1 )
-                     CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1,
-     $                           WORK( 1+N2 ), 1 )
-                  END IF
-   90          CONTINUE
-*
-*              Copy the vector x or Q*x to VR and normalize.
-*
-               IF( .NOT.OVER ) THEN
-                  CALL DCOPY( KI, WORK( 1+N ), 1, VR( 1, IS-1 ), 1 )
-                  CALL DCOPY( KI, WORK( 1+N2 ), 1, VR( 1, IS ), 1 )
-*
-                  EMAX = ZERO
-                  DO 100 K = 1, KI
-                     EMAX = MAX( EMAX, ABS( VR( K, IS-1 ) )+
-     $                      ABS( VR( K, IS ) ) )
-  100             CONTINUE
-*
-                  REMAX = ONE / EMAX
-                  CALL DSCAL( KI, REMAX, VR( 1, IS-1 ), 1 )
-                  CALL DSCAL( KI, REMAX, VR( 1, IS ), 1 )
-*
-                  DO 110 K = KI + 1, N
-                     VR( K, IS-1 ) = ZERO
-                     VR( K, IS ) = ZERO
-  110             CONTINUE
-*
-               ELSE
-*
-                  IF( KI.GT.2 ) THEN
-                     CALL DGEMV( 'N', N, KI-2, ONE, VR, LDVR,
-     $                           WORK( 1+N ), 1, WORK( KI-1+N ),
-     $                           VR( 1, KI-1 ), 1 )
-                     CALL DGEMV( 'N', N, KI-2, ONE, VR, LDVR,
-     $                           WORK( 1+N2 ), 1, WORK( KI+N2 ),
-     $                           VR( 1, KI ), 1 )
-                  ELSE
-                     CALL DSCAL( N, WORK( KI-1+N ), VR( 1, KI-1 ), 1 )
-                     CALL DSCAL( N, WORK( KI+N2 ), VR( 1, KI ), 1 )
-                  END IF
-*
-                  EMAX = ZERO
-                  DO 120 K = 1, N
-                     EMAX = MAX( EMAX, ABS( VR( K, KI-1 ) )+
-     $                      ABS( VR( K, KI ) ) )
-  120             CONTINUE
-                  REMAX = ONE / EMAX
-                  CALL DSCAL( N, REMAX, VR( 1, KI-1 ), 1 )
-                  CALL DSCAL( N, REMAX, VR( 1, KI ), 1 )
-               END IF
-            END IF
-*
-            IS = IS - 1
-            IF( IP.NE.0 )
-     $         IS = IS - 1
-  130       CONTINUE
-            IF( IP.EQ.1 )
-     $         IP = 0
-            IF( IP.EQ.-1 )
-     $         IP = 1
-  140    CONTINUE
-      END IF
-*
-      IF( LEFTV ) THEN
-*
-*        Compute left eigenvectors.
-*
-         IP = 0
-         IS = 1
-         DO 260 KI = 1, N
-*
-            IF( IP.EQ.-1 )
-     $         GO TO 250
-            IF( KI.EQ.N )
-     $         GO TO 150
-            IF( T( KI+1, KI ).EQ.ZERO )
-     $         GO TO 150
-            IP = 1
-*
-  150       CONTINUE
-            IF( SOMEV ) THEN
-               IF( .NOT.SELECT( KI ) )
-     $            GO TO 250
-            END IF
-*
-*           Compute the KI-th eigenvalue (WR,WI).
-*
-            WR = T( KI, KI )
-            WI = ZERO
-            IF( IP.NE.0 )
-     $         WI = SQRT( ABS( T( KI, KI+1 ) ) )*
-     $              SQRT( ABS( T( KI+1, KI ) ) )
-            SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM )
-*
-            IF( IP.EQ.0 ) THEN
-*
-*              Real left eigenvector.
-*
-               WORK( KI+N ) = ONE
-*
-*              Form right-hand side
-*
-               DO 160 K = KI + 1, N
-                  WORK( K+N ) = -T( KI, K )
-  160          CONTINUE
-*
-*              Solve the quasi-triangular system:
-*                 (T(KI+1:N,KI+1:N) - WR)'*X = SCALE*WORK
-*
-               VMAX = ONE
-               VCRIT = BIGNUM
-*
-               JNXT = KI + 1
-               DO 170 J = KI + 1, N
-                  IF( J.LT.JNXT )
-     $               GO TO 170
-                  J1 = J
-                  J2 = J
-                  JNXT = J + 1
-                  IF( J.LT.N ) THEN
-                     IF( T( J+1, J ).NE.ZERO ) THEN
-                        J2 = J + 1
-                        JNXT = J + 2
-                     END IF
-                  END IF
-*
-                  IF( J1.EQ.J2 ) THEN
-*
-*                    1-by-1 diagonal block
-*
-*                    Scale if necessary to avoid overflow when forming
-*                    the right-hand side.
-*
-                     IF( WORK( J ).GT.VCRIT ) THEN
-                        REC = ONE / VMAX
-                        CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
-                        VMAX = ONE
-                        VCRIT = BIGNUM
-                     END IF
-*
-                     WORK( J+N ) = WORK( J+N ) -
-     $                             DDOT( J-KI-1, T( KI+1, J ), 1,
-     $                             WORK( KI+1+N ), 1 )
-*
-*                    Solve (T(J,J)-WR)'*X = WORK
-*
-                     CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
-     $                            LDT, ONE, ONE, WORK( J+N ), N, WR,
-     $                            ZERO, X, 2, SCALE, XNORM, IERR )
-*
-*                    Scale if necessary
-*
-                     IF( SCALE.NE.ONE )
-     $                  CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
-                     WORK( J+N ) = X( 1, 1 )
-                     VMAX = MAX( ABS( WORK( J+N ) ), VMAX )
-                     VCRIT = BIGNUM / VMAX
-*
-                  ELSE
-*
-*                    2-by-2 diagonal block
-*
-*                    Scale if necessary to avoid overflow when forming
-*                    the right-hand side.
-*
-                     BETA = MAX( WORK( J ), WORK( J+1 ) )
-                     IF( BETA.GT.VCRIT ) THEN
-                        REC = ONE / VMAX
-                        CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
-                        VMAX = ONE
-                        VCRIT = BIGNUM
-                     END IF
-*
-                     WORK( J+N ) = WORK( J+N ) -
-     $                             DDOT( J-KI-1, T( KI+1, J ), 1,
-     $                             WORK( KI+1+N ), 1 )
-*
-                     WORK( J+1+N ) = WORK( J+1+N ) -
-     $                               DDOT( J-KI-1, T( KI+1, J+1 ), 1,
-     $                               WORK( KI+1+N ), 1 )
-*
-*                    Solve
-*                      [T(J,J)-WR   T(J,J+1)     ]'* X = SCALE*( WORK1 )
-*                      [T(J+1,J)    T(J+1,J+1)-WR]             ( WORK2 )
-*
-                     CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, T( J, J ),
-     $                            LDT, ONE, ONE, WORK( J+N ), N, WR,
-     $                            ZERO, X, 2, SCALE, XNORM, IERR )
-*
-*                    Scale if necessary
-*
-                     IF( SCALE.NE.ONE )
-     $                  CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
-                     WORK( J+N ) = X( 1, 1 )
-                     WORK( J+1+N ) = X( 2, 1 )
-*
-                     VMAX = MAX( ABS( WORK( J+N ) ),
-     $                      ABS( WORK( J+1+N ) ), VMAX )
-                     VCRIT = BIGNUM / VMAX
-*
-                  END IF
-  170          CONTINUE
-*
-*              Copy the vector x or Q*x to VL and normalize.
-*
-               IF( .NOT.OVER ) THEN
-                  CALL DCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 )
-*
-                  II = IDAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1
-                  REMAX = ONE / ABS( VL( II, IS ) )
-                  CALL DSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
-*
-                  DO 180 K = 1, KI - 1
-                     VL( K, IS ) = ZERO
-  180             CONTINUE
-*
-               ELSE
-*
-                  IF( KI.LT.N )
-     $               CALL DGEMV( 'N', N, N-KI, ONE, VL( 1, KI+1 ), LDVL,
-     $                           WORK( KI+1+N ), 1, WORK( KI+N ),
-     $                           VL( 1, KI ), 1 )
-*
-                  II = IDAMAX( N, VL( 1, KI ), 1 )
-                  REMAX = ONE / ABS( VL( II, KI ) )
-                  CALL DSCAL( N, REMAX, VL( 1, KI ), 1 )
-*
-               END IF
-*
-            ELSE
-*
-*              Complex left eigenvector.
-*
-*               Initial solve:
-*                 ((T(KI,KI)    T(KI,KI+1) )' - (WR - I* WI))*X = 0.
-*                 ((T(KI+1,KI) T(KI+1,KI+1))                )
-*
-               IF( ABS( T( KI, KI+1 ) ).GE.ABS( T( KI+1, KI ) ) ) THEN
-                  WORK( KI+N ) = WI / T( KI, KI+1 )
-                  WORK( KI+1+N2 ) = ONE
-               ELSE
-                  WORK( KI+N ) = ONE
-                  WORK( KI+1+N2 ) = -WI / T( KI+1, KI )
-               END IF
-               WORK( KI+1+N ) = ZERO
-               WORK( KI+N2 ) = ZERO
-*
-*              Form right-hand side
-*
-               DO 190 K = KI + 2, N
-                  WORK( K+N ) = -WORK( KI+N )*T( KI, K )
-                  WORK( K+N2 ) = -WORK( KI+1+N2 )*T( KI+1, K )
-  190          CONTINUE
-*
-*              Solve complex quasi-triangular system:
-*              ( T(KI+2,N:KI+2,N) - (WR-i*WI) )*X = WORK1+i*WORK2
-*
-               VMAX = ONE
-               VCRIT = BIGNUM
-*
-               JNXT = KI + 2
-               DO 200 J = KI + 2, N
-                  IF( J.LT.JNXT )
-     $               GO TO 200
-                  J1 = J
-                  J2 = J
-                  JNXT = J + 1
-                  IF( J.LT.N ) THEN
-                     IF( T( J+1, J ).NE.ZERO ) THEN
-                        J2 = J + 1
-                        JNXT = J + 2
-                     END IF
-                  END IF
-*
-                  IF( J1.EQ.J2 ) THEN
-*
-*                    1-by-1 diagonal block
-*
-*                    Scale if necessary to avoid overflow when
-*                    forming the right-hand side elements.
-*
-                     IF( WORK( J ).GT.VCRIT ) THEN
-                        REC = ONE / VMAX
-                        CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
-                        CALL DSCAL( N-KI+1, REC, WORK( KI+N2 ), 1 )
-                        VMAX = ONE
-                        VCRIT = BIGNUM
-                     END IF
-*
-                     WORK( J+N ) = WORK( J+N ) -
-     $                             DDOT( J-KI-2, T( KI+2, J ), 1,
-     $                             WORK( KI+2+N ), 1 )
-                     WORK( J+N2 ) = WORK( J+N2 ) -
-     $                              DDOT( J-KI-2, T( KI+2, J ), 1,
-     $                              WORK( KI+2+N2 ), 1 )
-*
-*                    Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2
-*
-                     CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ),
-     $                            LDT, ONE, ONE, WORK( J+N ), N, WR,
-     $                            -WI, X, 2, SCALE, XNORM, IERR )
-*
-*                    Scale if necessary
-*
-                     IF( SCALE.NE.ONE ) THEN
-                        CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
-                        CALL DSCAL( N-KI+1, SCALE, WORK( KI+N2 ), 1 )
-                     END IF
-                     WORK( J+N ) = X( 1, 1 )
-                     WORK( J+N2 ) = X( 1, 2 )
-                     VMAX = MAX( ABS( WORK( J+N ) ),
-     $                      ABS( WORK( J+N2 ) ), VMAX )
-                     VCRIT = BIGNUM / VMAX
-*
-                  ELSE
-*
-*                    2-by-2 diagonal block
-*
-*                    Scale if necessary to avoid overflow when forming
-*                    the right-hand side elements.
-*
-                     BETA = MAX( WORK( J ), WORK( J+1 ) )
-                     IF( BETA.GT.VCRIT ) THEN
-                        REC = ONE / VMAX
-                        CALL DSCAL( N-KI+1, REC, WORK( KI+N ), 1 )
-                        CALL DSCAL( N-KI+1, REC, WORK( KI+N2 ), 1 )
-                        VMAX = ONE
-                        VCRIT = BIGNUM
-                     END IF
-*
-                     WORK( J+N ) = WORK( J+N ) -
-     $                             DDOT( J-KI-2, T( KI+2, J ), 1,
-     $                             WORK( KI+2+N ), 1 )
-*
-                     WORK( J+N2 ) = WORK( J+N2 ) -
-     $                              DDOT( J-KI-2, T( KI+2, J ), 1,
-     $                              WORK( KI+2+N2 ), 1 )
-*
-                     WORK( J+1+N ) = WORK( J+1+N ) -
-     $                               DDOT( J-KI-2, T( KI+2, J+1 ), 1,
-     $                               WORK( KI+2+N ), 1 )
-*
-                     WORK( J+1+N2 ) = WORK( J+1+N2 ) -
-     $                                DDOT( J-KI-2, T( KI+2, J+1 ), 1,
-     $                                WORK( KI+2+N2 ), 1 )
-*
-*                    Solve 2-by-2 complex linear equation
-*                      ([T(j,j)   T(j,j+1)  ]'-(wr-i*wi)*I)*X = SCALE*B
-*                      ([T(j+1,j) T(j+1,j+1)]             )
-*
-                     CALL DLALN2( .TRUE., 2, 2, SMIN, ONE, T( J, J ),
-     $                            LDT, ONE, ONE, WORK( J+N ), N, WR,
-     $                            -WI, X, 2, SCALE, XNORM, IERR )
-*
-*                    Scale if necessary
-*
-                     IF( SCALE.NE.ONE ) THEN
-                        CALL DSCAL( N-KI+1, SCALE, WORK( KI+N ), 1 )
-                        CALL DSCAL( N-KI+1, SCALE, WORK( KI+N2 ), 1 )
-                     END IF
-                     WORK( J+N ) = X( 1, 1 )
-                     WORK( J+N2 ) = X( 1, 2 )
-                     WORK( J+1+N ) = X( 2, 1 )
-                     WORK( J+1+N2 ) = X( 2, 2 )
-                     VMAX = MAX( ABS( X( 1, 1 ) ), ABS( X( 1, 2 ) ),
-     $                      ABS( X( 2, 1 ) ), ABS( X( 2, 2 ) ), VMAX )
-                     VCRIT = BIGNUM / VMAX
-*
-                  END IF
-  200          CONTINUE
-*
-*              Copy the vector x or Q*x to VL and normalize.
-*
-               IF( .NOT.OVER ) THEN
-                  CALL DCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 )
-                  CALL DCOPY( N-KI+1, WORK( KI+N2 ), 1, VL( KI, IS+1 ),
-     $                        1 )
-*
-                  EMAX = ZERO
-                  DO 220 K = KI, N
-                     EMAX = MAX( EMAX, ABS( VL( K, IS ) )+
-     $                      ABS( VL( K, IS+1 ) ) )
-  220             CONTINUE
-                  REMAX = ONE / EMAX
-                  CALL DSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
-                  CALL DSCAL( N-KI+1, REMAX, VL( KI, IS+1 ), 1 )
-*
-                  DO 230 K = 1, KI - 1
-                     VL( K, IS ) = ZERO
-                     VL( K, IS+1 ) = ZERO
-  230             CONTINUE
-               ELSE
-                  IF( KI.LT.N-1 ) THEN
-                     CALL DGEMV( 'N', N, N-KI-1, ONE, VL( 1, KI+2 ),
-     $                           LDVL, WORK( KI+2+N ), 1, WORK( KI+N ),
-     $                           VL( 1, KI ), 1 )
-                     CALL DGEMV( 'N', N, N-KI-1, ONE, VL( 1, KI+2 ),
-     $                           LDVL, WORK( KI+2+N2 ), 1,
-     $                           WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 )
-                  ELSE
-                     CALL DSCAL( N, WORK( KI+N ), VL( 1, KI ), 1 )
-                     CALL DSCAL( N, WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 )
-                  END IF
-*
-                  EMAX = ZERO
-                  DO 240 K = 1, N
-                     EMAX = MAX( EMAX, ABS( VL( K, KI ) )+
-     $                      ABS( VL( K, KI+1 ) ) )
-  240             CONTINUE
-                  REMAX = ONE / EMAX
-                  CALL DSCAL( N, REMAX, VL( 1, KI ), 1 )
-                  CALL DSCAL( N, REMAX, VL( 1, KI+1 ), 1 )
-*
-               END IF
-*
-            END IF
-*
-            IS = IS + 1
-            IF( IP.NE.0 )
-     $         IS = IS + 1
-  250       CONTINUE
-            IF( IP.EQ.-1 )
-     $         IP = 0
-            IF( IP.EQ.1 )
-     $         IP = -1
-*
-  260    CONTINUE
-*
-      END IF
-*
-      RETURN
-*
-*     End of DTREVC
-*
-      END
diff --git a/src/lib/lapack/dtrexc.f b/src/lib/lapack/dtrexc.f
deleted file mode 100644
index db9be753..00000000
--- a/src/lib/lapack/dtrexc.f
+++ /dev/null
@@ -1,345 +0,0 @@
-      SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          COMPQ
-      INTEGER            IFST, ILST, INFO, LDQ, LDT, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   Q( LDQ, * ), T( LDT, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTREXC reorders the real Schur factorization of a real matrix
-*  A = Q*T*Q**T, so that the diagonal block of T with row index IFST is
-*  moved to row ILST.
-*
-*  The real Schur form T is reordered by an orthogonal similarity
-*  transformation Z**T*T*Z, and optionally the matrix Q of Schur vectors
-*  is updated by postmultiplying it with Z.
-*
-*  T must be in Schur canonical form (as returned by DHSEQR), that is,
-*  block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-*  2-by-2 diagonal block has its diagonal elements equal and its
-*  off-diagonal elements of opposite sign.
-*
-*  Arguments
-*  =========
-*
-*  COMPQ   (input) CHARACTER*1
-*          = 'V':  update the matrix Q of Schur vectors;
-*          = 'N':  do not update Q.
-*
-*  N       (input) INTEGER
-*          The order of the matrix T. N >= 0.
-*
-*  T       (input/output) DOUBLE PRECISION array, dimension (LDT,N)
-*          On entry, the upper quasi-triangular matrix T, in Schur
-*          Schur canonical form.
-*          On exit, the reordered upper quasi-triangular matrix, again
-*          in Schur canonical form.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= max(1,N).
-*
-*  Q       (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
-*          On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
-*          On exit, if COMPQ = 'V', Q has been postmultiplied by the
-*          orthogonal transformation matrix Z which reorders T.
-*          If COMPQ = 'N', Q is not referenced.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q.  LDQ >= max(1,N).
-*
-*  IFST    (input/output) INTEGER
-*  ILST    (input/output) INTEGER
-*          Specify the reordering of the diagonal blocks of T.
-*          The block with row index IFST is moved to row ILST, by a
-*          sequence of transpositions between adjacent blocks.
-*          On exit, if IFST pointed on entry to the second row of a
-*          2-by-2 block, it is changed to point to the first row; ILST
-*          always points to the first row of the block in its final
-*          position (which may differ from its input value by +1 or -1).
-*          1 <= IFST <= N; 1 <= ILST <= N.
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          = 1:  two adjacent blocks were too close to swap (the problem
-*                is very ill-conditioned); T may have been partially
-*                reordered, and ILST points to the first row of the
-*                current position of the block being moved.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            WANTQ
-      INTEGER            HERE, NBF, NBL, NBNEXT
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLAEXC, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test the input arguments.
-*
-      INFO = 0
-      WANTQ = LSAME( COMPQ, 'V' )
-      IF( .NOT.WANTQ .AND. .NOT.LSAME( COMPQ, 'N' ) ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
-         INFO = -4
-      ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN
-         INFO = -6
-      ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
-         INFO = -7
-      ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
-         INFO = -8
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTREXC', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-*     Determine the first row of specified block
-*     and find out it is 1 by 1 or 2 by 2.
-*
-      IF( IFST.GT.1 ) THEN
-         IF( T( IFST, IFST-1 ).NE.ZERO )
-     $      IFST = IFST - 1
-      END IF
-      NBF = 1
-      IF( IFST.LT.N ) THEN
-         IF( T( IFST+1, IFST ).NE.ZERO )
-     $      NBF = 2
-      END IF
-*
-*     Determine the first row of the final block
-*     and find out it is 1 by 1 or 2 by 2.
-*
-      IF( ILST.GT.1 ) THEN
-         IF( T( ILST, ILST-1 ).NE.ZERO )
-     $      ILST = ILST - 1
-      END IF
-      NBL = 1
-      IF( ILST.LT.N ) THEN
-         IF( T( ILST+1, ILST ).NE.ZERO )
-     $      NBL = 2
-      END IF
-*
-      IF( IFST.EQ.ILST )
-     $   RETURN
-*
-      IF( IFST.LT.ILST ) THEN
-*
-*        Update ILST
-*
-         IF( NBF.EQ.2 .AND. NBL.EQ.1 )
-     $      ILST = ILST - 1
-         IF( NBF.EQ.1 .AND. NBL.EQ.2 )
-     $      ILST = ILST + 1
-*
-         HERE = IFST
-*
-   10    CONTINUE
-*
-*        Swap block with next one below
-*
-         IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-*           Current block either 1 by 1 or 2 by 2
-*
-            NBNEXT = 1
-            IF( HERE+NBF+1.LE.N ) THEN
-               IF( T( HERE+NBF+1, HERE+NBF ).NE.ZERO )
-     $            NBNEXT = 2
-            END IF
-            CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBF, NBNEXT,
-     $                   WORK, INFO )
-            IF( INFO.NE.0 ) THEN
-               ILST = HERE
-               RETURN
-            END IF
-            HERE = HERE + NBNEXT
-*
-*           Test if 2 by 2 block breaks into two 1 by 1 blocks
-*
-            IF( NBF.EQ.2 ) THEN
-               IF( T( HERE+1, HERE ).EQ.ZERO )
-     $            NBF = 3
-            END IF
-*
-         ELSE
-*
-*           Current block consists of two 1 by 1 blocks each of which
-*           must be swapped individually
-*
-            NBNEXT = 1
-            IF( HERE+3.LE.N ) THEN
-               IF( T( HERE+3, HERE+2 ).NE.ZERO )
-     $            NBNEXT = 2
-            END IF
-            CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, NBNEXT,
-     $                   WORK, INFO )
-            IF( INFO.NE.0 ) THEN
-               ILST = HERE
-               RETURN
-            END IF
-            IF( NBNEXT.EQ.1 ) THEN
-*
-*              Swap two 1 by 1 blocks, no problems possible
-*
-               CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, NBNEXT,
-     $                      WORK, INFO )
-               HERE = HERE + 1
-            ELSE
-*
-*              Recompute NBNEXT in case 2 by 2 split
-*
-               IF( T( HERE+2, HERE+1 ).EQ.ZERO )
-     $            NBNEXT = 1
-               IF( NBNEXT.EQ.2 ) THEN
-*
-*                 2 by 2 Block did not split
-*
-                  CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1,
-     $                         NBNEXT, WORK, INFO )
-                  IF( INFO.NE.0 ) THEN
-                     ILST = HERE
-                     RETURN
-                  END IF
-                  HERE = HERE + 2
-               ELSE
-*
-*                 2 by 2 Block did split
-*
-                  CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1,
-     $                         WORK, INFO )
-                  CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, 1,
-     $                         WORK, INFO )
-                  HERE = HERE + 2
-               END IF
-            END IF
-         END IF
-         IF( HERE.LT.ILST )
-     $      GO TO 10
-*
-      ELSE
-*
-         HERE = IFST
-   20    CONTINUE
-*
-*        Swap block with next one above
-*
-         IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
-*
-*           Current block either 1 by 1 or 2 by 2
-*
-            NBNEXT = 1
-            IF( HERE.GE.3 ) THEN
-               IF( T( HERE-1, HERE-2 ).NE.ZERO )
-     $            NBNEXT = 2
-            END IF
-            CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT,
-     $                   NBF, WORK, INFO )
-            IF( INFO.NE.0 ) THEN
-               ILST = HERE
-               RETURN
-            END IF
-            HERE = HERE - NBNEXT
-*
-*           Test if 2 by 2 block breaks into two 1 by 1 blocks
-*
-            IF( NBF.EQ.2 ) THEN
-               IF( T( HERE+1, HERE ).EQ.ZERO )
-     $            NBF = 3
-            END IF
-*
-         ELSE
-*
-*           Current block consists of two 1 by 1 blocks each of which
-*           must be swapped individually
-*
-            NBNEXT = 1
-            IF( HERE.GE.3 ) THEN
-               IF( T( HERE-1, HERE-2 ).NE.ZERO )
-     $            NBNEXT = 2
-            END IF
-            CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT,
-     $                   1, WORK, INFO )
-            IF( INFO.NE.0 ) THEN
-               ILST = HERE
-               RETURN
-            END IF
-            IF( NBNEXT.EQ.1 ) THEN
-*
-*              Swap two 1 by 1 blocks, no problems possible
-*
-               CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBNEXT, 1,
-     $                      WORK, INFO )
-               HERE = HERE - 1
-            ELSE
-*
-*              Recompute NBNEXT in case 2 by 2 split
-*
-               IF( T( HERE, HERE-1 ).EQ.ZERO )
-     $            NBNEXT = 1
-               IF( NBNEXT.EQ.2 ) THEN
-*
-*                 2 by 2 Block did not split
-*
-                  CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 2, 1,
-     $                         WORK, INFO )
-                  IF( INFO.NE.0 ) THEN
-                     ILST = HERE
-                     RETURN
-                  END IF
-                  HERE = HERE - 2
-               ELSE
-*
-*                 2 by 2 Block did split
-*
-                  CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1,
-     $                         WORK, INFO )
-                  CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 1, 1,
-     $                         WORK, INFO )
-                  HERE = HERE - 2
-               END IF
-            END IF
-         END IF
-         IF( HERE.GT.ILST )
-     $      GO TO 20
-      END IF
-      ILST = HERE
-*
-      RETURN
-*
-*     End of DTREXC
-*
-      END
diff --git a/src/lib/lapack/dtrsen.f b/src/lib/lapack/dtrsen.f
deleted file mode 100644
index 1d3ab03a..00000000
--- a/src/lib/lapack/dtrsen.f
+++ /dev/null
@@ -1,459 +0,0 @@
-      SUBROUTINE DTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI,
-     $                   M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          COMPQ, JOB
-      INTEGER            INFO, LDQ, LDT, LIWORK, LWORK, M, N
-      DOUBLE PRECISION   S, SEP
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            SELECT( * )
-      INTEGER            IWORK( * )
-      DOUBLE PRECISION   Q( LDQ, * ), T( LDT, * ), WI( * ), WORK( * ),
-     $                   WR( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTRSEN reorders the real Schur factorization of a real matrix
-*  A = Q*T*Q**T, so that a selected cluster of eigenvalues appears in
-*  the leading diagonal blocks of the upper quasi-triangular matrix T,
-*  and the leading columns of Q form an orthonormal basis of the
-*  corresponding right invariant subspace.
-*
-*  Optionally the routine computes the reciprocal condition numbers of
-*  the cluster of eigenvalues and/or the invariant subspace.
-*
-*  T must be in Schur canonical form (as returned by DHSEQR), that is,
-*  block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
-*  2-by-2 diagonal block has its diagonal elemnts equal and its
-*  off-diagonal elements of opposite sign.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          Specifies whether condition numbers are required for the
-*          cluster of eigenvalues (S) or the invariant subspace (SEP):
-*          = 'N': none;
-*          = 'E': for eigenvalues only (S);
-*          = 'V': for invariant subspace only (SEP);
-*          = 'B': for both eigenvalues and invariant subspace (S and
-*                 SEP).
-*
-*  COMPQ   (input) CHARACTER*1
-*          = 'V': update the matrix Q of Schur vectors;
-*          = 'N': do not update Q.
-*
-*  SELECT  (input) LOGICAL array, dimension (N)
-*          SELECT specifies the eigenvalues in the selected cluster. To
-*          select a real eigenvalue w(j), SELECT(j) must be set to
-*          .TRUE.. To select a complex conjugate pair of eigenvalues
-*          w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
-*          either SELECT(j) or SELECT(j+1) or both must be set to
-*          .TRUE.; a complex conjugate pair of eigenvalues must be
-*          either both included in the cluster or both excluded.
-*
-*  N       (input) INTEGER
-*          The order of the matrix T. N >= 0.
-*
-*  T       (input/output) DOUBLE PRECISION array, dimension (LDT,N)
-*          On entry, the upper quasi-triangular matrix T, in Schur
-*          canonical form.
-*          On exit, T is overwritten by the reordered matrix T, again in
-*          Schur canonical form, with the selected eigenvalues in the
-*          leading diagonal blocks.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= max(1,N).
-*
-*  Q       (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
-*          On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
-*          On exit, if COMPQ = 'V', Q has been postmultiplied by the
-*          orthogonal transformation matrix which reorders T; the
-*          leading M columns of Q form an orthonormal basis for the
-*          specified invariant subspace.
-*          If COMPQ = 'N', Q is not referenced.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q.
-*          LDQ >= 1; and if COMPQ = 'V', LDQ >= N.
-*
-*  WR      (output) DOUBLE PRECISION array, dimension (N)
-*  WI      (output) DOUBLE PRECISION array, dimension (N)
-*          The real and imaginary parts, respectively, of the reordered
-*          eigenvalues of T. The eigenvalues are stored in the same
-*          order as on the diagonal of T, with WR(i) = T(i,i) and, if
-*          T(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) > 0 and
-*          WI(i+1) = -WI(i). Note that if a complex eigenvalue is
-*          sufficiently ill-conditioned, then its value may differ
-*          significantly from its value before reordering.
-*
-*  M       (output) INTEGER
-*          The dimension of the specified invariant subspace.
-*          0 < = M <= N.
-*
-*  S       (output) DOUBLE PRECISION
-*          If JOB = 'E' or 'B', S is a lower bound on the reciprocal
-*          condition number for the selected cluster of eigenvalues.
-*          S cannot underestimate the true reciprocal condition number
-*          by more than a factor of sqrt(N). If M = 0 or N, S = 1.
-*          If JOB = 'N' or 'V', S is not referenced.
-*
-*  SEP     (output) DOUBLE PRECISION
-*          If JOB = 'V' or 'B', SEP is the estimated reciprocal
-*          condition number of the specified invariant subspace. If
-*          M = 0 or N, SEP = norm(T).
-*          If JOB = 'N' or 'E', SEP is not referenced.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If JOB = 'N', LWORK >= max(1,N);
-*          if JOB = 'E', LWORK >= max(1,M*(N-M));
-*          if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
-*
-*          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.
-*
-*  IWORK   (workspace) INTEGER array, dimension (MAX(1,LIWORK))
-*          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*
-*  LIWORK  (input) INTEGER
-*          The dimension of the array IWORK.
-*          If JOB = 'N' or 'E', LIWORK >= 1;
-*          if JOB = 'V' or 'B', LIWORK >= max(1,M*(N-M)).
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*          = 1: reordering of T failed because some eigenvalues are too
-*               close to separate (the problem is very ill-conditioned);
-*               T may have been partially reordered, and WR and WI
-*               contain the eigenvalues in the same order as in T; S and
-*               SEP (if requested) are set to zero.
-*
-*  Further Details
-*  ===============
-*
-*  DTRSEN first collects the selected eigenvalues by computing an
-*  orthogonal transformation Z to move them to the top left corner of T.
-*  In other words, the selected eigenvalues are the eigenvalues of T11
-*  in:
-*
-*                Z'*T*Z = ( T11 T12 ) n1
-*                         (  0  T22 ) n2
-*                            n1  n2
-*
-*  where N = n1+n2 and Z' means the transpose of Z. The first n1 columns
-*  of Z span the specified invariant subspace of T.
-*
-*  If T has been obtained from the real Schur factorization of a matrix
-*  A = Q*T*Q', then the reordered real Schur factorization of A is given
-*  by A = (Q*Z)*(Z'*T*Z)*(Q*Z)', and the first n1 columns of Q*Z span
-*  the corresponding invariant subspace of A.
-*
-*  The reciprocal condition number of the average of the eigenvalues of
-*  T11 may be returned in S. S lies between 0 (very badly conditioned)
-*  and 1 (very well conditioned). It is computed as follows. First we
-*  compute R so that
-*
-*                         P = ( I  R ) n1
-*                             ( 0  0 ) n2
-*                               n1 n2
-*
-*  is the projector on the invariant subspace associated with T11.
-*  R is the solution of the Sylvester equation:
-*
-*                        T11*R - R*T22 = T12.
-*
-*  Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M) denote
-*  the two-norm of M. Then S is computed as the lower bound
-*
-*                      (1 + F-norm(R)**2)**(-1/2)
-*
-*  on the reciprocal of 2-norm(P), the true reciprocal condition number.
-*  S cannot underestimate 1 / 2-norm(P) by more than a factor of
-*  sqrt(N).
-*
-*  An approximate error bound for the computed average of the
-*  eigenvalues of T11 is
-*
-*                         EPS * norm(T) / S
-*
-*  where EPS is the machine precision.
-*
-*  The reciprocal condition number of the right invariant subspace
-*  spanned by the first n1 columns of Z (or of Q*Z) is returned in SEP.
-*  SEP is defined as the separation of T11 and T22:
-*
-*                     sep( T11, T22 ) = sigma-min( C )
-*
-*  where sigma-min(C) is the smallest singular value of the
-*  n1*n2-by-n1*n2 matrix
-*
-*     C  = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) )
-*
-*  I(m) is an m by m identity matrix, and kprod denotes the Kronecker
-*  product. We estimate sigma-min(C) by the reciprocal of an estimate of
-*  the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C)
-*  cannot differ from sigma-min(C) by more than a factor of sqrt(n1*n2).
-*
-*  When SEP is small, small changes in T can cause large changes in
-*  the invariant subspace. An approximate bound on the maximum angular
-*  error in the computed right invariant subspace is
-*
-*                      EPS * norm(T) / SEP
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, PAIR, SWAP, WANTBH, WANTQ, WANTS,
-     $                   WANTSP
-      INTEGER            IERR, K, KASE, KK, KS, LIWMIN, LWMIN, N1, N2,
-     $                   NN
-      DOUBLE PRECISION   EST, RNORM, SCALE
-*     ..
-*     .. Local Arrays ..
-      INTEGER            ISAVE( 3 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLANGE
-      EXTERNAL           LSAME, DLANGE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLACN2, DLACPY, DTREXC, DTRSYL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test the input parameters
-*
-      WANTBH = LSAME( JOB, 'B' )
-      WANTS = LSAME( JOB, 'E' ) .OR. WANTBH
-      WANTSP = LSAME( JOB, 'V' ) .OR. WANTBH
-      WANTQ = LSAME( COMPQ, 'V' )
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.WANTS .AND. .NOT.WANTSP )
-     $     THEN
-         INFO = -1
-      ELSE IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
-         INFO = -8
-      ELSE
-*
-*        Set M to the dimension of the specified invariant subspace,
-*        and test LWORK and LIWORK.
-*
-         M = 0
-         PAIR = .FALSE.
-         DO 10 K = 1, N
-            IF( PAIR ) THEN
-               PAIR = .FALSE.
-            ELSE
-               IF( K.LT.N ) THEN
-                  IF( T( K+1, K ).EQ.ZERO ) THEN
-                     IF( SELECT( K ) )
-     $                  M = M + 1
-                  ELSE
-                     PAIR = .TRUE.
-                     IF( SELECT( K ) .OR. SELECT( K+1 ) )
-     $                  M = M + 2
-                  END IF
-               ELSE
-                  IF( SELECT( N ) )
-     $               M = M + 1
-               END IF
-            END IF
-   10    CONTINUE
-*
-         N1 = M
-         N2 = N - M
-         NN = N1*N2
-*
-         IF( WANTSP ) THEN
-            LWMIN = MAX( 1, 2*NN )
-            LIWMIN = MAX( 1, NN )
-         ELSE IF( LSAME( JOB, 'N' ) ) THEN
-            LWMIN = MAX( 1, N )
-            LIWMIN = 1
-         ELSE IF( LSAME( JOB, 'E' ) ) THEN
-            LWMIN = MAX( 1, NN )
-            LIWMIN = 1
-         END IF
-*
-         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
-            INFO = -15
-         ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
-            INFO = -17
-         END IF
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         WORK( 1 ) = LWMIN
-         IWORK( 1 ) = LIWMIN
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTRSEN', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( M.EQ.N .OR. M.EQ.0 ) THEN
-         IF( WANTS )
-     $      S = ONE
-         IF( WANTSP )
-     $      SEP = DLANGE( '1', N, N, T, LDT, WORK )
-         GO TO 40
-      END IF
-*
-*     Collect the selected blocks at the top-left corner of T.
-*
-      KS = 0
-      PAIR = .FALSE.
-      DO 20 K = 1, N
-         IF( PAIR ) THEN
-            PAIR = .FALSE.
-         ELSE
-            SWAP = SELECT( K )
-            IF( K.LT.N ) THEN
-               IF( T( K+1, K ).NE.ZERO ) THEN
-                  PAIR = .TRUE.
-                  SWAP = SWAP .OR. SELECT( K+1 )
-               END IF
-            END IF
-            IF( SWAP ) THEN
-               KS = KS + 1
-*
-*              Swap the K-th block to position KS.
-*
-               IERR = 0
-               KK = K
-               IF( K.NE.KS )
-     $            CALL DTREXC( COMPQ, N, T, LDT, Q, LDQ, KK, KS, WORK,
-     $                         IERR )
-               IF( IERR.EQ.1 .OR. IERR.EQ.2 ) THEN
-*
-*                 Blocks too close to swap: exit.
-*
-                  INFO = 1
-                  IF( WANTS )
-     $               S = ZERO
-                  IF( WANTSP )
-     $               SEP = ZERO
-                  GO TO 40
-               END IF
-               IF( PAIR )
-     $            KS = KS + 1
-            END IF
-         END IF
-   20 CONTINUE
-*
-      IF( WANTS ) THEN
-*
-*        Solve Sylvester equation for R:
-*
-*           T11*R - R*T22 = scale*T12
-*
-         CALL DLACPY( 'F', N1, N2, T( 1, N1+1 ), LDT, WORK, N1 )
-         CALL DTRSYL( 'N', 'N', -1, N1, N2, T, LDT, T( N1+1, N1+1 ),
-     $                LDT, WORK, N1, SCALE, IERR )
-*
-*        Estimate the reciprocal of the condition number of the cluster
-*        of eigenvalues.
-*
-         RNORM = DLANGE( 'F', N1, N2, WORK, N1, WORK )
-         IF( RNORM.EQ.ZERO ) THEN
-            S = ONE
-         ELSE
-            S = SCALE / ( SQRT( SCALE*SCALE / RNORM+RNORM )*
-     $          SQRT( RNORM ) )
-         END IF
-      END IF
-*
-      IF( WANTSP ) THEN
-*
-*        Estimate sep(T11,T22).
-*
-         EST = ZERO
-         KASE = 0
-   30    CONTINUE
-         CALL DLACN2( NN, WORK( NN+1 ), WORK, IWORK, EST, KASE, ISAVE )
-         IF( KASE.NE.0 ) THEN
-            IF( KASE.EQ.1 ) THEN
-*
-*              Solve  T11*R - R*T22 = scale*X.
-*
-               CALL DTRSYL( 'N', 'N', -1, N1, N2, T, LDT,
-     $                      T( N1+1, N1+1 ), LDT, WORK, N1, SCALE,
-     $                      IERR )
-            ELSE
-*
-*              Solve  T11'*R - R*T22' = scale*X.
-*
-               CALL DTRSYL( 'T', 'T', -1, N1, N2, T, LDT,
-     $                      T( N1+1, N1+1 ), LDT, WORK, N1, SCALE,
-     $                      IERR )
-            END IF
-            GO TO 30
-         END IF
-*
-         SEP = SCALE / EST
-      END IF
-*
-   40 CONTINUE
-*
-*     Store the output eigenvalues in WR and WI.
-*
-      DO 50 K = 1, N
-         WR( K ) = T( K, K )
-         WI( K ) = ZERO
-   50 CONTINUE
-      DO 60 K = 1, N - 1
-         IF( T( K+1, K ).NE.ZERO ) THEN
-            WI( K ) = SQRT( ABS( T( K, K+1 ) ) )*
-     $                SQRT( ABS( T( K+1, K ) ) )
-            WI( K+1 ) = -WI( K )
-         END IF
-   60 CONTINUE
-*
-      WORK( 1 ) = LWMIN
-      IWORK( 1 ) = LIWMIN
-*
-      RETURN
-*
-*     End of DTRSEN
-*
-      END
diff --git a/src/lib/lapack/dtrsyl.f b/src/lib/lapack/dtrsyl.f
deleted file mode 100644
index 4c6c28e5..00000000
--- a/src/lib/lapack/dtrsyl.f
+++ /dev/null
@@ -1,913 +0,0 @@
-      SUBROUTINE DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
-     $                   LDC, SCALE, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TRANA, TRANB
-      INTEGER            INFO, ISGN, LDA, LDB, LDC, M, N
-      DOUBLE PRECISION   SCALE
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), C( LDC, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTRSYL solves the real Sylvester matrix equation:
-*
-*     op(A)*X + X*op(B) = scale*C or
-*     op(A)*X - X*op(B) = scale*C,
-*
-*  where op(A) = A or A**T, and  A and B are both upper quasi-
-*  triangular. A is M-by-M and B is N-by-N; the right hand side C and
-*  the solution X are M-by-N; and scale is an output scale factor, set
-*  <= 1 to avoid overflow in X.
-*
-*  A and B must be in Schur canonical form (as returned by DHSEQR), that
-*  is, block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
-*  each 2-by-2 diagonal block has its diagonal elements equal and its
-*  off-diagonal elements of opposite sign.
-*
-*  Arguments
-*  =========
-*
-*  TRANA   (input) CHARACTER*1
-*          Specifies the option op(A):
-*          = 'N': op(A) = A    (No transpose)
-*          = 'T': op(A) = A**T (Transpose)
-*          = 'C': op(A) = A**H (Conjugate transpose = Transpose)
-*
-*  TRANB   (input) CHARACTER*1
-*          Specifies the option op(B):
-*          = 'N': op(B) = B    (No transpose)
-*          = 'T': op(B) = B**T (Transpose)
-*          = 'C': op(B) = B**H (Conjugate transpose = Transpose)
-*
-*  ISGN    (input) INTEGER
-*          Specifies the sign in the equation:
-*          = +1: solve op(A)*X + X*op(B) = scale*C
-*          = -1: solve op(A)*X - X*op(B) = scale*C
-*
-*  M       (input) INTEGER
-*          The order of the matrix A, and the number of rows in the
-*          matrices X and C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The order of the matrix B, and the number of columns in the
-*          matrices X and C. N >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,M)
-*          The upper quasi-triangular matrix A, in Schur canonical form.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  B       (input) DOUBLE PRECISION array, dimension (LDB,N)
-*          The upper quasi-triangular matrix B, in Schur canonical form.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1,N).
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the M-by-N right hand side matrix C.
-*          On exit, C is overwritten by the solution matrix X.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M)
-*
-*  SCALE   (output) DOUBLE PRECISION
-*          The scale factor, scale, set <= 1 to avoid overflow in X.
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*          = 1: A and B have common or very close eigenvalues; perturbed
-*               values were used to solve the equation (but the matrices
-*               A and B are unchanged).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOTRNA, NOTRNB
-      INTEGER            IERR, J, K, K1, K2, KNEXT, L, L1, L2, LNEXT
-      DOUBLE PRECISION   A11, BIGNUM, DA11, DB, EPS, SCALOC, SGN, SMIN,
-     $                   SMLNUM, SUML, SUMR, XNORM
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   DUM( 1 ), VEC( 2, 2 ), X( 2, 2 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DDOT, DLAMCH, DLANGE
-      EXTERNAL           LSAME, DDOT, DLAMCH, DLANGE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, DLALN2, DLASY2, DSCAL, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and Test input parameters
-*
-      NOTRNA = LSAME( TRANA, 'N' )
-      NOTRNB = LSAME( TRANB, 'N' )
-*
-      INFO = 0
-      IF( .NOT.NOTRNA .AND. .NOT.LSAME( TRANA, 'T' ) .AND. .NOT.
-     $    LSAME( TRANA, 'C' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRNB .AND. .NOT.LSAME( TRANB, 'T' ) .AND. .NOT.
-     $         LSAME( TRANB, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( ISGN.NE.1 .AND. ISGN.NE.-1 ) THEN
-         INFO = -3
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -11
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTRSYL', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 )
-     $   RETURN
-*
-*     Set constants to control overflow
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SMLNUM*DBLE( M*N ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-      SMIN = MAX( SMLNUM, EPS*DLANGE( 'M', M, M, A, LDA, DUM ),
-     $       EPS*DLANGE( 'M', N, N, B, LDB, DUM ) )
-*
-      SCALE = ONE
-      SGN = ISGN
-*
-      IF( NOTRNA .AND. NOTRNB ) THEN
-*
-*        Solve    A*X + ISGN*X*B = scale*C.
-*
-*        The (K,L)th block of X is determined starting from
-*        bottom-left corner column by column by
-*
-*         A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
-*
-*        Where
-*                  M                         L-1
-*        R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(J,L)].
-*                I=K+1                       J=1
-*
-*        Start column loop (index = L)
-*        L1 (L2) : column index of the first (first) row of X(K,L).
-*
-         LNEXT = 1
-         DO 60 L = 1, N
-            IF( L.LT.LNEXT )
-     $         GO TO 60
-            IF( L.EQ.N ) THEN
-               L1 = L
-               L2 = L
-            ELSE
-               IF( B( L+1, L ).NE.ZERO ) THEN
-                  L1 = L
-                  L2 = L + 1
-                  LNEXT = L + 2
-               ELSE
-                  L1 = L
-                  L2 = L
-                  LNEXT = L + 1
-               END IF
-            END IF
-*
-*           Start row loop (index = K)
-*           K1 (K2): row index of the first (last) row of X(K,L).
-*
-            KNEXT = M
-            DO 50 K = M, 1, -1
-               IF( K.GT.KNEXT )
-     $            GO TO 50
-               IF( K.EQ.1 ) THEN
-                  K1 = K
-                  K2 = K
-               ELSE
-                  IF( A( K, K-1 ).NE.ZERO ) THEN
-                     K1 = K - 1
-                     K2 = K
-                     KNEXT = K - 2
-                  ELSE
-                     K1 = K
-                     K2 = K
-                     KNEXT = K - 1
-                  END IF
-               END IF
-*
-               IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
-                  SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
-     $                   C( MIN( K1+1, M ), L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-                  SCALOC = ONE
-*
-                  A11 = A( K1, K1 ) + SGN*B( L1, L1 )
-                  DA11 = ABS( A11 )
-                  IF( DA11.LE.SMIN ) THEN
-                     A11 = SMIN
-                     DA11 = SMIN
-                     INFO = 1
-                  END IF
-                  DB = ABS( VEC( 1, 1 ) )
-                  IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
-                     IF( DB.GT.BIGNUM*DA11 )
-     $                  SCALOC = ONE / DB
-                  END IF
-                  X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 10 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-   10                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-*
-               ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
-                  SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
-                  CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, A( K1, K1 ),
-     $                         LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
-     $                         ZERO, X, 2, SCALOC, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 20 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-   20                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K2, L1 ) = X( 2, 1 )
-*
-               ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
-                  SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
-     $                   C( MIN( K1+1, M ), L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
-                  SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
-     $                   C( MIN( K1+1, M ), L2 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
-                  VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
-                  CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, B( L1, L1 ),
-     $                         LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
-     $                         ZERO, X, 2, SCALOC, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 30 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-   30                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K1, L2 ) = X( 2, 1 )
-*
-               ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
-                  SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L2 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
-                  VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L2 ), 1 )
-                  SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L2 ), 1 )
-                  VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
-                  CALL DLASY2( .FALSE., .FALSE., ISGN, 2, 2,
-     $                         A( K1, K1 ), LDA, B( L1, L1 ), LDB, VEC,
-     $                         2, SCALOC, X, 2, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 40 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-   40                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K1, L2 ) = X( 1, 2 )
-                  C( K2, L1 ) = X( 2, 1 )
-                  C( K2, L2 ) = X( 2, 2 )
-               END IF
-*
-   50       CONTINUE
-*
-   60    CONTINUE
-*
-      ELSE IF( .NOT.NOTRNA .AND. NOTRNB ) THEN
-*
-*        Solve    A' *X + ISGN*X*B = scale*C.
-*
-*        The (K,L)th block of X is determined starting from
-*        upper-left corner column by column by
-*
-*          A(K,K)'*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
-*
-*        Where
-*                   K-1                        L-1
-*          R(K,L) = SUM [A(I,K)'*X(I,L)] +ISGN*SUM [X(K,J)*B(J,L)]
-*                   I=1                        J=1
-*
-*        Start column loop (index = L)
-*        L1 (L2): column index of the first (last) row of X(K,L)
-*
-         LNEXT = 1
-         DO 120 L = 1, N
-            IF( L.LT.LNEXT )
-     $         GO TO 120
-            IF( L.EQ.N ) THEN
-               L1 = L
-               L2 = L
-            ELSE
-               IF( B( L+1, L ).NE.ZERO ) THEN
-                  L1 = L
-                  L2 = L + 1
-                  LNEXT = L + 2
-               ELSE
-                  L1 = L
-                  L2 = L
-                  LNEXT = L + 1
-               END IF
-            END IF
-*
-*           Start row loop (index = K)
-*           K1 (K2): row index of the first (last) row of X(K,L)
-*
-            KNEXT = 1
-            DO 110 K = 1, M
-               IF( K.LT.KNEXT )
-     $            GO TO 110
-               IF( K.EQ.M ) THEN
-                  K1 = K
-                  K2 = K
-               ELSE
-                  IF( A( K+1, K ).NE.ZERO ) THEN
-                     K1 = K
-                     K2 = K + 1
-                     KNEXT = K + 2
-                  ELSE
-                     K1 = K
-                     K2 = K
-                     KNEXT = K + 1
-                  END IF
-               END IF
-*
-               IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-                  SCALOC = ONE
-*
-                  A11 = A( K1, K1 ) + SGN*B( L1, L1 )
-                  DA11 = ABS( A11 )
-                  IF( DA11.LE.SMIN ) THEN
-                     A11 = SMIN
-                     DA11 = SMIN
-                     INFO = 1
-                  END IF
-                  DB = ABS( VEC( 1, 1 ) )
-                  IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
-                     IF( DB.GT.BIGNUM*DA11 )
-     $                  SCALOC = ONE / DB
-                  END IF
-                  X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 70 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-   70                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-*
-               ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
-                  CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, A( K1, K1 ),
-     $                         LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
-     $                         ZERO, X, 2, SCALOC, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 80 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-   80                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K2, L1 ) = X( 2, 1 )
-*
-               ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
-                  VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
-                  CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, B( L1, L1 ),
-     $                         LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
-     $                         ZERO, X, 2, SCALOC, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 90 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-   90                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K1, L2 ) = X( 2, 1 )
-*
-               ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
-                  SUMR = DDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
-                  VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
-                  VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L2 ), 1 )
-                  SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L2 ), 1 )
-                  VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
-                  CALL DLASY2( .TRUE., .FALSE., ISGN, 2, 2, A( K1, K1 ),
-     $                         LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
-     $                         2, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 100 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-  100                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K1, L2 ) = X( 1, 2 )
-                  C( K2, L1 ) = X( 2, 1 )
-                  C( K2, L2 ) = X( 2, 2 )
-               END IF
-*
-  110       CONTINUE
-  120    CONTINUE
-*
-      ELSE IF( .NOT.NOTRNA .AND. .NOT.NOTRNB ) THEN
-*
-*        Solve    A'*X + ISGN*X*B' = scale*C.
-*
-*        The (K,L)th block of X is determined starting from
-*        top-right corner column by column by
-*
-*           A(K,K)'*X(K,L) + ISGN*X(K,L)*B(L,L)' = C(K,L) - R(K,L)
-*
-*        Where
-*                     K-1                          N
-*            R(K,L) = SUM [A(I,K)'*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)'].
-*                     I=1                        J=L+1
-*
-*        Start column loop (index = L)
-*        L1 (L2): column index of the first (last) row of X(K,L)
-*
-         LNEXT = N
-         DO 180 L = N, 1, -1
-            IF( L.GT.LNEXT )
-     $         GO TO 180
-            IF( L.EQ.1 ) THEN
-               L1 = L
-               L2 = L
-            ELSE
-               IF( B( L, L-1 ).NE.ZERO ) THEN
-                  L1 = L - 1
-                  L2 = L
-                  LNEXT = L - 2
-               ELSE
-                  L1 = L
-                  L2 = L
-                  LNEXT = L - 1
-               END IF
-            END IF
-*
-*           Start row loop (index = K)
-*           K1 (K2): row index of the first (last) row of X(K,L)
-*
-            KNEXT = 1
-            DO 170 K = 1, M
-               IF( K.LT.KNEXT )
-     $            GO TO 170
-               IF( K.EQ.M ) THEN
-                  K1 = K
-                  K2 = K
-               ELSE
-                  IF( A( K+1, K ).NE.ZERO ) THEN
-                     K1 = K
-                     K2 = K + 1
-                     KNEXT = K + 2
-                  ELSE
-                     K1 = K
-                     K2 = K
-                     KNEXT = K + 1
-                  END IF
-               END IF
-*
-               IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( N-L1, C( K1, MIN( L1+1, N ) ), LDC,
-     $                   B( L1, MIN( L1+1, N ) ), LDB )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-                  SCALOC = ONE
-*
-                  A11 = A( K1, K1 ) + SGN*B( L1, L1 )
-                  DA11 = ABS( A11 )
-                  IF( DA11.LE.SMIN ) THEN
-                     A11 = SMIN
-                     DA11 = SMIN
-                     INFO = 1
-                  END IF
-                  DB = ABS( VEC( 1, 1 ) )
-                  IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
-                     IF( DB.GT.BIGNUM*DA11 )
-     $                  SCALOC = ONE / DB
-                  END IF
-                  X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 130 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-  130                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-*
-               ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
-     $                   B( L1, MIN( L2+1, N ) ), LDB )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
-     $                   B( L1, MIN( L2+1, N ) ), LDB )
-                  VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
-                  CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, A( K1, K1 ),
-     $                         LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
-     $                         ZERO, X, 2, SCALOC, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 140 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-  140                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K2, L1 ) = X( 2, 1 )
-*
-               ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
-     $                   B( L1, MIN( L2+1, N ) ), LDB )
-                  VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
-                  SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
-     $                   B( L2, MIN( L2+1, N ) ), LDB )
-                  VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
-                  CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, B( L1, L1 ),
-     $                         LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
-     $                         ZERO, X, 2, SCALOC, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 150 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-  150                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K1, L2 ) = X( 2, 1 )
-*
-               ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
-     $                   B( L1, MIN( L2+1, N ) ), LDB )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
-                  SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
-     $                   B( L2, MIN( L2+1, N ) ), LDB )
-                  VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
-                  SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
-     $                   B( L1, MIN( L2+1, N ) ), LDB )
-                  VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( K1-1, A( 1, K2 ), 1, C( 1, L2 ), 1 )
-                  SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
-     $                   B( L2, MIN( L2+1, N ) ), LDB )
-                  VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
-                  CALL DLASY2( .TRUE., .TRUE., ISGN, 2, 2, A( K1, K1 ),
-     $                         LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
-     $                         2, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 160 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-  160                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K1, L2 ) = X( 1, 2 )
-                  C( K2, L1 ) = X( 2, 1 )
-                  C( K2, L2 ) = X( 2, 2 )
-               END IF
-*
-  170       CONTINUE
-  180    CONTINUE
-*
-      ELSE IF( NOTRNA .AND. .NOT.NOTRNB ) THEN
-*
-*        Solve    A*X + ISGN*X*B' = scale*C.
-*
-*        The (K,L)th block of X is determined starting from
-*        bottom-right corner column by column by
-*
-*            A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L)' = C(K,L) - R(K,L)
-*
-*        Where
-*                      M                          N
-*            R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)'].
-*                    I=K+1                      J=L+1
-*
-*        Start column loop (index = L)
-*        L1 (L2): column index of the first (last) row of X(K,L)
-*
-         LNEXT = N
-         DO 240 L = N, 1, -1
-            IF( L.GT.LNEXT )
-     $         GO TO 240
-            IF( L.EQ.1 ) THEN
-               L1 = L
-               L2 = L
-            ELSE
-               IF( B( L, L-1 ).NE.ZERO ) THEN
-                  L1 = L - 1
-                  L2 = L
-                  LNEXT = L - 2
-               ELSE
-                  L1 = L
-                  L2 = L
-                  LNEXT = L - 1
-               END IF
-            END IF
-*
-*           Start row loop (index = K)
-*           K1 (K2): row index of the first (last) row of X(K,L)
-*
-            KNEXT = M
-            DO 230 K = M, 1, -1
-               IF( K.GT.KNEXT )
-     $            GO TO 230
-               IF( K.EQ.1 ) THEN
-                  K1 = K
-                  K2 = K
-               ELSE
-                  IF( A( K, K-1 ).NE.ZERO ) THEN
-                     K1 = K - 1
-                     K2 = K
-                     KNEXT = K - 2
-                  ELSE
-                     K1 = K
-                     K2 = K
-                     KNEXT = K - 1
-                  END IF
-               END IF
-*
-               IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
-                  SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
-     $                   C( MIN( K1+1, M ), L1 ), 1 )
-                  SUMR = DDOT( N-L1, C( K1, MIN( L1+1, N ) ), LDC,
-     $                   B( L1, MIN( L1+1, N ) ), LDB )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-                  SCALOC = ONE
-*
-                  A11 = A( K1, K1 ) + SGN*B( L1, L1 )
-                  DA11 = ABS( A11 )
-                  IF( DA11.LE.SMIN ) THEN
-                     A11 = SMIN
-                     DA11 = SMIN
-                     INFO = 1
-                  END IF
-                  DB = ABS( VEC( 1, 1 ) )
-                  IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
-                     IF( DB.GT.BIGNUM*DA11 )
-     $                  SCALOC = ONE / DB
-                  END IF
-                  X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 190 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-  190                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-*
-               ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
-*
-                  SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L1 ), 1 )
-                  SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
-     $                   B( L1, MIN( L2+1, N ) ), LDB )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L1 ), 1 )
-                  SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
-     $                   B( L1, MIN( L2+1, N ) ), LDB )
-                  VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
-                  CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, A( K1, K1 ),
-     $                         LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
-     $                         ZERO, X, 2, SCALOC, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 200 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-  200                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K2, L1 ) = X( 2, 1 )
-*
-               ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
-*
-                  SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
-     $                   C( MIN( K1+1, M ), L1 ), 1 )
-                  SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
-     $                   B( L1, MIN( L2+1, N ) ), LDB )
-                  VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
-*
-                  SUML = DDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
-     $                   C( MIN( K1+1, M ), L2 ), 1 )
-                  SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
-     $                   B( L2, MIN( L2+1, N ) ), LDB )
-                  VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
-*
-                  CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, B( L1, L1 ),
-     $                         LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
-     $                         ZERO, X, 2, SCALOC, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 210 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-  210                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K1, L2 ) = X( 2, 1 )
-*
-               ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
-*
-                  SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L1 ), 1 )
-                  SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
-     $                   B( L1, MIN( L2+1, N ) ), LDB )
-                  VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L2 ), 1 )
-                  SUMR = DDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
-     $                   B( L2, MIN( L2+1, N ) ), LDB )
-                  VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L1 ), 1 )
-                  SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
-     $                   B( L1, MIN( L2+1, N ) ), LDB )
-                  VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
-*
-                  SUML = DDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
-     $                   C( MIN( K2+1, M ), L2 ), 1 )
-                  SUMR = DDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
-     $                   B( L2, MIN( L2+1, N ) ), LDB )
-                  VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
-*
-                  CALL DLASY2( .FALSE., .TRUE., ISGN, 2, 2, A( K1, K1 ),
-     $                         LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
-     $                         2, XNORM, IERR )
-                  IF( IERR.NE.0 )
-     $               INFO = 1
-*
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 220 J = 1, N
-                        CALL DSCAL( M, SCALOC, C( 1, J ), 1 )
-  220                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-                  C( K1, L1 ) = X( 1, 1 )
-                  C( K1, L2 ) = X( 1, 2 )
-                  C( K2, L1 ) = X( 2, 1 )
-                  C( K2, L2 ) = X( 2, 2 )
-               END IF
-*
-  230       CONTINUE
-  240    CONTINUE
-*
-      END IF
-*
-      RETURN
-*
-*     End of DTRSYL
-*
-      END
diff --git a/src/lib/lapack/dtrti2.f b/src/lib/lapack/dtrti2.f
deleted file mode 100644
index e7ae764d..00000000
--- a/src/lib/lapack/dtrti2.f
+++ /dev/null
@@ -1,146 +0,0 @@
-      SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIAG, UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTRTI2 computes the inverse of a real upper or lower triangular
-*  matrix.
-*
-*  This is the Level 2 BLAS version of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the matrix A is upper or lower triangular.
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
-*
-*  DIAG    (input) CHARACTER*1
-*          Specifies whether or not the matrix A is unit triangular.
-*          = 'N':  Non-unit triangular
-*          = 'U':  Unit triangular
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the triangular matrix A.  If UPLO = 'U', the
-*          leading n by n upper triangular part of the array A contains
-*          the upper triangular matrix, and the strictly lower
-*          triangular part of A is not referenced.  If UPLO = 'L', the
-*          leading n by n lower triangular part of the array A contains
-*          the lower triangular matrix, and the strictly upper
-*          triangular part of A is not referenced.  If DIAG = 'U', the
-*          diagonal elements of A are also not referenced and are
-*          assumed to be 1.
-*
-*          On exit, the (triangular) inverse of the original matrix, in
-*          the same storage format.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -k, the k-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOUNIT, UPPER
-      INTEGER            J
-      DOUBLE PRECISION   AJJ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSCAL, DTRMV, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      UPPER = LSAME( UPLO, 'U' )
-      NOUNIT = LSAME( DIAG, 'N' )
-      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, '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.NE.0 ) THEN
-         CALL XERBLA( 'DTRTI2', -INFO )
-         RETURN
-      END IF
-*
-      IF( UPPER ) THEN
-*
-*        Compute inverse of upper triangular matrix.
-*
-         DO 10 J = 1, N
-            IF( NOUNIT ) THEN
-               A( J, J ) = ONE / A( J, J )
-               AJJ = -A( J, J )
-            ELSE
-               AJJ = -ONE
-            END IF
-*
-*           Compute elements 1:j-1 of j-th column.
-*
-            CALL DTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
-     $                  A( 1, J ), 1 )
-            CALL DSCAL( J-1, AJJ, A( 1, J ), 1 )
-   10    CONTINUE
-      ELSE
-*
-*        Compute inverse of lower triangular matrix.
-*
-         DO 20 J = N, 1, -1
-            IF( NOUNIT ) THEN
-               A( J, J ) = ONE / A( J, J )
-               AJJ = -A( J, J )
-            ELSE
-               AJJ = -ONE
-            END IF
-            IF( J.LT.N ) THEN
-*
-*              Compute elements j+1:n of j-th column.
-*
-               CALL DTRMV( 'Lower', 'No transpose', DIAG, N-J,
-     $                     A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
-               CALL DSCAL( N-J, AJJ, A( J+1, J ), 1 )
-            END IF
-   20    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of DTRTI2
-*
-      END
diff --git a/src/lib/lapack/dtrtri.f b/src/lib/lapack/dtrtri.f
deleted file mode 100644
index 375813c6..00000000
--- a/src/lib/lapack/dtrtri.f
+++ /dev/null
@@ -1,176 +0,0 @@
-      SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIAG, UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTRTRI computes the inverse of a real upper or lower triangular
-*  matrix A.
-*
-*  This is the Level 3 BLAS version of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  A is upper triangular;
-*          = 'L':  A is lower triangular.
-*
-*  DIAG    (input) CHARACTER*1
-*          = 'N':  A is non-unit triangular;
-*          = 'U':  A is unit triangular.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the triangular matrix A.  If UPLO = 'U', the
-*          leading N-by-N upper triangular part of the array A contains
-*          the upper triangular matrix, and the strictly lower
-*          triangular part of A is not referenced.  If UPLO = 'L', the
-*          leading N-by-N lower triangular part of the array A contains
-*          the lower triangular matrix, and the strictly upper
-*          triangular part of A is not referenced.  If DIAG = 'U', the
-*          diagonal elements of A are also not referenced and are
-*          assumed to be 1.
-*          On exit, the (triangular) inverse of the original matrix, in
-*          the same storage format.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*          > 0: if INFO = i, A(i,i) is exactly zero.  The triangular
-*               matrix is singular and its inverse can not be computed.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOUNIT, UPPER
-      INTEGER            J, JB, NB, NN
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DTRMM, DTRSM, DTRTI2, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      UPPER = LSAME( UPLO, 'U' )
-      NOUNIT = LSAME( DIAG, 'N' )
-      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, '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.NE.0 ) THEN
-         CALL XERBLA( 'DTRTRI', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Check for singularity if non-unit.
-*
-      IF( NOUNIT ) THEN
-         DO 10 INFO = 1, N
-            IF( A( INFO, INFO ).EQ.ZERO )
-     $         RETURN
-   10    CONTINUE
-         INFO = 0
-      END IF
-*
-*     Determine the block size for this environment.
-*
-      NB = ILAENV( 1, 'DTRTRI', UPLO // DIAG, N, -1, -1, -1 )
-      IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-*        Use unblocked code
-*
-         CALL DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
-      ELSE
-*
-*        Use blocked code
-*
-         IF( UPPER ) THEN
-*
-*           Compute inverse of upper triangular matrix
-*
-            DO 20 J = 1, N, NB
-               JB = MIN( NB, N-J+1 )
-*
-*              Compute rows 1:j-1 of current block column
-*
-               CALL DTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1,
-     $                     JB, ONE, A, LDA, A( 1, J ), LDA )
-               CALL DTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1,
-     $                     JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA )
-*
-*              Compute inverse of current diagonal block
-*
-               CALL DTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO )
-   20       CONTINUE
-         ELSE
-*
-*           Compute inverse of lower triangular matrix
-*
-            NN = ( ( N-1 ) / NB )*NB + 1
-            DO 30 J = NN, 1, -NB
-               JB = MIN( NB, N-J+1 )
-               IF( J+JB.LE.N ) THEN
-*
-*                 Compute rows j+jb:n of current block column
-*
-                  CALL DTRMM( 'Left', 'Lower', 'No transpose', DIAG,
-     $                        N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA,
-     $                        A( J+JB, J ), LDA )
-                  CALL DTRSM( 'Right', 'Lower', 'No transpose', DIAG,
-     $                        N-J-JB+1, JB, -ONE, A( J, J ), LDA,
-     $                        A( J+JB, J ), LDA )
-               END IF
-*
-*              Compute inverse of current diagonal block
-*
-               CALL DTRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO )
-   30       CONTINUE
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DTRTRI
-*
-      END
diff --git a/src/lib/lapack/dtrtrs.f b/src/lib/lapack/dtrtrs.f
deleted file mode 100644
index 139ea6d4..00000000
--- a/src/lib/lapack/dtrtrs.f
+++ /dev/null
@@ -1,147 +0,0 @@
-      SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIAG, TRANS, UPLO
-      INTEGER            INFO, LDA, LDB, N, NRHS
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTRTRS solves a triangular system of the form
-*
-*     A * X = B  or  A**T * X = B,
-*
-*  where A is a triangular matrix of order N, and B is an N-by-NRHS
-*  matrix.  A check is made to verify that A is nonsingular.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  A is upper triangular;
-*          = 'L':  A is lower triangular.
-*
-*  TRANS   (input) CHARACTER*1
-*          Specifies the form of the system of equations:
-*          = 'N':  A * X = B  (No transpose)
-*          = 'T':  A**T * X = B  (Transpose)
-*          = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
-*
-*  DIAG    (input) CHARACTER*1
-*          = 'N':  A is non-unit triangular;
-*          = 'U':  A is unit triangular.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of columns
-*          of the matrix B.  NRHS >= 0.
-*
-*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
-*          The triangular matrix A.  If UPLO = 'U', the leading N-by-N
-*          upper triangular part of the array A contains the upper
-*          triangular matrix, and the strictly lower triangular part of
-*          A is not referenced.  If UPLO = 'L', the leading N-by-N lower
-*          triangular part of the array A contains the lower triangular
-*          matrix, and the strictly upper triangular part of A is not
-*          referenced.  If DIAG = 'U', the diagonal elements of A are
-*          also not referenced and are assumed to be 1.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
-*          On entry, the right hand side matrix B.
-*          On exit, if INFO = 0, the solution matrix X.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*          > 0: if INFO = i, the i-th diagonal element of A is zero,
-*               indicating that the matrix is singular and the solutions
-*               X have not been computed.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOUNIT
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DTRSM, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      NOUNIT = LSAME( DIAG, 'N' )
-      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
-     $         LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( NRHS.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTRTRS', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Check for singularity.
-*
-      IF( NOUNIT ) THEN
-         DO 10 INFO = 1, N
-            IF( A( INFO, INFO ).EQ.ZERO )
-     $         RETURN
-   10    CONTINUE
-      END IF
-      INFO = 0
-*
-*     Solve A * x = b  or  A' * x = b.
-*
-      CALL DTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B,
-     $            LDB )
-*
-      RETURN
-*
-*     End of DTRTRS
-*
-      END
diff --git a/src/lib/lapack/dtzrqf.f b/src/lib/lapack/dtzrqf.f
deleted file mode 100644
index 5555df38..00000000
--- a/src/lib/lapack/dtzrqf.f
+++ /dev/null
@@ -1,164 +0,0 @@
-      SUBROUTINE DTZRQF( M, N, A, LDA, TAU, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  This routine is deprecated and has been replaced by routine DTZRZF.
-*
-*  DTZRQF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
-*  to upper triangular form by means of orthogonal transformations.
-*
-*  The upper trapezoidal matrix A is factored as
-*
-*     A = ( R  0 ) * Z,
-*
-*  where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
-*  triangular matrix.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= M.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the leading M-by-N upper trapezoidal part of the
-*          array A must contain the matrix to be factorized.
-*          On exit, the leading M-by-M upper triangular part of A
-*          contains the upper triangular matrix R, and elements M+1 to
-*          N of the first M rows of A, with the array TAU, represent the
-*          orthogonal matrix Z as a product of M elementary reflectors.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (M)
-*          The scalar factors of the elementary reflectors.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The factorization is obtained by Householder's method.  The kth
-*  transformation matrix, Z( k ), which is used to introduce zeros into
-*  the ( m - k + 1 )th row of A, is given in the form
-*
-*     Z( k ) = ( I     0   ),
-*              ( 0  T( k ) )
-*
-*  where
-*
-*     T( k ) = I - tau*u( k )*u( k )',   u( k ) = (   1    ),
-*                                                 (   0    )
-*                                                 ( z( k ) )
-*
-*  tau is a scalar and z( k ) is an ( n - m ) element vector.
-*  tau and z( k ) are chosen to annihilate the elements of the kth row
-*  of X.
-*
-*  The scalar tau is returned in the kth element of TAU and the vector
-*  u( k ) in the kth row of A, such that the elements of z( k ) are
-*  in  a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
-*  the upper triangular part of A.
-*
-*  Z is given by
-*
-*     Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, K, M1
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DCOPY, DGEMV, DGER, DLARFG, XERBLA
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.M ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTZRQF', -INFO )
-         RETURN
-      END IF
-*
-*     Perform the factorization.
-*
-      IF( M.EQ.0 )
-     $   RETURN
-      IF( M.EQ.N ) THEN
-         DO 10 I = 1, N
-            TAU( I ) = ZERO
-   10    CONTINUE
-      ELSE
-         M1 = MIN( M+1, N )
-         DO 20 K = M, 1, -1
-*
-*           Use a Householder reflection to zero the kth row of A.
-*           First set up the reflection.
-*
-            CALL DLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA, TAU( K ) )
-*
-            IF( ( TAU( K ).NE.ZERO ) .AND. ( K.GT.1 ) ) THEN
-*
-*              We now perform the operation  A := A*P( k ).
-*
-*              Use the first ( k - 1 ) elements of TAU to store  a( k ),
-*              where  a( k ) consists of the first ( k - 1 ) elements of
-*              the  kth column  of  A.  Also  let  B  denote  the  first
-*              ( k - 1 ) rows of the last ( n - m ) columns of A.
-*
-               CALL DCOPY( K-1, A( 1, K ), 1, TAU, 1 )
-*
-*              Form   w = a( k ) + B*z( k )  in TAU.
-*
-               CALL DGEMV( 'No transpose', K-1, N-M, ONE, A( 1, M1 ),
-     $                     LDA, A( K, M1 ), LDA, ONE, TAU, 1 )
-*
-*              Now form  a( k ) := a( k ) - tau*w
-*              and       B      := B      - tau*w*z( k )'.
-*
-               CALL DAXPY( K-1, -TAU( K ), TAU, 1, A( 1, K ), 1 )
-               CALL DGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ), LDA,
-     $                    A( 1, M1 ), LDA )
-            END IF
-   20    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of DTZRQF
-*
-      END
diff --git a/src/lib/lapack/dtzrzf.f b/src/lib/lapack/dtzrzf.f
deleted file mode 100644
index 378eefe1..00000000
--- a/src/lib/lapack/dtzrzf.f
+++ /dev/null
@@ -1,244 +0,0 @@
-      SUBROUTINE DTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DTZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
-*  to upper triangular form by means of orthogonal transformations.
-*
-*  The upper trapezoidal matrix A is factored as
-*
-*     A = ( R  0 ) * Z,
-*
-*  where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
-*  triangular matrix.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= M.
-*
-*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
-*          On entry, the leading M-by-N upper trapezoidal part of the
-*          array A must contain the matrix to be factorized.
-*          On exit, the leading M-by-M upper triangular part of A
-*          contains the upper triangular matrix R, and elements M+1 to
-*          N of the first M rows of A, with the array TAU, represent the
-*          orthogonal matrix Z as a product of M elementary reflectors.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) DOUBLE PRECISION array, dimension (M)
-*          The scalar factors of the elementary reflectors.
-*
-*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,M).
-*          For optimum performance LWORK >= M*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  The factorization is obtained by Householder's method.  The kth
-*  transformation matrix, Z( k ), which is used to introduce zeros into
-*  the ( m - k + 1 )th row of A, is given in the form
-*
-*     Z( k ) = ( I     0   ),
-*              ( 0  T( k ) )
-*
-*  where
-*
-*     T( k ) = I - tau*u( k )*u( k )',   u( k ) = (   1    ),
-*                                                 (   0    )
-*                                                 ( z( k ) )
-*
-*  tau is a scalar and z( k ) is an ( n - m ) element vector.
-*  tau and z( k ) are chosen to annihilate the elements of the kth row
-*  of X.
-*
-*  The scalar tau is returned in the kth element of TAU and the vector
-*  u( k ) in the kth row of A, such that the elements of z( k ) are
-*  in  a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
-*  the upper triangular part of A.
-*
-*  Z is given by
-*
-*     Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IWS, KI, KK, LDWORK, LWKOPT, M1, MU, NB,
-     $                   NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARZB, DLARZT, DLATRZ, XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.M ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( M.EQ.0 .OR. M.EQ.N ) THEN
-            LWKOPT = 1
-         ELSE
-*
-*           Determine the block size.
-*
-            NB = ILAENV( 1, 'DGERQF', ' ', M, N, -1, -1 )
-            LWKOPT = M*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
-            INFO = -7
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'DTZRZF', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 ) THEN
-         RETURN
-      ELSE IF( M.EQ.N ) THEN
-         DO 10 I = 1, N
-            TAU( I ) = ZERO
-   10    CONTINUE
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 1
-      IWS = M
-      IF( NB.GT.1 .AND. NB.LT.M ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'DGERQF', ' ', M, N, -1, -1 ) )
-         IF( NX.LT.M ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = M
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'DGERQF', ' ', M, N, -1,
-     $                 -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.M .AND. NX.LT.M ) THEN
-*
-*        Use blocked code initially.
-*        The last kk rows are handled by the block method.
-*
-         M1 = MIN( M+1, N )
-         KI = ( ( M-NX-1 ) / NB )*NB
-         KK = MIN( M, KI+NB )
-*
-         DO 20 I = M - KK + KI + 1, M - KK + 1, -NB
-            IB = MIN( M-I+1, NB )
-*
-*           Compute the TZ factorization of the current block
-*           A(i:i+ib-1,i:n)
-*
-            CALL DLATRZ( IB, N-I+1, N-M, A( I, I ), LDA, TAU( I ),
-     $                   WORK )
-            IF( I.GT.1 ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i+ib-1) . . . H(i+1) H(i)
-*
-               CALL DLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, M1 ),
-     $                      LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H to A(1:i-1,i:n) from the right
-*
-               CALL DLARZB( 'Right', 'No transpose', 'Backward',
-     $                      'Rowwise', I-1, N-I+1, IB, N-M, A( I, M1 ),
-     $                      LDA, WORK, LDWORK, A( 1, I ), LDA,
-     $                      WORK( IB+1 ), LDWORK )
-            END IF
-   20    CONTINUE
-         MU = I + NB - 1
-      ELSE
-         MU = M
-      END IF
-*
-*     Use unblocked code to factor the last or only block
-*
-      IF( MU.GT.0 )
-     $   CALL DLATRZ( MU, N, N-M, A, LDA, TAU, WORK )
-*
-      WORK( 1 ) = LWKOPT
-*
-      RETURN
-*
-*     End of DTZRZF
-*
-      END
diff --git a/src/lib/lapack/dzsum1.f b/src/lib/lapack/dzsum1.f
deleted file mode 100644
index 0b6c60e7..00000000
--- a/src/lib/lapack/dzsum1.f
+++ /dev/null
@@ -1,81 +0,0 @@
-      DOUBLE PRECISION FUNCTION DZSUM1( N, CX, INCX )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         CX( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DZSUM1 takes the sum of the absolute values of a complex
-*  vector and returns a double precision result.
-*
-*  Based on DZASUM from the Level 1 BLAS.
-*  The change is to use the 'genuine' absolute value.
-*
-*  Contributed by Nick Higham for use with ZLACON.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of elements in the vector CX.
-*
-*  CX      (input) COMPLEX*16 array, dimension (N)
-*          The vector whose elements will be summed.
-*
-*  INCX    (input) INTEGER
-*          The spacing between successive values of CX.  INCX > 0.
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, NINCX
-      DOUBLE PRECISION   STEMP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS
-*     ..
-*     .. Executable Statements ..
-*
-      DZSUM1 = 0.0D0
-      STEMP = 0.0D0
-      IF( N.LE.0 )
-     $   RETURN
-      IF( INCX.EQ.1 )
-     $   GO TO 20
-*
-*     CODE FOR INCREMENT NOT EQUAL TO 1
-*
-      NINCX = N*INCX
-      DO 10 I = 1, NINCX, INCX
-*
-*        NEXT LINE MODIFIED.
-*
-         STEMP = STEMP + ABS( CX( I ) )
-   10 CONTINUE
-      DZSUM1 = STEMP
-      RETURN
-*
-*     CODE FOR INCREMENT EQUAL TO 1
-*
-   20 CONTINUE
-      DO 30 I = 1, N
-*
-*        NEXT LINE MODIFIED.
-*
-         STEMP = STEMP + ABS( CX( I ) )
-   30 CONTINUE
-      DZSUM1 = STEMP
-      RETURN
-*
-*     End of DZSUM1
-*
-      END
diff --git a/src/lib/lapack/ieeeck.f b/src/lib/lapack/ieeeck.f
deleted file mode 100644
index ac4aff85..00000000
--- a/src/lib/lapack/ieeeck.f
+++ /dev/null
@@ -1,147 +0,0 @@
-      INTEGER          FUNCTION IEEECK( ISPEC, ZERO, ONE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            ISPEC
-      REAL               ONE, ZERO
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  IEEECK is called from the ILAENV to verify that Infinity and
-*  possibly NaN arithmetic is safe (i.e. will not trap).
-*
-*  Arguments
-*  =========
-*
-*  ISPEC   (input) INTEGER
-*          Specifies whether to test just for inifinity arithmetic
-*          or whether to test for infinity and NaN arithmetic.
-*          = 0: Verify infinity arithmetic only.
-*          = 1: Verify infinity and NaN arithmetic.
-*
-*  ZERO    (input) REAL
-*          Must contain the value 0.0
-*          This is passed to prevent the compiler from optimizing
-*          away this code.
-*
-*  ONE     (input) REAL
-*          Must contain the value 1.0
-*          This is passed to prevent the compiler from optimizing
-*          away this code.
-*
-*  RETURN VALUE:  INTEGER
-*          = 0:  Arithmetic failed to produce the correct answers
-*          = 1:  Arithmetic produced the correct answers
-*
-*     .. Local Scalars ..
-      REAL               NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
-     $                   NEGZRO, NEWZRO, POSINF
-*     ..
-*     .. Executable Statements ..
-      IEEECK = 1
-*
-      POSINF = ONE / ZERO
-      IF( POSINF.LE.ONE ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      NEGINF = -ONE / ZERO
-      IF( NEGINF.GE.ZERO ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      NEGZRO = ONE / ( NEGINF+ONE )
-      IF( NEGZRO.NE.ZERO ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      NEGINF = ONE / NEGZRO
-      IF( NEGINF.GE.ZERO ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      NEWZRO = NEGZRO + ZERO
-      IF( NEWZRO.NE.ZERO ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      POSINF = ONE / NEWZRO
-      IF( POSINF.LE.ONE ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      NEGINF = NEGINF*POSINF
-      IF( NEGINF.GE.ZERO ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      POSINF = POSINF*POSINF
-      IF( POSINF.LE.ONE ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-*
-*
-*
-*     Return if we were only asked to check infinity arithmetic
-*
-      IF( ISPEC.EQ.0 )
-     $   RETURN
-*
-      NAN1 = POSINF + NEGINF
-*
-      NAN2 = POSINF / NEGINF
-*
-      NAN3 = POSINF / POSINF
-*
-      NAN4 = POSINF*ZERO
-*
-      NAN5 = NEGINF*NEGZRO
-*
-      NAN6 = NAN5*0.0
-*
-      IF( NAN1.EQ.NAN1 ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      IF( NAN2.EQ.NAN2 ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      IF( NAN3.EQ.NAN3 ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      IF( NAN4.EQ.NAN4 ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      IF( NAN5.EQ.NAN5 ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      IF( NAN6.EQ.NAN6 ) THEN
-         IEEECK = 0
-         RETURN
-      END IF
-*
-      RETURN
-      END
diff --git a/src/lib/lapack/ilaenv.f b/src/lib/lapack/ilaenv.f
deleted file mode 100644
index c375031b..00000000
--- a/src/lib/lapack/ilaenv.f
+++ /dev/null
@@ -1,552 +0,0 @@
-      INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER*( * )    NAME, OPTS
-      INTEGER            ISPEC, N1, N2, N3, N4
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ILAENV is called from the LAPACK routines to choose problem-dependent
-*  parameters for the local environment.  See ISPEC for a description of
-*  the parameters.
-*
-*  This version provides a set of parameters which should give good,
-*  but not optimal, performance on many of the currently available
-*  computers.  Users are encouraged to modify this subroutine to set
-*  the tuning parameters for their particular machine using the option
-*  and problem size information in the arguments.
-*
-*  This routine will not function correctly if it is converted to all
-*  lower case.  Converting it to all upper case is allowed.
-*
-*  Arguments
-*  =========
-*
-*  ISPEC   (input) INTEGER
-*          Specifies the parameter to be returned as the value of
-*          ILAENV.
-*          = 1: the optimal blocksize; if this value is 1, an unblocked
-*               algorithm will give the best performance.
-*          = 2: the minimum block size for which the block routine
-*               should be used; if the usable block size is less than
-*               this value, an unblocked routine should be used.
-*          = 3: the crossover point (in a block routine, for N less
-*               than this value, an unblocked routine should be used)
-*          = 4: the number of shifts, used in the nonsymmetric
-*               eigenvalue routines (DEPRECATED)
-*          = 5: the minimum column dimension for blocking to be used;
-*               rectangular blocks must have dimension at least k by m,
-*               where k is given by ILAENV(2,...) and m by ILAENV(5,...)
-*          = 6: the crossover point for the SVD (when reducing an m by n
-*               matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
-*               this value, a QR factorization is used first to reduce
-*               the matrix to a triangular form.)
-*          = 7: the number of processors
-*          = 8: the crossover point for the multishift QR method
-*               for nonsymmetric eigenvalue problems (DEPRECATED)
-*          = 9: maximum size of the subproblems at the bottom of the
-*               computation tree in the divide-and-conquer algorithm
-*               (used by xGELSD and xGESDD)
-*          =10: ieee NaN arithmetic can be trusted not to trap
-*          =11: infinity arithmetic can be trusted not to trap
-*          12 <= ISPEC <= 16:
-*               xHSEQR or one of its subroutines,
-*               see IPARMQ for detailed explanation
-*
-*  NAME    (input) CHARACTER*(*)
-*          The name of the calling subroutine, in either upper case or
-*          lower case.
-*
-*  OPTS    (input) 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'.
-*
-*  N1      (input) INTEGER
-*  N2      (input) INTEGER
-*  N3      (input) INTEGER
-*  N4      (input) INTEGER
-*          Problem dimensions for the subroutine NAME; these may not all
-*          be required.
-*
-* (ILAENV) (output) INTEGER
-*          >= 0: the value of the parameter specified by ISPEC
-*          < 0:  if ILAENV = -k, the k-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The following conventions have been used when calling ILAENV from the
-*  LAPACK routines:
-*  1)  OPTS is a concatenation of all of the character options to
-*      subroutine NAME, in the same order that they appear in the
-*      argument list for NAME, even if they are not used in determining
-*      the value of the parameter specified by ISPEC.
-*  2)  The problem dimensions N1, N2, N3, N4 are specified in the order
-*      that they appear in the argument list for NAME.  N1 is used
-*      first, N2 second, and so on, and unused problem dimensions are
-*      passed a value of -1.
-*  3)  The parameter value returned by ILAENV is checked for validity in
-*      the calling subroutine.  For example, ILAENV is used to retrieve
-*      the optimal blocksize for STRTRI as follows:
-*
-*      NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
-*      IF( NB.LE.1 ) NB = MAX( 1, N )
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, IC, IZ, NB, NBMIN, NX
-      LOGICAL            CNAME, SNAME
-      CHARACTER          C1*1, C2*2, C4*2, C3*3, SUBNAM*6
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          CHAR, ICHAR, INT, MIN, REAL
-*     ..
-*     .. External Functions ..
-      INTEGER            IEEECK, IPARMQ
-      EXTERNAL           IEEECK, IPARMQ
-*     ..
-*     .. Executable Statements ..
-*
-      GO TO ( 10, 10, 10, 80, 90, 100, 110, 120,
-     $        130, 140, 150, 160, 160, 160, 160, 160 )ISPEC
-*
-*     Invalid value for ISPEC
-*
-      ILAENV = -1
-      RETURN
-*
-   10 CONTINUE
-*
-*     Convert NAME to upper case if the first character is lower case.
-*
-      ILAENV = 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 20 I = 2, 6
-               IC = ICHAR( SUBNAM( I: I ) )
-               IF( IC.GE.97 .AND. IC.LE.122 )
-     $            SUBNAM( I: I ) = CHAR( IC-32 )
-   20       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 30 I = 2, 6
-               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 )
-   30       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 40 I = 2, 6
-               IC = ICHAR( SUBNAM( I: I ) )
-               IF( IC.GE.225 .AND. IC.LE.250 )
-     $            SUBNAM( I: I ) = CHAR( IC-32 )
-   40       CONTINUE
-         END IF
-      END IF
-*
-      C1 = SUBNAM( 1: 1 )
-      SNAME = C1.EQ.'S' .OR. C1.EQ.'D'
-      CNAME = C1.EQ.'C' .OR. C1.EQ.'Z'
-      IF( .NOT.( CNAME .OR. SNAME ) )
-     $   RETURN
-      C2 = SUBNAM( 2: 3 )
-      C3 = SUBNAM( 4: 6 )
-      C4 = C3( 2: 3 )
-*
-      GO TO ( 50, 60, 70 )ISPEC
-*
-   50 CONTINUE
-*
-*     ISPEC = 1:  block size
-*
-*     In these examples, separate code is provided for setting NB for
-*     real and complex.  We assume that NB will take the same value in
-*     single or double precision.
-*
-      NB = 1
-*
-      IF( C2.EQ.'GE' ) THEN
-         IF( C3.EQ.'TRF' ) THEN
-            IF( SNAME ) THEN
-               NB = 64
-            ELSE
-               NB = 64
-            END IF
-         ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
-     $            C3.EQ.'QLF' ) THEN
-            IF( SNAME ) THEN
-               NB = 32
-            ELSE
-               NB = 32
-            END IF
-         ELSE IF( C3.EQ.'HRD' ) THEN
-            IF( SNAME ) THEN
-               NB = 32
-            ELSE
-               NB = 32
-            END IF
-         ELSE IF( C3.EQ.'BRD' ) THEN
-            IF( SNAME ) THEN
-               NB = 32
-            ELSE
-               NB = 32
-            END IF
-         ELSE IF( C3.EQ.'TRI' ) THEN
-            IF( SNAME ) THEN
-               NB = 64
-            ELSE
-               NB = 64
-            END IF
-         END IF
-      ELSE IF( C2.EQ.'PO' ) THEN
-         IF( C3.EQ.'TRF' ) THEN
-            IF( SNAME ) THEN
-               NB = 64
-            ELSE
-               NB = 64
-            END IF
-         END IF
-      ELSE IF( C2.EQ.'SY' ) THEN
-         IF( C3.EQ.'TRF' ) THEN
-            IF( SNAME ) THEN
-               NB = 64
-            ELSE
-               NB = 64
-            END IF
-         ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
-            NB = 32
-         ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN
-            NB = 64
-         END IF
-      ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
-         IF( C3.EQ.'TRF' ) THEN
-            NB = 64
-         ELSE IF( C3.EQ.'TRD' ) THEN
-            NB = 32
-         ELSE IF( C3.EQ.'GST' ) THEN
-            NB = 64
-         END IF
-      ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
-         IF( C3( 1: 1 ).EQ.'G' ) THEN
-            IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
-     $          'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
-     $           THEN
-               NB = 32
-            END IF
-         ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
-            IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
-     $          'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
-     $           THEN
-               NB = 32
-            END IF
-         END IF
-      ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
-         IF( C3( 1: 1 ).EQ.'G' ) THEN
-            IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
-     $          'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
-     $           THEN
-               NB = 32
-            END IF
-         ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
-            IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
-     $          'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
-     $           THEN
-               NB = 32
-            END IF
-         END IF
-      ELSE IF( C2.EQ.'GB' ) THEN
-         IF( C3.EQ.'TRF' ) THEN
-            IF( SNAME ) THEN
-               IF( N4.LE.64 ) THEN
-                  NB = 1
-               ELSE
-                  NB = 32
-               END IF
-            ELSE
-               IF( N4.LE.64 ) THEN
-                  NB = 1
-               ELSE
-                  NB = 32
-               END IF
-            END IF
-         END IF
-      ELSE IF( C2.EQ.'PB' ) THEN
-         IF( C3.EQ.'TRF' ) THEN
-            IF( SNAME ) THEN
-               IF( N2.LE.64 ) THEN
-                  NB = 1
-               ELSE
-                  NB = 32
-               END IF
-            ELSE
-               IF( N2.LE.64 ) THEN
-                  NB = 1
-               ELSE
-                  NB = 32
-               END IF
-            END IF
-         END IF
-      ELSE IF( C2.EQ.'TR' ) THEN
-         IF( C3.EQ.'TRI' ) THEN
-            IF( SNAME ) THEN
-               NB = 64
-            ELSE
-               NB = 64
-            END IF
-         END IF
-      ELSE IF( C2.EQ.'LA' ) THEN
-         IF( C3.EQ.'UUM' ) THEN
-            IF( SNAME ) THEN
-               NB = 64
-            ELSE
-               NB = 64
-            END IF
-         END IF
-      ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN
-         IF( C3.EQ.'EBZ' ) THEN
-            NB = 1
-         END IF
-      END IF
-      ILAENV = NB
-      RETURN
-*
-   60 CONTINUE
-*
-*     ISPEC = 2:  minimum block size
-*
-      NBMIN = 2
-      IF( C2.EQ.'GE' ) THEN
-         IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. C3.EQ.
-     $       'QLF' ) THEN
-            IF( SNAME ) THEN
-               NBMIN = 2
-            ELSE
-               NBMIN = 2
-            END IF
-         ELSE IF( C3.EQ.'HRD' ) THEN
-            IF( SNAME ) THEN
-               NBMIN = 2
-            ELSE
-               NBMIN = 2
-            END IF
-         ELSE IF( C3.EQ.'BRD' ) THEN
-            IF( SNAME ) THEN
-               NBMIN = 2
-            ELSE
-               NBMIN = 2
-            END IF
-         ELSE IF( C3.EQ.'TRI' ) THEN
-            IF( SNAME ) THEN
-               NBMIN = 2
-            ELSE
-               NBMIN = 2
-            END IF
-         END IF
-      ELSE IF( C2.EQ.'SY' ) THEN
-         IF( C3.EQ.'TRF' ) THEN
-            IF( SNAME ) THEN
-               NBMIN = 8
-            ELSE
-               NBMIN = 8
-            END IF
-         ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
-            NBMIN = 2
-         END IF
-      ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
-         IF( C3.EQ.'TRD' ) THEN
-            NBMIN = 2
-         END IF
-      ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
-         IF( C3( 1: 1 ).EQ.'G' ) THEN
-            IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
-     $          'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
-     $           THEN
-               NBMIN = 2
-            END IF
-         ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
-            IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
-     $          'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
-     $           THEN
-               NBMIN = 2
-            END IF
-         END IF
-      ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
-         IF( C3( 1: 1 ).EQ.'G' ) THEN
-            IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
-     $          'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
-     $           THEN
-               NBMIN = 2
-            END IF
-         ELSE IF( C3( 1: 1 ).EQ.'M' ) THEN
-            IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
-     $          'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
-     $           THEN
-               NBMIN = 2
-            END IF
-         END IF
-      END IF
-      ILAENV = NBMIN
-      RETURN
-*
-   70 CONTINUE
-*
-*     ISPEC = 3:  crossover point
-*
-      NX = 0
-      IF( C2.EQ.'GE' ) THEN
-         IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. C3.EQ.
-     $       'QLF' ) THEN
-            IF( SNAME ) THEN
-               NX = 128
-            ELSE
-               NX = 128
-            END IF
-         ELSE IF( C3.EQ.'HRD' ) THEN
-            IF( SNAME ) THEN
-               NX = 128
-            ELSE
-               NX = 128
-            END IF
-         ELSE IF( C3.EQ.'BRD' ) THEN
-            IF( SNAME ) THEN
-               NX = 128
-            ELSE
-               NX = 128
-            END IF
-         END IF
-      ELSE IF( C2.EQ.'SY' ) THEN
-         IF( SNAME .AND. C3.EQ.'TRD' ) THEN
-            NX = 32
-         END IF
-      ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
-         IF( C3.EQ.'TRD' ) THEN
-            NX = 32
-         END IF
-      ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
-         IF( C3( 1: 1 ).EQ.'G' ) THEN
-            IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
-     $          'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
-     $           THEN
-               NX = 128
-            END IF
-         END IF
-      ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
-         IF( C3( 1: 1 ).EQ.'G' ) THEN
-            IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. C4.EQ.
-     $          'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. C4.EQ.'BR' )
-     $           THEN
-               NX = 128
-            END IF
-         END IF
-      END IF
-      ILAENV = NX
-      RETURN
-*
-   80 CONTINUE
-*
-*     ISPEC = 4:  number of shifts (used by xHSEQR)
-*
-      ILAENV = 6
-      RETURN
-*
-   90 CONTINUE
-*
-*     ISPEC = 5:  minimum column dimension (not used)
-*
-      ILAENV = 2
-      RETURN
-*
-  100 CONTINUE
-*
-*     ISPEC = 6:  crossover point for SVD (used by xGELSS and xGESVD)
-*
-      ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
-      RETURN
-*
-  110 CONTINUE
-*
-*     ISPEC = 7:  number of processors (not used)
-*
-      ILAENV = 1
-      RETURN
-*
-  120 CONTINUE
-*
-*     ISPEC = 8:  crossover point for multishift (used by xHSEQR)
-*
-      ILAENV = 50
-      RETURN
-*
-  130 CONTINUE
-*
-*     ISPEC = 9:  maximum size of the subproblems at the bottom of the
-*                 computation tree in the divide-and-conquer algorithm
-*                 (used by xGELSD and xGESDD)
-*
-      ILAENV = 25
-      RETURN
-*
-  140 CONTINUE
-*
-*     ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
-*
-*     ILAENV = 0
-      ILAENV = 1
-      IF( ILAENV.EQ.1 ) THEN
-         ILAENV = IEEECK( 0, 0.0, 1.0 )
-      END IF
-      RETURN
-*
-  150 CONTINUE
-*
-*     ISPEC = 11: infinity arithmetic can be trusted not to trap
-*
-*     ILAENV = 0
-      ILAENV = 1
-      IF( ILAENV.EQ.1 ) THEN
-         ILAENV = IEEECK( 1, 0.0, 1.0 )
-      END IF
-      RETURN
-*
-  160 CONTINUE
-*
-*     12 <= ISPEC <= 16: xHSEQR or one of its subroutines. 
-*
-      ILAENV = IPARMQ( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
-      RETURN
-*
-*     End of ILAENV
-*
-      END
diff --git a/src/lib/lapack/iparmq.f b/src/lib/lapack/iparmq.f
deleted file mode 100644
index d9d0af36..00000000
--- a/src/lib/lapack/iparmq.f
+++ /dev/null
@@ -1,253 +0,0 @@
-      INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*     
-*     .. Scalar Arguments ..
-      INTEGER            IHI, ILO, ISPEC, LWORK, N
-      CHARACTER          NAME*( * ), OPTS*( * )
-*
-*  Purpose
-*  =======
-*
-*       This program sets problem and machine dependent parameters
-*       useful for xHSEQR and its subroutines. It is called whenever 
-*       ILAENV is called with 12 <= ISPEC <= 16
-*
-*  Arguments
-*  =========
-*
-*       ISPEC  (input) integer scalar
-*              ISPEC specifies which tunable parameter IPARMQ should
-*              return.
-*
-*              ISPEC=12: (INMIN)  Matrices of order nmin or less
-*                        are sent directly to xLAHQR, the implicit
-*                        double shift QR algorithm.  NMIN must be
-*                        at least 11.
-*
-*              ISPEC=13: (INWIN)  Size of the deflation window.
-*                        This is best set greater than or equal to
-*                        the number of simultaneous shifts NS.
-*                        Larger matrices benefit from larger deflation
-*                        windows.
-*
-*              ISPEC=14: (INIBL) Determines when to stop nibbling and
-*                        invest in an (expensive) multi-shift QR sweep.
-*                        If the aggressive early deflation subroutine
-*                        finds LD converged eigenvalues from an order
-*                        NW deflation window and LD.GT.(NW*NIBBLE)/100,
-*                        then the next QR sweep is skipped and early
-*                        deflation is applied immediately to the
-*                        remaining active diagonal block.  Setting
-*                        IPARMQ(ISPEC=14) = 0 causes TTQRE to skip a
-*                        multi-shift QR sweep whenever early deflation
-*                        finds a converged eigenvalue.  Setting
-*                        IPARMQ(ISPEC=14) greater than or equal to 100
-*                        prevents TTQRE from skipping a multi-shift
-*                        QR sweep.
-*
-*              ISPEC=15: (NSHFTS) The number of simultaneous shifts in
-*                        a multi-shift QR iteration.
-*
-*              ISPEC=16: (IACC22) IPARMQ is set to 0, 1 or 2 with the
-*                        following meanings.
-*                        0:  During the multi-shift QR sweep,
-*                            xLAQR5 does not accumulate reflections and
-*                            does not use matrix-matrix multiply to
-*                            update the far-from-diagonal matrix
-*                            entries.
-*                        1:  During the multi-shift QR sweep,
-*                            xLAQR5 and/or xLAQRaccumulates reflections and uses
-*                            matrix-matrix multiply to update the
-*                            far-from-diagonal matrix entries.
-*                        2:  During the multi-shift QR sweep.
-*                            xLAQR5 accumulates reflections and takes
-*                            advantage of 2-by-2 block structure during
-*                            matrix-matrix multiplies.
-*                        (If xTRMM is slower than xGEMM, then
-*                        IPARMQ(ISPEC=16)=1 may be more efficient than
-*                        IPARMQ(ISPEC=16)=2 despite the greater level of
-*                        arithmetic work implied by the latter choice.)
-*
-*       NAME    (input) character string
-*               Name of the calling subroutine
-*
-*       OPTS    (input) character string
-*               This is a concatenation of the string arguments to
-*               TTQRE.
-*
-*       N       (input) integer scalar
-*               N is the order of the Hessenberg matrix H.
-*
-*       ILO     (input) INTEGER
-*       IHI     (input) INTEGER
-*               It is assumed that H is already upper triangular
-*               in rows and columns 1:ILO-1 and IHI+1:N.
-*
-*       LWORK   (input) integer scalar
-*               The amount of workspace available.
-*
-*  Further Details
-*  ===============
-*
-*       Little is known about how best to choose these parameters.
-*       It is possible to use different values of the parameters
-*       for each of CHSEQR, DHSEQR, SHSEQR and ZHSEQR.
-*
-*       It is probably best to choose different parameters for
-*       different matrices and different parameters at different
-*       times during the iteration, but this has not been
-*       implemented --- yet.
-*
-*
-*       The best choices of most of the parameters depend
-*       in an ill-understood way on the relative execution
-*       rate of xLAQR3 and xLAQR5 and on the nature of each
-*       particular eigenvalue problem.  Experiment may be the
-*       only practical way to determine which choices are most
-*       effective.
-*
-*       Following is a list of default values supplied by IPARMQ.
-*       These defaults may be adjusted in order to attain better
-*       performance in any particular computational environment.
-*
-*       IPARMQ(ISPEC=12) The xLAHQR vs xLAQR0 crossover point.
-*                        Default: 75. (Must be at least 11.)
-*
-*       IPARMQ(ISPEC=13) Recommended deflation window size.
-*                        This depends on ILO, IHI and NS, the
-*                        number of simultaneous shifts returned
-*                        by IPARMQ(ISPEC=15).  The default for
-*                        (IHI-ILO+1).LE.500 is NS.  The default
-*                        for (IHI-ILO+1).GT.500 is 3*NS/2.
-*
-*       IPARMQ(ISPEC=14) Nibble crossover point.  Default: 14.
-*
-*       IPARMQ(ISPEC=15) Number of simultaneous shifts, NS.
-*                        a multi-shift QR iteration.
-*
-*                        If IHI-ILO+1 is ...
-*
-*                        greater than      ...but less    ... the
-*                        or equal to ...      than        default is
-*
-*                                0               30       NS =   2+
-*                               30               60       NS =   4+
-*                               60              150       NS =  10
-*                              150              590       NS =  **
-*                              590             3000       NS =  64
-*                             3000             6000       NS = 128
-*                             6000             infinity   NS = 256
-*
-*                    (+)  By default matrices of this order are
-*                         passed to the implicit double shift routine
-*                         xLAHQR.  See IPARMQ(ISPEC=12) above.   These
-*                         values of NS are used only in case of a rare
-*                         xLAHQR failure.
-*
-*                    (**) The asterisks (**) indicate an ad-hoc
-*                         function increasing from 10 to 64.
-*
-*       IPARMQ(ISPEC=16) Select structured matrix multiply.
-*                        (See ISPEC=16 above for details.)
-*                        Default: 3.
-*
-*     ================================================================
-*     .. Parameters ..
-      INTEGER            INMIN, INWIN, INIBL, ISHFTS, IACC22
-      PARAMETER          ( INMIN = 12, INWIN = 13, INIBL = 14,
-     $                   ISHFTS = 15, IACC22 = 16 )
-      INTEGER            NMIN, K22MIN, KACMIN, NIBBLE, KNWSWP
-      PARAMETER          ( NMIN = 75, K22MIN = 14, KACMIN = 14,
-     $                   NIBBLE = 14, KNWSWP = 500 )
-      REAL               TWO
-      PARAMETER          ( TWO = 2.0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            NH, NS
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          LOG, MAX, MOD, NINT, REAL
-*     ..
-*     .. Executable Statements ..
-      IF( ( ISPEC.EQ.ISHFTS ) .OR. ( ISPEC.EQ.INWIN ) .OR.
-     $    ( ISPEC.EQ.IACC22 ) ) THEN
-*
-*        ==== Set the number simultaneous shifts ====
-*
-         NH = IHI - ILO + 1
-         NS = 2
-         IF( NH.GE.30 )
-     $      NS = 4
-         IF( NH.GE.60 )
-     $      NS = 10
-         IF( NH.GE.150 )
-     $      NS = MAX( 10, NH / NINT( LOG( REAL( NH ) ) / LOG( TWO ) ) )
-         IF( NH.GE.590 )
-     $      NS = 64
-         IF( NH.GE.3000 )
-     $      NS = 128
-         IF( NH.GE.6000 )
-     $      NS = 256
-         NS = MAX( 2, NS-MOD( NS, 2 ) )
-      END IF
-*
-      IF( ISPEC.EQ.INMIN ) THEN
-*
-*
-*        ===== Matrices of order smaller than NMIN get sent
-*        .     to xLAHQR, the classic double shift algorithm.
-*        .     This must be at least 11. ====
-*
-         IPARMQ = NMIN
-*
-      ELSE IF( ISPEC.EQ.INIBL ) THEN
-*
-*        ==== INIBL: skip a multi-shift qr iteration and
-*        .    whenever aggressive early deflation finds
-*        .    at least (NIBBLE*(window size)/100) deflations. ====
-*
-         IPARMQ = NIBBLE
-*
-      ELSE IF( ISPEC.EQ.ISHFTS ) THEN
-*
-*        ==== NSHFTS: The number of simultaneous shifts =====
-*
-         IPARMQ = NS
-*
-      ELSE IF( ISPEC.EQ.INWIN ) THEN
-*
-*        ==== NW: deflation window size.  ====
-*
-         IF( NH.LE.KNWSWP ) THEN
-            IPARMQ = NS
-         ELSE
-            IPARMQ = 3*NS / 2
-         END IF
-*
-      ELSE IF( ISPEC.EQ.IACC22 ) THEN
-*
-*        ==== IACC22: Whether to accumulate reflections
-*        .     before updating the far-from-diagonal elements
-*        .     and whether to use 2-by-2 block structure while
-*        .     doing it.  A small amount of work could be saved
-*        .     by making this choice dependent also upon the
-*        .     NH=IHI-ILO+1.
-*
-         IPARMQ = 0
-         IF( NS.GE.KACMIN )
-     $      IPARMQ = 1
-         IF( NS.GE.K22MIN )
-     $      IPARMQ = 2
-*
-      ELSE
-*        ===== invalid value of ispec =====
-         IPARMQ = -1
-*
-      END IF
-*
-*     ==== End of IPARMQ ====
-*
-      END
diff --git a/src/lib/lapack/izmax1.f b/src/lib/lapack/izmax1.f
deleted file mode 100644
index 7ebffee3..00000000
--- a/src/lib/lapack/izmax1.f
+++ /dev/null
@@ -1,95 +0,0 @@
-      INTEGER          FUNCTION IZMAX1( N, CX, INCX )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         CX( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  IZMAX1 finds the index of the element whose real part has maximum
-*  absolute value.
-*
-*  Based on IZAMAX from Level 1 BLAS.
-*  The change is to use the 'genuine' absolute value.
-*
-*  Contributed by Nick Higham for use with ZLACON.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of elements in the vector CX.
-*
-*  CX      (input) COMPLEX*16 array, dimension (N)
-*          The vector whose elements will be summed.
-*
-*  INCX    (input) INTEGER
-*          The spacing between successive values of CX.  INCX >= 1.
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, IX
-      DOUBLE PRECISION   SMAX
-      COMPLEX*16         ZDUM
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-*
-*     NEXT LINE IS THE ONLY MODIFICATION.
-      CABS1( ZDUM ) = ABS( ZDUM )
-*     ..
-*     .. Executable Statements ..
-*
-      IZMAX1 = 0
-      IF( N.LT.1 )
-     $   RETURN
-      IZMAX1 = 1
-      IF( N.EQ.1 )
-     $   RETURN
-      IF( INCX.EQ.1 )
-     $   GO TO 30
-*
-*     CODE FOR INCREMENT NOT EQUAL TO 1
-*
-      IX = 1
-      SMAX = CABS1( CX( 1 ) )
-      IX = IX + INCX
-      DO 20 I = 2, N
-         IF( CABS1( CX( IX ) ).LE.SMAX )
-     $      GO TO 10
-         IZMAX1 = I
-         SMAX = CABS1( CX( IX ) )
-   10    CONTINUE
-         IX = IX + INCX
-   20 CONTINUE
-      RETURN
-*
-*     CODE FOR INCREMENT EQUAL TO 1
-*
-   30 CONTINUE
-      SMAX = CABS1( CX( 1 ) )
-      DO 40 I = 2, N
-         IF( CABS1( CX( I ) ).LE.SMAX )
-     $      GO TO 40
-         IZMAX1 = I
-         SMAX = CABS1( CX( I ) )
-   40 CONTINUE
-      RETURN
-*
-*     End of IZMAX1
-*
-      END
diff --git a/src/lib/lapack/lapack_f/lapack.def b/src/lib/lapack/lapack_f/lapack.def
deleted file mode 100644
index a6ce5165..00000000
--- a/src/lib/lapack/lapack_f/lapack.def
+++ /dev/null
@@ -1,306 +0,0 @@
-LIBRARY    lapack.dll

-

-

-EXPORTS

- dbdsqr_

- dgebak_

- dgebal_

- dgebd2_

- dgebrd_

- dgecon_

- dgeequ_

- dgees_ 

- dgeesx_

- dgeev_ 

- dgegs_ 

- dgehd2_

- dgehrd_

- dgelq2_

- dgelqf_

- dgels_ 

- dgelss_

- dgelsx_

- dgelsy_

- dgeql2_

- dgeqlf_

- dgeqp3_

- dgeqpf_

- dgeqr2_

- dgeqrf_

- dgerfs_

- dgerq2_

- dgerqf_

- dgesc2_

- dgesv_ 

- dgesvd_

- dgesvx_

- dgetc2_

- dgetf2_

- dgetrf_

- dgetri_

- dgetrs_

- dggbak_

- dggbal_

- dgges_ 

- dggev_ 

- dgghrd_

- dhgeqz_

- dhseqr_

- disnan_

- dlabad_

- dlabrd_

- dlacn2_

- dlacon_

- dlacpy_

- dladiv_

- dlae2_

- dlaev2_

- dlaexc_

- dlag2_ 

- dlagv2_

- dlahqr_

- dlahr2_

- dlahrd_

- dlaic1_

- dlaisnan_

- dlaln2_

- dlamch_

- dlamc2_

- dlamc1_

- dlamc3_

- dlamc4_

- dlamc5_

- dlange_

- dlanhs_

- dlansp_

- dlanst_

- dlansy_

- dlantr_

- dlanv2_

- dlapmt_

- dlapy2_

- dlapy3_

- dlaqge_

- dlaqp2_

- dlaqps_

- dlaqr0_

- dlaqr1_

- dlaqr2_

- dlaqr3_

- dlaqr4_

- dlaqr5_

- dlarf_ 

- dlarfb_

- dlarfg_

- dlarft_

- dlarfx_

- dlartg_

- dlarz_ 

- dlarzb_

- dlarzt_

- dlas2_ 

- dlascl_

- dlaset_

- dlasq1_

- dlasq2_

- dlasq3_

- dlasq4_

- dlasq5_

- dlasq6_

- dlasr_ 

- dlasrt_

- dlassq_

- dlasv2_

- dlaswp_

- dlasy2_

- dlasyf_

- dlatdf_

- dlatrd_

- dlatrs_

- dlatrz_

- dlatzm_

- dlazq3_

- dlazq4_

- dopgtr_

- dorg2l_

- dorg2r_

- dorgbr_

- dorghr_

- dorgl2_

- dorglq_

- dorgql_

- dorgqr_

- dorgr2_

- dorgrq_

- dorgtr_

- dorm2l_

- dorm2r_

- dormbr_

- dormhr_

- dorml2_

- dormlq_

- dormql_

- dormqr_

- dormr2_

- dormr3_

- dormrq_

- dormrz_

- dpocon_

- dpotf2_

- dpotrf_

- dpotrs_

- dpptrf_

- drscl_ 

- dspev_ 

- dspgst_

- dspgv_ 

- dsptrd_

- dsptrf_

- dsteqr_

- dsterf_

- dsycon_

- dsyev_ 

- dsysv_ 

- dsytd2_

- dsytf2_

- dsytrd_

- dsytrf_

- dsytri_

- dsytrs_

- dtgevc_

- dtgex2_

- dtgexc_

- dtgsen_

- dtgsy2_

- dtgsyl_

- dtrcon_

- dtrevc_

- dtrexc_

- dtrsen_

- dtrsyl_

- dtrti2_

- dtrtri_

- dtrtrs_

- dtzrqf_

- dtzrzf_

- dzsum1_

- ieeeck_

- ilaenv_

- iparmq_

- izmax1_

- lsame_ 

- slamch_

- slamc2_

- slamc1_

- slamc3_

- slamc4_

- slamc5_

- zbdsqr_

- zdrot_ 

- zdrscl_

- zgebak_

- zgebal_

- zgebd2_

- zgebrd_

- zgecon_

- zgees_ 

- zgeev_ 

- zgehd2_

- zgehrd_

- zgelq2_

- zgelqf_

- zgelsy_

- zgeqp3_

- zgeqpf_

- zgeqr2_

- zgeqrf_

- zgesc2_

- zgesvd_

- zgetc2_

- zgetf2_

- zgetrf_

- zgetri_

- zgetrs_

- zggbak_

- zggbal_

- zgges_

- zggev_ 

- zgghrd_

- zheev_ 

- zhetd2_

- zhetrd_

- zhgeqz_

- zhseqr_

- zlabrd_

- zlacgv_

- zlacn2_

- zlacon_

- zlacpy_

- zladiv_

- zlahqr_

- zlahr2_

- zlahrd_

- zlaic1_

- zlange_

- zlanhe_

- zlanhs_

- zlaqp2_

- zlaqps_

- zlaqr0_

- zlaqr1_

- zlaqr2_

- zlaqr3_

- zlaqr4_

- zlaqr5_

- zlarf_ 

- zlarfb_

- zlarfg_

- zlarft_

- zlarfx_

- zlartg_

- zlarz_

- zlarzb_

- zlarzt_

- zlascl_

- zlaset_

- zlasr_

- zlassq_

- zlaswp_

- zlatdf_

- zlatrd_

- zlatrs_

- zlatrz_

- zpotf2_

- zpotrf_

- zrot_  

- zsteqr_

- ztgevc_

- ztgex2_

- ztgexc_

- ztgsen_

- ztgsy2_

- ztgsyl_

- ztrevc_

- ztrexc_

- ztrsen_

- ztrsyl_

- ztrti2_

- ztrtri_

- ztzrzf_

- zung2l_

- zung2r_

- zungbr_

- zunghr_

- zungl2_

- zunglq_

- zungql_

- zungqr_

- zungtr_

- zunm2r_

- zunmbr_

- zunml2_

- zunmlq_

- zunmqr_

- zunmr3_

- zunmrz_

- 
\ No newline at end of file
diff --git a/src/lib/lapack/lapack_f/lapack_DLL.vfproj b/src/lib/lapack/lapack_f/lapack_DLL.vfproj
deleted file mode 100644
index 027b6234..00000000
--- a/src/lib/lapack/lapack_f/lapack_DLL.vfproj
+++ /dev/null
@@ -1,348 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>

-<VisualStudioProject ProjectType="typeDynamicLibrary" ProjectCreator="Intel Fortran" Keyword="Dll" Version="9.10" ProjectIdGuid="{69296D00-0DE1-4F4B-B0CE-FE4F3CB43923}">

-	<Platforms>

-		<Platform Name="Win32"/>

-		<Platform Name="x64"/></Platforms>

-	<Configurations>

-		<Configuration Name="Debug|Win32" OutputDirectory="$(InputDir)$(ConfigurationName)" DeleteExtensionsOnClean="*.obj;*.mod;*.pdb;*.asm;*.map;*.dyn;*.dpi;*.tmp;*.log;*.ilk;*.dll;$(TargetPath)" ConfigurationType="typeDynamicLibrary">

-				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" Optimization="optimizeDisabled" OptimizeForProcessor="procOptimizeBlended" F77RuntimeCompatibility="true" CallingConvention="callConventionCRef" ExternalNameUnderscore="true" ModulePath="$(INTDIR)/" ObjectFile="$(INTDIR)/" Traceback="true" RuntimeLibrary="rtMultiThreadedDebug"/>

-				<Tool Name="VFLinkerTool" OutputFile="$(SolutionDir)bin/lapack.dll" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" IgnoreDefaultLibraryNames="msvcrtd.lib" ModuleDefinitionFile="lapack.def" GenerateDebugInformation="true" SubSystem="subSystemWindows" ImportLibrary="$(SolutionDir)bin/lapack.lib" LinkDLL="true" AdditionalDependencies="libcmtd.lib "/>

-				<Tool Name="VFResourceCompilerTool"/>

-				<Tool Name="VFMidlTool" SuppressStartupBanner="true" HeaderFileName="$(InputName).h" TypeLibraryName="$(IntDir)/$(InputName).tlb"/>

-				<Tool Name="VFCustomBuildTool"/>

-				<Tool Name="VFPreLinkEventTool"/>

-				<Tool Name="VFPreBuildEventTool"/>

-				<Tool Name="VFPostBuildEventTool"/></Configuration>

-		<Configuration Name="Release|Win32" OutputDirectory="$(InputDir)$(ConfigurationName)" DeleteExtensionsOnClean="*.obj;*.mod;*.pdb;*.asm;*.map;*.dyn;*.dpi;*.tmp;*.log;*.ilk;*.dll;$(TargetPath)" ConfigurationType="typeDynamicLibrary">

-				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" OptimizeForProcessor="procOptimizePentiumProThruIII" UseProcessorExtensions="codeForStreamingSIMD" RequireProcessorExtensions="codeExclusivelyStreamingSIMD" F77RuntimeCompatibility="true" CallingConvention="callConventionCRef" ExternalNameUnderscore="true" ModulePath="$(INTDIR)/" ObjectFile="$(INTDIR)/"/>

-				<Tool Name="VFLinkerTool" OutputFile="$(SolutionDir)bin/lapack.dll" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" IgnoreDefaultLibraryNames="msvcrt.lib" ModuleDefinitionFile="lapack.def" SubSystem="subSystemWindows" SupportUnloadOfDelayLoadedDLL="true" ImportLibrary="$(SolutionDir)bin/lapack.lib" LinkDLL="true" AdditionalDependencies="libcmt.lib"/>

-				<Tool Name="VFResourceCompilerTool"/>

-				<Tool Name="VFMidlTool" SuppressStartupBanner="true" HeaderFileName="$(InputName).h" TypeLibraryName="$(IntDir)/$(InputName).tlb"/>

-				<Tool Name="VFCustomBuildTool"/>

-				<Tool Name="VFPreLinkEventTool"/>

-				<Tool Name="VFPreBuildEventTool"/>

-				<Tool Name="VFPostBuildEventTool"/></Configuration>

-		<Configuration Name="Debug|x64" OutputDirectory="$(InputDir)$(ConfigurationName)" IntermediateDirectory="$(ConfigurationName)" DeleteExtensionsOnClean="*.obj;*.mod;*.pdb;*.asm;*.map;*.dyn;*.dpi;*.tmp;*.log;*.ilk;*.dll;$(TargetPath)" ConfigurationType="typeDynamicLibrary">

-				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" Optimization="optimizeDisabled" F77RuntimeCompatibility="true" CallingConvention="callConventionCRef" ExternalNameUnderscore="true" ModulePath="$(INTDIR)/" ObjectFile="$(INTDIR)/" Traceback="true" RuntimeLibrary="rtMultiThreadedDebugDLL"/>

-				<Tool Name="VFLinkerTool" OutputFile="../../lapack.dll" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" IgnoreDefaultLibraryNames="msvcrtd.lib" ModuleDefinitionFile="lapack.def" GenerateDebugInformation="true" SubSystem="subSystemWindows" ImportLibrary="../../lapack.lib" LinkDLL="true" AdditionalDependencies="libcmtd.lib ../../blas.lib"/>

-				<Tool Name="VFResourceCompilerTool"/>

-				<Tool Name="VFMidlTool" SuppressStartupBanner="true" HeaderFileName="$(InputName).h" TypeLibraryName="$(IntDir)/$(InputName).tlb"/>

-				<Tool Name="VFCustomBuildTool"/>

-				<Tool Name="VFPreLinkEventTool"/>

-				<Tool Name="VFPreBuildEventTool"/>

-				<Tool Name="VFPostBuildEventTool"/></Configuration>

-		<Configuration Name="Release|x64" OutputDirectory="$(InputDir)$(ConfigurationName)" IntermediateDirectory="$(ConfigurationName)" DeleteExtensionsOnClean="*.obj;*.mod;*.pdb;*.asm;*.map;*.dyn;*.dpi;*.tmp;*.log;*.ilk;*.dll;$(TargetPath)" ConfigurationType="typeDynamicLibrary">

-				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" F77RuntimeCompatibility="true" CallingConvention="callConventionCRef" ExternalNameUnderscore="true" ModulePath="$(INTDIR)/" ObjectFile="$(INTDIR)/"/>

-				<Tool Name="VFLinkerTool" OutputFile="../../lapack.dll" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" IgnoreDefaultLibraryNames="msvcrt.lib" ModuleDefinitionFile="lapack.def" SubSystem="subSystemWindows" SupportUnloadOfDelayLoadedDLL="true" ImportLibrary="../../lapack.lib" LinkDLL="true" AdditionalDependencies="libcmt.lib"/>

-				<Tool Name="VFResourceCompilerTool"/>

-				<Tool Name="VFMidlTool" SuppressStartupBanner="true" HeaderFileName="$(InputName).h" TypeLibraryName="$(IntDir)/$(InputName).tlb"/>

-				<Tool Name="VFCustomBuildTool"/>

-				<Tool Name="VFPreLinkEventTool"/>

-				<Tool Name="VFPreBuildEventTool"/>

-				<Tool Name="VFPostBuildEventTool"/></Configuration></Configurations>

-	<Files>

-		<Filter Name="Header Files" Filter="fi;fd"/>

-		<Filter Name="Resource Files" Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"/>

-		<Filter Name="Source Files" Filter="f90;for;f;fpp;ftn;def;odl;idl">

-		<File RelativePath="..\dbdsqr.f"/>

-		<File RelativePath="..\dgebak.f"/>

-		<File RelativePath="..\dgebal.f"/>

-		<File RelativePath="..\dgebd2.f"/>

-		<File RelativePath="..\dgebrd.f"/>

-		<File RelativePath="..\dgecon.f"/>

-		<File RelativePath="..\dgeequ.f"/>

-		<File RelativePath="..\dgees.f"/>

-		<File RelativePath="..\dgeesx.f"/>

-		<File RelativePath="..\dgeev.f"/>

-		<File RelativePath="..\dgegs.f"/>

-		<File RelativePath="..\dgehd2.f"/>

-		<File RelativePath="..\dgehrd.f"/>

-		<File RelativePath="..\dgelq2.f"/>

-		<File RelativePath="..\dgelqf.f"/>

-		<File RelativePath="..\dgels.f"/>

-		<File RelativePath="..\dgelss.f"/>

-		<File RelativePath="..\dgelsx.f"/>

-		<File RelativePath="..\dgelsy.f"/>

-		<File RelativePath="..\dgeql2.f"/>

-		<File RelativePath="..\dgeqlf.f"/>

-		<File RelativePath="..\dgeqp3.f"/>

-		<File RelativePath="..\dgeqpf.f"/>

-		<File RelativePath="..\dgeqr2.f"/>

-		<File RelativePath="..\dgeqrf.f"/>

-		<File RelativePath="..\dgerfs.f"/>

-		<File RelativePath="..\dgerq2.f"/>

-		<File RelativePath="..\dgerqf.f"/>

-		<File RelativePath="..\dgesc2.f"/>

-		<File RelativePath="..\dgesv.f"/>

-		<File RelativePath="..\dgesvd.f"/>

-		<File RelativePath="..\dgesvx.f"/>

-		<File RelativePath="..\dgetc2.f"/>

-		<File RelativePath="..\dgetf2.f"/>

-		<File RelativePath="..\dgetrf.f"/>

-		<File RelativePath="..\dgetri.f"/>

-		<File RelativePath="..\dgetrs.f"/>

-		<File RelativePath="..\dggbak.f"/>

-		<File RelativePath="..\dggbal.f"/>

-		<File RelativePath="..\dgges.f"/>

-		<File RelativePath="..\dggev.f"/>

-		<File RelativePath="..\dgghrd.f"/>

-		<File RelativePath="..\dhgeqz.f"/>

-		<File RelativePath="..\dhseqr.f"/>

-		<File RelativePath="..\disnan.f"/>

-		<File RelativePath="..\dlabad.f"/>

-		<File RelativePath="..\dlabrd.f"/>

-		<File RelativePath="..\dlacn2.f"/>

-		<File RelativePath="..\dlacon.f"/>

-		<File RelativePath="..\dlacpy.f"/>

-		<File RelativePath="..\dladiv.f"/>

-		<File RelativePath="..\dlae2.f"/>

-		<File RelativePath="..\dlaev2.f"/>

-		<File RelativePath="..\dlaexc.f"/>

-		<File RelativePath="..\dlag2.f"/>

-		<File RelativePath="..\dlagv2.f"/>

-		<File RelativePath="..\dlahqr.f"/>

-		<File RelativePath="..\dlahr2.f"/>

-		<File RelativePath="..\dlahrd.f"/>

-		<File RelativePath="..\dlaic1.f"/>

-		<File RelativePath="..\dlaisnan.f"/>

-		<File RelativePath="..\dlaln2.f"/>

-		<File RelativePath="..\dlamch.f">

-			<FileConfiguration Name="Release|x64">

-				<Tool Name="VFFortranCompilerTool" Optimization="optimizeDisabled"/></FileConfiguration>

-			<FileConfiguration Name="Release|Win32">

-				<Tool Name="VFFortranCompilerTool" Optimization="optimizeDisabled" OptimizeForProcessor="procOptimizeBlended"/></FileConfiguration></File>

-		<File RelativePath="..\dlange.f"/>

-		<File RelativePath="..\dlanhs.f"/>

-		<File RelativePath="..\dlansp.f"/>

-		<File RelativePath="..\dlanst.f"/>

-		<File RelativePath="..\dlansy.f"/>

-		<File RelativePath="..\dlantr.f"/>

-		<File RelativePath="..\dlanv2.f"/>

-		<File RelativePath="..\dlapmt.f"/>

-		<File RelativePath="..\dlapy2.f"/>

-		<File RelativePath="..\dlapy3.f"/>

-		<File RelativePath="..\dlaqge.f"/>

-		<File RelativePath="..\dlaqp2.f"/>

-		<File RelativePath="..\dlaqps.f"/>

-		<File RelativePath="..\dlaqr0.f"/>

-		<File RelativePath="..\dlaqr1.f"/>

-		<File RelativePath="..\dlaqr2.f"/>

-		<File RelativePath="..\dlaqr3.f"/>

-		<File RelativePath="..\dlaqr4.f"/>

-		<File RelativePath="..\dlaqr5.f"/>

-		<File RelativePath="..\dlarf.f"/>

-		<File RelativePath="..\dlarfb.f"/>

-		<File RelativePath="..\dlarfg.f"/>

-		<File RelativePath="..\dlarft.f"/>

-		<File RelativePath="..\dlarfx.f"/>

-		<File RelativePath="..\dlartg.f"/>

-		<File RelativePath="..\dlarz.f"/>

-		<File RelativePath="..\dlarzb.f"/>

-		<File RelativePath="..\dlarzt.f"/>

-		<File RelativePath="..\dlas2.f"/>

-		<File RelativePath="..\dlascl.f"/>

-		<File RelativePath="..\dlaset.f"/>

-		<File RelativePath="..\dlasq1.f"/>

-		<File RelativePath="..\dlasq2.f"/>

-		<File RelativePath="..\dlasq3.f"/>

-		<File RelativePath="..\dlasq4.f"/>

-		<File RelativePath="..\dlasq5.f"/>

-		<File RelativePath="..\dlasq6.f"/>

-		<File RelativePath="..\dlasr.f"/>

-		<File RelativePath="..\dlasrt.f"/>

-		<File RelativePath="..\dlassq.f"/>

-		<File RelativePath="..\dlasv2.f"/>

-		<File RelativePath="..\dlaswp.f"/>

-		<File RelativePath="..\dlasy2.f"/>

-		<File RelativePath="..\dlasyf.f"/>

-		<File RelativePath="..\dlatdf.f"/>

-		<File RelativePath="..\dlatrd.f"/>

-		<File RelativePath="..\dlatrs.f"/>

-		<File RelativePath="..\dlatrz.f"/>

-		<File RelativePath="..\dlatzm.f"/>

-		<File RelativePath="..\dlazq3.f"/>

-		<File RelativePath="..\dlazq4.f"/>

-		<File RelativePath="..\dopgtr.f"/>

-		<File RelativePath="..\dorg2l.f"/>

-		<File RelativePath="..\dorg2r.f"/>

-		<File RelativePath="..\dorgbr.f"/>

-		<File RelativePath="..\dorghr.f"/>

-		<File RelativePath="..\dorgl2.f"/>

-		<File RelativePath="..\dorglq.f"/>

-		<File RelativePath="..\dorgql.f"/>

-		<File RelativePath="..\dorgqr.f"/>

-		<File RelativePath="..\dorgr2.f"/>

-		<File RelativePath="..\dorgrq.f"/>

-		<File RelativePath="..\dorgtr.f"/>

-		<File RelativePath="..\dorm2l.f"/>

-		<File RelativePath="..\dorm2r.f"/>

-		<File RelativePath="..\dormbr.f"/>

-		<File RelativePath="..\dormhr.f"/>

-		<File RelativePath="..\dorml2.f"/>

-		<File RelativePath="..\dormlq.f"/>

-		<File RelativePath="..\dormql.f"/>

-		<File RelativePath="..\dormqr.f"/>

-		<File RelativePath="..\dormr2.f"/>

-		<File RelativePath="..\dormr3.f"/>

-		<File RelativePath="..\dormrq.f"/>

-		<File RelativePath="..\dormrz.f"/>

-		<File RelativePath="..\dpocon.f"/>

-		<File RelativePath="..\dpotf2.f"/>

-		<File RelativePath="..\dpotrf.f"/>

-		<File RelativePath="..\dpotrs.f"/>

-		<File RelativePath="..\dpptrf.f"/>

-		<File RelativePath="..\drscl.f"/>

-		<File RelativePath="..\dspev.f"/>

-		<File RelativePath="..\dspgst.f"/>

-		<File RelativePath="..\dspgv.f"/>

-		<File RelativePath="..\dsptrd.f"/>

-		<File RelativePath="..\dsptrf.f"/>

-		<File RelativePath="..\dsteqr.f"/>

-		<File RelativePath="..\dsterf.f"/>

-		<File RelativePath="..\dsycon.f"/>

-		<File RelativePath="..\dsyev.f"/>

-		<File RelativePath="..\dsysv.f"/>

-		<File RelativePath="..\dsytd2.f"/>

-		<File RelativePath="..\dsytf2.f"/>

-		<File RelativePath="..\dsytrd.f"/>

-		<File RelativePath="..\dsytrf.f"/>

-		<File RelativePath="..\dsytri.f"/>

-		<File RelativePath="..\dsytrs.f"/>

-		<File RelativePath="..\dtgevc.f"/>

-		<File RelativePath="..\dtgex2.f"/>

-		<File RelativePath="..\dtgexc.f"/>

-		<File RelativePath="..\dtgsen.f"/>

-		<File RelativePath="..\dtgsy2.f"/>

-		<File RelativePath="..\dtgsyl.f"/>

-		<File RelativePath="..\dtrcon.f"/>

-		<File RelativePath="..\dtrevc.f"/>

-		<File RelativePath="..\dtrexc.f"/>

-		<File RelativePath="..\dtrsen.f"/>

-		<File RelativePath="..\dtrsyl.f"/>

-		<File RelativePath="..\dtrti2.f"/>

-		<File RelativePath="..\dtrtri.f"/>

-		<File RelativePath="..\dtrtrs.f"/>

-		<File RelativePath="..\dtzrqf.f"/>

-		<File RelativePath="..\dtzrzf.f"/>

-		<File RelativePath="..\dzsum1.f"/>

-		<File RelativePath="..\ieeeck.f"/>

-		<File RelativePath="..\ilaenv.f"/>

-		<File RelativePath="..\iparmq.f"/>

-		<File RelativePath="..\izmax1.f"/>

-		<File RelativePath="..\lsame.f"/>

-		<File RelativePath="..\slamch.f">

-			<FileConfiguration Name="Release|x64">

-				<Tool Name="VFFortranCompilerTool" Optimization="optimizeDisabled"/></FileConfiguration>

-			<FileConfiguration Name="Release|Win32">

-				<Tool Name="VFFortranCompilerTool" Optimization="optimizeDisabled"/></FileConfiguration></File>

-		<File RelativePath="..\xerbla.f"/>

-		<File RelativePath="..\zbdsqr.f"/>

-		<File RelativePath="..\zdrot.f"/>

-		<File RelativePath="..\zdrscl.f"/>

-		<File RelativePath="..\zgebak.f"/>

-		<File RelativePath="..\zgebal.f"/>

-		<File RelativePath="..\zgebd2.f"/>

-		<File RelativePath="..\zgebrd.f"/>

-		<File RelativePath="..\zgecon.f"/>

-		<File RelativePath="..\zgees.f"/>

-		<File RelativePath="..\zgeev.f"/>

-		<File RelativePath="..\zgehd2.f"/>

-		<File RelativePath="..\zgehrd.f"/>

-		<File RelativePath="..\zgelq2.f"/>

-		<File RelativePath="..\zgelqf.f"/>

-		<File RelativePath="..\zgelsy.f"/>

-		<File RelativePath="..\zgeqp3.f"/>

-		<File RelativePath="..\zgeqpf.f"/>

-		<File RelativePath="..\zgeqr2.f"/>

-		<File RelativePath="..\zgeqrf.f"/>

-		<File RelativePath="..\zgesc2.f"/>

-		<File RelativePath="..\zgesvd.f"/>

-		<File RelativePath="..\zgetc2.f"/>

-		<File RelativePath="..\zgetf2.f"/>

-		<File RelativePath="..\zgetrf.f"/>

-		<File RelativePath="..\zgetri.f"/>

-		<File RelativePath="..\zgetrs.f"/>

-		<File RelativePath="..\zggbak.f"/>

-		<File RelativePath="..\zggbal.f"/>

-		<File RelativePath="..\zgges.f"/>

-		<File RelativePath="..\zggev.f"/>

-		<File RelativePath="..\zgghrd.f"/>

-		<File RelativePath="..\zheev.f"/>

-		<File RelativePath="..\zhetd2.f"/>

-		<File RelativePath="..\zhetrd.f"/>

-		<File RelativePath="..\zhgeqz.f"/>

-		<File RelativePath="..\zhseqr.f"/>

-		<File RelativePath="..\zlabrd.f"/>

-		<File RelativePath="..\zlacgv.f"/>

-		<File RelativePath="..\zlacn2.f"/>

-		<File RelativePath="..\zlacon.f"/>

-		<File RelativePath="..\zlacpy.f"/>

-		<File RelativePath="..\zladiv.f"/>

-		<File RelativePath="..\zlahqr.f"/>

-		<File RelativePath="..\zlahr2.f"/>

-		<File RelativePath="..\zlahrd.f"/>

-		<File RelativePath="..\zlaic1.f"/>

-		<File RelativePath="..\zlange.f"/>

-		<File RelativePath="..\zlanhe.f"/>

-		<File RelativePath="..\zlanhs.f"/>

-		<File RelativePath="..\zlaqp2.f"/>

-		<File RelativePath="..\zlaqps.f"/>

-		<File RelativePath="..\zlaqr0.f"/>

-		<File RelativePath="..\zlaqr1.f"/>

-		<File RelativePath="..\zlaqr2.f"/>

-		<File RelativePath="..\zlaqr3.f"/>

-		<File RelativePath="..\zlaqr4.f"/>

-		<File RelativePath="..\zlaqr5.f"/>

-		<File RelativePath="..\zlarf.f"/>

-		<File RelativePath="..\zlarfb.f"/>

-		<File RelativePath="..\zlarfg.f"/>

-		<File RelativePath="..\zlarft.f"/>

-		<File RelativePath="..\zlarfx.f"/>

-		<File RelativePath="..\zlartg.f"/>

-		<File RelativePath="..\zlarz.f"/>

-		<File RelativePath="..\zlarzb.f"/>

-		<File RelativePath="..\zlarzt.f"/>

-		<File RelativePath="..\zlascl.f"/>

-		<File RelativePath="..\zlaset.f"/>

-		<File RelativePath="..\zlasr.f"/>

-		<File RelativePath="..\zlassq.f"/>

-		<File RelativePath="..\zlaswp.f"/>

-		<File RelativePath="..\zlatdf.f"/>

-		<File RelativePath="..\zlatrd.f"/>

-		<File RelativePath="..\zlatrs.f"/>

-		<File RelativePath="..\zlatrz.f"/>

-		<File RelativePath="..\zpotf2.f"/>

-		<File RelativePath="..\zpotrf.f"/>

-		<File RelativePath="..\zrot.f"/>

-		<File RelativePath="..\zsteqr.f"/>

-		<File RelativePath="..\ztgevc.f"/>

-		<File RelativePath="..\ztgex2.f"/>

-		<File RelativePath="..\ztgexc.f"/>

-		<File RelativePath="..\ztgsen.f"/>

-		<File RelativePath="..\ztgsy2.f"/>

-		<File RelativePath="..\ztgsyl.f"/>

-		<File RelativePath="..\ztrevc.f"/>

-		<File RelativePath="..\ztrexc.f"/>

-		<File RelativePath="..\ztrsen.f"/>

-		<File RelativePath="..\ztrsyl.f"/>

-		<File RelativePath="..\ztrti2.f"/>

-		<File RelativePath="..\ztrtri.f"/>

-		<File RelativePath="..\ztzrzf.f"/>

-		<File RelativePath="..\zung2l.f"/>

-		<File RelativePath="..\zung2r.f"/>

-		<File RelativePath="..\zungbr.f"/>

-		<File RelativePath="..\zunghr.f"/>

-		<File RelativePath="..\zungl2.f"/>

-		<File RelativePath="..\zunglq.f"/>

-		<File RelativePath="..\zungql.f"/>

-		<File RelativePath="..\zungqr.f"/>

-		<File RelativePath="..\zungtr.f"/>

-		<File RelativePath="..\zunm2r.f"/>

-		<File RelativePath="..\zunmbr.f"/>

-		<File RelativePath="..\zunml2.f"/>

-		<File RelativePath="..\zunmlq.f"/>

-		<File RelativePath="..\zunmqr.f"/>

-		<File RelativePath="..\zunmr3.f"/>

-		<File RelativePath="..\zunmrz.f"/></Filter>

-		<File RelativePath=".\lapack.def"/></Files>

-	<Globals/></VisualStudioProject>

diff --git a/src/lib/lapack/lapack_f/lapack_DLL_f2c.vcproj b/src/lib/lapack/lapack_f/lapack_DLL_f2c.vcproj
deleted file mode 100644
index b87e27ef..00000000
--- a/src/lib/lapack/lapack_f/lapack_DLL_f2c.vcproj
+++ /dev/null
@@ -1,2779 +0,0 @@
-<?xml version="1.0" encoding="Windows-1252"?>

-<VisualStudioProject

-	ProjectType="Visual C++"

-	Version="9,00"

-	Name="lapack_f2c_DLL"

-	ProjectGUID="{69296D00-0DE1-4F4B-B0CE-FE4F3CB43923}"

-	RootNamespace="lapack_f2c_DLL"

-	Keyword="Win32Proj"

-	TargetFrameworkVersion="0"

-	>

-	<Platforms>

-		<Platform

-			Name="Win32"

-		/>

-		<Platform

-			Name="x64"

-		/>

-	</Platforms>

-	<ToolFiles>

-		<ToolFile

-			RelativePath="..\..\..\..\Visual-Studio-settings\f2c.rules"

-		/>

-	</ToolFiles>

-	<Configurations>

-		<Configuration

-			Name="Debug|Win32"

-			OutputDirectory="$(SolutionDir)$(ConfigurationName)"

-			IntermediateDirectory="$(ConfigurationName)"

-			ConfigurationType="2"

-			CharacterSet="2"

-			>

-			<Tool

-				Name="f2c rule"

-				ExecutionBucket="1"

-			/>

-			<Tool

-				Name="VCPreBuildEventTool"

-				CommandLine=""

-				ExecutionBucket="2"

-			/>

-			<Tool

-				Name="VCCustomBuildTool"

-			/>

-			<Tool

-				Name="VCWebServiceProxyGeneratorTool"

-				ExecutionBucket="4"

-			/>

-			<Tool

-				Name="VCXMLDataGeneratorTool"

-			/>

-			<Tool

-				Name="VCMIDLTool"

-				ExecutionBucket="5"

-			/>

-			<Tool

-				Name="VCCLCompilerTool"

-				ExecutionBucket="6"

-				Optimization="0"

-				AdditionalIncludeDirectories="../../f2c"

-				PreprocessorDefinitions="STRICT;__STDC__;_CRT_SECURE_NO_DEPRECATE"

-				MinimalRebuild="true"

-				BasicRuntimeChecks="0"

-				RuntimeLibrary="1"

-				UsePrecompiledHeader="0"

-				ObjectFile="$(ConfigurationName)/"

-				ProgramDataBaseFileName="$(ConfigurationName)/vc80.pdb"

-				WarningLevel="3"

-				Detect64BitPortabilityProblems="false"

-				DebugInformationFormat="3"

-			/>

-			<Tool

-				Name="VCManagedResourceCompilerTool"

-				ExecutionBucket="7"

-			/>

-			<Tool

-				Name="VCResourceCompilerTool"

-				ExecutionBucket="8"

-			/>

-			<Tool

-				Name="VCPreLinkEventTool"

-				Description="Build Lapack.def file"

-				CommandLine=""

-				ExecutionBucket="9"

-			/>

-			<Tool

-				Name="VCLinkerTool"

-				ExecutionBucket="10"

-				AdditionalOptions="/fixed:no"

-				OutputFile="$(SolutionDir)bin\lapack.dll"

-				ModuleDefinitionFile="lapack.def"

-				RandomizedBaseAddress="1"

-				DataExecutionPrevention="0"

-				ImportLibrary="$(SolutionDir)bin\$(TargetName).lib"

-				CLRUnmanagedCodeCheck="true"

-			/>

-			<Tool

-				Name="VCALinkTool"

-				ExecutionBucket="11"

-			/>

-			<Tool

-				Name="VCManifestTool"

-				ExecutionBucket="12"

-			/>

-			<Tool

-				Name="VCXDCMakeTool"

-				ExecutionBucket="13"

-			/>

-			<Tool

-				Name="VCBscMakeTool"

-				ExecutionBucket="14"

-			/>

-			<Tool

-				Name="VCFxCopTool"

-				ExecutionBucket="15"

-			/>

-			<Tool

-				Name="VCPostBuildEventTool"

-				CommandLine=""

-				ExecutionBucket="17"

-			/>

-			<Tool

-				Name="VCAppVerifierTool"

-			/>

-		</Configuration>

-		<Configuration

-			Name="Debug|x64"

-			OutputDirectory="$(SolutionDir)$(ConfigurationName)"

-			IntermediateDirectory="$(ConfigurationName)"

-			ConfigurationType="2"

-			CharacterSet="2"

-			>

-			<Tool

-				Name="VCPreBuildEventTool"

-				CommandLine=""

-			/>

-			<Tool

-				Name="VCCustomBuildTool"

-			/>

-			<Tool

-				Name="f2c rule"

-			/>

-			<Tool

-				Name="VCXMLDataGeneratorTool"

-			/>

-			<Tool

-				Name="VCWebServiceProxyGeneratorTool"

-			/>

-			<Tool

-				Name="VCMIDLTool"

-				TargetEnvironment="3"

-			/>

-			<Tool

-				Name="VCCLCompilerTool"

-				Optimization="0"

-				AdditionalIncludeDirectories="../../f2c"

-				PreprocessorDefinitions="STRICT;__STDC__;_CRT_SECURE_NO_DEPRECATE"

-				MinimalRebuild="true"

-				BasicRuntimeChecks="0"

-				RuntimeLibrary="1"

-				UsePrecompiledHeader="0"

-				ObjectFile="$(ConfigurationName)/"

-				ProgramDataBaseFileName="$(ConfigurationName)/vc80.pdb"

-				WarningLevel="3"

-				Detect64BitPortabilityProblems="false"

-				DebugInformationFormat="3"

-			/>

-			<Tool

-				Name="VCManagedResourceCompilerTool"

-			/>

-			<Tool

-				Name="VCResourceCompilerTool"

-			/>

-			<Tool

-				Name="VCPreLinkEventTool"

-				Description="Build Lapack.def file"

-				CommandLine=""

-			/>

-			<Tool

-				Name="VCLinkerTool"

-				AdditionalOptions="/fixed:no"

-				OutputFile="../../../bin/lapack.dll"

-				ModuleDefinitionFile="lapack.def"

-				RandomizedBaseAddress="1"

-				DataExecutionPrevention="0"

-				TargetMachine="17"

-				CLRUnmanagedCodeCheck="true"

-			/>

-			<Tool

-				Name="VCALinkTool"

-			/>

-			<Tool

-				Name="VCManifestTool"

-			/>

-			<Tool

-				Name="VCXDCMakeTool"

-			/>

-			<Tool

-				Name="VCBscMakeTool"

-			/>

-			<Tool

-				Name="VCFxCopTool"

-			/>

-			<Tool

-				Name="VCAppVerifierTool"

-			/>

-			<Tool

-				Name="VCPostBuildEventTool"

-				CommandLine=""

-			/>

-		</Configuration>

-		<Configuration

-			Name="Release|Win32"

-			OutputDirectory="$(SolutionDir)$(ConfigurationName)"

-			IntermediateDirectory="$(ConfigurationName)"

-			ConfigurationType="2"

-			CharacterSet="2"

-			>

-			<Tool

-				Name="f2c rule"

-				ExecutionBucket="1"

-			/>

-			<Tool

-				Name="VCPreBuildEventTool"

-				CommandLine=""

-				ExecutionBucket="2"

-			/>

-			<Tool

-				Name="VCCustomBuildTool"

-			/>

-			<Tool

-				Name="VCWebServiceProxyGeneratorTool"

-				ExecutionBucket="4"

-			/>

-			<Tool

-				Name="VCXMLDataGeneratorTool"

-			/>

-			<Tool

-				Name="VCMIDLTool"

-				ExecutionBucket="5"

-			/>

-			<Tool

-				Name="VCCLCompilerTool"

-				ExecutionBucket="6"

-				FavorSizeOrSpeed="1"

-				AdditionalIncludeDirectories="../../f2c"

-				PreprocessorDefinitions="STRICT;__STDC__;_CRT_SECURE_NO_DEPRECATE"

-				RuntimeLibrary="0"

-				EnableEnhancedInstructionSet="0"

-				UsePrecompiledHeader="0"

-				ObjectFile="$(ConfigurationName)/"

-				ProgramDataBaseFileName="$(ConfigurationName)/vc80.pdb"

-				WarningLevel="3"

-				Detect64BitPortabilityProblems="false"

-				DebugInformationFormat="3"

-			/>

-			<Tool

-				Name="VCManagedResourceCompilerTool"

-				ExecutionBucket="7"

-			/>

-			<Tool

-				Name="VCResourceCompilerTool"

-				ExecutionBucket="8"

-			/>

-			<Tool

-				Name="VCPreLinkEventTool"

-				Description="Build Lapack.def file"

-				CommandLine=""

-				ExecutionBucket="9"

-			/>

-			<Tool

-				Name="VCLinkerTool"

-				ExecutionBucket="10"

-				OutputFile="$(SolutionDir)bin\lapack.dll"

-				ModuleDefinitionFile="lapack.def"

-				RandomizedBaseAddress="1"

-				DataExecutionPrevention="0"

-				ImportLibrary="$(SolutionDir)bin\$(TargetName).lib"

-				CLRUnmanagedCodeCheck="true"

-			/>

-			<Tool

-				Name="VCALinkTool"

-				ExecutionBucket="11"

-			/>

-			<Tool

-				Name="VCManifestTool"

-				ExecutionBucket="12"

-			/>

-			<Tool

-				Name="VCXDCMakeTool"

-				ExecutionBucket="13"

-			/>

-			<Tool

-				Name="VCBscMakeTool"

-				ExecutionBucket="14"

-			/>

-			<Tool

-				Name="VCFxCopTool"

-				ExecutionBucket="15"

-			/>

-			<Tool

-				Name="VCPostBuildEventTool"

-				CommandLine=""

-				ExecutionBucket="17"

-			/>

-			<Tool

-				Name="VCAppVerifierTool"

-			/>

-		</Configuration>

-		<Configuration

-			Name="Release|x64"

-			OutputDirectory="$(SolutionDir)$(ConfigurationName)"

-			IntermediateDirectory="$(ConfigurationName)"

-			ConfigurationType="2"

-			CharacterSet="2"

-			>

-			<Tool

-				Name="VCPreBuildEventTool"

-				CommandLine=""

-			/>

-			<Tool

-				Name="VCCustomBuildTool"

-			/>

-			<Tool

-				Name="f2c rule"

-			/>

-			<Tool

-				Name="VCXMLDataGeneratorTool"

-			/>

-			<Tool

-				Name="VCWebServiceProxyGeneratorTool"

-			/>

-			<Tool

-				Name="VCMIDLTool"

-				TargetEnvironment="3"

-			/>

-			<Tool

-				Name="VCCLCompilerTool"

-				FavorSizeOrSpeed="1"

-				AdditionalIncludeDirectories="../../f2c"

-				PreprocessorDefinitions="STRICT;__STDC__;_CRT_SECURE_NO_DEPRECATE"

-				RuntimeLibrary="0"

-				EnableEnhancedInstructionSet="1"

-				UsePrecompiledHeader="0"

-				ObjectFile="$(ConfigurationName)/"

-				ProgramDataBaseFileName="$(ConfigurationName)/vc80.pdb"

-				WarningLevel="3"

-				Detect64BitPortabilityProblems="false"

-				DebugInformationFormat="3"

-			/>

-			<Tool

-				Name="VCManagedResourceCompilerTool"

-			/>

-			<Tool

-				Name="VCResourceCompilerTool"

-			/>

-			<Tool

-				Name="VCPreLinkEventTool"

-				Description="Build Lapack.def file"

-				CommandLine=""

-			/>

-			<Tool

-				Name="VCLinkerTool"

-				OutputFile="../../../bin/lapack.dll"

-				ModuleDefinitionFile="lapack.def"

-				RandomizedBaseAddress="1"

-				DataExecutionPrevention="0"

-				TargetMachine="17"

-				CLRUnmanagedCodeCheck="true"

-			/>

-			<Tool

-				Name="VCALinkTool"

-			/>

-			<Tool

-				Name="VCManifestTool"

-			/>

-			<Tool

-				Name="VCXDCMakeTool"

-			/>

-			<Tool

-				Name="VCBscMakeTool"

-			/>

-			<Tool

-				Name="VCFxCopTool"

-			/>

-			<Tool

-				Name="VCAppVerifierTool"

-			/>

-			<Tool

-				Name="VCPostBuildEventTool"

-				CommandLine=""

-			/>

-		</Configuration>

-	</Configurations>

-	<References>

-	</References>

-	<Files>

-		<Filter

-			Name="Source Files"

-			Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm;asmx"

-			>

-			<File

-				RelativePath="..\dbdsqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgebak.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgebal.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgebd2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgebrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgecon.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeequ.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgees.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeesx.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeev.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgegs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgehd2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgehrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgelq2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgelqf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgels.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgelss.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgelsx.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgelsy.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeql2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeqlf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeqp3.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeqpf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeqr2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeqrf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgerfs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgerq2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgerqf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgesc2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgesv.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgesvd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgesvx.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgetc2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgetf2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgetrf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgetri.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgetrs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dggbak.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dggbal.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgges.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dggev.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dgghrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dhgeqz.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dhseqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\disnan.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlabad.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlabrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlacn2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlacon.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlacpy.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dladiv.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlae2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaev2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaexc.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlag2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlagv2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlahqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlahr2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlahrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaic1.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaisnan.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaln2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlamch.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlange.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlanhs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlansp.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlanst.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlansy.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlantr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlanv2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlapmt.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlapy2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlapy3.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqge.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqp2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqps.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr0.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr1.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr3.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr4.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr5.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarfb.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarfg.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarft.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarfx.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlartg.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarz.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarzb.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarzt.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlas2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlascl.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaset.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq1.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq3.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq4.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq5.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq6.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasrt.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlassq.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasv2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaswp.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasy2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasyf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlatdf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlatrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlatrs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlatrz.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlatzm.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlazq3.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dlazq4.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dopgtr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorg2l.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorg2r.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgbr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorghr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgl2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorglq.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgql.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgr2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgrq.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgtr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorm2l.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorm2r.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dormbr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dormhr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dorml2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dormlq.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dormql.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dormqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dormr2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dormr3.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dormrq.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dormrz.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dpocon.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dpotf2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dpotrf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dpotrs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dpptrf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\drscl.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dspev.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dspgst.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dspgv.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsptrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsptrf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsteqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsterf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsycon.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsyev.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsysv.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytd2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytf2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytrf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytri.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytrs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgevc.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgex2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgexc.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgsen.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgsy2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgsyl.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrcon.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrevc.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrexc.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrsen.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrsyl.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrti2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrtri.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrtrs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtzrqf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dtzrzf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\dzsum1.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ieeeck.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ilaenv.c"

-				>

-			</File>

-			<File

-				RelativePath="..\iparmq.c"

-				>

-			</File>

-			<File

-				RelativePath="..\izmax1.c"

-				>

-			</File>

-			<File

-				RelativePath="..\lsame.c"

-				>

-			</File>

-			<File

-				RelativePath="..\slamch.c"

-				>

-			</File>

-			<File

-				RelativePath="..\xerbla.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zbdsqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zdrot.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zdrscl.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgebak.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgebal.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgebd2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgebrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgecon.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgees.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgeev.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgehd2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgehrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgelq2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgelqf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgelsy.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgeqp3.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgeqpf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgeqr2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgeqrf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgesc2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgesvd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgetc2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgetf2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgetrf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgetri.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgetrs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zggbak.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zggbal.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgges.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zggev.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zgghrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zheev.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zhetd2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zhetrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zhgeqz.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zhseqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlabrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlacgv.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlacn2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlacon.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlacpy.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zladiv.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlahqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlahr2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlahrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaic1.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlange.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlanhe.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlanhs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqp2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqps.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr0.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr1.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr3.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr4.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr5.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarfb.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarfg.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarft.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarfx.c"

-				>

-				<FileConfiguration

-					Name="Release|Win32"

-					>

-					<Tool

-						Name="VCCLCompilerTool"

-						Optimization="0"

-					/>

-				</FileConfiguration>

-				<FileConfiguration

-					Name="Release|x64"

-					>

-					<Tool

-						Name="VCCLCompilerTool"

-						Optimization="0"

-					/>

-				</FileConfiguration>

-			</File>

-			<File

-				RelativePath="..\zlartg.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarz.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarzb.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarzt.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlascl.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaset.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlasr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlassq.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaswp.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlatdf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlatrd.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlatrs.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zlatrz.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zpotf2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zpotrf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zrot.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zsteqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgevc.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgex2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgexc.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgsen.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgsy2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgsyl.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrevc.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrexc.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrsen.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrsyl.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrti2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrtri.c"

-				>

-			</File>

-			<File

-				RelativePath="..\ztzrzf.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zung2l.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zung2r.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zungbr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zunghr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zungl2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zunglq.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zungql.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zungqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zungtr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zunm2r.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zunmbr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zunml2.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zunmlq.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zunmqr.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zunmr3.c"

-				>

-			</File>

-			<File

-				RelativePath="..\zunmrz.c"

-				>

-			</File>

-		</Filter>

-		<Filter

-			Name="Header Files"

-			Filter="h;hpp;hxx;hm;inl;inc;xsd"

-			>

-		</Filter>

-		<Filter

-			Name="Resource Files"

-			Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx"

-			>

-		</Filter>

-		<Filter

-			Name="Fortran Files"

-			>

-			<File

-				RelativePath="..\dbdsqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgebak.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgebal.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgebd2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgebrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgecon.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeequ.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgees.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeesx.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeev.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgegs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgehd2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgehrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgelq2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgelqf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgels.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgelss.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgelsx.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgelsy.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeql2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeqlf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeqp3.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeqpf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeqr2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgeqrf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgerfs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgerq2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgerqf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgesc2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgesv.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgesvd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgesvx.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgetc2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgetf2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgetrf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgetri.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgetrs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dggbak.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dggbal.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgges.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dggev.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dgghrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dhgeqz.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dhseqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\disnan.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlabad.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlabrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlacn2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlacon.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlacpy.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dladiv.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlae2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaev2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaexc.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlag2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlagv2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlahqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlahr2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlahrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaic1.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaisnan.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaln2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlamch.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlange.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlanhs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlansp.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlanst.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlansy.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlantr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlanv2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlapmt.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlapy2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlapy3.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqge.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqp2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqps.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr0.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr1.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr3.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr4.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaqr5.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarfb.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarfg.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarft.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarfx.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlartg.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarz.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarzb.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlarzt.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlas2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlascl.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaset.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq1.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq3.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq4.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq5.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasq6.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasrt.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlassq.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasv2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlaswp.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasy2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlasyf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlatdf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlatrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlatrs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlatrz.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlatzm.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlazq3.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dlazq4.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dopgtr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorg2l.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorg2r.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgbr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorghr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgl2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorglq.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgql.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgr2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgrq.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorgtr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorm2l.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorm2r.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dormbr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dormhr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dorml2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dormlq.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dormql.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dormqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dormr2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dormr3.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dormrq.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dormrz.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dpocon.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dpotf2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dpotrf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dpotrs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dpptrf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\drscl.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dspev.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dspgst.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dspgv.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsptrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsptrf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsteqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsterf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsycon.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsyev.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsysv.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytd2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytf2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytrf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytri.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dsytrs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgevc.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgex2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgexc.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgsen.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgsy2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtgsyl.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrcon.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrevc.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrexc.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrsen.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrsyl.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrti2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrtri.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtrtrs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtzrqf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dtzrzf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\dzsum1.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ieeeck.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ilaenv.f"

-				>

-			</File>

-			<File

-				RelativePath="..\iparmq.f"

-				>

-			</File>

-			<File

-				RelativePath="..\izmax1.f"

-				>

-			</File>

-			<File

-				RelativePath="..\lsame.f"

-				>

-			</File>

-			<File

-				RelativePath="..\slamch.f"

-				>

-			</File>

-			<File

-				RelativePath="..\xerbla.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zbdsqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zdrot.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zdrscl.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgebak.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgebal.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgebd2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgebrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgecon.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgees.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgeev.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgehd2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgehrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgelq2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgelqf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgelsy.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgeqp3.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgeqpf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgeqr2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgeqrf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgesc2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgesvd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgetc2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgetf2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgetrf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgetri.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgetrs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zggbak.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zggbal.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgges.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zggev.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zgghrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zheev.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zhetd2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zhetrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zhgeqz.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zhseqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlabrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlacgv.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlacn2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlacon.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlacpy.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zladiv.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlahqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlahr2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlahrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaic1.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlange.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlanhe.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlanhs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqp2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqps.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr0.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr1.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr3.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr4.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaqr5.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarfb.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarfg.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarft.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarfx.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlartg.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarz.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarzb.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlarzt.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlascl.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaset.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlasr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlassq.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlaswp.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlatdf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlatrd.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlatrs.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zlatrz.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zpotf2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zpotrf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zrot.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zsteqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgevc.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgex2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgexc.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgsen.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgsy2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztgsyl.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrevc.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrexc.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrsen.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrsyl.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrti2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztrtri.f"

-				>

-			</File>

-			<File

-				RelativePath="..\ztzrzf.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zung2l.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zung2r.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zungbr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zunghr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zungl2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zunglq.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zungql.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zungqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zungtr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zunm2r.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zunmbr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zunml2.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zunmlq.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zunmqr.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zunmr3.f"

-				>

-			</File>

-			<File

-				RelativePath="..\zunmrz.f"

-				>

-			</File>

-		</Filter>

-		<File

-			RelativePath="..\..\..\..\bin\libf2c.lib"

-			>

-		</File>

-		<File

-			RelativePath="..\Makefile.am"

-			>

-		</File>

-	</Files>

-	<Globals>

-	</Globals>

-</VisualStudioProject>

diff --git a/src/lib/lapack/lsame.f b/src/lib/lapack/lsame.f
deleted file mode 100644
index bf25d86f..00000000
--- a/src/lib/lapack/lsame.f
+++ /dev/null
@@ -1,87 +0,0 @@
-      LOGICAL          FUNCTION LSAME( CA, CB )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     September 30, 1994
-*
-*     .. Scalar Arguments ..
-      CHARACTER          CA, CB
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  LSAME returns .TRUE. if CA is the same letter as CB regardless of
-*  case.
-*
-*  Arguments
-*  =========
-*
-*  CA      (input) CHARACTER*1
-*  CB      (input) CHARACTER*1
-*          CA and CB specify the single characters to be compared.
-*
-* =====================================================================
-*
-*     .. Intrinsic Functions ..
-      INTRINSIC          ICHAR
-*     ..
-*     .. Local Scalars ..
-      INTEGER            INTA, INTB, ZCODE
-*     ..
-*     .. Executable Statements ..
-*
-*     Test if the characters are equal
-*
-      LSAME = CA.EQ.CB
-      IF( LSAME )
-     $   RETURN
-*
-*     Now test for equivalence if both characters are alphabetic.
-*
-      ZCODE = ICHAR( 'Z' )
-*
-*     Use 'Z' rather than 'A' so that ASCII can be detected on Prime
-*     machines, on which ICHAR returns a value with bit 8 set.
-*     ICHAR('A') on Prime machines returns 193 which is the same as
-*     ICHAR('A') on an EBCDIC machine.
-*
-      INTA = ICHAR( CA )
-      INTB = ICHAR( CB )
-*
-      IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN
-*
-*        ASCII is assumed - ZCODE is the ASCII code of either lower or
-*        upper case 'Z'.
-*
-         IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32
-         IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32
-*
-      ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN
-*
-*        EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
-*        upper case 'Z'.
-*
-         IF( INTA.GE.129 .AND. INTA.LE.137 .OR.
-     $       INTA.GE.145 .AND. INTA.LE.153 .OR.
-     $       INTA.GE.162 .AND. INTA.LE.169 ) INTA = INTA + 64
-         IF( INTB.GE.129 .AND. INTB.LE.137 .OR.
-     $       INTB.GE.145 .AND. INTB.LE.153 .OR.
-     $       INTB.GE.162 .AND. INTB.LE.169 ) INTB = INTB + 64
-*
-      ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN
-*
-*        ASCII is assumed, on Prime machines - ZCODE is the ASCII code
-*        plus 128 of either lower or upper case 'Z'.
-*
-         IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32
-         IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32
-      END IF
-      LSAME = INTA.EQ.INTB
-*
-*     RETURN
-*
-*     End of LSAME
-*
-      END
diff --git a/src/lib/lapack/slamch.f b/src/lib/lapack/slamch.f
deleted file mode 100644
index afb4d368..00000000
--- a/src/lib/lapack/slamch.f
+++ /dev/null
@@ -1,857 +0,0 @@
-      REAL             FUNCTION SLAMCH( CMACH )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992 
-*
-*     .. Scalar Arguments ..
-      CHARACTER          CMACH
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  SLAMCH determines single precision machine parameters.
-*
-*  Arguments
-*  =========
-*
-*  CMACH   (input) CHARACTER*1
-*          Specifies the value to be returned by SLAMCH:
-*          = 'E' or 'e',   SLAMCH := eps
-*          = 'S' or 's ,   SLAMCH := sfmin
-*          = 'B' or 'b',   SLAMCH := base
-*          = 'P' or 'p',   SLAMCH := eps*base
-*          = 'N' or 'n',   SLAMCH := t
-*          = 'R' or 'r',   SLAMCH := rnd
-*          = 'M' or 'm',   SLAMCH := emin
-*          = 'U' or 'u',   SLAMCH := rmin
-*          = 'L' or 'l',   SLAMCH := emax
-*          = 'O' or 'o',   SLAMCH := rmax
-*
-*          where
-*
-*          eps   = relative machine precision
-*          sfmin = safe minimum, such that 1/sfmin does not overflow
-*          base  = base of the machine
-*          prec  = eps*base
-*          t     = number of (base) digits in the mantissa
-*          rnd   = 1.0 when rounding occurs in addition, 0.0 otherwise
-*          emin  = minimum exponent before (gradual) underflow
-*          rmin  = underflow threshold - base**(emin-1)
-*          emax  = largest exponent before overflow
-*          rmax  = overflow threshold  - (base**emax)*(1-eps)
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      REAL               ONE, ZERO
-      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            FIRST, LRND
-      INTEGER            BETA, IMAX, IMIN, IT
-      REAL               BASE, EMAX, EMIN, EPS, PREC, RMACH, RMAX, RMIN,
-     $                   RND, SFMIN, SMALL, T
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           SLAMC2
-*     ..
-*     .. Save statement ..
-      SAVE               FIRST, EPS, SFMIN, BASE, T, RND, EMIN, RMIN,
-     $                   EMAX, RMAX, PREC
-*     ..
-*     .. Data statements ..
-      DATA               FIRST / .TRUE. /
-*     ..
-*     .. Executable Statements ..
-*
-      IF( FIRST ) THEN
-         FIRST = .FALSE.
-         CALL SLAMC2( BETA, IT, LRND, EPS, IMIN, RMIN, IMAX, RMAX )
-         BASE = BETA
-         T = IT
-         IF( LRND ) THEN
-            RND = ONE
-            EPS = ( BASE**( 1-IT ) ) / 2
-         ELSE
-            RND = ZERO
-            EPS = BASE**( 1-IT )
-         END IF
-         PREC = EPS*BASE
-         EMIN = IMIN
-         EMAX = IMAX
-         SFMIN = RMIN
-         SMALL = ONE / RMAX
-         IF( SMALL.GE.SFMIN ) THEN
-*
-*           Use SMALL plus a bit, to avoid the possibility of rounding
-*           causing overflow when computing  1/sfmin.
-*
-            SFMIN = SMALL*( ONE+EPS )
-         END IF
-      END IF
-*
-      IF( LSAME( CMACH, 'E' ) ) THEN
-         RMACH = EPS
-      ELSE IF( LSAME( CMACH, 'S' ) ) THEN
-         RMACH = SFMIN
-      ELSE IF( LSAME( CMACH, 'B' ) ) THEN
-         RMACH = BASE
-      ELSE IF( LSAME( CMACH, 'P' ) ) THEN
-         RMACH = PREC
-      ELSE IF( LSAME( CMACH, 'N' ) ) THEN
-         RMACH = T
-      ELSE IF( LSAME( CMACH, 'R' ) ) THEN
-         RMACH = RND
-      ELSE IF( LSAME( CMACH, 'M' ) ) THEN
-         RMACH = EMIN
-      ELSE IF( LSAME( CMACH, 'U' ) ) THEN
-         RMACH = RMIN
-      ELSE IF( LSAME( CMACH, 'L' ) ) THEN
-         RMACH = EMAX
-      ELSE IF( LSAME( CMACH, 'O' ) ) THEN
-         RMACH = RMAX
-      END IF
-*
-      SLAMCH = RMACH
-      RETURN
-*
-*     End of SLAMCH
-*
-      END
-*
-************************************************************************
-*
-      SUBROUTINE SLAMC1( BETA, T, RND, IEEE1 )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      LOGICAL            IEEE1, RND
-      INTEGER            BETA, T
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  SLAMC1 determines the machine parameters given by BETA, T, RND, and
-*  IEEE1.
-*
-*  Arguments
-*  =========
-*
-*  BETA    (output) INTEGER
-*          The base of the machine.
-*
-*  T       (output) INTEGER
-*          The number of ( BETA ) digits in the mantissa.
-*
-*  RND     (output) LOGICAL
-*          Specifies whether proper rounding  ( RND = .TRUE. )  or
-*          chopping  ( RND = .FALSE. )  occurs in addition. This may not
-*          be a reliable guide to the way in which the machine performs
-*          its arithmetic.
-*
-*  IEEE1   (output) LOGICAL
-*          Specifies whether rounding appears to be done in the IEEE
-*          'round to nearest' style.
-*
-*  Further Details
-*  ===============
-*
-*  The routine is based on the routine  ENVRON  by Malcolm and
-*  incorporates suggestions by Gentleman and Marovich. See
-*
-*     Malcolm M. A. (1972) Algorithms to reveal properties of
-*        floating-point arithmetic. Comms. of the ACM, 15, 949-951.
-*
-*     Gentleman W. M. and Marovich S. B. (1974) More on algorithms
-*        that reveal properties of floating point arithmetic units.
-*        Comms. of the ACM, 17, 276-277.
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            FIRST, LIEEE1, LRND
-      INTEGER            LBETA, LT
-      REAL               A, B, C, F, ONE, QTR, SAVEC, T1, T2
-*     ..
-*     .. External Functions ..
-      REAL               SLAMC3
-      EXTERNAL           SLAMC3
-*     ..
-*     .. Save statement ..
-      SAVE               FIRST, LIEEE1, LBETA, LRND, LT
-*     ..
-*     .. Data statements ..
-      DATA               FIRST / .TRUE. /
-*     ..
-*     .. Executable Statements ..
-*
-      IF( FIRST ) THEN
-         FIRST = .FALSE.
-         ONE = 1
-*
-*        LBETA,  LIEEE1,  LT and  LRND  are the  local values  of  BETA,
-*        IEEE1, T and RND.
-*
-*        Throughout this routine  we use the function  SLAMC3  to ensure
-*        that relevant values are  stored and not held in registers,  or
-*        are not affected by optimizers.
-*
-*        Compute  a = 2.0**m  with the  smallest positive integer m such
-*        that
-*
-*           fl( a + 1.0 ) = a.
-*
-         A = 1
-         C = 1
-*
-*+       WHILE( C.EQ.ONE )LOOP
-   10    CONTINUE
-         IF( C.EQ.ONE ) THEN
-            A = 2*A
-            C = SLAMC3( A, ONE )
-            C = SLAMC3( C, -A )
-            GO TO 10
-         END IF
-*+       END WHILE
-*
-*        Now compute  b = 2.0**m  with the smallest positive integer m
-*        such that
-*
-*           fl( a + b ) .gt. a.
-*
-         B = 1
-         C = SLAMC3( A, B )
-*
-*+       WHILE( C.EQ.A )LOOP
-   20    CONTINUE
-         IF( C.EQ.A ) THEN
-            B = 2*B
-            C = SLAMC3( A, B )
-            GO TO 20
-         END IF
-*+       END WHILE
-*
-*        Now compute the base.  a and c  are neighbouring floating point
-*        numbers  in the  interval  ( beta**t, beta**( t + 1 ) )  and so
-*        their difference is beta. Adding 0.25 to c is to ensure that it
-*        is truncated to beta and not ( beta - 1 ).
-*
-         QTR = ONE / 4
-         SAVEC = C
-         C = SLAMC3( C, -A )
-         LBETA = C + QTR
-*
-*        Now determine whether rounding or chopping occurs,  by adding a
-*        bit  less  than  beta/2  and a  bit  more  than  beta/2  to  a.
-*
-         B = LBETA
-         F = SLAMC3( B / 2, -B / 100 )
-         C = SLAMC3( F, A )
-         IF( C.EQ.A ) THEN
-            LRND = .TRUE.
-         ELSE
-            LRND = .FALSE.
-         END IF
-         F = SLAMC3( B / 2, B / 100 )
-         C = SLAMC3( F, A )
-         IF( ( LRND ) .AND. ( C.EQ.A ) )
-     $      LRND = .FALSE.
-*
-*        Try and decide whether rounding is done in the  IEEE  'round to
-*        nearest' style. B/2 is half a unit in the last place of the two
-*        numbers A and SAVEC. Furthermore, A is even, i.e. has last  bit
-*        zero, and SAVEC is odd. Thus adding B/2 to A should not  change
-*        A, but adding B/2 to SAVEC should change SAVEC.
-*
-         T1 = SLAMC3( B / 2, A )
-         T2 = SLAMC3( B / 2, SAVEC )
-         LIEEE1 = ( T1.EQ.A ) .AND. ( T2.GT.SAVEC ) .AND. LRND
-*
-*        Now find  the  mantissa, t.  It should  be the  integer part of
-*        log to the base beta of a,  however it is safer to determine  t
-*        by powering.  So we find t as the smallest positive integer for
-*        which
-*
-*           fl( beta**t + 1.0 ) = 1.0.
-*
-         LT = 0
-         A = 1
-         C = 1
-*
-*+       WHILE( C.EQ.ONE )LOOP
-   30    CONTINUE
-         IF( C.EQ.ONE ) THEN
-            LT = LT + 1
-            A = A*LBETA
-            C = SLAMC3( A, ONE )
-            C = SLAMC3( C, -A )
-            GO TO 30
-         END IF
-*+       END WHILE
-*
-      END IF
-*
-      BETA = LBETA
-      T = LT
-      RND = LRND
-      IEEE1 = LIEEE1
-      RETURN
-*
-*     End of SLAMC1
-*
-      END
-*
-************************************************************************
-*
-      SUBROUTINE SLAMC2( BETA, T, RND, EPS, EMIN, RMIN, EMAX, RMAX )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      LOGICAL            RND
-      INTEGER            BETA, EMAX, EMIN, T
-      REAL               EPS, RMAX, RMIN
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  SLAMC2 determines the machine parameters specified in its argument
-*  list.
-*
-*  Arguments
-*  =========
-*
-*  BETA    (output) INTEGER
-*          The base of the machine.
-*
-*  T       (output) INTEGER
-*          The number of ( BETA ) digits in the mantissa.
-*
-*  RND     (output) LOGICAL
-*          Specifies whether proper rounding  ( RND = .TRUE. )  or
-*          chopping  ( RND = .FALSE. )  occurs in addition. This may not
-*          be a reliable guide to the way in which the machine performs
-*          its arithmetic.
-*
-*  EPS     (output) REAL
-*          The smallest positive number such that
-*
-*             fl( 1.0 - EPS ) .LT. 1.0,
-*
-*          where fl denotes the computed value.
-*
-*  EMIN    (output) INTEGER
-*          The minimum exponent before (gradual) underflow occurs.
-*
-*  RMIN    (output) REAL
-*          The smallest normalized number for the machine, given by
-*          BASE**( EMIN - 1 ), where  BASE  is the floating point value
-*          of BETA.
-*
-*  EMAX    (output) INTEGER
-*          The maximum exponent before overflow occurs.
-*
-*  RMAX    (output) REAL
-*          The largest positive number for the machine, given by
-*          BASE**EMAX * ( 1 - EPS ), where  BASE  is the floating point
-*          value of BETA.
-*
-*  Further Details
-*  ===============
-*
-*  The computation of  EPS  is based on a routine PARANOIA by
-*  W. Kahan of the University of California at Berkeley.
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            FIRST, IEEE, IWARN, LIEEE1, LRND
-      INTEGER            GNMIN, GPMIN, I, LBETA, LEMAX, LEMIN, LT,
-     $                   NGNMIN, NGPMIN
-      REAL               A, B, C, HALF, LEPS, LRMAX, LRMIN, ONE, RBASE,
-     $                   SIXTH, SMALL, THIRD, TWO, ZERO
-*     ..
-*     .. External Functions ..
-      REAL               SLAMC3
-      EXTERNAL           SLAMC3
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           SLAMC1, SLAMC4, SLAMC5
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
-*     ..
-*     .. Save statement ..
-      SAVE               FIRST, IWARN, LBETA, LEMAX, LEMIN, LEPS, LRMAX,
-     $                   LRMIN, LT
-*     ..
-*     .. Data statements ..
-      DATA               FIRST / .TRUE. / , IWARN / .FALSE. /
-*     ..
-*     .. Executable Statements ..
-*
-      IF( FIRST ) THEN
-         FIRST = .FALSE.
-         ZERO = 0
-         ONE = 1
-         TWO = 2
-*
-*        LBETA, LT, LRND, LEPS, LEMIN and LRMIN  are the local values of
-*        BETA, T, RND, EPS, EMIN and RMIN.
-*
-*        Throughout this routine  we use the function  SLAMC3  to ensure
-*        that relevant values are stored  and not held in registers,  or
-*        are not affected by optimizers.
-*
-*        SLAMC1 returns the parameters  LBETA, LT, LRND and LIEEE1.
-*
-         CALL SLAMC1( LBETA, LT, LRND, LIEEE1 )
-*
-*        Start to find EPS.
-*
-         B = LBETA
-         A = B**( -LT )
-         LEPS = A
-*
-*        Try some tricks to see whether or not this is the correct  EPS.
-*
-         B = TWO / 3
-         HALF = ONE / 2
-         SIXTH = SLAMC3( B, -HALF )
-         THIRD = SLAMC3( SIXTH, SIXTH )
-         B = SLAMC3( THIRD, -HALF )
-         B = SLAMC3( B, SIXTH )
-         B = ABS( B )
-         IF( B.LT.LEPS )
-     $      B = LEPS
-*
-         LEPS = 1
-*
-*+       WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP
-   10    CONTINUE
-         IF( ( LEPS.GT.B ) .AND. ( B.GT.ZERO ) ) THEN
-            LEPS = B
-            C = SLAMC3( HALF*LEPS, ( TWO**5 )*( LEPS**2 ) )
-            C = SLAMC3( HALF, -C )
-            B = SLAMC3( HALF, C )
-            C = SLAMC3( HALF, -B )
-            B = SLAMC3( HALF, C )
-            GO TO 10
-         END IF
-*+       END WHILE
-*
-         IF( A.LT.LEPS )
-     $      LEPS = A
-*
-*        Computation of EPS complete.
-*
-*        Now find  EMIN.  Let A = + or - 1, and + or - (1 + BASE**(-3)).
-*        Keep dividing  A by BETA until (gradual) underflow occurs. This
-*        is detected when we cannot recover the previous A.
-*
-         RBASE = ONE / LBETA
-         SMALL = ONE
-         DO 20 I = 1, 3
-            SMALL = SLAMC3( SMALL*RBASE, ZERO )
-   20    CONTINUE
-         A = SLAMC3( ONE, SMALL )
-         CALL SLAMC4( NGPMIN, ONE, LBETA )
-         CALL SLAMC4( NGNMIN, -ONE, LBETA )
-         CALL SLAMC4( GPMIN, A, LBETA )
-         CALL SLAMC4( GNMIN, -A, LBETA )
-         IEEE = .FALSE.
-*
-         IF( ( NGPMIN.EQ.NGNMIN ) .AND. ( GPMIN.EQ.GNMIN ) ) THEN
-            IF( NGPMIN.EQ.GPMIN ) THEN
-               LEMIN = NGPMIN
-*            ( Non twos-complement machines, no gradual underflow;
-*              e.g.,  VAX )
-            ELSE IF( ( GPMIN-NGPMIN ).EQ.3 ) THEN
-               LEMIN = NGPMIN - 1 + LT
-               IEEE = .TRUE.
-*            ( Non twos-complement machines, with gradual underflow;
-*              e.g., IEEE standard followers )
-            ELSE
-               LEMIN = MIN( NGPMIN, GPMIN )
-*            ( A guess; no known machine )
-               IWARN = .TRUE.
-            END IF
-*
-         ELSE IF( ( NGPMIN.EQ.GPMIN ) .AND. ( NGNMIN.EQ.GNMIN ) ) THEN
-            IF( ABS( NGPMIN-NGNMIN ).EQ.1 ) THEN
-               LEMIN = MAX( NGPMIN, NGNMIN )
-*            ( Twos-complement machines, no gradual underflow;
-*              e.g., CYBER 205 )
-            ELSE
-               LEMIN = MIN( NGPMIN, NGNMIN )
-*            ( A guess; no known machine )
-               IWARN = .TRUE.
-            END IF
-*
-         ELSE IF( ( ABS( NGPMIN-NGNMIN ).EQ.1 ) .AND.
-     $            ( GPMIN.EQ.GNMIN ) ) THEN
-            IF( ( GPMIN-MIN( NGPMIN, NGNMIN ) ).EQ.3 ) THEN
-               LEMIN = MAX( NGPMIN, NGNMIN ) - 1 + LT
-*            ( Twos-complement machines with gradual underflow;
-*              no known machine )
-            ELSE
-               LEMIN = MIN( NGPMIN, NGNMIN )
-*            ( A guess; no known machine )
-               IWARN = .TRUE.
-            END IF
-*
-         ELSE
-            LEMIN = MIN( NGPMIN, NGNMIN, GPMIN, GNMIN )
-*         ( A guess; no known machine )
-            IWARN = .TRUE.
-         END IF
-***
-* Comment out this if block if EMIN is ok
-         IF( IWARN ) THEN
-            FIRST = .TRUE.
-            WRITE( 6, FMT = 9999 )LEMIN
-         END IF
-***
-*
-*        Assume IEEE arithmetic if we found denormalised  numbers above,
-*        or if arithmetic seems to round in the  IEEE style,  determined
-*        in routine SLAMC1. A true IEEE machine should have both  things
-*        true; however, faulty machines may have one or the other.
-*
-         IEEE = IEEE .OR. LIEEE1
-*
-*        Compute  RMIN by successive division by  BETA. We could compute
-*        RMIN as BASE**( EMIN - 1 ),  but some machines underflow during
-*        this computation.
-*
-         LRMIN = 1
-         DO 30 I = 1, 1 - LEMIN
-            LRMIN = SLAMC3( LRMIN*RBASE, ZERO )
-   30    CONTINUE
-*
-*        Finally, call SLAMC5 to compute EMAX and RMAX.
-*
-         CALL SLAMC5( LBETA, LT, LEMIN, IEEE, LEMAX, LRMAX )
-      END IF
-*
-      BETA = LBETA
-      T = LT
-      RND = LRND
-      EPS = LEPS
-      EMIN = LEMIN
-      RMIN = LRMIN
-      EMAX = LEMAX
-      RMAX = LRMAX
-*
-      RETURN
-*
- 9999 FORMAT( / / ' WARNING. The value EMIN may be incorrect:-',
-     $      '  EMIN = ', I8, /
-     $      ' If, after inspection, the value EMIN looks',
-     $      ' acceptable please comment out ',
-     $      / ' the IF block as marked within the code of routine',
-     $      ' SLAMC2,', / ' otherwise supply EMIN explicitly.', / )
-*
-*     End of SLAMC2
-*
-      END
-*
-************************************************************************
-*
-      REAL             FUNCTION SLAMC3( A, B )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      REAL               A, B
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  SLAMC3  is intended to force  A  and  B  to be stored prior to doing
-*  the addition of  A  and  B ,  for use in situations where optimizers
-*  might hold one of these in a register.
-*
-*  Arguments
-*  =========
-*
-*  A, B    (input) REAL
-*          The values A and B.
-*
-* =====================================================================
-*
-*     .. Executable Statements ..
-*
-      SLAMC3 = A + B
-*
-      RETURN
-*
-*     End of SLAMC3
-*
-      END
-*
-************************************************************************
-*
-      SUBROUTINE SLAMC4( EMIN, START, BASE )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      INTEGER            BASE, EMIN
-      REAL               START
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  SLAMC4 is a service routine for SLAMC2.
-*
-*  Arguments
-*  =========
-*
-*  EMIN    (output) EMIN
-*          The minimum exponent before (gradual) underflow, computed by
-*          setting A = START and dividing by BASE until the previous A
-*          can not be recovered.
-*
-*  START   (input) REAL
-*          The starting point for determining EMIN.
-*
-*  BASE    (input) INTEGER
-*          The base of the machine.
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I
-      REAL               A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
-*     ..
-*     .. External Functions ..
-      REAL               SLAMC3
-      EXTERNAL           SLAMC3
-*     ..
-*     .. Executable Statements ..
-*
-      A = START
-      ONE = 1
-      RBASE = ONE / BASE
-      ZERO = 0
-      EMIN = 1
-      B1 = SLAMC3( A*RBASE, ZERO )
-      C1 = A
-      C2 = A
-      D1 = A
-      D2 = A
-*+    WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
-*    $       ( D1.EQ.A ).AND.( D2.EQ.A )      )LOOP
-   10 CONTINUE
-      IF( ( C1.EQ.A ) .AND. ( C2.EQ.A ) .AND. ( D1.EQ.A ) .AND.
-     $    ( D2.EQ.A ) ) THEN
-         EMIN = EMIN - 1
-         A = B1
-         B1 = SLAMC3( A / BASE, ZERO )
-         C1 = SLAMC3( B1*BASE, ZERO )
-         D1 = ZERO
-         DO 20 I = 1, BASE
-            D1 = D1 + B1
-   20    CONTINUE
-         B2 = SLAMC3( A*RBASE, ZERO )
-         C2 = SLAMC3( B2 / RBASE, ZERO )
-         D2 = ZERO
-         DO 30 I = 1, BASE
-            D2 = D2 + B2
-   30    CONTINUE
-         GO TO 10
-      END IF
-*+    END WHILE
-*
-      RETURN
-*
-*     End of SLAMC4
-*
-      END
-*
-************************************************************************
-*
-      SUBROUTINE SLAMC5( BETA, P, EMIN, IEEE, EMAX, RMAX )
-*
-*  -- LAPACK auxiliary routine (version 3.0) --
-*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
-*     Courant Institute, Argonne National Lab, and Rice University
-*     October 31, 1992
-*
-*     .. Scalar Arguments ..
-      LOGICAL            IEEE
-      INTEGER            BETA, EMAX, EMIN, P
-      REAL               RMAX
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  SLAMC5 attempts to compute RMAX, the largest machine floating-point
-*  number, without overflow.  It assumes that EMAX + abs(EMIN) sum
-*  approximately to a power of 2.  It will fail on machines where this
-*  assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
-*  EMAX = 28718).  It will also fail if the value supplied for EMIN is
-*  too large (i.e. too close to zero), probably with overflow.
-*
-*  Arguments
-*  =========
-*
-*  BETA    (input) INTEGER
-*          The base of floating-point arithmetic.
-*
-*  P       (input) INTEGER
-*          The number of base BETA digits in the mantissa of a
-*          floating-point value.
-*
-*  EMIN    (input) INTEGER
-*          The minimum exponent before (gradual) underflow.
-*
-*  IEEE    (input) LOGICAL
-*          A logical flag specifying whether or not the arithmetic
-*          system is thought to comply with the IEEE standard.
-*
-*  EMAX    (output) INTEGER
-*          The largest exponent before overflow
-*
-*  RMAX    (output) REAL
-*          The largest machine floating-point number.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      REAL               ZERO, ONE
-      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            EXBITS, EXPSUM, I, LEXP, NBITS, TRY, UEXP
-      REAL               OLDY, RECBAS, Y, Z
-*     ..
-*     .. External Functions ..
-      REAL               SLAMC3
-      EXTERNAL           SLAMC3
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MOD
-*     ..
-*     .. Executable Statements ..
-*
-*     First compute LEXP and UEXP, two powers of 2 that bound
-*     abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
-*     approximately to the bound that is closest to abs(EMIN).
-*     (EMAX is the exponent of the required number RMAX).
-*
-      LEXP = 1
-      EXBITS = 1
-   10 CONTINUE
-      TRY = LEXP*2
-      IF( TRY.LE.( -EMIN ) ) THEN
-         LEXP = TRY
-         EXBITS = EXBITS + 1
-         GO TO 10
-      END IF
-      IF( LEXP.EQ.-EMIN ) THEN
-         UEXP = LEXP
-      ELSE
-         UEXP = TRY
-         EXBITS = EXBITS + 1
-      END IF
-*
-*     Now -LEXP is less than or equal to EMIN, and -UEXP is greater
-*     than or equal to EMIN. EXBITS is the number of bits needed to
-*     store the exponent.
-*
-      IF( ( UEXP+EMIN ).GT.( -LEXP-EMIN ) ) THEN
-         EXPSUM = 2*LEXP
-      ELSE
-         EXPSUM = 2*UEXP
-      END IF
-*
-*     EXPSUM is the exponent range, approximately equal to
-*     EMAX - EMIN + 1 .
-*
-      EMAX = EXPSUM + EMIN - 1
-      NBITS = 1 + EXBITS + P
-*
-*     NBITS is the total number of bits needed to store a
-*     floating-point number.
-*
-      IF( ( MOD( NBITS, 2 ).EQ.1 ) .AND. ( BETA.EQ.2 ) ) THEN
-*
-*        Either there are an odd number of bits used to store a
-*        floating-point number, which is unlikely, or some bits are
-*        not used in the representation of numbers, which is possible,
-*        (e.g. Cray machines) or the mantissa has an implicit bit,
-*        (e.g. IEEE machines, Dec Vax machines), which is perhaps the
-*        most likely. We have to assume the last alternative.
-*        If this is true, then we need to reduce EMAX by one because
-*        there must be some way of representing zero in an implicit-bit
-*        system. On machines like Cray, we are reducing EMAX by one
-*        unnecessarily.
-*
-         EMAX = EMAX - 1
-      END IF
-*
-      IF( IEEE ) THEN
-*
-*        Assume we are on an IEEE machine which reserves one exponent
-*        for infinity and NaN.
-*
-         EMAX = EMAX - 1
-      END IF
-*
-*     Now create RMAX, the largest machine number, which should
-*     be equal to (1.0 - BETA**(-P)) * BETA**EMAX .
-*
-*     First compute 1.0 - BETA**(-P), being careful that the
-*     result is less than 1.0 .
-*
-      RECBAS = ONE / BETA
-      Z = BETA - ONE
-      Y = ZERO
-      DO 20 I = 1, P
-         Z = Z*RECBAS
-         IF( Y.LT.ONE )
-     $      OLDY = Y
-         Y = SLAMC3( Y, Z )
-   20 CONTINUE
-      IF( Y.GE.ONE )
-     $   Y = OLDY
-*
-*     Now multiply by BETA**EMAX to get RMAX.
-*
-      DO 30 I = 1, EMAX
-         Y = SLAMC3( Y*BETA, ZERO )
-   30 CONTINUE
-*
-      RMAX = Y
-      RETURN
-*
-*     End of SLAMC5
-*
-      END
diff --git a/src/lib/lapack/xerbla.f b/src/lib/lapack/xerbla.f
deleted file mode 100644
index c8c9231b..00000000
--- a/src/lib/lapack/xerbla.f
+++ /dev/null
@@ -1,45 +0,0 @@
-      SUBROUTINE XERBLA( SRNAME, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER*6        SRNAME
-      INTEGER            INFO
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  XERBLA  is an error handler for the LAPACK routines.
-*  It is called by an LAPACK routine if an input parameter has an
-*  invalid value.  A message is printed and execution stops.
-*
-*  Installers may consider modifying the STOP statement in order to
-*  call system-specific exception-handling facilities.
-*
-*  Arguments
-*  =========
-*
-*  SRNAME  (input) CHARACTER*6
-*          The name of the routine which called XERBLA.
-*
-*  INFO    (input) INTEGER
-*          The position of the invalid parameter in the parameter list
-*          of the calling routine.
-*
-* =====================================================================
-*
-*     .. Executable Statements ..
-*
-      WRITE( *, FMT = 9999 )SRNAME, INFO
-*
-      STOP
-*
- 9999 FORMAT( ' ** On entry to ', A6, ' parameter number ', I2, ' had ',
-     $      'an illegal value' )
-*
-*     End of XERBLA
-*
-      END
diff --git a/src/lib/lapack/zbdsqr.f b/src/lib/lapack/zbdsqr.f
deleted file mode 100644
index f9086be5..00000000
--- a/src/lib/lapack/zbdsqr.f
+++ /dev/null
@@ -1,742 +0,0 @@
-      SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
-     $                   LDU, C, LDC, RWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * ), RWORK( * )
-      COMPLEX*16         C( LDC, * ), U( LDU, * ), VT( LDVT, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZBDSQR computes the singular values and, optionally, the right and/or
-*  left singular vectors from the singular value decomposition (SVD) of
-*  a real N-by-N (upper or lower) bidiagonal matrix B using the implicit
-*  zero-shift QR algorithm.  The SVD of B has the form
-* 
-*     B = Q * S * P**H
-* 
-*  where S is the diagonal matrix of singular values, Q is an orthogonal
-*  matrix of left singular vectors, and P is an orthogonal matrix of
-*  right singular vectors.  If left singular vectors are requested, this
-*  subroutine actually returns U*Q instead of Q, and, if right singular
-*  vectors are requested, this subroutine returns P**H*VT instead of
-*  P**H, for given complex input matrices U and VT.  When U and VT are
-*  the unitary matrices that reduce a general matrix A to bidiagonal
-*  form: A = U*B*VT, as computed by ZGEBRD, then
-* 
-*     A = (U*Q) * S * (P**H*VT)
-* 
-*  is the SVD of A.  Optionally, the subroutine may also compute Q**H*C
-*  for a given complex input matrix C.
-*
-*  See "Computing  Small Singular Values of Bidiagonal Matrices With
-*  Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
-*  LAPACK Working Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11,
-*  no. 5, pp. 873-912, Sept 1990) and
-*  "Accurate singular values and differential qd algorithms," by
-*  B. Parlett and V. Fernando, Technical Report CPAM-554, Mathematics
-*  Department, University of California at Berkeley, July 1992
-*  for a detailed description of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  B is upper bidiagonal;
-*          = 'L':  B is lower bidiagonal.
-*
-*  N       (input) INTEGER
-*          The order of the matrix B.  N >= 0.
-*
-*  NCVT    (input) INTEGER
-*          The number of columns of the matrix VT. NCVT >= 0.
-*
-*  NRU     (input) INTEGER
-*          The number of rows of the matrix U. NRU >= 0.
-*
-*  NCC     (input) INTEGER
-*          The number of columns of the matrix C. NCC >= 0.
-*
-*  D       (input/output) DOUBLE PRECISION array, dimension (N)
-*          On entry, the n diagonal elements of the bidiagonal matrix B.
-*          On exit, if INFO=0, the singular values of B in decreasing
-*          order.
-*
-*  E       (input/output) DOUBLE PRECISION array, dimension (N-1)
-*          On entry, the N-1 offdiagonal elements of the bidiagonal
-*          matrix B.
-*          On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E
-*          will contain the diagonal and superdiagonal elements of a
-*          bidiagonal matrix orthogonally equivalent to the one given
-*          as input.
-*
-*  VT      (input/output) COMPLEX*16 array, dimension (LDVT, NCVT)
-*          On entry, an N-by-NCVT matrix VT.
-*          On exit, VT is overwritten by P**H * VT.
-*          Not referenced if NCVT = 0.
-*
-*  LDVT    (input) INTEGER
-*          The leading dimension of the array VT.
-*          LDVT >= max(1,N) if NCVT > 0; LDVT >= 1 if NCVT = 0.
-*
-*  U       (input/output) COMPLEX*16 array, dimension (LDU, N)
-*          On entry, an NRU-by-N matrix U.
-*          On exit, U is overwritten by U * Q.
-*          Not referenced if NRU = 0.
-*
-*  LDU     (input) INTEGER
-*          The leading dimension of the array U.  LDU >= max(1,NRU).
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC, NCC)
-*          On entry, an N-by-NCC matrix C.
-*          On exit, C is overwritten by Q**H * C.
-*          Not referenced if NCC = 0.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C.
-*          LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*N)
-*          if NCVT = NRU = NCC = 0, (max(1, 4*N-4)) otherwise
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  If INFO = -i, the i-th argument had an illegal value
-*          > 0:  the algorithm did not converge; D and E contain the
-*                elements of a bidiagonal matrix which is orthogonally
-*                similar to the input matrix B;  if INFO = i, i
-*                elements of E have not converged to zero.
-*
-*  Internal Parameters
-*  ===================
-*
-*  TOLMUL  DOUBLE PRECISION, default = max(10,min(100,EPS**(-1/8)))
-*          TOLMUL controls the convergence criterion of the QR loop.
-*          If it is positive, TOLMUL*EPS is the desired relative
-*             precision in the computed singular values.
-*          If it is negative, abs(TOLMUL*EPS*sigma_max) is the
-*             desired absolute accuracy in the computed singular
-*             values (corresponds to relative accuracy
-*             abs(TOLMUL*EPS) in the largest singular value.
-*          abs(TOLMUL) should be between 1 and 1/EPS, and preferably
-*             between 10 (for fast convergence) and .1/EPS
-*             (for there to be some accuracy in the results).
-*          Default is to lose at either one eighth or 2 of the
-*             available decimal digits in each computed singular value
-*             (whichever is smaller).
-*
-*  MAXITR  INTEGER, default = 6
-*          MAXITR controls the maximum number of passes of the
-*          algorithm through its inner loop. The algorithms stops
-*          (and so fails to converge) if the number of passes
-*          through the inner loop exceeds MAXITR*N**2.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D0 )
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D0 )
-      DOUBLE PRECISION   NEGONE
-      PARAMETER          ( NEGONE = -1.0D0 )
-      DOUBLE PRECISION   HNDRTH
-      PARAMETER          ( HNDRTH = 0.01D0 )
-      DOUBLE PRECISION   TEN
-      PARAMETER          ( TEN = 10.0D0 )
-      DOUBLE PRECISION   HNDRD
-      PARAMETER          ( HNDRD = 100.0D0 )
-      DOUBLE PRECISION   MEIGTH
-      PARAMETER          ( MEIGTH = -0.125D0 )
-      INTEGER            MAXITR
-      PARAMETER          ( MAXITR = 6 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LOWER, ROTATE
-      INTEGER            I, IDIR, ISUB, ITER, J, LL, LLL, M, MAXIT, NM1,
-     $                   NM12, NM13, OLDLL, OLDM
-      DOUBLE PRECISION   ABSE, ABSS, COSL, COSR, CS, EPS, F, G, H, MU,
-     $                   OLDCS, OLDSN, R, SHIFT, SIGMN, SIGMX, SINL,
-     $                   SINR, SLL, SMAX, SMIN, SMINL, SMINOA,
-     $                   SN, THRESH, TOL, TOLMUL, UNFL
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLARTG, DLAS2, DLASQ1, DLASV2, XERBLA, ZDROT,
-     $                   ZDSCAL, ZLASR, ZSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX, MIN, SIGN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      LOWER = LSAME( UPLO, 'L' )
-      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LOWER ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( NCVT.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( NRU.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( NCC.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( ( NCVT.EQ.0 .AND. LDVT.LT.1 ) .OR.
-     $         ( NCVT.GT.0 .AND. LDVT.LT.MAX( 1, N ) ) ) THEN
-         INFO = -9
-      ELSE IF( LDU.LT.MAX( 1, NRU ) ) THEN
-         INFO = -11
-      ELSE IF( ( NCC.EQ.0 .AND. LDC.LT.1 ) .OR.
-     $         ( NCC.GT.0 .AND. LDC.LT.MAX( 1, N ) ) ) THEN
-         INFO = -13
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZBDSQR', -INFO )
-         RETURN
-      END IF
-      IF( N.EQ.0 )
-     $   RETURN
-      IF( N.EQ.1 )
-     $   GO TO 160
-*
-*     ROTATE is true if any singular vectors desired, false otherwise
-*
-      ROTATE = ( NCVT.GT.0 ) .OR. ( NRU.GT.0 ) .OR. ( NCC.GT.0 )
-*
-*     If no singular vectors desired, use qd algorithm
-*
-      IF( .NOT.ROTATE ) THEN
-         CALL DLASQ1( N, D, E, RWORK, INFO )
-         RETURN
-      END IF
-*
-      NM1 = N - 1
-      NM12 = NM1 + NM1
-      NM13 = NM12 + NM1
-      IDIR = 0
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'Epsilon' )
-      UNFL = DLAMCH( 'Safe minimum' )
-*
-*     If matrix lower bidiagonal, rotate to be upper bidiagonal
-*     by applying Givens rotations on the left
-*
-      IF( LOWER ) THEN
-         DO 10 I = 1, N - 1
-            CALL DLARTG( D( I ), E( I ), CS, SN, R )
-            D( I ) = R
-            E( I ) = SN*D( I+1 )
-            D( I+1 ) = CS*D( I+1 )
-            RWORK( I ) = CS
-            RWORK( NM1+I ) = SN
-   10    CONTINUE
-*
-*        Update singular vectors if desired
-*
-         IF( NRU.GT.0 )
-     $      CALL ZLASR( 'R', 'V', 'F', NRU, N, RWORK( 1 ), RWORK( N ),
-     $                  U, LDU )
-         IF( NCC.GT.0 )
-     $      CALL ZLASR( 'L', 'V', 'F', N, NCC, RWORK( 1 ), RWORK( N ),
-     $                  C, LDC )
-      END IF
-*
-*     Compute singular values to relative accuracy TOL
-*     (By setting TOL to be negative, algorithm will compute
-*     singular values to absolute accuracy ABS(TOL)*norm(input matrix))
-*
-      TOLMUL = MAX( TEN, MIN( HNDRD, EPS**MEIGTH ) )
-      TOL = TOLMUL*EPS
-*
-*     Compute approximate maximum, minimum singular values
-*
-      SMAX = ZERO
-      DO 20 I = 1, N
-         SMAX = MAX( SMAX, ABS( D( I ) ) )
-   20 CONTINUE
-      DO 30 I = 1, N - 1
-         SMAX = MAX( SMAX, ABS( E( I ) ) )
-   30 CONTINUE
-      SMINL = ZERO
-      IF( TOL.GE.ZERO ) THEN
-*
-*        Relative accuracy desired
-*
-         SMINOA = ABS( D( 1 ) )
-         IF( SMINOA.EQ.ZERO )
-     $      GO TO 50
-         MU = SMINOA
-         DO 40 I = 2, N
-            MU = ABS( D( I ) )*( MU / ( MU+ABS( E( I-1 ) ) ) )
-            SMINOA = MIN( SMINOA, MU )
-            IF( SMINOA.EQ.ZERO )
-     $         GO TO 50
-   40    CONTINUE
-   50    CONTINUE
-         SMINOA = SMINOA / SQRT( DBLE( N ) )
-         THRESH = MAX( TOL*SMINOA, MAXITR*N*N*UNFL )
-      ELSE
-*
-*        Absolute accuracy desired
-*
-         THRESH = MAX( ABS( TOL )*SMAX, MAXITR*N*N*UNFL )
-      END IF
-*
-*     Prepare for main iteration loop for the singular values
-*     (MAXIT is the maximum number of passes through the inner
-*     loop permitted before nonconvergence signalled.)
-*
-      MAXIT = MAXITR*N*N
-      ITER = 0
-      OLDLL = -1
-      OLDM = -1
-*
-*     M points to last element of unconverged part of matrix
-*
-      M = N
-*
-*     Begin main iteration loop
-*
-   60 CONTINUE
-*
-*     Check for convergence or exceeding iteration count
-*
-      IF( M.LE.1 )
-     $   GO TO 160
-      IF( ITER.GT.MAXIT )
-     $   GO TO 200
-*
-*     Find diagonal block of matrix to work on
-*
-      IF( TOL.LT.ZERO .AND. ABS( D( M ) ).LE.THRESH )
-     $   D( M ) = ZERO
-      SMAX = ABS( D( M ) )
-      SMIN = SMAX
-      DO 70 LLL = 1, M - 1
-         LL = M - LLL
-         ABSS = ABS( D( LL ) )
-         ABSE = ABS( E( LL ) )
-         IF( TOL.LT.ZERO .AND. ABSS.LE.THRESH )
-     $      D( LL ) = ZERO
-         IF( ABSE.LE.THRESH )
-     $      GO TO 80
-         SMIN = MIN( SMIN, ABSS )
-         SMAX = MAX( SMAX, ABSS, ABSE )
-   70 CONTINUE
-      LL = 0
-      GO TO 90
-   80 CONTINUE
-      E( LL ) = ZERO
-*
-*     Matrix splits since E(LL) = 0
-*
-      IF( LL.EQ.M-1 ) THEN
-*
-*        Convergence of bottom singular value, return to top of loop
-*
-         M = M - 1
-         GO TO 60
-      END IF
-   90 CONTINUE
-      LL = LL + 1
-*
-*     E(LL) through E(M-1) are nonzero, E(LL-1) is zero
-*
-      IF( LL.EQ.M-1 ) THEN
-*
-*        2 by 2 block, handle separately
-*
-         CALL DLASV2( D( M-1 ), E( M-1 ), D( M ), SIGMN, SIGMX, SINR,
-     $                COSR, SINL, COSL )
-         D( M-1 ) = SIGMX
-         E( M-1 ) = ZERO
-         D( M ) = SIGMN
-*
-*        Compute singular vectors, if desired
-*
-         IF( NCVT.GT.0 )
-     $      CALL ZDROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT,
-     $                  COSR, SINR )
-         IF( NRU.GT.0 )
-     $      CALL ZDROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL )
-         IF( NCC.GT.0 )
-     $      CALL ZDROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL,
-     $                  SINL )
-         M = M - 2
-         GO TO 60
-      END IF
-*
-*     If working on new submatrix, choose shift direction
-*     (from larger end diagonal element towards smaller)
-*
-      IF( LL.GT.OLDM .OR. M.LT.OLDLL ) THEN
-         IF( ABS( D( LL ) ).GE.ABS( D( M ) ) ) THEN
-*
-*           Chase bulge from top (big end) to bottom (small end)
-*
-            IDIR = 1
-         ELSE
-*
-*           Chase bulge from bottom (big end) to top (small end)
-*
-            IDIR = 2
-         END IF
-      END IF
-*
-*     Apply convergence tests
-*
-      IF( IDIR.EQ.1 ) THEN
-*
-*        Run convergence test in forward direction
-*        First apply standard test to bottom of matrix
-*
-         IF( ABS( E( M-1 ) ).LE.ABS( TOL )*ABS( D( M ) ) .OR.
-     $       ( TOL.LT.ZERO .AND. ABS( E( M-1 ) ).LE.THRESH ) ) THEN
-            E( M-1 ) = ZERO
-            GO TO 60
-         END IF
-*
-         IF( TOL.GE.ZERO ) THEN
-*
-*           If relative accuracy desired,
-*           apply convergence criterion forward
-*
-            MU = ABS( D( LL ) )
-            SMINL = MU
-            DO 100 LLL = LL, M - 1
-               IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
-                  E( LLL ) = ZERO
-                  GO TO 60
-               END IF
-               MU = ABS( D( LLL+1 ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
-               SMINL = MIN( SMINL, MU )
-  100       CONTINUE
-         END IF
-*
-      ELSE
-*
-*        Run convergence test in backward direction
-*        First apply standard test to top of matrix
-*
-         IF( ABS( E( LL ) ).LE.ABS( TOL )*ABS( D( LL ) ) .OR.
-     $       ( TOL.LT.ZERO .AND. ABS( E( LL ) ).LE.THRESH ) ) THEN
-            E( LL ) = ZERO
-            GO TO 60
-         END IF
-*
-         IF( TOL.GE.ZERO ) THEN
-*
-*           If relative accuracy desired,
-*           apply convergence criterion backward
-*
-            MU = ABS( D( M ) )
-            SMINL = MU
-            DO 110 LLL = M - 1, LL, -1
-               IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
-                  E( LLL ) = ZERO
-                  GO TO 60
-               END IF
-               MU = ABS( D( LLL ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
-               SMINL = MIN( SMINL, MU )
-  110       CONTINUE
-         END IF
-      END IF
-      OLDLL = LL
-      OLDM = M
-*
-*     Compute shift.  First, test if shifting would ruin relative
-*     accuracy, and if so set the shift to zero.
-*
-      IF( TOL.GE.ZERO .AND. N*TOL*( SMINL / SMAX ).LE.
-     $    MAX( EPS, HNDRTH*TOL ) ) THEN
-*
-*        Use a zero shift to avoid loss of relative accuracy
-*
-         SHIFT = ZERO
-      ELSE
-*
-*        Compute the shift from 2-by-2 block at end of matrix
-*
-         IF( IDIR.EQ.1 ) THEN
-            SLL = ABS( D( LL ) )
-            CALL DLAS2( D( M-1 ), E( M-1 ), D( M ), SHIFT, R )
-         ELSE
-            SLL = ABS( D( M ) )
-            CALL DLAS2( D( LL ), E( LL ), D( LL+1 ), SHIFT, R )
-         END IF
-*
-*        Test if shift negligible, and if so set to zero
-*
-         IF( SLL.GT.ZERO ) THEN
-            IF( ( SHIFT / SLL )**2.LT.EPS )
-     $         SHIFT = ZERO
-         END IF
-      END IF
-*
-*     Increment iteration count
-*
-      ITER = ITER + M - LL
-*
-*     If SHIFT = 0, do simplified QR iteration
-*
-      IF( SHIFT.EQ.ZERO ) THEN
-         IF( IDIR.EQ.1 ) THEN
-*
-*           Chase bulge from top to bottom
-*           Save cosines and sines for later singular vector updates
-*
-            CS = ONE
-            OLDCS = ONE
-            DO 120 I = LL, M - 1
-               CALL DLARTG( D( I )*CS, E( I ), CS, SN, R )
-               IF( I.GT.LL )
-     $            E( I-1 ) = OLDSN*R
-               CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) )
-               RWORK( I-LL+1 ) = CS
-               RWORK( I-LL+1+NM1 ) = SN
-               RWORK( I-LL+1+NM12 ) = OLDCS
-               RWORK( I-LL+1+NM13 ) = OLDSN
-  120       CONTINUE
-            H = D( M )*CS
-            D( M ) = H*OLDCS
-            E( M-1 ) = H*OLDSN
-*
-*           Update singular vectors
-*
-            IF( NCVT.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCVT, RWORK( 1 ),
-     $                     RWORK( N ), VT( LL, 1 ), LDVT )
-            IF( NRU.GT.0 )
-     $         CALL ZLASR( 'R', 'V', 'F', NRU, M-LL+1, RWORK( NM12+1 ),
-     $                     RWORK( NM13+1 ), U( 1, LL ), LDU )
-            IF( NCC.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCC, RWORK( NM12+1 ),
-     $                     RWORK( NM13+1 ), C( LL, 1 ), LDC )
-*
-*           Test convergence
-*
-            IF( ABS( E( M-1 ) ).LE.THRESH )
-     $         E( M-1 ) = ZERO
-*
-         ELSE
-*
-*           Chase bulge from bottom to top
-*           Save cosines and sines for later singular vector updates
-*
-            CS = ONE
-            OLDCS = ONE
-            DO 130 I = M, LL + 1, -1
-               CALL DLARTG( D( I )*CS, E( I-1 ), CS, SN, R )
-               IF( I.LT.M )
-     $            E( I ) = OLDSN*R
-               CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) )
-               RWORK( I-LL ) = CS
-               RWORK( I-LL+NM1 ) = -SN
-               RWORK( I-LL+NM12 ) = OLDCS
-               RWORK( I-LL+NM13 ) = -OLDSN
-  130       CONTINUE
-            H = D( LL )*CS
-            D( LL ) = H*OLDCS
-            E( LL ) = H*OLDSN
-*
-*           Update singular vectors
-*
-            IF( NCVT.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCVT, RWORK( NM12+1 ),
-     $                     RWORK( NM13+1 ), VT( LL, 1 ), LDVT )
-            IF( NRU.GT.0 )
-     $         CALL ZLASR( 'R', 'V', 'B', NRU, M-LL+1, RWORK( 1 ),
-     $                     RWORK( N ), U( 1, LL ), LDU )
-            IF( NCC.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCC, RWORK( 1 ),
-     $                     RWORK( N ), C( LL, 1 ), LDC )
-*
-*           Test convergence
-*
-            IF( ABS( E( LL ) ).LE.THRESH )
-     $         E( LL ) = ZERO
-         END IF
-      ELSE
-*
-*        Use nonzero shift
-*
-         IF( IDIR.EQ.1 ) THEN
-*
-*           Chase bulge from top to bottom
-*           Save cosines and sines for later singular vector updates
-*
-            F = ( ABS( D( LL ) )-SHIFT )*
-     $          ( SIGN( ONE, D( LL ) )+SHIFT / D( LL ) )
-            G = E( LL )
-            DO 140 I = LL, M - 1
-               CALL DLARTG( F, G, COSR, SINR, R )
-               IF( I.GT.LL )
-     $            E( I-1 ) = R
-               F = COSR*D( I ) + SINR*E( I )
-               E( I ) = COSR*E( I ) - SINR*D( I )
-               G = SINR*D( I+1 )
-               D( I+1 ) = COSR*D( I+1 )
-               CALL DLARTG( F, G, COSL, SINL, R )
-               D( I ) = R
-               F = COSL*E( I ) + SINL*D( I+1 )
-               D( I+1 ) = COSL*D( I+1 ) - SINL*E( I )
-               IF( I.LT.M-1 ) THEN
-                  G = SINL*E( I+1 )
-                  E( I+1 ) = COSL*E( I+1 )
-               END IF
-               RWORK( I-LL+1 ) = COSR
-               RWORK( I-LL+1+NM1 ) = SINR
-               RWORK( I-LL+1+NM12 ) = COSL
-               RWORK( I-LL+1+NM13 ) = SINL
-  140       CONTINUE
-            E( M-1 ) = F
-*
-*           Update singular vectors
-*
-            IF( NCVT.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCVT, RWORK( 1 ),
-     $                     RWORK( N ), VT( LL, 1 ), LDVT )
-            IF( NRU.GT.0 )
-     $         CALL ZLASR( 'R', 'V', 'F', NRU, M-LL+1, RWORK( NM12+1 ),
-     $                     RWORK( NM13+1 ), U( 1, LL ), LDU )
-            IF( NCC.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCC, RWORK( NM12+1 ),
-     $                     RWORK( NM13+1 ), C( LL, 1 ), LDC )
-*
-*           Test convergence
-*
-            IF( ABS( E( M-1 ) ).LE.THRESH )
-     $         E( M-1 ) = ZERO
-*
-         ELSE
-*
-*           Chase bulge from bottom to top
-*           Save cosines and sines for later singular vector updates
-*
-            F = ( ABS( D( M ) )-SHIFT )*( SIGN( ONE, D( M ) )+SHIFT /
-     $          D( M ) )
-            G = E( M-1 )
-            DO 150 I = M, LL + 1, -1
-               CALL DLARTG( F, G, COSR, SINR, R )
-               IF( I.LT.M )
-     $            E( I ) = R
-               F = COSR*D( I ) + SINR*E( I-1 )
-               E( I-1 ) = COSR*E( I-1 ) - SINR*D( I )
-               G = SINR*D( I-1 )
-               D( I-1 ) = COSR*D( I-1 )
-               CALL DLARTG( F, G, COSL, SINL, R )
-               D( I ) = R
-               F = COSL*E( I-1 ) + SINL*D( I-1 )
-               D( I-1 ) = COSL*D( I-1 ) - SINL*E( I-1 )
-               IF( I.GT.LL+1 ) THEN
-                  G = SINL*E( I-2 )
-                  E( I-2 ) = COSL*E( I-2 )
-               END IF
-               RWORK( I-LL ) = COSR
-               RWORK( I-LL+NM1 ) = -SINR
-               RWORK( I-LL+NM12 ) = COSL
-               RWORK( I-LL+NM13 ) = -SINL
-  150       CONTINUE
-            E( LL ) = F
-*
-*           Test convergence
-*
-            IF( ABS( E( LL ) ).LE.THRESH )
-     $         E( LL ) = ZERO
-*
-*           Update singular vectors if desired
-*
-            IF( NCVT.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCVT, RWORK( NM12+1 ),
-     $                     RWORK( NM13+1 ), VT( LL, 1 ), LDVT )
-            IF( NRU.GT.0 )
-     $         CALL ZLASR( 'R', 'V', 'B', NRU, M-LL+1, RWORK( 1 ),
-     $                     RWORK( N ), U( 1, LL ), LDU )
-            IF( NCC.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCC, RWORK( 1 ),
-     $                     RWORK( N ), C( LL, 1 ), LDC )
-         END IF
-      END IF
-*
-*     QR iteration finished, go back and check convergence
-*
-      GO TO 60
-*
-*     All singular values converged, so make them positive
-*
-  160 CONTINUE
-      DO 170 I = 1, N
-         IF( D( I ).LT.ZERO ) THEN
-            D( I ) = -D( I )
-*
-*           Change sign of singular vectors, if desired
-*
-            IF( NCVT.GT.0 )
-     $         CALL ZDSCAL( NCVT, NEGONE, VT( I, 1 ), LDVT )
-         END IF
-  170 CONTINUE
-*
-*     Sort the singular values into decreasing order (insertion sort on
-*     singular values, but only one transposition per singular vector)
-*
-      DO 190 I = 1, N - 1
-*
-*        Scan for smallest D(I)
-*
-         ISUB = 1
-         SMIN = D( 1 )
-         DO 180 J = 2, N + 1 - I
-            IF( D( J ).LE.SMIN ) THEN
-               ISUB = J
-               SMIN = D( J )
-            END IF
-  180    CONTINUE
-         IF( ISUB.NE.N+1-I ) THEN
-*
-*           Swap singular values and vectors
-*
-            D( ISUB ) = D( N+1-I )
-            D( N+1-I ) = SMIN
-            IF( NCVT.GT.0 )
-     $         CALL ZSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( N+1-I, 1 ),
-     $                     LDVT )
-            IF( NRU.GT.0 )
-     $         CALL ZSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 )
-            IF( NCC.GT.0 )
-     $         CALL ZSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC )
-         END IF
-  190 CONTINUE
-      GO TO 220
-*
-*     Maximum number of iterations exceeded, failure to converge
-*
-  200 CONTINUE
-      INFO = 0
-      DO 210 I = 1, N - 1
-         IF( E( I ).NE.ZERO )
-     $      INFO = INFO + 1
-  210 CONTINUE
-  220 CONTINUE
-      RETURN
-*
-*     End of ZBDSQR
-*
-      END
diff --git a/src/lib/lapack/zdrot.f b/src/lib/lapack/zdrot.f
deleted file mode 100644
index 3b946e99..00000000
--- a/src/lib/lapack/zdrot.f
+++ /dev/null
@@ -1,96 +0,0 @@
-      SUBROUTINE ZDROT( N, CX, INCX, CY, INCY, C, S )
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, INCY, N
-      DOUBLE PRECISION   C, S
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         CX( * ), CY( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  Applies a plane rotation, where the cos and sin (c and s) are real
-*  and the vectors cx and cy are complex.
-*  jack dongarra, linpack, 3/11/78.
-*
-*  Arguments
-*  ==========
-*
-*  N        (input) INTEGER
-*           On entry, N specifies the order of the vectors cx and cy.
-*           N must be at least zero.
-*           Unchanged on exit.
-*
-*  CX       (input) COMPLEX*16 array, dimension at least
-*           ( 1 + ( N - 1 )*abs( INCX ) ).
-*           Before entry, the incremented array CX must contain the n
-*           element vector cx. On exit, CX is overwritten by the updated
-*           vector cx.
-*
-*  INCX     (input) INTEGER
-*           On entry, INCX specifies the increment for the elements of
-*           CX. INCX must not be zero.
-*           Unchanged on exit.
-*
-*  CY       (input) COMPLEX*16 array, dimension at least
-*           ( 1 + ( N - 1 )*abs( INCY ) ).
-*           Before entry, the incremented array CY must contain the n
-*           element vector cy. On exit, CY is overwritten by the updated
-*           vector cy.
-*
-*  INCY     (input) INTEGER
-*           On entry, INCY specifies the increment for the elements of
-*           CY. INCY must not be zero.
-*           Unchanged on exit.
-*
-*  C        (input) DOUBLE PRECISION
-*           On entry, C specifies the cosine, cos.
-*           Unchanged on exit.
-*
-*  S        (input) DOUBLE PRECISION
-*           On entry, S specifies the sine, sin.
-*           Unchanged on exit.
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, IX, IY
-      COMPLEX*16         CTEMP
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.LE.0 )
-     $   RETURN
-      IF( INCX.EQ.1 .AND. INCY.EQ.1 )
-     $   GO TO 20
-*
-*        code for unequal increments or equal increments not equal
-*          to 1
-*
-      IX = 1
-      IY = 1
-      IF( INCX.LT.0 )
-     $   IX = ( -N+1 )*INCX + 1
-      IF( INCY.LT.0 )
-     $   IY = ( -N+1 )*INCY + 1
-      DO 10 I = 1, N
-         CTEMP = C*CX( IX ) + S*CY( IY )
-         CY( IY ) = C*CY( IY ) - S*CX( IX )
-         CX( IX ) = CTEMP
-         IX = IX + INCX
-         IY = IY + INCY
-   10 CONTINUE
-      RETURN
-*
-*        code for both increments equal to 1
-*
-   20 CONTINUE
-      DO 30 I = 1, N
-         CTEMP = C*CX( I ) + S*CY( I )
-         CY( I ) = C*CY( I ) - S*CX( I )
-         CX( I ) = CTEMP
-   30 CONTINUE
-      RETURN
-      END
diff --git a/src/lib/lapack/zdrscl.f b/src/lib/lapack/zdrscl.f
deleted file mode 100644
index 11686d0b..00000000
--- a/src/lib/lapack/zdrscl.f
+++ /dev/null
@@ -1,114 +0,0 @@
-      SUBROUTINE ZDRSCL( N, SA, SX, INCX )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-      DOUBLE PRECISION   SA
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         SX( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZDRSCL multiplies an n-element complex vector x by the real scalar
-*  1/a.  This is done without overflow or underflow as long as
-*  the final result x/a does not overflow or underflow.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of components of the vector x.
-*
-*  SA      (input) DOUBLE PRECISION
-*          The scalar a which is used to divide each component of x.
-*          SA must be >= 0, or the subroutine will divide by zero.
-*
-*  SX      (input/output) COMPLEX*16 array, dimension
-*                         (1+(N-1)*abs(INCX))
-*          The n-element vector x.
-*
-*  INCX    (input) INTEGER
-*          The increment between successive values of the vector SX.
-*          > 0:  SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i),     1< i<= n
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            DONE
-      DOUBLE PRECISION   BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, ZDSCAL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-*     Get machine parameters
-*
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Initialize the denominator to SA and the numerator to 1.
-*
-      CDEN = SA
-      CNUM = ONE
-*
-   10 CONTINUE
-      CDEN1 = CDEN*SMLNUM
-      CNUM1 = CNUM / BIGNUM
-      IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
-*
-*        Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
-*
-         MUL = SMLNUM
-         DONE = .FALSE.
-         CDEN = CDEN1
-      ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
-*
-*        Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
-*
-         MUL = BIGNUM
-         DONE = .FALSE.
-         CNUM = CNUM1
-      ELSE
-*
-*        Multiply X by CNUM / CDEN and return.
-*
-         MUL = CNUM / CDEN
-         DONE = .TRUE.
-      END IF
-*
-*     Scale the vector X by MUL
-*
-      CALL ZDSCAL( N, MUL, SX, INCX )
-*
-      IF( .NOT.DONE )
-     $   GO TO 10
-*
-      RETURN
-*
-*     End of ZDRSCL
-*
-      END
diff --git a/src/lib/lapack/zgebak.f b/src/lib/lapack/zgebak.f
deleted file mode 100644
index 1023601d..00000000
--- a/src/lib/lapack/zgebak.f
+++ /dev/null
@@ -1,189 +0,0 @@
-      SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOB, SIDE
-      INTEGER            IHI, ILO, INFO, LDV, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   SCALE( * )
-      COMPLEX*16         V( LDV, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEBAK forms the right or left eigenvectors of a complex general
-*  matrix by backward transformation on the computed eigenvectors of the
-*  balanced matrix output by ZGEBAL.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          Specifies the type of backward transformation required:
-*          = 'N', do nothing, return immediately;
-*          = 'P', do backward transformation for permutation only;
-*          = 'S', do backward transformation for scaling only;
-*          = 'B', do backward transformations for both permutation and
-*                 scaling.
-*          JOB must be the same as the argument JOB supplied to ZGEBAL.
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'R':  V contains right eigenvectors;
-*          = 'L':  V contains left eigenvectors.
-*
-*  N       (input) INTEGER
-*          The number of rows of the matrix V.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          The integers ILO and IHI determined by ZGEBAL.
-*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-*  SCALE   (input) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutation and scaling factors, as returned
-*          by ZGEBAL.
-*
-*  M       (input) INTEGER
-*          The number of columns of the matrix V.  M >= 0.
-*
-*  V       (input/output) COMPLEX*16 array, dimension (LDV,M)
-*          On entry, the matrix of right or left eigenvectors to be
-*          transformed, as returned by ZHSEIN or ZTREVC.
-*          On exit, V is overwritten by the transformed eigenvectors.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V. LDV >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFTV, RIGHTV
-      INTEGER            I, II, K
-      DOUBLE PRECISION   S
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZDSCAL, ZSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and Test the input parameters
-*
-      RIGHTV = LSAME( SIDE, 'R' )
-      LEFTV = LSAME( SIDE, 'L' )
-*
-      INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
-         INFO = -4
-      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
-         INFO = -5
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -7
-      ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGEBAK', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-      IF( M.EQ.0 )
-     $   RETURN
-      IF( LSAME( JOB, 'N' ) )
-     $   RETURN
-*
-      IF( ILO.EQ.IHI )
-     $   GO TO 30
-*
-*     Backward balance
-*
-      IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
-         IF( RIGHTV ) THEN
-            DO 10 I = ILO, IHI
-               S = SCALE( I )
-               CALL ZDSCAL( M, S, V( I, 1 ), LDV )
-   10       CONTINUE
-         END IF
-*
-         IF( LEFTV ) THEN
-            DO 20 I = ILO, IHI
-               S = ONE / SCALE( I )
-               CALL ZDSCAL( M, S, V( I, 1 ), LDV )
-   20       CONTINUE
-         END IF
-*
-      END IF
-*
-*     Backward permutation
-*
-*     For  I = ILO-1 step -1 until 1,
-*              IHI+1 step 1 until N do --
-*
-   30 CONTINUE
-      IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
-         IF( RIGHTV ) THEN
-            DO 40 II = 1, N
-               I = II
-               IF( I.GE.ILO .AND. I.LE.IHI )
-     $            GO TO 40
-               IF( I.LT.ILO )
-     $            I = ILO - II
-               K = SCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 40
-               CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-   40       CONTINUE
-         END IF
-*
-         IF( LEFTV ) THEN
-            DO 50 II = 1, N
-               I = II
-               IF( I.GE.ILO .AND. I.LE.IHI )
-     $            GO TO 50
-               IF( I.LT.ILO )
-     $            I = ILO - II
-               K = SCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 50
-               CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-   50       CONTINUE
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of ZGEBAK
-*
-      END
diff --git a/src/lib/lapack/zgebal.f b/src/lib/lapack/zgebal.f
deleted file mode 100644
index 67ac2e14..00000000
--- a/src/lib/lapack/zgebal.f
+++ /dev/null
@@ -1,330 +0,0 @@
-      SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOB
-      INTEGER            IHI, ILO, INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   SCALE( * )
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEBAL balances a general complex matrix A.  This involves, first,
-*  permuting A by a similarity transformation to isolate eigenvalues
-*  in the first 1 to ILO-1 and last IHI+1 to N elements on the
-*  diagonal; and second, applying a diagonal similarity transformation
-*  to rows and columns ILO to IHI to make the rows and columns as
-*  close in norm as possible.  Both steps are optional.
-*
-*  Balancing may reduce the 1-norm of the matrix, and improve the
-*  accuracy of the computed eigenvalues and/or eigenvectors.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          Specifies the operations to be performed on A:
-*          = 'N':  none:  simply set ILO = 1, IHI = N, SCALE(I) = 1.0
-*                  for i = 1,...,N;
-*          = 'P':  permute only;
-*          = 'S':  scale only;
-*          = 'B':  both permute and scale.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the input matrix A.
-*          On exit,  A is overwritten by the balanced matrix.
-*          If JOB = 'N', A is not referenced.
-*          See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  ILO     (output) INTEGER
-*  IHI     (output) INTEGER
-*          ILO and IHI are set to integers such that on exit
-*          A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
-*          If JOB = 'N' or 'S', ILO = 1 and IHI = N.
-*
-*  SCALE   (output) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutations and scaling factors applied to
-*          A.  If P(j) is the index of the row and column interchanged
-*          with row and column j and D(j) is the scaling factor
-*          applied to row and column j, then
-*          SCALE(j) = P(j)    for j = 1,...,ILO-1
-*                   = D(j)    for j = ILO,...,IHI
-*                   = P(j)    for j = IHI+1,...,N.
-*          The order in which the interchanges are made is N to IHI+1,
-*          then 1 to ILO-1.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The permutations consist of row and column interchanges which put
-*  the matrix in the form
-*
-*             ( T1   X   Y  )
-*     P A P = (  0   B   Z  )
-*             (  0   0   T2 )
-*
-*  where T1 and T2 are upper triangular matrices whose eigenvalues lie
-*  along the diagonal.  The column indices ILO and IHI mark the starting
-*  and ending columns of the submatrix B. Balancing consists of applying
-*  a diagonal similarity transformation inv(D) * B * D to make the
-*  1-norms of each row of B and its corresponding column nearly equal.
-*  The output matrix is
-*
-*     ( T1     X*D          Y    )
-*     (  0  inv(D)*B*D  inv(D)*Z ).
-*     (  0      0           T2   )
-*
-*  Information about the permutations P and the diagonal matrix D is
-*  returned in the vector SCALE.
-*
-*  This subroutine is based on the EISPACK routine CBAL.
-*
-*  Modified by Tzu-Yi Chen, Computer Science Division, University of
-*    California at Berkeley, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-      DOUBLE PRECISION   SCLFAC
-      PARAMETER          ( SCLFAC = 2.0D+0 )
-      DOUBLE PRECISION   FACTOR
-      PARAMETER          ( FACTOR = 0.95D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOCONV
-      INTEGER            I, ICA, IEXC, IRA, J, K, L, M
-      DOUBLE PRECISION   C, CA, F, G, R, RA, S, SFMAX1, SFMAX2, SFMIN1,
-     $                   SFMIN2
-      COMPLEX*16         CDUM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IZAMAX
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, IZAMAX, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZDSCAL, ZSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DIMAG, MAX, MIN
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
-         INFO = -1
-      ELSE IF( 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( 'ZGEBAL', -INFO )
-         RETURN
-      END IF
-*
-      K = 1
-      L = N
-*
-      IF( N.EQ.0 )
-     $   GO TO 210
-*
-      IF( LSAME( JOB, 'N' ) ) THEN
-         DO 10 I = 1, N
-            SCALE( I ) = ONE
-   10    CONTINUE
-         GO TO 210
-      END IF
-*
-      IF( LSAME( JOB, 'S' ) )
-     $   GO TO 120
-*
-*     Permutation to isolate eigenvalues if possible
-*
-      GO TO 50
-*
-*     Row and column exchange.
-*
-   20 CONTINUE
-      SCALE( M ) = J
-      IF( J.EQ.M )
-     $   GO TO 30
-*
-      CALL ZSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
-      CALL ZSWAP( N-K+1, A( J, K ), LDA, A( M, K ), LDA )
-*
-   30 CONTINUE
-      GO TO ( 40, 80 )IEXC
-*
-*     Search for rows isolating an eigenvalue and push them down.
-*
-   40 CONTINUE
-      IF( L.EQ.1 )
-     $   GO TO 210
-      L = L - 1
-*
-   50 CONTINUE
-      DO 70 J = L, 1, -1
-*
-         DO 60 I = 1, L
-            IF( I.EQ.J )
-     $         GO TO 60
-            IF( DBLE( A( J, I ) ).NE.ZERO .OR. DIMAG( A( J, I ) ).NE.
-     $          ZERO )GO TO 70
-   60    CONTINUE
-*
-         M = L
-         IEXC = 1
-         GO TO 20
-   70 CONTINUE
-*
-      GO TO 90
-*
-*     Search for columns isolating an eigenvalue and push them left.
-*
-   80 CONTINUE
-      K = K + 1
-*
-   90 CONTINUE
-      DO 110 J = K, L
-*
-         DO 100 I = K, L
-            IF( I.EQ.J )
-     $         GO TO 100
-            IF( DBLE( A( I, J ) ).NE.ZERO .OR. DIMAG( A( I, J ) ).NE.
-     $          ZERO )GO TO 110
-  100    CONTINUE
-*
-         M = K
-         IEXC = 2
-         GO TO 20
-  110 CONTINUE
-*
-  120 CONTINUE
-      DO 130 I = K, L
-         SCALE( I ) = ONE
-  130 CONTINUE
-*
-      IF( LSAME( JOB, 'P' ) )
-     $   GO TO 210
-*
-*     Balance the submatrix in rows K to L.
-*
-*     Iterative loop for norm reduction
-*
-      SFMIN1 = DLAMCH( 'S' ) / DLAMCH( 'P' )
-      SFMAX1 = ONE / SFMIN1
-      SFMIN2 = SFMIN1*SCLFAC
-      SFMAX2 = ONE / SFMIN2
-  140 CONTINUE
-      NOCONV = .FALSE.
-*
-      DO 200 I = K, L
-         C = ZERO
-         R = ZERO
-*
-         DO 150 J = K, L
-            IF( J.EQ.I )
-     $         GO TO 150
-            C = C + CABS1( A( J, I ) )
-            R = R + CABS1( A( I, J ) )
-  150    CONTINUE
-         ICA = IZAMAX( L, A( 1, I ), 1 )
-         CA = ABS( A( ICA, I ) )
-         IRA = IZAMAX( N-K+1, A( I, K ), LDA )
-         RA = ABS( A( I, IRA+K-1 ) )
-*
-*        Guard against zero C or R due to underflow.
-*
-         IF( C.EQ.ZERO .OR. R.EQ.ZERO )
-     $      GO TO 200
-         G = R / SCLFAC
-         F = ONE
-         S = C + R
-  160    CONTINUE
-         IF( C.GE.G .OR. MAX( F, C, CA ).GE.SFMAX2 .OR.
-     $       MIN( R, G, RA ).LE.SFMIN2 )GO TO 170
-         F = F*SCLFAC
-         C = C*SCLFAC
-         CA = CA*SCLFAC
-         R = R / SCLFAC
-         G = G / SCLFAC
-         RA = RA / SCLFAC
-         GO TO 160
-*
-  170    CONTINUE
-         G = C / SCLFAC
-  180    CONTINUE
-         IF( G.LT.R .OR. MAX( R, RA ).GE.SFMAX2 .OR.
-     $       MIN( F, C, G, CA ).LE.SFMIN2 )GO TO 190
-         F = F / SCLFAC
-         C = C / SCLFAC
-         G = G / SCLFAC
-         CA = CA / SCLFAC
-         R = R*SCLFAC
-         RA = RA*SCLFAC
-         GO TO 180
-*
-*        Now balance.
-*
-  190    CONTINUE
-         IF( ( C+R ).GE.FACTOR*S )
-     $      GO TO 200
-         IF( F.LT.ONE .AND. SCALE( I ).LT.ONE ) THEN
-            IF( F*SCALE( I ).LE.SFMIN1 )
-     $         GO TO 200
-         END IF
-         IF( F.GT.ONE .AND. SCALE( I ).GT.ONE ) THEN
-            IF( SCALE( I ).GE.SFMAX1 / F )
-     $         GO TO 200
-         END IF
-         G = ONE / F
-         SCALE( I ) = SCALE( I )*F
-         NOCONV = .TRUE.
-*
-         CALL ZDSCAL( N-K+1, G, A( I, K ), LDA )
-         CALL ZDSCAL( L, F, A( 1, I ), 1 )
-*
-  200 CONTINUE
-*
-      IF( NOCONV )
-     $   GO TO 140
-*
-  210 CONTINUE
-      ILO = K
-      IHI = L
-*
-      RETURN
-*
-*     End of ZGEBAL
-*
-      END
diff --git a/src/lib/lapack/zgebd2.f b/src/lib/lapack/zgebd2.f
deleted file mode 100644
index 5ba52e87..00000000
--- a/src/lib/lapack/zgebd2.f
+++ /dev/null
@@ -1,250 +0,0 @@
-      SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * )
-      COMPLEX*16         A( LDA, * ), TAUP( * ), TAUQ( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEBD2 reduces a complex general m by n matrix A to upper or lower
-*  real bidiagonal form B by a unitary transformation: Q' * A * P = B.
-*
-*  If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows in the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns in the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the m by n general matrix to be reduced.
-*          On exit,
-*          if m >= n, the diagonal and the first superdiagonal are
-*            overwritten with the upper bidiagonal matrix B; the
-*            elements below the diagonal, with the array TAUQ, represent
-*            the unitary matrix Q as a product of elementary
-*            reflectors, and the elements above the first superdiagonal,
-*            with the array TAUP, represent the unitary matrix P as
-*            a product of elementary reflectors;
-*          if m < n, the diagonal and the first subdiagonal are
-*            overwritten with the lower bidiagonal matrix B; the
-*            elements below the first subdiagonal, with the array TAUQ,
-*            represent the unitary matrix Q as a product of
-*            elementary reflectors, and the elements above the diagonal,
-*            with the array TAUP, represent the unitary matrix P as
-*            a product of elementary reflectors.
-*          See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  D       (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The diagonal elements of the bidiagonal matrix B:
-*          D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
-*          The off-diagonal elements of the bidiagonal matrix B:
-*          if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
-*          if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
-*
-*  TAUQ    (output) COMPLEX*16 array dimension (min(M,N))
-*          The scalar factors of the elementary reflectors which
-*          represent the unitary matrix Q. See Further Details.
-*
-*  TAUP    (output) COMPLEX*16 array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors which
-*          represent the unitary matrix P. See Further Details.
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (max(M,N))
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The matrices Q and P are represented as products of elementary
-*  reflectors:
-*
-*  If m >= n,
-*
-*     Q = H(1) H(2) . . . H(n)  and  P = G(1) G(2) . . . G(n-1)
-*
-*  Each H(i) and G(i) has the form:
-*
-*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'
-*
-*  where tauq and taup are complex scalars, and v and u are complex
-*  vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in
-*  A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in
-*  A(i,i+2:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  If m < n,
-*
-*     Q = H(1) H(2) . . . H(m-1)  and  P = G(1) G(2) . . . G(m)
-*
-*  Each H(i) and G(i) has the form:
-*
-*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'
-*
-*  where tauq and taup are complex scalars, v and u are complex vectors;
-*  v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
-*  u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
-*  tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  The contents of A on exit are illustrated by the following examples:
-*
-*  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):
-*
-*    (  d   e   u1  u1  u1 )           (  d   u1  u1  u1  u1  u1 )
-*    (  v1  d   e   u2  u2 )           (  e   d   u2  u2  u2  u2 )
-*    (  v1  v2  d   e   u3 )           (  v1  e   d   u3  u3  u3 )
-*    (  v1  v2  v3  d   e  )           (  v1  v2  e   d   u4  u4 )
-*    (  v1  v2  v3  v4  d  )           (  v1  v2  v3  e   d   u5 )
-*    (  v1  v2  v3  v4  v5 )
-*
-*  where d and e denote diagonal and off-diagonal elements of B, vi
-*  denotes an element of the vector defining H(i), and ui an element of
-*  the vector defining G(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-      COMPLEX*16         ALPHA
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACGV, ZLARF, ZLARFG
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.LT.0 ) THEN
-         CALL XERBLA( 'ZGEBD2', -INFO )
-         RETURN
-      END IF
-*
-      IF( M.GE.N ) THEN
-*
-*        Reduce to upper bidiagonal form
-*
-         DO 10 I = 1, N
-*
-*           Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
-            ALPHA = A( I, I )
-            CALL ZLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
-     $                   TAUQ( I ) )
-            D( I ) = ALPHA
-            A( I, I ) = ONE
-*
-*           Apply H(i)' to A(i:m,i+1:n) from the left
-*
-            IF( I.LT.N )
-     $         CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
-     $                     DCONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
-            A( I, I ) = D( I )
-*
-            IF( I.LT.N ) THEN
-*
-*              Generate elementary reflector G(i) to annihilate
-*              A(i,i+2:n)
-*
-               CALL ZLACGV( N-I, A( I, I+1 ), LDA )
-               ALPHA = A( I, I+1 )
-               CALL ZLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ), LDA,
-     $                      TAUP( I ) )
-               E( I ) = ALPHA
-               A( I, I+1 ) = ONE
-*
-*              Apply G(i) to A(i+1:m,i+1:n) from the right
-*
-               CALL ZLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
-     $                     TAUP( I ), A( I+1, I+1 ), LDA, WORK )
-               CALL ZLACGV( N-I, A( I, I+1 ), LDA )
-               A( I, I+1 ) = E( I )
-            ELSE
-               TAUP( I ) = ZERO
-            END IF
-   10    CONTINUE
-      ELSE
-*
-*        Reduce to lower bidiagonal form
-*
-         DO 20 I = 1, M
-*
-*           Generate elementary reflector G(i) to annihilate A(i,i+1:n)
-*
-            CALL ZLACGV( N-I+1, A( I, I ), LDA )
-            ALPHA = A( I, I )
-            CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
-     $                   TAUP( I ) )
-            D( I ) = ALPHA
-            A( I, I ) = ONE
-*
-*           Apply G(i) to A(i+1:m,i:n) from the right
-*
-            IF( I.LT.M )
-     $         CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
-     $                     TAUP( I ), A( I+1, I ), LDA, WORK )
-            CALL ZLACGV( N-I+1, A( I, I ), LDA )
-            A( I, I ) = D( I )
-*
-            IF( I.LT.M ) THEN
-*
-*              Generate elementary reflector H(i) to annihilate
-*              A(i+2:m,i)
-*
-               ALPHA = A( I+1, I )
-               CALL ZLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
-     $                      TAUQ( I ) )
-               E( I ) = ALPHA
-               A( I+1, I ) = ONE
-*
-*              Apply H(i)' to A(i+1:m,i+1:n) from the left
-*
-               CALL ZLARF( 'Left', M-I, N-I, A( I+1, I ), 1,
-     $                     DCONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
-     $                     WORK )
-               A( I+1, I ) = E( I )
-            ELSE
-               TAUQ( I ) = ZERO
-            END IF
-   20    CONTINUE
-      END IF
-      RETURN
-*
-*     End of ZGEBD2
-*
-      END
diff --git a/src/lib/lapack/zgebrd.f b/src/lib/lapack/zgebrd.f
deleted file mode 100644
index 4f97bd7e..00000000
--- a/src/lib/lapack/zgebrd.f
+++ /dev/null
@@ -1,268 +0,0 @@
-      SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * )
-      COMPLEX*16         A( LDA, * ), TAUP( * ), TAUQ( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEBRD reduces a general complex M-by-N matrix A to upper or lower
-*  bidiagonal form B by a unitary transformation: Q**H * A * P = B.
-*
-*  If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows in the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns in the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the M-by-N general matrix to be reduced.
-*          On exit,
-*          if m >= n, the diagonal and the first superdiagonal are
-*            overwritten with the upper bidiagonal matrix B; the
-*            elements below the diagonal, with the array TAUQ, represent
-*            the unitary matrix Q as a product of elementary
-*            reflectors, and the elements above the first superdiagonal,
-*            with the array TAUP, represent the unitary matrix P as
-*            a product of elementary reflectors;
-*          if m < n, the diagonal and the first subdiagonal are
-*            overwritten with the lower bidiagonal matrix B; the
-*            elements below the first subdiagonal, with the array TAUQ,
-*            represent the unitary matrix Q as a product of
-*            elementary reflectors, and the elements above the diagonal,
-*            with the array TAUP, represent the unitary matrix P as
-*            a product of elementary reflectors.
-*          See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  D       (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The diagonal elements of the bidiagonal matrix B:
-*          D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
-*          The off-diagonal elements of the bidiagonal matrix B:
-*          if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
-*          if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
-*
-*  TAUQ    (output) COMPLEX*16 array dimension (min(M,N))
-*          The scalar factors of the elementary reflectors which
-*          represent the unitary matrix Q. See Further Details.
-*
-*  TAUP    (output) COMPLEX*16 array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors which
-*          represent the unitary matrix P. See Further Details.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The length of the array WORK.  LWORK >= max(1,M,N).
-*          For optimum performance LWORK >= (M+N)*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The matrices Q and P are represented as products of elementary
-*  reflectors:
-*
-*  If m >= n,
-*
-*     Q = H(1) H(2) . . . H(n)  and  P = G(1) G(2) . . . G(n-1)
-*
-*  Each H(i) and G(i) has the form:
-*
-*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'
-*
-*  where tauq and taup are complex scalars, and v and u are complex
-*  vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in
-*  A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in
-*  A(i,i+2:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  If m < n,
-*
-*     Q = H(1) H(2) . . . H(m-1)  and  P = G(1) G(2) . . . G(m)
-*
-*  Each H(i) and G(i) has the form:
-*
-*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'
-*
-*  where tauq and taup are complex scalars, and v and u are complex
-*  vectors; v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in
-*  A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in
-*  A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  The contents of A on exit are illustrated by the following examples:
-*
-*  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):
-*
-*    (  d   e   u1  u1  u1 )           (  d   u1  u1  u1  u1  u1 )
-*    (  v1  d   e   u2  u2 )           (  e   d   u2  u2  u2  u2 )
-*    (  v1  v2  d   e   u3 )           (  v1  e   d   u3  u3  u3 )
-*    (  v1  v2  v3  d   e  )           (  v1  v2  e   d   u4  u4 )
-*    (  v1  v2  v3  v4  d  )           (  v1  v2  v3  e   d   u5 )
-*    (  v1  v2  v3  v4  v5 )
-*
-*  where d and e denote diagonal and off-diagonal elements of B, vi
-*  denotes an element of the vector defining H(i), and ui an element of
-*  the vector defining G(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
-     $                   NBMIN, NX
-      DOUBLE PRECISION   WS
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEBD2, ZGEMM, ZLABRD
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      NB = MAX( 1, ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) )
-      LWKOPT = ( M+N )*NB
-      WORK( 1 ) = DBLE( LWKOPT )
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.LT.0 ) THEN
-         CALL XERBLA( 'ZGEBRD', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      MINMN = MIN( M, N )
-      IF( MINMN.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      WS = MAX( M, N )
-      LDWRKX = M
-      LDWRKY = N
-*
-      IF( NB.GT.1 .AND. NB.LT.MINMN ) THEN
-*
-*        Set the crossover point NX.
-*
-         NX = MAX( NB, ILAENV( 3, 'ZGEBRD', ' ', M, N, -1, -1 ) )
-*
-*        Determine when to switch from blocked to unblocked code.
-*
-         IF( NX.LT.MINMN ) THEN
-            WS = ( M+N )*NB
-            IF( LWORK.LT.WS ) THEN
-*
-*              Not enough work space for the optimal NB, consider using
-*              a smaller block size.
-*
-               NBMIN = ILAENV( 2, 'ZGEBRD', ' ', M, N, -1, -1 )
-               IF( LWORK.GE.( M+N )*NBMIN ) THEN
-                  NB = LWORK / ( M+N )
-               ELSE
-                  NB = 1
-                  NX = MINMN
-               END IF
-            END IF
-         END IF
-      ELSE
-         NX = MINMN
-      END IF
-*
-      DO 30 I = 1, MINMN - NX, NB
-*
-*        Reduce rows and columns i:i+ib-1 to bidiagonal form and return
-*        the matrices X and Y which are needed to update the unreduced
-*        part of the matrix
-*
-         CALL ZLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ),
-     $                TAUQ( I ), TAUP( I ), WORK, LDWRKX,
-     $                WORK( LDWRKX*NB+1 ), LDWRKY )
-*
-*        Update the trailing submatrix A(i+ib:m,i+ib:n), using
-*        an update of the form  A := A - V*Y' - X*U'
-*
-         CALL ZGEMM( 'No transpose', 'Conjugate transpose', M-I-NB+1,
-     $               N-I-NB+1, NB, -ONE, A( I+NB, I ), LDA,
-     $               WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE,
-     $               A( I+NB, I+NB ), LDA )
-         CALL ZGEMM( 'No transpose', 'No transpose', M-I-NB+1, N-I-NB+1,
-     $               NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA,
-     $               ONE, A( I+NB, I+NB ), LDA )
-*
-*        Copy diagonal and off-diagonal elements of B back into A
-*
-         IF( M.GE.N ) THEN
-            DO 10 J = I, I + NB - 1
-               A( J, J ) = D( J )
-               A( J, J+1 ) = E( J )
-   10       CONTINUE
-         ELSE
-            DO 20 J = I, I + NB - 1
-               A( J, J ) = D( J )
-               A( J+1, J ) = E( J )
-   20       CONTINUE
-         END IF
-   30 CONTINUE
-*
-*     Use unblocked code to reduce the remainder of the matrix
-*
-      CALL ZGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ),
-     $             TAUQ( I ), TAUP( I ), WORK, IINFO )
-      WORK( 1 ) = WS
-      RETURN
-*
-*     End of ZGEBRD
-*
-      END
diff --git a/src/lib/lapack/zgecon.f b/src/lib/lapack/zgecon.f
deleted file mode 100644
index cfaaca35..00000000
--- a/src/lib/lapack/zgecon.f
+++ /dev/null
@@ -1,193 +0,0 @@
-      SUBROUTINE ZGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     Modified to call ZLACN2 in place of ZLACON, 10 Feb 03, SJH.
-*
-*     .. Scalar Arguments ..
-      CHARACTER          NORM
-      INTEGER            INFO, LDA, N
-      DOUBLE PRECISION   ANORM, RCOND
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGECON estimates the reciprocal of the condition number of a general
-*  complex matrix A, in either the 1-norm or the infinity-norm, using
-*  the LU factorization computed by ZGETRF.
-*
-*  An estimate is obtained for norm(inv(A)), and the reciprocal of the
-*  condition number is computed as
-*     RCOND = 1 / ( norm(A) * norm(inv(A)) ).
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies whether the 1-norm condition number or the
-*          infinity-norm condition number is required:
-*          = '1' or 'O':  1-norm;
-*          = 'I':         Infinity-norm.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA,N)
-*          The factors L and U from the factorization A = P*L*U
-*          as computed by ZGETRF.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  ANORM   (input) DOUBLE PRECISION
-*          If NORM = '1' or 'O', the 1-norm of the original matrix A.
-*          If NORM = 'I', the infinity-norm of the original matrix A.
-*
-*  RCOND   (output) DOUBLE PRECISION
-*          The reciprocal of the condition number of the matrix A,
-*          computed as RCOND = 1/(norm(A) * norm(inv(A))).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (2*N)
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            ONENRM
-      CHARACTER          NORMIN
-      INTEGER            IX, KASE, KASE1
-      DOUBLE PRECISION   AINVNM, SCALE, SL, SMLNUM, SU
-      COMPLEX*16         ZDUM
-*     ..
-*     .. Local Arrays ..
-      INTEGER            ISAVE( 3 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IZAMAX
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, IZAMAX, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZDRSCL, ZLACN2, ZLATRS
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DIMAG, MAX
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
-      IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) 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 = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGECON', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      RCOND = ZERO
-      IF( N.EQ.0 ) THEN
-         RCOND = ONE
-         RETURN
-      ELSE IF( ANORM.EQ.ZERO ) THEN
-         RETURN
-      END IF
-*
-      SMLNUM = DLAMCH( 'Safe minimum' )
-*
-*     Estimate the norm of inv(A).
-*
-      AINVNM = ZERO
-      NORMIN = 'N'
-      IF( ONENRM ) THEN
-         KASE1 = 1
-      ELSE
-         KASE1 = 2
-      END IF
-      KASE = 0
-   10 CONTINUE
-      CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
-      IF( KASE.NE.0 ) THEN
-         IF( KASE.EQ.KASE1 ) THEN
-*
-*           Multiply by inv(L).
-*
-            CALL ZLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A,
-     $                   LDA, WORK, SL, RWORK, INFO )
-*
-*           Multiply by inv(U).
-*
-            CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
-     $                   A, LDA, WORK, SU, RWORK( N+1 ), INFO )
-         ELSE
-*
-*           Multiply by inv(U').
-*
-            CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit',
-     $                   NORMIN, N, A, LDA, WORK, SU, RWORK( N+1 ),
-     $                   INFO )
-*
-*           Multiply by inv(L').
-*
-            CALL ZLATRS( 'Lower', 'Conjugate transpose', 'Unit', NORMIN,
-     $                   N, A, LDA, WORK, SL, RWORK, INFO )
-         END IF
-*
-*        Divide X by 1/(SL*SU) if doing so will not cause overflow.
-*
-         SCALE = SL*SU
-         NORMIN = 'Y'
-         IF( SCALE.NE.ONE ) THEN
-            IX = IZAMAX( N, WORK, 1 )
-            IF( SCALE.LT.CABS1( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
-     $         GO TO 20
-            CALL ZDRSCL( N, SCALE, WORK, 1 )
-         END IF
-         GO TO 10
-      END IF
-*
-*     Compute the estimate of the reciprocal condition number.
-*
-      IF( AINVNM.NE.ZERO )
-     $   RCOND = ( ONE / AINVNM ) / ANORM
-*
-   20 CONTINUE
-      RETURN
-*
-*     End of ZGECON
-*
-      END
diff --git a/src/lib/lapack/zgees.f b/src/lib/lapack/zgees.f
deleted file mode 100644
index ade5f9f2..00000000
--- a/src/lib/lapack/zgees.f
+++ /dev/null
@@ -1,324 +0,0 @@
-      SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS,
-     $                  LDVS, WORK, LWORK, RWORK, BWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBVS, SORT
-      INTEGER            INFO, LDA, LDVS, LWORK, N, SDIM
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            BWORK( * )
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         A( LDA, * ), VS( LDVS, * ), W( * ), WORK( * )
-*     ..
-*     .. Function Arguments ..
-      LOGICAL            SELECT
-      EXTERNAL           SELECT
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEES computes for an N-by-N complex nonsymmetric matrix A, the
-*  eigenvalues, the Schur form T, and, optionally, the matrix of Schur
-*  vectors Z.  This gives the Schur factorization A = Z*T*(Z**H).
-*
-*  Optionally, it also orders the eigenvalues on the diagonal of the
-*  Schur form so that selected eigenvalues are at the top left.
-*  The leading columns of Z then form an orthonormal basis for the
-*  invariant subspace corresponding to the selected eigenvalues.
-*
-*  A complex matrix is in Schur form if it is upper triangular.
-*
-*  Arguments
-*  =========
-*
-*  JOBVS   (input) CHARACTER*1
-*          = 'N': Schur vectors are not computed;
-*          = 'V': Schur vectors are computed.
-*
-*  SORT    (input) CHARACTER*1
-*          Specifies whether or not to order the eigenvalues on the
-*          diagonal of the Schur form.
-*          = 'N': Eigenvalues are not ordered:
-*          = 'S': Eigenvalues are ordered (see SELECT).
-*
-*  SELECT  (external procedure) LOGICAL FUNCTION of one COMPLEX*16 argument
-*          SELECT must be declared EXTERNAL in the calling subroutine.
-*          If SORT = 'S', SELECT is used to select eigenvalues to order
-*          to the top left of the Schur form.
-*          IF SORT = 'N', SELECT is not referenced.
-*          The eigenvalue W(j) is selected if SELECT(W(j)) is true.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A. N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the N-by-N matrix A.
-*          On exit, A has been overwritten by its Schur form T.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  SDIM    (output) INTEGER
-*          If SORT = 'N', SDIM = 0.
-*          If SORT = 'S', SDIM = number of eigenvalues for which
-*                         SELECT is true.
-*
-*  W       (output) COMPLEX*16 array, dimension (N)
-*          W contains the computed eigenvalues, in the same order that
-*          they appear on the diagonal of the output Schur form T.
-*
-*  VS      (output) COMPLEX*16 array, dimension (LDVS,N)
-*          If JOBVS = 'V', VS contains the unitary matrix Z of Schur
-*          vectors.
-*          If JOBVS = 'N', VS is not referenced.
-*
-*  LDVS    (input) INTEGER
-*          The leading dimension of the array VS.  LDVS >= 1; if
-*          JOBVS = 'V', LDVS >= N.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,2*N).
-*          For good performance, LWORK must generally be larger.
-*
-*          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.
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  BWORK   (workspace) LOGICAL array, dimension (N)
-*          Not referenced if SORT = 'N'.
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value.
-*          > 0: if INFO = i, and i is
-*               <= N:  the QR algorithm failed to compute all the
-*                      eigenvalues; elements 1:ILO-1 and i+1:N of W
-*                      contain those eigenvalues which have converged;
-*                      if JOBVS = 'V', VS contains the matrix which
-*                      reduces A to its partially converged Schur form.
-*               = N+1: the eigenvalues could not be reordered because
-*                      some eigenvalues were too close to separate (the
-*                      problem is very ill-conditioned);
-*               = N+2: after reordering, roundoff changed values of
-*                      some complex eigenvalues so that leading
-*                      eigenvalues in the Schur form no longer satisfy
-*                      SELECT = .TRUE..  This could also be caused by
-*                      underflow due to scaling.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, SCALEA, WANTST, WANTVS
-      INTEGER            HSWORK, I, IBAL, ICOND, IERR, IEVAL, IHI, ILO,
-     $                   ITAU, IWRK, MAXWRK, MINWRK
-      DOUBLE PRECISION   ANRM, BIGNUM, CSCALE, EPS, S, SEP, SMLNUM
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   DUM( 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD,
-     $                   ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, ZLANGE
-      EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      WANTVS = LSAME( JOBVS, 'V' )
-      WANTST = LSAME( SORT, 'S' )
-      IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
-         INFO = -1
-      ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      ELSE IF( LDVS.LT.1 .OR. ( WANTVS .AND. LDVS.LT.N ) ) THEN
-         INFO = -10
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       CWorkspace refers to complex workspace, and RWorkspace to real
-*       workspace. NB refers to the optimal block size for the
-*       immediately following subroutine, as returned by ILAENV.
-*       HSWORK refers to the workspace preferred by ZHSEQR, as
-*       calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-*       the worst case.)
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( N.EQ.0 ) THEN
-            MINWRK = 1
-            MAXWRK = 1
-         ELSE
-            MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
-            MINWRK = 2*N
-*
-            CALL ZHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS,
-     $             WORK, -1, IEVAL )
-            HSWORK = WORK( 1 )
-*
-            IF( .NOT.WANTVS ) THEN
-               MAXWRK = MAX( MAXWRK, HSWORK )
-            ELSE
-               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',
-     $                       ' ', N, 1, N, -1 ) )
-               MAXWRK = MAX( MAXWRK, HSWORK )
-            END IF
-         END IF
-         WORK( 1 ) = MAXWRK
-*
-         IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
-            INFO = -12
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGEES ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         SDIM = 0
-         RETURN
-      END IF
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SQRT( SMLNUM ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = ZLANGE( 'M', N, N, A, LDA, DUM )
-      SCALEA = .FALSE.
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         SCALEA = .TRUE.
-         CSCALE = SMLNUM
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         SCALEA = .TRUE.
-         CSCALE = BIGNUM
-      END IF
-      IF( SCALEA )
-     $   CALL ZLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-*     Permute the matrix to make it more nearly triangular
-*     (CWorkspace: none)
-*     (RWorkspace: need N)
-*
-      IBAL = 1
-      CALL ZGEBAL( 'P', N, A, LDA, ILO, IHI, RWORK( IBAL ), IERR )
-*
-*     Reduce to upper Hessenberg form
-*     (CWorkspace: need 2*N, prefer N+N*NB)
-*     (RWorkspace: none)
-*
-      ITAU = 1
-      IWRK = N + ITAU
-      CALL ZGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
-     $             LWORK-IWRK+1, IERR )
-*
-      IF( WANTVS ) THEN
-*
-*        Copy Householder vectors to VS
-*
-         CALL ZLACPY( 'L', N, N, A, LDA, VS, LDVS )
-*
-*        Generate unitary matrix in VS
-*        (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
-*        (RWorkspace: none)
-*
-         CALL ZUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
-     $                LWORK-IWRK+1, IERR )
-      END IF
-*
-      SDIM = 0
-*
-*     Perform QR iteration, accumulating Schur vectors in VS if desired
-*     (CWorkspace: need 1, prefer HSWORK (see comments) )
-*     (RWorkspace: none)
-*
-      IWRK = ITAU
-      CALL ZHSEQR( 'S', JOBVS, N, ILO, IHI, A, LDA, W, VS, LDVS,
-     $             WORK( IWRK ), LWORK-IWRK+1, IEVAL )
-      IF( IEVAL.GT.0 )
-     $   INFO = IEVAL
-*
-*     Sort eigenvalues if desired
-*
-      IF( WANTST .AND. INFO.EQ.0 ) THEN
-         IF( SCALEA )
-     $      CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, W, N, IERR )
-         DO 10 I = 1, N
-            BWORK( I ) = SELECT( W( I ) )
-   10    CONTINUE
-*
-*        Reorder eigenvalues and transform Schur vectors
-*        (CWorkspace: none)
-*        (RWorkspace: none)
-*
-         CALL ZTRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, W, SDIM,
-     $                S, SEP, WORK( IWRK ), LWORK-IWRK+1, ICOND )
-      END IF
-*
-      IF( WANTVS ) THEN
-*
-*        Undo balancing
-*        (CWorkspace: none)
-*        (RWorkspace: need N)
-*
-         CALL ZGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, LDVS,
-     $                IERR )
-      END IF
-*
-      IF( SCALEA ) THEN
-*
-*        Undo scaling for the Schur form of A
-*
-         CALL ZLASCL( 'U', 0, 0, CSCALE, ANRM, N, N, A, LDA, IERR )
-         CALL ZCOPY( N, A, LDA+1, W, 1 )
-      END IF
-*
-      WORK( 1 ) = MAXWRK
-      RETURN
-*
-*     End of ZGEES
-*
-      END
diff --git a/src/lib/lapack/zgeev.f b/src/lib/lapack/zgeev.f
deleted file mode 100644
index 0fa66307..00000000
--- a/src/lib/lapack/zgeev.f
+++ /dev/null
@@ -1,396 +0,0 @@
-      SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
-     $                  WORK, LWORK, RWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBVL, JOBVR
-      INTEGER            INFO, LDA, LDVL, LDVR, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
-     $                   W( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEEV computes for an N-by-N complex nonsymmetric matrix A, the
-*  eigenvalues and, optionally, the left and/or right eigenvectors.
-*
-*  The right eigenvector v(j) of A satisfies
-*                   A * v(j) = lambda(j) * v(j)
-*  where lambda(j) is its eigenvalue.
-*  The left eigenvector u(j) of A satisfies
-*                u(j)**H * A = lambda(j) * u(j)**H
-*  where u(j)**H denotes the conjugate transpose of u(j).
-*
-*  The computed eigenvectors are normalized to have Euclidean norm
-*  equal to 1 and largest component real.
-*
-*  Arguments
-*  =========
-*
-*  JOBVL   (input) CHARACTER*1
-*          = 'N': left eigenvectors of A are not computed;
-*          = 'V': left eigenvectors of are computed.
-*
-*  JOBVR   (input) CHARACTER*1
-*          = 'N': right eigenvectors of A are not computed;
-*          = 'V': right eigenvectors of A are computed.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A. N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the N-by-N matrix A.
-*          On exit, A has been overwritten.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  W       (output) COMPLEX*16 array, dimension (N)
-*          W contains the computed eigenvalues.
-*
-*  VL      (output) COMPLEX*16 array, dimension (LDVL,N)
-*          If JOBVL = 'V', the left eigenvectors u(j) are stored one
-*          after another in the columns of VL, in the same order
-*          as their eigenvalues.
-*          If JOBVL = 'N', VL is not referenced.
-*          u(j) = VL(:,j), the j-th column of VL.
-*
-*  LDVL    (input) INTEGER
-*          The leading dimension of the array VL.  LDVL >= 1; if
-*          JOBVL = 'V', LDVL >= N.
-*
-*  VR      (output) COMPLEX*16 array, dimension (LDVR,N)
-*          If JOBVR = 'V', the right eigenvectors v(j) are stored one
-*          after another in the columns of VR, in the same order
-*          as their eigenvalues.
-*          If JOBVR = 'N', VR is not referenced.
-*          v(j) = VR(:,j), the j-th column of VR.
-*
-*  LDVR    (input) INTEGER
-*          The leading dimension of the array VR.  LDVR >= 1; if
-*          JOBVR = 'V', LDVR >= N.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,2*N).
-*          For good performance, LWORK must generally be larger.
-*
-*          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.
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          > 0:  if INFO = i, the QR algorithm failed to compute all the
-*                eigenvalues, and no eigenvectors have been computed;
-*                elements and i+1:N of W contain eigenvalues which have
-*                converged.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, SCALEA, WANTVL, WANTVR
-      CHARACTER          SIDE
-      INTEGER            HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,
-     $                   IWRK, K, MAXWRK, MINWRK, NOUT
-      DOUBLE PRECISION   ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
-      COMPLEX*16         TMP
-*     ..
-*     .. Local Arrays ..
-      LOGICAL            SELECT( 1 )
-      DOUBLE PRECISION   DUM( 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD,
-     $                   ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, ZUNGHR
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX, ILAENV
-      DOUBLE PRECISION   DLAMCH, DZNRM2, ZLANGE
-      EXTERNAL           LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, DCMPLX, DCONJG, DIMAG, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      WANTVL = LSAME( JOBVL, 'V' )
-      WANTVR = LSAME( JOBVR, 'V' )
-      IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
-         INFO = -1
-      ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN
-         INFO = -8
-      ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN
-         INFO = -10
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       CWorkspace refers to complex workspace, and RWorkspace to real
-*       workspace. NB refers to the optimal block size for the
-*       immediately following subroutine, as returned by ILAENV.
-*       HSWORK refers to the workspace preferred by ZHSEQR, as
-*       calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
-*       the worst case.)
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( N.EQ.0 ) THEN
-            MINWRK = 1
-            MAXWRK = 1
-         ELSE
-            MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
-            MINWRK = 2*N
-            IF( WANTVL ) THEN
-               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',
-     $                       ' ', N, 1, N, -1 ) )
-               CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL,
-     $                WORK, -1, INFO )
-            ELSE IF( WANTVR ) THEN
-               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',
-     $                       ' ', N, 1, N, -1 ) )
-               CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR,
-     $                WORK, -1, INFO )
-            ELSE
-               CALL ZHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR,
-     $                WORK, -1, INFO )
-            END IF
-            HSWORK = WORK( 1 )
-            MAXWRK = MAX( MAXWRK, HSWORK, MINWRK )
-         END IF
-         WORK( 1 ) = MAXWRK
-*
-         IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
-            INFO = -12
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGEEV ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SQRT( SMLNUM ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = ZLANGE( 'M', N, N, A, LDA, DUM )
-      SCALEA = .FALSE.
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         SCALEA = .TRUE.
-         CSCALE = SMLNUM
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         SCALEA = .TRUE.
-         CSCALE = BIGNUM
-      END IF
-      IF( SCALEA )
-     $   CALL ZLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
-*
-*     Balance the matrix
-*     (CWorkspace: none)
-*     (RWorkspace: need N)
-*
-      IBAL = 1
-      CALL ZGEBAL( 'B', N, A, LDA, ILO, IHI, RWORK( IBAL ), IERR )
-*
-*     Reduce to upper Hessenberg form
-*     (CWorkspace: need 2*N, prefer N+N*NB)
-*     (RWorkspace: none)
-*
-      ITAU = 1
-      IWRK = ITAU + N
-      CALL ZGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
-     $             LWORK-IWRK+1, IERR )
-*
-      IF( WANTVL ) THEN
-*
-*        Want left eigenvectors
-*        Copy Householder vectors to VL
-*
-         SIDE = 'L'
-         CALL ZLACPY( 'L', N, N, A, LDA, VL, LDVL )
-*
-*        Generate unitary matrix in VL
-*        (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
-*        (RWorkspace: none)
-*
-         CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
-     $                LWORK-IWRK+1, IERR )
-*
-*        Perform QR iteration, accumulating Schur vectors in VL
-*        (CWorkspace: need 1, prefer HSWORK (see comments) )
-*        (RWorkspace: none)
-*
-         IWRK = ITAU
-         CALL ZHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, W, VL, LDVL,
-     $                WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
-         IF( WANTVR ) THEN
-*
-*           Want left and right eigenvectors
-*           Copy Schur vectors to VR
-*
-            SIDE = 'B'
-            CALL ZLACPY( 'F', N, N, VL, LDVL, VR, LDVR )
-         END IF
-*
-      ELSE IF( WANTVR ) THEN
-*
-*        Want right eigenvectors
-*        Copy Householder vectors to VR
-*
-         SIDE = 'R'
-         CALL ZLACPY( 'L', N, N, A, LDA, VR, LDVR )
-*
-*        Generate unitary matrix in VR
-*        (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
-*        (RWorkspace: none)
-*
-         CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
-     $                LWORK-IWRK+1, IERR )
-*
-*        Perform QR iteration, accumulating Schur vectors in VR
-*        (CWorkspace: need 1, prefer HSWORK (see comments) )
-*        (RWorkspace: none)
-*
-         IWRK = ITAU
-         CALL ZHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, W, VR, LDVR,
-     $                WORK( IWRK ), LWORK-IWRK+1, INFO )
-*
-      ELSE
-*
-*        Compute eigenvalues only
-*        (CWorkspace: need 1, prefer HSWORK (see comments) )
-*        (RWorkspace: none)
-*
-         IWRK = ITAU
-         CALL ZHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, W, VR, LDVR,
-     $                WORK( IWRK ), LWORK-IWRK+1, INFO )
-      END IF
-*
-*     If INFO > 0 from ZHSEQR, then quit
-*
-      IF( INFO.GT.0 )
-     $   GO TO 50
-*
-      IF( WANTVL .OR. WANTVR ) THEN
-*
-*        Compute left and/or right eigenvectors
-*        (CWorkspace: need 2*N)
-*        (RWorkspace: need 2*N)
-*
-         IRWORK = IBAL + N
-         CALL ZTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
-     $                N, NOUT, WORK( IWRK ), RWORK( IRWORK ), IERR )
-      END IF
-*
-      IF( WANTVL ) THEN
-*
-*        Undo balancing of left eigenvectors
-*        (CWorkspace: none)
-*        (RWorkspace: need N)
-*
-         CALL ZGEBAK( 'B', 'L', N, ILO, IHI, RWORK( IBAL ), N, VL, LDVL,
-     $                IERR )
-*
-*        Normalize left eigenvectors and make largest component real
-*
-         DO 20 I = 1, N
-            SCL = ONE / DZNRM2( N, VL( 1, I ), 1 )
-            CALL ZDSCAL( N, SCL, VL( 1, I ), 1 )
-            DO 10 K = 1, N
-               RWORK( IRWORK+K-1 ) = DBLE( VL( K, I ) )**2 +
-     $                               DIMAG( VL( K, I ) )**2
-   10       CONTINUE
-            K = IDAMAX( N, RWORK( IRWORK ), 1 )
-            TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) )
-            CALL ZSCAL( N, TMP, VL( 1, I ), 1 )
-            VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO )
-   20    CONTINUE
-      END IF
-*
-      IF( WANTVR ) THEN
-*
-*        Undo balancing of right eigenvectors
-*        (CWorkspace: none)
-*        (RWorkspace: need N)
-*
-         CALL ZGEBAK( 'B', 'R', N, ILO, IHI, RWORK( IBAL ), N, VR, LDVR,
-     $                IERR )
-*
-*        Normalize right eigenvectors and make largest component real
-*
-         DO 40 I = 1, N
-            SCL = ONE / DZNRM2( N, VR( 1, I ), 1 )
-            CALL ZDSCAL( N, SCL, VR( 1, I ), 1 )
-            DO 30 K = 1, N
-               RWORK( IRWORK+K-1 ) = DBLE( VR( K, I ) )**2 +
-     $                               DIMAG( VR( K, I ) )**2
-   30       CONTINUE
-            K = IDAMAX( N, RWORK( IRWORK ), 1 )
-            TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) )
-            CALL ZSCAL( N, TMP, VR( 1, I ), 1 )
-            VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO )
-   40    CONTINUE
-      END IF
-*
-*     Undo scaling if necessary
-*
-   50 CONTINUE
-      IF( SCALEA ) THEN
-         CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, W( INFO+1 ),
-     $                MAX( N-INFO, 1 ), IERR )
-         IF( INFO.GT.0 ) THEN
-            CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, IERR )
-         END IF
-      END IF
-*
-      WORK( 1 ) = MAXWRK
-      RETURN
-*
-*     End of ZGEEV
-*
-      END
diff --git a/src/lib/lapack/zgehd2.f b/src/lib/lapack/zgehd2.f
deleted file mode 100644
index c73f4200..00000000
--- a/src/lib/lapack/zgehd2.f
+++ /dev/null
@@ -1,148 +0,0 @@
-      SUBROUTINE ZGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, ILO, INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEHD2 reduces a complex general matrix A to upper Hessenberg form H
-*  by a unitary similarity transformation:  Q' * A * Q = H .
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          It is assumed that A is already upper triangular in rows
-*          and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*          set by a previous call to ZGEBAL; otherwise they should be
-*          set to 1 and N respectively. See Further Details.
-*          1 <= ILO <= IHI <= max(1,N).
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the n by n general matrix to be reduced.
-*          On exit, the upper triangle and the first subdiagonal of A
-*          are overwritten with the upper Hessenberg matrix H, 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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  TAU     (output) COMPLEX*16 array, dimension (N-1)
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of (ihi-ilo) elementary
-*  reflectors
-*
-*     Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
-*  exit in A(i+2:ihi,i), and tau in TAU(i).
-*
-*  The contents of A are illustrated by the following example, with
-*  n = 7, ilo = 2 and ihi = 6:
-*
-*  on entry,                        on exit,
-*
-*  ( a   a   a   a   a   a   a )    (  a   a   h   h   h   h   a )
-*  (     a   a   a   a   a   a )    (      a   h   h   h   h   a )
-*  (     a   a   a   a   a   a )    (      h   h   h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  h   h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  v3  h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  v3  v4  h   h   h )
-*  (                         a )    (                          a )
-*
-*  where a denotes an element of the original matrix A, h denotes a
-*  modified element of the upper Hessenberg matrix H, and vi denotes an
-*  element of the vector defining H(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-      COMPLEX*16         ALPHA
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF, ZLARFG
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      IF( N.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
-         INFO = -2
-      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGEHD2', -INFO )
-         RETURN
-      END IF
-*
-      DO 10 I = ILO, IHI - 1
-*
-*        Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
-*
-         ALPHA = A( I+1, I )
-         CALL ZLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAU( I ) )
-         A( I+1, I ) = ONE
-*
-*        Apply H(i) to A(1:ihi,i+1:ihi) from the right
-*
-         CALL ZLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
-     $               A( 1, I+1 ), LDA, WORK )
-*
-*        Apply H(i)' to A(i+1:ihi,i+1:n) from the left
-*
-         CALL ZLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1,
-     $               DCONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
-*
-         A( I+1, I ) = ALPHA
-   10 CONTINUE
-*
-      RETURN
-*
-*     End of ZGEHD2
-*
-      END
diff --git a/src/lib/lapack/zgehrd.f b/src/lib/lapack/zgehrd.f
deleted file mode 100644
index 83c1aa32..00000000
--- a/src/lib/lapack/zgehrd.f
+++ /dev/null
@@ -1,273 +0,0 @@
-      SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, ILO, INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16        A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEHRD reduces a complex general matrix A to upper Hessenberg form H by
-*  an unitary similarity transformation:  Q' * A * Q = H .
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          It is assumed that A is already upper triangular in rows
-*          and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*          set by a previous call to ZGEBAL; otherwise they should be
-*          set to 1 and N respectively. See Further Details.
-*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the N-by-N general matrix to be reduced.
-*          On exit, the upper triangle and the first subdiagonal of A
-*          are overwritten with the upper Hessenberg matrix H, 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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  TAU     (output) COMPLEX*16 array, dimension (N-1)
-*          The scalar factors of the elementary reflectors (see Further
-*          Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
-*          zero.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (LWORK)
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The length of the array WORK.  LWORK >= max(1,N).
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of (ihi-ilo) elementary
-*  reflectors
-*
-*     Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
-*  exit in A(i+2:ihi,i), and tau in TAU(i).
-*
-*  The contents of A are illustrated by the following example, with
-*  n = 7, ilo = 2 and ihi = 6:
-*
-*  on entry,                        on exit,
-*
-*  ( a   a   a   a   a   a   a )    (  a   a   h   h   h   h   a )
-*  (     a   a   a   a   a   a )    (      a   h   h   h   h   a )
-*  (     a   a   a   a   a   a )    (      h   h   h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  h   h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  v3  h   h   h   h )
-*  (     a   a   a   a   a   a )    (      v2  v3  v4  h   h   h )
-*  (                         a )    (                          a )
-*
-*  where a denotes an element of the original matrix A, h denotes a
-*  modified element of the upper Hessenberg matrix H, and vi denotes an
-*  element of the vector defining H(i).
-*
-*  This file is a slight modification of LAPACK-3.0's ZGEHRD
-*  subroutine incorporating improvements proposed by Quintana-Orti and
-*  Van de Geijn (2005). 
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            NBMAX, LDT
-      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
-      COMPLEX*16        ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ), 
-     $                     ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, J, LDWORK, LWKOPT, NB,
-     $                   NBMIN, NH, NX
-      COMPLEX*16        EI
-*     ..
-*     .. Local Arrays ..
-      COMPLEX*16        T( LDT, NBMAX )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZAXPY, ZGEHD2, ZGEMM, ZLAHR2, ZLARFB, ZTRMM,
-     $                   XERBLA
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
-      LWKOPT = N*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( N.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
-         INFO = -2
-      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -8
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGEHRD', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Set elements 1:ILO-1 and IHI:N-1 of TAU to zero
-*
-      DO 10 I = 1, ILO - 1
-         TAU( I ) = ZERO
-   10 CONTINUE
-      DO 20 I = MAX( 1, IHI ), N - 1
-         TAU( I ) = ZERO
-   20 CONTINUE
-*
-*     Quick return if possible
-*
-      NH = IHI - ILO + 1
-      IF( NH.LE.1 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-*     Determine the block size
-*
-      NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
-      NBMIN = 2
-      IWS = 1
-      IF( NB.GT.1 .AND. NB.LT.NH ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code
-*        (last block is always handled by unblocked code)
-*
-         NX = MAX( NB, ILAENV( 3, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
-         IF( NX.LT.NH ) THEN
-*
-*           Determine if workspace is large enough for blocked code
-*
-            IWS = N*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  determine the
-*              minimum value of NB, and reduce NB or force use of
-*              unblocked code
-*
-               NBMIN = MAX( 2, ILAENV( 2, 'ZGEHRD', ' ', N, ILO, IHI,
-     $                 -1 ) )
-               IF( LWORK.GE.N*NBMIN ) THEN
-                  NB = LWORK / N
-               ELSE
-                  NB = 1
-               END IF
-            END IF
-         END IF
-      END IF
-      LDWORK = N
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.NH ) THEN
-*
-*        Use unblocked code below
-*
-         I = ILO
-*
-      ELSE
-*
-*        Use blocked code
-*
-         DO 40 I = ILO, IHI - 1 - NX, NB
-            IB = MIN( NB, IHI-I )
-*
-*           Reduce columns i:i+ib-1 to Hessenberg form, returning the
-*           matrices V and T of the block reflector H = I - V*T*V'
-*           which performs the reduction, and also the matrix Y = A*V*T
-*
-            CALL ZLAHR2( IHI, I, IB, A( 1, I ), LDA, TAU( I ), T, LDT,
-     $                   WORK, LDWORK )
-*
-*           Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
-*           right, computing  A := A - Y * V'. V(i+ib,ib-1) must be set
-*           to 1
-*
-            EI = A( I+IB, I+IB-1 )
-            A( I+IB, I+IB-1 ) = ONE
-            CALL ZGEMM( 'No transpose', 'Conjugate transpose', 
-     $                  IHI, IHI-I-IB+1,
-     $                  IB, -ONE, WORK, LDWORK, A( I+IB, I ), LDA, ONE,
-     $                  A( 1, I+IB ), LDA )
-            A( I+IB, I+IB-1 ) = EI
-*
-*           Apply the block reflector H to A(1:i,i+1:i+ib-1) from the
-*           right
-*
-            CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
-     $                  'Unit', I, IB-1,
-     $                  ONE, A( I+1, I ), LDA, WORK, LDWORK )
-            DO 30 J = 0, IB-2
-               CALL ZAXPY( I, -ONE, WORK( LDWORK*J+1 ), 1,
-     $                     A( 1, I+J+1 ), 1 )
-   30       CONTINUE
-*
-*           Apply the block reflector H to A(i+1:ihi,i+ib:n) from the
-*           left
-*
-            CALL ZLARFB( 'Left', 'Conjugate transpose', 'Forward',
-     $                   'Columnwise',
-     $                   IHI-I, N-I-IB+1, IB, A( I+1, I ), LDA, T, LDT,
-     $                   A( I+1, I+IB ), LDA, WORK, LDWORK )
-   40    CONTINUE
-      END IF
-*
-*     Use unblocked code to reduce the rest of the matrix
-*
-      CALL ZGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
-      WORK( 1 ) = IWS
-*
-      RETURN
-*
-*     End of ZGEHRD
-*
-      END
diff --git a/src/lib/lapack/zgelq2.f b/src/lib/lapack/zgelq2.f
deleted file mode 100644
index dc387af0..00000000
--- a/src/lib/lapack/zgelq2.f
+++ /dev/null
@@ -1,123 +0,0 @@
-      SUBROUTINE ZGELQ2( M, N, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGELQ2 computes an LQ factorization of a complex m by n matrix A:
-*  A = L * Q.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the m by n matrix A.
-*          On exit, the elements on and below the diagonal of the array
-*          contain the m by min(m,n) lower trapezoidal matrix L (L is
-*          lower triangular if m <= n); the elements above the diagonal,
-*          with the array TAU, represent the unitary matrix Q as a
-*          product of elementary reflectors (see Further Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) COMPLEX*16 array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (M)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(k)' . . . H(2)' H(1)', where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in
-*  A(i,i+1:n), and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, K
-      COMPLEX*16         ALPHA
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACGV, ZLARF, ZLARFG
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGELQ2', -INFO )
-         RETURN
-      END IF
-*
-      K = MIN( M, N )
-*
-      DO 10 I = 1, K
-*
-*        Generate elementary reflector H(i) to annihilate A(i,i+1:n)
-*
-         CALL ZLACGV( N-I+1, A( I, I ), LDA )
-         ALPHA = A( I, I )
-         CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
-     $                TAU( I ) )
-         IF( I.LT.M ) THEN
-*
-*           Apply H(i) to A(i+1:m,i:n) from the right
-*
-            A( I, I ) = ONE
-            CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
-     $                  A( I+1, I ), LDA, WORK )
-         END IF
-         A( I, I ) = ALPHA
-         CALL ZLACGV( N-I+1, A( I, I ), LDA )
-   10 CONTINUE
-      RETURN
-*
-*     End of ZGELQ2
-*
-      END
diff --git a/src/lib/lapack/zgelqf.f b/src/lib/lapack/zgelqf.f
deleted file mode 100644
index 5dac50dc..00000000
--- a/src/lib/lapack/zgelqf.f
+++ /dev/null
@@ -1,195 +0,0 @@
-      SUBROUTINE ZGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGELQF computes an LQ factorization of a complex M-by-N matrix A:
-*  A = L * Q.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the elements on and below the diagonal of the array
-*          contain the m-by-min(m,n) lower trapezoidal matrix L (L is
-*          lower triangular if m <= n); the elements above the diagonal,
-*          with the array TAU, represent the unitary matrix Q as a
-*          product of elementary reflectors (see Further Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) COMPLEX*16 array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,M).
-*          For optimum performance LWORK >= M*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(k)' . . . H(2)' H(1)', where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in
-*  A(i,i+1:n), and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
-     $                   NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGELQ2, ZLARFB, ZLARFT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NB = ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
-      LWKOPT = M*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
-         INFO = -7
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGELQF', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      K = MIN( M, N )
-      IF( K.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = M
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'ZGELQF', ' ', M, N, -1, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = M
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'ZGELQF', ' ', M, N, -1,
-     $                 -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code initially
-*
-         DO 10 I = 1, K - NX, NB
-            IB = MIN( K-I+1, NB )
-*
-*           Compute the LQ factorization of the current block
-*           A(i:i+ib-1,i:n)
-*
-            CALL ZGELQ2( IB, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
-     $                   IINFO )
-            IF( I+IB.LE.M ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i) H(i+1) . . . H(i+ib-1)
-*
-               CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
-     $                      LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H to A(i+ib:m,i:n) from the right
-*
-               CALL ZLARFB( 'Right', 'No transpose', 'Forward',
-     $                      'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ),
-     $                      LDA, WORK, LDWORK, A( I+IB, I ), LDA,
-     $                      WORK( IB+1 ), LDWORK )
-            END IF
-   10    CONTINUE
-      ELSE
-         I = 1
-      END IF
-*
-*     Use unblocked code to factor the last or only block.
-*
-      IF( I.LE.K )
-     $   CALL ZGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
-     $                IINFO )
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of ZGELQF
-*
-      END
diff --git a/src/lib/lapack/zgelsy.f b/src/lib/lapack/zgelsy.f
deleted file mode 100644
index 95aece58..00000000
--- a/src/lib/lapack/zgelsy.f
+++ /dev/null
@@ -1,385 +0,0 @@
-      SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
-     $                   WORK, LWORK, RWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
-      DOUBLE PRECISION   RCOND
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGELSY computes the minimum-norm solution to a complex linear least
-*  squares problem:
-*      minimize || A * X - B ||
-*  using a complete orthogonal factorization of A.  A is an M-by-N
-*  matrix which may be rank-deficient.
-*
-*  Several right hand side vectors b and solution vectors x can be
-*  handled in a single call; they are stored as the columns of the
-*  M-by-NRHS right hand side matrix B and the N-by-NRHS solution
-*  matrix X.
-*
-*  The routine first computes a QR factorization with column pivoting:
-*      A * P = Q * [ R11 R12 ]
-*                  [  0  R22 ]
-*  with R11 defined as the largest leading submatrix whose estimated
-*  condition number is less than 1/RCOND.  The order of R11, RANK,
-*  is the effective rank of A.
-*
-*  Then, R22 is considered to be negligible, and R12 is annihilated
-*  by unitary transformations from the right, arriving at the
-*  complete orthogonal factorization:
-*     A * P = Q * [ T11 0 ] * Z
-*                 [  0  0 ]
-*  The minimum-norm solution is then
-*     X = P * Z' [ inv(T11)*Q1'*B ]
-*                [        0       ]
-*  where Q1 consists of the first RANK columns of Q.
-*
-*  This routine is basically identical to the original xGELSX except
-*  three differences:
-*    o The permutation of matrix B (the right hand side) is faster and
-*      more simple.
-*    o The call to the subroutine xGEQPF has been substituted by the
-*      the call to the subroutine xGEQP3. This subroutine is a Blas-3
-*      version of the QR factorization with column pivoting.
-*    o Matrix B (the right hand side) is updated with Blas-3.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of
-*          columns of matrices B and X. NRHS >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, A has been overwritten by details of its
-*          complete orthogonal factorization.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  B       (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
-*          On entry, the M-by-NRHS right hand side matrix B.
-*          On exit, the N-by-NRHS solution matrix X.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1,M,N).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*          to the front of AP, otherwise column i is a free column.
-*          On exit, if JPVT(i) = k, then the i-th column of A*P
-*          was the k-th column of A.
-*
-*  RCOND   (input) DOUBLE PRECISION
-*          RCOND is used to determine the effective rank of A, which
-*          is defined as the order of the largest leading triangular
-*          submatrix R11 in the QR factorization with pivoting of A,
-*          whose estimated condition number < 1/RCOND.
-*
-*  RANK    (output) INTEGER
-*          The effective rank of A, i.e., the order of the submatrix
-*          R11.  This is the same as the order of the submatrix T11
-*          in the complete orthogonal factorization of A.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          The unblocked strategy requires that:
-*            LWORK >= MN + MAX( 2*MN, N+1, MN+NRHS )
-*          where MN = min(M,N).
-*          The block algorithm requires that:
-*            LWORK >= MN + MAX( 2*MN, NB*(N+1), MN+MN*NB, MN+NB*NRHS )
-*          where NB is an upper bound on the blocksize returned
-*          by ILAENV for the routines ZGEQP3, ZTZRZF, CTZRQF, ZUNMQR,
-*          and ZUNMRZ.
-*
-*          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.
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*    E. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            IMAX, IMIN
-      PARAMETER          ( IMAX = 1, IMIN = 2 )
-      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 ..
-      LOGICAL            LQUERY
-      INTEGER            I, IASCL, IBSCL, ISMAX, ISMIN, J, LWKOPT, MN,
-     $                   NB, NB1, NB2, NB3, NB4
-      DOUBLE PRECISION   ANRM, BIGNUM, BNRM, SMAX, SMAXPR, SMIN, SMINPR,
-     $                   SMLNUM, WSIZE
-      COMPLEX*16         C1, C2, S1, S2
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZCOPY, ZGEQP3, ZLAIC1, ZLASCL,
-     $                   ZLASET, ZTRSM, ZTZRZF, ZUNMQR, ZUNMRZ
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, ZLANGE
-      EXTERNAL           ILAENV, DLAMCH, ZLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-      MN = MIN( M, N )
-      ISMIN = MN + 1
-      ISMAX = 2*MN + 1
-*
-*     Test the input arguments.
-*
-      INFO = 0
-      NB1 = ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-      NB2 = ILAENV( 1, 'ZGERQF', ' ', M, N, -1, -1 )
-      NB3 = ILAENV( 1, 'ZUNMQR', ' ', M, N, NRHS, -1 )
-      NB4 = ILAENV( 1, 'ZUNMRQ', ' ', M, N, NRHS, -1 )
-      NB = MAX( NB1, NB2, NB3, NB4 )
-      LWKOPT = MAX( 1, MN+2*N+NB*( N+1 ), 2*MN+NB*NRHS )
-      WORK( 1 ) = DCMPLX( LWKOPT )
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) 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, M ) ) THEN
-         INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
-         INFO = -7
-      ELSE IF( LWORK.LT.( MN+MAX( 2*MN, N+1, MN+NRHS ) ) .AND. .NOT.
-     $         LQUERY ) THEN
-         INFO = -12
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGELSY', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( MIN( M, N, NRHS ).EQ.0 ) THEN
-         RANK = 0
-         RETURN
-      END IF
-*
-*     Get machine parameters
-*
-      SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Scale A, B if max entries outside range [SMLNUM,BIGNUM]
-*
-      ANRM = ZLANGE( 'M', M, N, A, LDA, RWORK )
-      IASCL = 0
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-*
-*        Scale matrix norm up to SMLNUM
-*
-         CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
-         IASCL = 1
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-*
-*        Scale matrix norm down to BIGNUM
-*
-         CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
-         IASCL = 2
-      ELSE IF( ANRM.EQ.ZERO ) THEN
-*
-*        Matrix all zero. Return zero solution.
-*
-         CALL ZLASET( 'F', MAX( M, N ), NRHS, CZERO, CZERO, B, LDB )
-         RANK = 0
-         GO TO 70
-      END IF
-*
-      BNRM = ZLANGE( 'M', M, NRHS, B, LDB, RWORK )
-      IBSCL = 0
-      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-*
-*        Scale matrix norm up to SMLNUM
-*
-         CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
-         IBSCL = 1
-      ELSE IF( BNRM.GT.BIGNUM ) THEN
-*
-*        Scale matrix norm down to BIGNUM
-*
-         CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
-         IBSCL = 2
-      END IF
-*
-*     Compute QR factorization with column pivoting of A:
-*        A * P = Q * R
-*
-      CALL ZGEQP3( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ),
-     $             LWORK-MN, RWORK, INFO )
-      WSIZE = MN + DBLE( WORK( MN+1 ) )
-*
-*     complex workspace: MN+NB*(N+1). real workspace 2*N.
-*     Details of Householder rotations stored in WORK(1:MN).
-*
-*     Determine RANK using incremental condition estimation
-*
-      WORK( ISMIN ) = CONE
-      WORK( ISMAX ) = CONE
-      SMAX = ABS( A( 1, 1 ) )
-      SMIN = SMAX
-      IF( ABS( A( 1, 1 ) ).EQ.ZERO ) THEN
-         RANK = 0
-         CALL ZLASET( 'F', MAX( M, N ), NRHS, CZERO, CZERO, B, LDB )
-         GO TO 70
-      ELSE
-         RANK = 1
-      END IF
-*
-   10 CONTINUE
-      IF( RANK.LT.MN ) THEN
-         I = RANK + 1
-         CALL ZLAIC1( IMIN, RANK, WORK( ISMIN ), SMIN, A( 1, I ),
-     $                A( I, I ), SMINPR, S1, C1 )
-         CALL ZLAIC1( IMAX, RANK, WORK( ISMAX ), SMAX, A( 1, I ),
-     $                A( I, I ), SMAXPR, S2, C2 )
-*
-         IF( SMAXPR*RCOND.LE.SMINPR ) THEN
-            DO 20 I = 1, RANK
-               WORK( ISMIN+I-1 ) = S1*WORK( ISMIN+I-1 )
-               WORK( ISMAX+I-1 ) = S2*WORK( ISMAX+I-1 )
-   20       CONTINUE
-            WORK( ISMIN+RANK ) = C1
-            WORK( ISMAX+RANK ) = C2
-            SMIN = SMINPR
-            SMAX = SMAXPR
-            RANK = RANK + 1
-            GO TO 10
-         END IF
-      END IF
-*
-*     complex workspace: 3*MN.
-*
-*     Logically partition R = [ R11 R12 ]
-*                             [  0  R22 ]
-*     where R11 = R(1:RANK,1:RANK)
-*
-*     [R11,R12] = [ T11, 0 ] * Y
-*
-c      IF( RANK.LT.N )
-c     $   CALL ZTZRZF( RANK, N, A, LDA, WORK( MN+1 ), WORK( 2*MN+1 ),
-c     $                LWORK-2*MN, INFO )
-*
-*     complex workspace: 2*MN.
-*     Details of Householder rotations stored in WORK(MN+1:2*MN)
-*
-*     B(1:M,1:NRHS) := Q' * B(1:M,1:NRHS)
-*
-      CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, MN, A, LDA,
-     $             WORK( 1 ), B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO )
-      WSIZE = MAX( WSIZE, 2*MN+DBLE( WORK( 2*MN+1 ) ) )
-*
-*     complex workspace: 2*MN+NB*NRHS.
-*
-*     B(1:RANK,1:NRHS) := inv(T11) * B(1:RANK,1:NRHS)
-*
-      CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', RANK,
-     $            NRHS, CONE, A, LDA, B, LDB )
-*
-      DO 40 J = 1, NRHS
-         DO 30 I = RANK + 1, N
-            B( I, J ) = CZERO
-   30    CONTINUE
-   40 CONTINUE
-*
-*     B(1:N,1:NRHS) := Y' * B(1:N,1:NRHS)
-*
-c      IF( RANK.LT.N ) THEN
-c         CALL ZUNMRZ( 'Left', 'Conjugate transpose', N, NRHS, RANK,
-c     $                N-RANK, A, LDA, WORK( MN+1 ), B, LDB,
-c     $                WORK( 2*MN+1 ), LWORK-2*MN, INFO )
-c      END IF
-*
-*     complex workspace: 2*MN+NRHS.
-*
-*     B(1:N,1:NRHS) := P * B(1:N,1:NRHS)
-*
-      DO 60 J = 1, NRHS
-         DO 50 I = 1, N
-            WORK( JPVT( I ) ) = B( I, J )
-   50    CONTINUE
-         CALL ZCOPY( N, WORK( 1 ), 1, B( 1, J ), 1 )
-   60 CONTINUE
-*
-*     complex workspace: N.
-*
-*     Undo scaling
-*
-      IF( IASCL.EQ.1 ) THEN
-         CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
-         CALL ZLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA,
-     $                INFO )
-      ELSE IF( IASCL.EQ.2 ) THEN
-         CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
-         CALL ZLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA,
-     $                INFO )
-      END IF
-      IF( IBSCL.EQ.1 ) THEN
-         CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
-      ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
-      END IF
-*
-   70 CONTINUE
-      WORK( 1 ) = DCMPLX( LWKOPT )
-*
-      RETURN
-*
-*     End of ZGELSY
-*
-      END
diff --git a/src/lib/lapack/zgeqp3.f b/src/lib/lapack/zgeqp3.f
deleted file mode 100644
index 32bf3367..00000000
--- a/src/lib/lapack/zgeqp3.f
+++ /dev/null
@@ -1,293 +0,0 @@
-      SUBROUTINE ZGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK,
-     $                   INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEQP3 computes a QR factorization with column pivoting of a
-*  matrix A:  A*P = Q*R  using Level 3 BLAS.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the upper triangle of the array contains the
-*          min(M,N)-by-N upper trapezoidal matrix R; the elements below
-*          the diagonal, together with the array TAU, represent the
-*          unitary matrix Q as a product of min(M,N) elementary
-*          reflectors.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          On entry, if JPVT(J).ne.0, the J-th column of A is permuted
-*          to the front of A*P (a leading column); if JPVT(J)=0,
-*          the J-th column of A is a free column.
-*          On exit, if JPVT(J)=K, then the J-th column of A*P was the
-*          the K-th column of A.
-*
-*  TAU     (output) COMPLEX*16 array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO=0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= N+1.
-*          For optimal 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.
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit.
-*          < 0: if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a real/complex scalar, and v is a real/complex vector
-*  with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in
-*  A(i+1:m,i), and tau in TAU(i).
-*
-*  Based on contributions by
-*    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*    X. Sun, Computer Science Dept., Duke University, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            INB, INBMIN, IXOVER
-      PARAMETER          ( INB = 1, INBMIN = 2, IXOVER = 3 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            FJB, IWS, J, JB, LWKOPT, MINMN, MINWS, NA, NB,
-     $                   NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEQRF, ZLAQP2, ZLAQPS, ZSWAP, ZUNMQR
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DZNRM2
-      EXTERNAL           ILAENV, DZNRM2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          INT, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test input arguments
-*     ====================
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         MINMN = MIN( M, N )
-         IF( MINMN.EQ.0 ) THEN
-            IWS = 1
-            LWKOPT = 1
-         ELSE
-            IWS = N + 1
-            NB = ILAENV( INB, 'ZGEQRF', ' ', M, N, -1, -1 )
-            LWKOPT = ( N + 1 )*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
-            INFO = -8
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGEQP3', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( MINMN.EQ.0 ) THEN
-         RETURN
-      END IF
-*
-*     Move initial columns up front.
-*
-      NFXD = 1
-      DO 10 J = 1, N
-         IF( JPVT( J ).NE.0 ) THEN
-            IF( J.NE.NFXD ) THEN
-               CALL ZSWAP( M, A( 1, J ), 1, A( 1, NFXD ), 1 )
-               JPVT( J ) = JPVT( NFXD )
-               JPVT( NFXD ) = J
-            ELSE
-               JPVT( J ) = J
-            END IF
-            NFXD = NFXD + 1
-         ELSE
-            JPVT( J ) = J
-         END IF
-   10 CONTINUE
-      NFXD = NFXD - 1
-*
-*     Factorize fixed columns
-*     =======================
-*
-*     Compute the QR factorization of fixed columns and update
-*     remaining columns.
-*
-      IF( NFXD.GT.0 ) THEN
-         NA = MIN( M, NFXD )
-*CC      CALL ZGEQR2( M, NA, A, LDA, TAU, WORK, INFO )
-         CALL ZGEQRF( M, NA, A, LDA, TAU, WORK, LWORK, INFO )
-         IWS = MAX( IWS, INT( WORK( 1 ) ) )
-         IF( NA.LT.N ) THEN
-*CC         CALL ZUNM2R( 'Left', 'Conjugate Transpose', M, N-NA,
-*CC  $                   NA, A, LDA, TAU, A( 1, NA+1 ), LDA, WORK,
-*CC  $                   INFO )
-            CALL ZUNMQR( 'Left', 'Conjugate Transpose', M, N-NA, NA, A,
-     $                   LDA, TAU, A( 1, NA+1 ), LDA, WORK, LWORK,
-     $                   INFO )
-            IWS = MAX( IWS, INT( WORK( 1 ) ) )
-         END IF
-      END IF
-*
-*     Factorize free columns
-*     ======================
-*
-      IF( NFXD.LT.MINMN ) THEN
-*
-         SM = M - NFXD
-         SN = N - NFXD
-         SMINMN = MINMN - NFXD
-*
-*        Determine the block size.
-*
-         NB = ILAENV( INB, 'ZGEQRF', ' ', SM, SN, -1, -1 )
-         NBMIN = 2
-         NX = 0
-*
-         IF( ( NB.GT.1 ) .AND. ( NB.LT.SMINMN ) ) THEN
-*
-*           Determine when to cross over from blocked to unblocked code.
-*
-            NX = MAX( 0, ILAENV( IXOVER, 'ZGEQRF', ' ', SM, SN, -1,
-     $           -1 ) )
-*
-*
-            IF( NX.LT.SMINMN ) THEN
-*
-*              Determine if workspace is large enough for blocked code.
-*
-               MINWS = ( SN+1 )*NB
-               IWS = MAX( IWS, MINWS )
-               IF( LWORK.LT.MINWS ) THEN
-*
-*                 Not enough workspace to use optimal NB: Reduce NB and
-*                 determine the minimum value of NB.
-*
-                  NB = LWORK / ( SN+1 )
-                  NBMIN = MAX( 2, ILAENV( INBMIN, 'ZGEQRF', ' ', SM, SN,
-     $                    -1, -1 ) )
-*
-*
-               END IF
-            END IF
-         END IF
-*
-*        Initialize partial column norms. The first N elements of work
-*        store the exact column norms.
-*
-         DO 20 J = NFXD + 1, N
-            RWORK( J ) = DZNRM2( SM, A( NFXD+1, J ), 1 )
-            RWORK( N+J ) = RWORK( J )
-   20    CONTINUE
-*
-         IF( ( NB.GE.NBMIN ) .AND. ( NB.LT.SMINMN ) .AND.
-     $       ( NX.LT.SMINMN ) ) THEN
-*
-*           Use blocked code initially.
-*
-            J = NFXD + 1
-*
-*           Compute factorization: while loop.
-*
-*
-            TOPBMN = MINMN - NX
-   30       CONTINUE
-            IF( J.LE.TOPBMN ) THEN
-               JB = MIN( NB, TOPBMN-J+1 )
-*
-*              Factorize JB columns among columns J:N.
-*
-               CALL ZLAQPS( M, N-J+1, J-1, JB, FJB, A( 1, J ), LDA,
-     $                      JPVT( J ), TAU( J ), RWORK( J ),
-     $                      RWORK( N+J ), WORK( 1 ), WORK( JB+1 ),
-     $                      N-J+1 )
-*
-               J = J + FJB
-               GO TO 30
-            END IF
-         ELSE
-            J = NFXD + 1
-         END IF
-*
-*        Use unblocked code to factor the last or only block.
-*
-*
-         IF( J.LE.MINMN )
-     $      CALL ZLAQP2( M, N-J+1, J-1, A( 1, J ), LDA, JPVT( J ),
-     $                   TAU( J ), RWORK( J ), RWORK( N+J ), WORK( 1 ) )
-*
-      END IF
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of ZGEQP3
-*
-      END
diff --git a/src/lib/lapack/zgeqpf.f b/src/lib/lapack/zgeqpf.f
deleted file mode 100644
index 6d4f86f0..00000000
--- a/src/lib/lapack/zgeqpf.f
+++ /dev/null
@@ -1,234 +0,0 @@
-      SUBROUTINE ZGEQPF( M, N, A, LDA, JPVT, TAU, WORK, RWORK, INFO )
-*
-*  -- LAPACK deprecated driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  This routine is deprecated and has been replaced by routine ZGEQP3.
-*
-*  ZGEQPF computes a QR factorization with column pivoting of a
-*  complex M-by-N matrix A: A*P = Q*R.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A. N >= 0
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the upper triangle of the array contains the
-*          min(M,N)-by-N upper triangular matrix R; the elements
-*          below the diagonal, together with the array TAU,
-*          represent the unitary matrix Q as a product of
-*          min(m,n) elementary reflectors.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*          to the front of A*P (a leading column); if JPVT(i) = 0,
-*          the i-th column of A is a free column.
-*          On exit, if JPVT(i) = k, then the i-th column of A*P
-*          was the k-th column of A.
-*
-*  TAU     (output) COMPLEX*16 array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors.
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (N)
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(n)
-*
-*  Each H(i) has the form
-*
-*     H = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).
-*
-*  The matrix P is represented in jpvt as follows: If
-*     jpvt(j) = i
-*  then the jth column of P is the ith canonical unit vector.
-*
-*  Partial column norm updating strategy modified by
-*    Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*    University of Zagreb, Croatia.
-*    June 2006.
-*  For more details see LAPACK Working Note 176.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ITEMP, J, MA, MN, PVT
-      DOUBLE PRECISION   TEMP, TEMP2, TOL3Z
-      COMPLEX*16         AII
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEQR2, ZLARF, ZLARFG, ZSWAP, ZUNM2R
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DCMPLX, DCONJG, MAX, MIN, SQRT
-*     ..
-*     .. External Functions ..
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH, DZNRM2
-      EXTERNAL           IDAMAX, DLAMCH, DZNRM2
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGEQPF', -INFO )
-         RETURN
-      END IF
-*
-      MN = MIN( M, N )
-      TOL3Z = SQRT(DLAMCH('Epsilon'))
-*
-*     Move initial columns up front
-*
-      ITEMP = 1
-      DO 10 I = 1, N
-         IF( JPVT( I ).NE.0 ) THEN
-            IF( I.NE.ITEMP ) THEN
-               CALL ZSWAP( M, A( 1, I ), 1, A( 1, ITEMP ), 1 )
-               JPVT( I ) = JPVT( ITEMP )
-               JPVT( ITEMP ) = I
-            ELSE
-               JPVT( I ) = I
-            END IF
-            ITEMP = ITEMP + 1
-         ELSE
-            JPVT( I ) = I
-         END IF
-   10 CONTINUE
-      ITEMP = ITEMP - 1
-*
-*     Compute the QR factorization and update remaining columns
-*
-      IF( ITEMP.GT.0 ) THEN
-         MA = MIN( ITEMP, M )
-         CALL ZGEQR2( M, MA, A, LDA, TAU, WORK, INFO )
-         IF( MA.LT.N ) THEN
-            CALL ZUNM2R( 'Left', 'Conjugate transpose', M, N-MA, MA, A,
-     $                   LDA, TAU, A( 1, MA+1 ), LDA, WORK, INFO )
-         END IF
-      END IF
-*
-      IF( ITEMP.LT.MN ) THEN
-*
-*        Initialize partial column norms. The first n elements of
-*        work store the exact column norms.
-*
-         DO 20 I = ITEMP + 1, N
-            RWORK( I ) = DZNRM2( M-ITEMP, A( ITEMP+1, I ), 1 )
-            RWORK( N+I ) = RWORK( I )
-   20    CONTINUE
-*
-*        Compute factorization
-*
-         DO 40 I = ITEMP + 1, MN
-*
-*           Determine ith pivot column and swap if necessary
-*
-            PVT = ( I-1 ) + IDAMAX( N-I+1, RWORK( I ), 1 )
-*
-            IF( PVT.NE.I ) THEN
-               CALL ZSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
-               ITEMP = JPVT( PVT )
-               JPVT( PVT ) = JPVT( I )
-               JPVT( I ) = ITEMP
-               RWORK( PVT ) = RWORK( I )
-               RWORK( N+PVT ) = RWORK( N+I )
-            END IF
-*
-*           Generate elementary reflector H(i)
-*
-            AII = A( I, I )
-            CALL ZLARFG( M-I+1, AII, A( MIN( I+1, M ), I ), 1,
-     $                   TAU( I ) )
-            A( I, I ) = AII
-*
-            IF( I.LT.N ) THEN
-*
-*              Apply H(i) to A(i:m,i+1:n) from the left
-*
-               AII = A( I, I )
-               A( I, I ) = DCMPLX( ONE )
-               CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
-     $                     DCONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
-               A( I, I ) = AII
-            END IF
-*
-*           Update partial column norms
-*
-            DO 30 J = I + 1, N
-               IF( RWORK( J ).NE.ZERO ) THEN
-*
-*                 NOTE: The following 4 lines follow from the analysis in
-*                 Lapack Working Note 176.
-*                 
-                  TEMP = ABS( A( I, J ) ) / RWORK( J )
-                  TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
-                  TEMP2 = TEMP*( RWORK( J ) / RWORK( N+J ) )**2
-                  IF( TEMP2 .LE. TOL3Z ) THEN 
-                     IF( M-I.GT.0 ) THEN
-                        RWORK( J ) = DZNRM2( M-I, A( I+1, J ), 1 )
-                        RWORK( N+J ) = RWORK( J )
-                     ELSE
-                        RWORK( J ) = ZERO
-                        RWORK( N+J ) = ZERO
-                     END IF
-                  ELSE
-                     RWORK( J ) = RWORK( J )*SQRT( TEMP )
-                  END IF
-               END IF
-   30       CONTINUE
-*
-   40    CONTINUE
-      END IF
-      RETURN
-*
-*     End of ZGEQPF
-*
-      END
diff --git a/src/lib/lapack/zgeqr2.f b/src/lib/lapack/zgeqr2.f
deleted file mode 100644
index 962ab588..00000000
--- a/src/lib/lapack/zgeqr2.f
+++ /dev/null
@@ -1,121 +0,0 @@
-      SUBROUTINE ZGEQR2( M, N, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEQR2 computes a QR factorization of a complex m by n matrix A:
-*  A = Q * R.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the m by n matrix A.
-*          On exit, the elements on and above the diagonal of the array
-*          contain the min(m,n) by n upper trapezoidal matrix R (R is
-*          upper triangular if m >= n); the elements below the diagonal,
-*          with the array TAU, represent the unitary matrix Q as a
-*          product of elementary reflectors (see Further Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) COMPLEX*16 array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*  and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, K
-      COMPLEX*16         ALPHA
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF, ZLARFG
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGEQR2', -INFO )
-         RETURN
-      END IF
-*
-      K = MIN( M, N )
-*
-      DO 10 I = 1, K
-*
-*        Generate elementary reflector H(i) to annihilate A(i+1:m,i)
-*
-         CALL ZLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
-     $                TAU( I ) )
-         IF( I.LT.N ) THEN
-*
-*           Apply H(i)' to A(i:m,i+1:n) from the left
-*
-            ALPHA = A( I, I )
-            A( I, I ) = ONE
-            CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
-     $                  DCONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
-            A( I, I ) = ALPHA
-         END IF
-   10 CONTINUE
-      RETURN
-*
-*     End of ZGEQR2
-*
-      END
diff --git a/src/lib/lapack/zgeqrf.f b/src/lib/lapack/zgeqrf.f
deleted file mode 100644
index d11c9245..00000000
--- a/src/lib/lapack/zgeqrf.f
+++ /dev/null
@@ -1,196 +0,0 @@
-      SUBROUTINE ZGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGEQRF computes a QR factorization of a complex M-by-N matrix A:
-*  A = Q * R.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the elements on and above the diagonal of the array
-*          contain the min(M,N)-by-N upper trapezoidal matrix R (R is
-*          upper triangular if m >= n); the elements below the diagonal,
-*          with the array TAU, represent the unitary matrix Q as a
-*          product of min(m,n) elementary reflectors (see Further
-*          Details).
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) COMPLEX*16 array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,N).
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(k), where k = min(m,n).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
-*  and tau in TAU(i).
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
-     $                   NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEQR2, ZLARFB, ZLARFT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NB = ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-      LWKOPT = N*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -7
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGEQRF', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      K = MIN( M, N )
-      IF( K.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = N
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'ZGEQRF', ' ', M, N, -1, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = N
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'ZGEQRF', ' ', M, N, -1,
-     $                 -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code initially
-*
-         DO 10 I = 1, K - NX, NB
-            IB = MIN( K-I+1, NB )
-*
-*           Compute the QR factorization of the current block
-*           A(i:m,i:i+ib-1)
-*
-            CALL ZGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
-     $                   IINFO )
-            IF( I+IB.LE.N ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i) H(i+1) . . . H(i+ib-1)
-*
-               CALL ZLARFT( 'Forward', 'Columnwise', M-I+1, IB,
-     $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H' to A(i:m,i+ib:n) from the left
-*
-               CALL ZLARFB( 'Left', 'Conjugate transpose', 'Forward',
-     $                      'Columnwise', M-I+1, N-I-IB+1, IB,
-     $                      A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
-     $                      LDA, WORK( IB+1 ), LDWORK )
-            END IF
-   10    CONTINUE
-      ELSE
-         I = 1
-      END IF
-*
-*     Use unblocked code to factor the last or only block.
-*
-      IF( I.LE.K )
-     $   CALL ZGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
-     $                IINFO )
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of ZGEQRF
-*
-      END
diff --git a/src/lib/lapack/zgesc2.f b/src/lib/lapack/zgesc2.f
deleted file mode 100644
index d4d51337..00000000
--- a/src/lib/lapack/zgesc2.f
+++ /dev/null
@@ -1,133 +0,0 @@
-      SUBROUTINE ZGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            LDA, N
-      DOUBLE PRECISION   SCALE
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * ), JPIV( * )
-      COMPLEX*16         A( LDA, * ), RHS( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGESC2 solves a system of linear equations
-*
-*            A * X = scale* RHS
-*
-*  with a general N-by-N matrix A using the LU factorization with
-*  complete pivoting computed by ZGETC2.
-*
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA, N)
-*          On entry, the  LU part of the factorization of the n-by-n
-*          matrix A computed by ZGETC2:  A = P * L * U * Q
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1, N).
-*
-*  RHS     (input/output) COMPLEX*16 array, dimension N.
-*          On entry, the right hand side vector b.
-*          On exit, the solution vector X.
-*
-*  IPIV    (input) INTEGER array, dimension (N).
-*          The pivot indices; for 1 <= i <= N, row i of the
-*          matrix has been interchanged with row IPIV(i).
-*
-*  JPIV    (input) INTEGER array, dimension (N).
-*          The pivot indices; for 1 <= j <= N, column j of the
-*          matrix has been interchanged with column JPIV(j).
-*
-*  SCALE    (output) DOUBLE PRECISION
-*           On exit, SCALE contains the scale factor. SCALE is chosen
-*           0 <= SCALE <= 1 to prevent owerflow in the solution.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE, TWO
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   BIGNUM, EPS, SMLNUM
-      COMPLEX*16         TEMP
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZLASWP, ZSCAL
-*     ..
-*     .. External Functions ..
-      INTEGER            IZAMAX
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           IZAMAX, DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX
-*     ..
-*     .. Executable Statements ..
-*
-*     Set constant to control overflow
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' ) / EPS
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Apply permutations IPIV to RHS
-*
-      CALL ZLASWP( 1, RHS, LDA, 1, N-1, IPIV, 1 )
-*
-*     Solve for L part
-*
-      DO 20 I = 1, N - 1
-         DO 10 J = I + 1, N
-            RHS( J ) = RHS( J ) - A( J, I )*RHS( I )
-   10    CONTINUE
-   20 CONTINUE
-*
-*     Solve for U part
-*
-      SCALE = ONE
-*
-*     Check for scaling
-*
-      I = IZAMAX( N, RHS, 1 )
-      IF( TWO*SMLNUM*ABS( RHS( I ) ).GT.ABS( A( N, N ) ) ) THEN
-         TEMP = DCMPLX( ONE / TWO, ZERO ) / ABS( RHS( I ) )
-         CALL ZSCAL( N, TEMP, RHS( 1 ), 1 )
-         SCALE = SCALE*DBLE( TEMP )
-      END IF
-      DO 40 I = N, 1, -1
-         TEMP = DCMPLX( ONE, ZERO ) / A( I, I )
-         RHS( I ) = RHS( I )*TEMP
-         DO 30 J = I + 1, N
-            RHS( I ) = RHS( I ) - RHS( J )*( A( I, J )*TEMP )
-   30    CONTINUE
-   40 CONTINUE
-*
-*     Apply permutations JPIV to the solution (RHS)
-*
-      CALL ZLASWP( 1, RHS, LDA, 1, N-1, JPIV, -1 )
-      RETURN
-*
-*     End of ZGESC2
-*
-      END
diff --git a/src/lib/lapack/zgesvd.f b/src/lib/lapack/zgesvd.f
deleted file mode 100644
index 7b238d8b..00000000
--- a/src/lib/lapack/zgesvd.f
+++ /dev/null
@@ -1,3602 +0,0 @@
-      SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
-     $                   WORK, LWORK, RWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBU, JOBVT
-      INTEGER            INFO, LDA, LDU, LDVT, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   RWORK( * ), S( * )
-      COMPLEX*16         A( LDA, * ), U( LDU, * ), VT( LDVT, * ),
-     $                   WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGESVD computes the singular value decomposition (SVD) of a complex
-*  M-by-N matrix A, optionally computing the left and/or right singular
-*  vectors. The SVD is written
-*
-*       A = U * SIGMA * conjugate-transpose(V)
-*
-*  where SIGMA is an M-by-N matrix which is zero except for its
-*  min(m,n) diagonal elements, U is an M-by-M unitary matrix, and
-*  V is an N-by-N unitary matrix.  The diagonal elements of SIGMA
-*  are the singular values of A; they are real and non-negative, and
-*  are returned in descending order.  The first min(m,n) columns of
-*  U and V are the left and right singular vectors of A.
-*
-*  Note that the routine returns V**H, not V.
-*
-*  Arguments
-*  =========
-*
-*  JOBU    (input) CHARACTER*1
-*          Specifies options for computing all or part of the matrix U:
-*          = 'A':  all M columns of U are returned in array U:
-*          = 'S':  the first min(m,n) columns of U (the left singular
-*                  vectors) are returned in the array U;
-*          = 'O':  the first min(m,n) columns of U (the left singular
-*                  vectors) are overwritten on the array A;
-*          = 'N':  no columns of U (no left singular vectors) are
-*                  computed.
-*
-*  JOBVT   (input) CHARACTER*1
-*          Specifies options for computing all or part of the matrix
-*          V**H:
-*          = 'A':  all N rows of V**H are returned in the array VT;
-*          = 'S':  the first min(m,n) rows of V**H (the right singular
-*                  vectors) are returned in the array VT;
-*          = 'O':  the first min(m,n) rows of V**H (the right singular
-*                  vectors) are overwritten on the array A;
-*          = 'N':  no rows of V**H (no right singular vectors) are
-*                  computed.
-*
-*          JOBVT and JOBU cannot both be 'O'.
-*
-*  M       (input) INTEGER
-*          The number of rows of the input matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the input matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit,
-*          if JOBU = 'O',  A is overwritten with the first min(m,n)
-*                          columns of U (the left singular vectors,
-*                          stored columnwise);
-*          if JOBVT = 'O', A is overwritten with the first min(m,n)
-*                          rows of V**H (the right singular vectors,
-*                          stored rowwise);
-*          if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
-*                          are destroyed.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  S       (output) DOUBLE PRECISION array, dimension (min(M,N))
-*          The singular values of A, sorted so that S(i) >= S(i+1).
-*
-*  U       (output) COMPLEX*16 array, dimension (LDU,UCOL)
-*          (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'.
-*          If JOBU = 'A', U contains the M-by-M unitary matrix U;
-*          if JOBU = 'S', U contains the first min(m,n) columns of U
-*          (the left singular vectors, stored columnwise);
-*          if JOBU = 'N' or 'O', U is not referenced.
-*
-*  LDU     (input) INTEGER
-*          The leading dimension of the array U.  LDU >= 1; if
-*          JOBU = 'S' or 'A', LDU >= M.
-*
-*  VT      (output) COMPLEX*16 array, dimension (LDVT,N)
-*          If JOBVT = 'A', VT contains the N-by-N unitary matrix
-*          V**H;
-*          if JOBVT = 'S', VT contains the first min(m,n) rows of
-*          V**H (the right singular vectors, stored rowwise);
-*          if JOBVT = 'N' or 'O', VT is not referenced.
-*
-*  LDVT    (input) INTEGER
-*          The leading dimension of the array VT.  LDVT >= 1; if
-*          JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          LWORK >=  MAX(1,2*MIN(M,N)+MAX(M,N)).
-*          For good performance, LWORK should generally be larger.
-*
-*          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.
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (5*min(M,N))
-*          On exit, if INFO > 0, RWORK(1:MIN(M,N)-1) contains the
-*          unconverged superdiagonal elements of an upper bidiagonal
-*          matrix B whose diagonal is in S (not necessarily sorted).
-*          B satisfies A = U * B * VT, so it has the same singular
-*          values as A, and singular vectors related by U and VT.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          > 0:  if ZBDSQR did not converge, INFO specifies how many
-*                superdiagonals of an intermediate bidiagonal form B
-*                did not converge to zero. See the description of RWORK
-*                above for details.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         CZERO, CONE
-      PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ),
-     $                   CONE = ( 1.0D0, 0.0D0 ) )
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
-     $                   WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
-      INTEGER            BLK, CHUNK, I, IE, IERR, IR, IRWORK, ISCL,
-     $                   ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
-     $                   MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
-     $                   NRVT, WRKBL
-      DOUBLE PRECISION   ANRM, BIGNUM, EPS, SMLNUM
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   DUM( 1 )
-      COMPLEX*16         CDUM( 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLASCL, XERBLA, ZBDSQR, ZGEBRD, ZGELQF, ZGEMM,
-     $                   ZGEQRF, ZLACPY, ZLASCL, ZLASET, ZUNGBR, ZUNGLQ,
-     $                   ZUNGQR, ZUNMBR
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, ZLANGE
-      EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      MINMN = MIN( M, N )
-      WNTUA = LSAME( JOBU, 'A' )
-      WNTUS = LSAME( JOBU, 'S' )
-      WNTUAS = WNTUA .OR. WNTUS
-      WNTUO = LSAME( JOBU, 'O' )
-      WNTUN = LSAME( JOBU, 'N' )
-      WNTVA = LSAME( JOBVT, 'A' )
-      WNTVS = LSAME( JOBVT, 'S' )
-      WNTVAS = WNTVA .OR. WNTVS
-      WNTVO = LSAME( JOBVT, 'O' )
-      WNTVN = LSAME( JOBVT, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-      IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.( WNTVA .OR. WNTVS .OR. WNTVO .OR. WNTVN ) .OR.
-     $         ( WNTVO .AND. WNTUO ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -6
-      ELSE IF( LDU.LT.1 .OR. ( WNTUAS .AND. LDU.LT.M ) ) THEN
-         INFO = -9
-      ELSE IF( LDVT.LT.1 .OR. ( WNTVA .AND. LDVT.LT.N ) .OR.
-     $         ( WNTVS .AND. LDVT.LT.MINMN ) ) THEN
-         INFO = -11
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       CWorkspace refers to complex workspace, and RWorkspace to
-*       real workspace. NB refers to the optimal block size for the
-*       immediately following subroutine, as returned by ILAENV.)
-*
-      IF( INFO.EQ.0 ) THEN
-         MINWRK = 1
-         MAXWRK = 1
-         IF( M.GE.N .AND. MINMN.GT.0 ) THEN
-*
-*           Space needed for ZBDSQR is BDSPAC = 5*N
-*
-            MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )
-            IF( M.GE.MNTHR ) THEN
-               IF( WNTUN ) THEN
-*
-*                 Path 1 (M much larger than N, JOBU='N')
-*
-                  MAXWRK = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1,
-     $                     -1 )
-                  MAXWRK = MAX( MAXWRK, 2*N+2*N*
-     $                     ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
-                  IF( WNTVO .OR. WNTVAS )
-     $               MAXWRK = MAX( MAXWRK, 2*N+( N-1 )*
-     $                        ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
-                  MINWRK = 3*N
-               ELSE IF( WNTUO .AND. WNTVN ) THEN
-*
-*                 Path 2 (M much larger than N, JOBU='O', JOBVT='N')
-*
-                  WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M,
-     $                    N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+2*N*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+N*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
-                  MAXWRK = MAX( N*N+WRKBL, N*N+M*N )
-                  MINWRK = 2*N + M
-               ELSE IF( WNTUO .AND. WNTVAS ) THEN
-*
-*                 Path 3 (M much larger than N, JOBU='O', JOBVT='S' or
-*                 'A')
-*
-                  WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M,
-     $                    N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+2*N*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+N*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+( N-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
-                  MAXWRK = MAX( N*N+WRKBL, N*N+M*N )
-                  MINWRK = 2*N + M
-               ELSE IF( WNTUS .AND. WNTVN ) THEN
-*
-*                 Path 4 (M much larger than N, JOBU='S', JOBVT='N')
-*
-                  WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M,
-     $                    N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+2*N*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+N*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
-                  MAXWRK = N*N + WRKBL
-                  MINWRK = 2*N + M
-               ELSE IF( WNTUS .AND. WNTVO ) THEN
-*
-*                 Path 5 (M much larger than N, JOBU='S', JOBVT='O')
-*
-                  WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M,
-     $                    N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+2*N*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+N*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+( N-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
-                  MAXWRK = 2*N*N + WRKBL
-                  MINWRK = 2*N + M
-               ELSE IF( WNTUS .AND. WNTVAS ) THEN
-*
-*                 Path 6 (M much larger than N, JOBU='S', JOBVT='S' or
-*                 'A')
-*
-                  WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M,
-     $                    N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+2*N*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+N*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+( N-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
-                  MAXWRK = N*N + WRKBL
-                  MINWRK = 2*N + M
-               ELSE IF( WNTUA .AND. WNTVN ) THEN
-*
-*                 Path 7 (M much larger than N, JOBU='A', JOBVT='N')
-*
-                  WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'ZUNGQR', ' ', M,
-     $                    M, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+2*N*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+N*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
-                  MAXWRK = N*N + WRKBL
-                  MINWRK = 2*N + M
-               ELSE IF( WNTUA .AND. WNTVO ) THEN
-*
-*                 Path 8 (M much larger than N, JOBU='A', JOBVT='O')
-*
-                  WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'ZUNGQR', ' ', M,
-     $                    M, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+2*N*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+N*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+( N-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
-                  MAXWRK = 2*N*N + WRKBL
-                  MINWRK = 2*N + M
-               ELSE IF( WNTUA .AND. WNTVAS ) THEN
-*
-*                 Path 9 (M much larger than N, JOBU='A', JOBVT='S' or
-*                 'A')
-*
-                  WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'ZUNGQR', ' ', M,
-     $                    M, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+2*N*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+N*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*N+( N-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
-                  MAXWRK = N*N + WRKBL
-                  MINWRK = 2*N + M
-               END IF
-            ELSE
-*
-*              Path 10 (M at least N, but not much larger)
-*
-               MAXWRK = 2*N + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N,
-     $                  -1, -1 )
-               IF( WNTUS .OR. WNTUO )
-     $            MAXWRK = MAX( MAXWRK, 2*N+N*
-     $                     ILAENV( 1, 'ZUNGBR', 'Q', M, N, N, -1 ) )
-               IF( WNTUA )
-     $            MAXWRK = MAX( MAXWRK, 2*N+M*
-     $                     ILAENV( 1, 'ZUNGBR', 'Q', M, M, N, -1 ) )
-               IF( .NOT.WNTVN )
-     $            MAXWRK = MAX( MAXWRK, 2*N+( N-1 )*
-     $                     ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
-               MINWRK = 2*N + M
-            END IF
-         ELSE IF( MINMN.GT.0 ) THEN
-*
-*           Space needed for ZBDSQR is BDSPAC = 5*M
-*
-            MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )
-            IF( N.GE.MNTHR ) THEN
-               IF( WNTVN ) THEN
-*
-*                 Path 1t(N much larger than M, JOBVT='N')
-*
-                  MAXWRK = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1,
-     $                     -1 )
-                  MAXWRK = MAX( MAXWRK, 2*M+2*M*
-     $                     ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
-                  IF( WNTUO .OR. WNTUAS )
-     $               MAXWRK = MAX( MAXWRK, 2*M+M*
-     $                        ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
-                  MINWRK = 3*M
-               ELSE IF( WNTVO .AND. WNTUN ) THEN
-*
-*                 Path 2t(N much larger than M, JOBU='N', JOBVT='O')
-*
-                  WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+2*M*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+( M-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
-                  MAXWRK = MAX( M*M+WRKBL, M*M+M*N )
-                  MINWRK = 2*M + N
-               ELSE IF( WNTVO .AND. WNTUAS ) THEN
-*
-*                 Path 3t(N much larger than M, JOBU='S' or 'A',
-*                 JOBVT='O')
-*
-                  WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+2*M*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+( M-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+M*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
-                  MAXWRK = MAX( M*M+WRKBL, M*M+M*N )
-                  MINWRK = 2*M + N
-               ELSE IF( WNTVS .AND. WNTUN ) THEN
-*
-*                 Path 4t(N much larger than M, JOBU='N', JOBVT='S')
-*
-                  WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+2*M*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+( M-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
-                  MAXWRK = M*M + WRKBL
-                  MINWRK = 2*M + N
-               ELSE IF( WNTVS .AND. WNTUO ) THEN
-*
-*                 Path 5t(N much larger than M, JOBU='O', JOBVT='S')
-*
-                  WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+2*M*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+( M-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+M*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
-                  MAXWRK = 2*M*M + WRKBL
-                  MINWRK = 2*M + N
-               ELSE IF( WNTVS .AND. WNTUAS ) THEN
-*
-*                 Path 6t(N much larger than M, JOBU='S' or 'A',
-*                 JOBVT='S')
-*
-                  WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+2*M*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+( M-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+M*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
-                  MAXWRK = M*M + WRKBL
-                  MINWRK = 2*M + N
-               ELSE IF( WNTVA .AND. WNTUN ) THEN
-*
-*                 Path 7t(N much larger than M, JOBU='N', JOBVT='A')
-*
-                  WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'ZUNGLQ', ' ', N,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+2*M*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+( M-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
-                  MAXWRK = M*M + WRKBL
-                  MINWRK = 2*M + N
-               ELSE IF( WNTVA .AND. WNTUO ) THEN
-*
-*                 Path 8t(N much larger than M, JOBU='O', JOBVT='A')
-*
-                  WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'ZUNGLQ', ' ', N,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+2*M*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+( M-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+M*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
-                  MAXWRK = 2*M*M + WRKBL
-                  MINWRK = 2*M + N
-               ELSE IF( WNTVA .AND. WNTUAS ) THEN
-*
-*                 Path 9t(N much larger than M, JOBU='S' or 'A',
-*                 JOBVT='A')
-*
-                  WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
-                  WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'ZUNGLQ', ' ', N,
-     $                    N, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+2*M*
-     $                    ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+( M-1 )*
-     $                    ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
-                  WRKBL = MAX( WRKBL, 2*M+M*
-     $                    ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
-                  MAXWRK = M*M + WRKBL
-                  MINWRK = 2*M + N
-               END IF
-            ELSE
-*
-*              Path 10t(N greater than M, but not much larger)
-*
-               MAXWRK = 2*M + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N,
-     $                  -1, -1 )
-               IF( WNTVS .OR. WNTVO )
-     $            MAXWRK = MAX( MAXWRK, 2*M+M*
-     $                     ILAENV( 1, 'ZUNGBR', 'P', M, N, M, -1 ) )
-               IF( WNTVA )
-     $            MAXWRK = MAX( MAXWRK, 2*M+N*
-     $                     ILAENV( 1, 'ZUNGBR', 'P', N, N, M, -1 ) )
-               IF( .NOT.WNTUN )
-     $            MAXWRK = MAX( MAXWRK, 2*M+( M-1 )*
-     $                     ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
-               MINWRK = 2*M + N
-            END IF
-         END IF
-         MAXWRK = MAX( MAXWRK, MINWRK )
-         WORK( 1 ) = MAXWRK
-*
-         IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
-            INFO = -13
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGESVD', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         RETURN
-      END IF
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = SQRT( DLAMCH( 'S' ) ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = ZLANGE( 'M', M, N, A, LDA, DUM )
-      ISCL = 0
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         ISCL = 1
-         CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, IERR )
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         ISCL = 1
-         CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, IERR )
-      END IF
-*
-      IF( M.GE.N ) THEN
-*
-*        A has at least as many rows as columns. If A has sufficiently
-*        more rows than columns, first reduce using the QR
-*        decomposition (if sufficient workspace available)
-*
-         IF( M.GE.MNTHR ) THEN
-*
-            IF( WNTUN ) THEN
-*
-*              Path 1 (M much larger than N, JOBU='N')
-*              No left singular vectors to be computed
-*
-               ITAU = 1
-               IWORK = ITAU + N
-*
-*              Compute A=Q*R
-*              (CWorkspace: need 2*N, prefer N+N*NB)
-*              (RWorkspace: need 0)
-*
-               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
-     $                      LWORK-IWORK+1, IERR )
-*
-*              Zero out below R
-*
-               CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ),
-     $                      LDA )
-               IE = 1
-               ITAUQ = 1
-               ITAUP = ITAUQ + N
-               IWORK = ITAUP + N
-*
-*              Bidiagonalize R in A
-*              (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
-*              (RWorkspace: need N)
-*
-               CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
-     $                      WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
-     $                      IERR )
-               NCVT = 0
-               IF( WNTVO .OR. WNTVAS ) THEN
-*
-*                 If right singular vectors desired, generate P'.
-*                 (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  NCVT = N
-               END IF
-               IRWORK = IE + N
-*
-*              Perform bidiagonal QR iteration, computing right
-*              singular vectors of A in A if desired
-*              (CWorkspace: 0)
-*              (RWorkspace: need BDSPAC)
-*
-               CALL ZBDSQR( 'U', N, NCVT, 0, 0, S, RWORK( IE ), A, LDA,
-     $                      CDUM, 1, CDUM, 1, RWORK( IRWORK ), INFO )
-*
-*              If right singular vectors desired in VT, copy them there
-*
-               IF( WNTVAS )
-     $            CALL ZLACPY( 'F', N, N, A, LDA, VT, LDVT )
-*
-            ELSE IF( WNTUO .AND. WNTVN ) THEN
-*
-*              Path 2 (M much larger than N, JOBU='O', JOBVT='N')
-*              N left singular vectors to be overwritten on A and
-*              no right singular vectors to be computed
-*
-               IF( LWORK.GE.N*N+3*N ) THEN
-*
-*                 Sufficient workspace for a fast algorithm
-*
-                  IR = 1
-                  IF( LWORK.GE.MAX( WRKBL, LDA*N )+LDA*N ) THEN
-*
-*                    WORK(IU) is LDA by N, WORK(IR) is LDA by N
-*
-                     LDWRKU = LDA
-                     LDWRKR = LDA
-                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N )+N*N ) THEN
-*
-*                    WORK(IU) is LDA by N, WORK(IR) is N by N
-*
-                     LDWRKU = LDA
-                     LDWRKR = N
-                  ELSE
-*
-*                    WORK(IU) is LDWRKU by N, WORK(IR) is N by N
-*
-                     LDWRKU = ( LWORK-N*N ) / N
-                     LDWRKR = N
-                  END IF
-                  ITAU = IR + LDWRKR*N
-                  IWORK = ITAU + N
-*
-*                 Compute A=Q*R
-*                 (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy R to WORK(IR) and zero out below it
-*
-                  CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
-                  CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                         WORK( IR+1 ), LDWRKR )
-*
-*                 Generate Q in A
-*                 (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = 1
-                  ITAUQ = ITAU
-                  ITAUP = ITAUQ + N
-                  IWORK = ITAUP + N
-*
-*                 Bidiagonalize R in WORK(IR)
-*                 (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
-*                 (RWorkspace: need N)
-*
-                  CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Generate left vectors bidiagonalizing R
-*                 (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
-*                 (RWorkspace: need 0)
-*
-                  CALL ZUNGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
-     $                         WORK( ITAUQ ), WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-                  IRWORK = IE + N
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of R in WORK(IR)
-*                 (CWorkspace: need N*N)
-*                 (RWorkspace: need BDSPAC)
-*
-                  CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, 1,
-     $                         WORK( IR ), LDWRKR, CDUM, 1,
-     $                         RWORK( IRWORK ), INFO )
-                  IU = ITAUQ
-*
-*                 Multiply Q in A by left singular vectors of R in
-*                 WORK(IR), storing result in WORK(IU) and copying to A
-*                 (CWorkspace: need N*N+N, prefer N*N+M*N)
-*                 (RWorkspace: 0)
-*
-                  DO 10 I = 1, M, LDWRKU
-                     CHUNK = MIN( M-I+1, LDWRKU )
-                     CALL ZGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, 1 ),
-     $                           LDA, WORK( IR ), LDWRKR, CZERO,
-     $                           WORK( IU ), LDWRKU )
-                     CALL ZLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
-     $                            A( I, 1 ), LDA )
-   10             CONTINUE
-*
-               ELSE
-*
-*                 Insufficient workspace for a fast algorithm
-*
-                  IE = 1
-                  ITAUQ = 1
-                  ITAUP = ITAUQ + N
-                  IWORK = ITAUP + N
-*
-*                 Bidiagonalize A
-*                 (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB)
-*                 (RWorkspace: N)
-*
-                  CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Generate left vectors bidiagonalizing A
-*                 (CWorkspace: need 3*N, prefer 2*N+N*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IRWORK = IE + N
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of A in A
-*                 (CWorkspace: need 0)
-*                 (RWorkspace: need BDSPAC)
-*
-                  CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM, 1,
-     $                         A, LDA, CDUM, 1, RWORK( IRWORK ), INFO )
-*
-               END IF
-*
-            ELSE IF( WNTUO .AND. WNTVAS ) THEN
-*
-*              Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A')
-*              N left singular vectors to be overwritten on A and
-*              N right singular vectors to be computed in VT
-*
-               IF( LWORK.GE.N*N+3*N ) THEN
-*
-*                 Sufficient workspace for a fast algorithm
-*
-                  IR = 1
-                  IF( LWORK.GE.MAX( WRKBL, LDA*N )+LDA*N ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
-                     LDWRKU = LDA
-                     LDWRKR = LDA
-                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N )+N*N ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is N by N
-*
-                     LDWRKU = LDA
-                     LDWRKR = N
-                  ELSE
-*
-*                    WORK(IU) is LDWRKU by N and WORK(IR) is N by N
-*
-                     LDWRKU = ( LWORK-N*N ) / N
-                     LDWRKR = N
-                  END IF
-                  ITAU = IR + LDWRKR*N
-                  IWORK = ITAU + N
-*
-*                 Compute A=Q*R
-*                 (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy R to VT, zeroing out below it
-*
-                  CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT )
-                  IF( N.GT.1 )
-     $               CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            VT( 2, 1 ), LDVT )
-*
-*                 Generate Q in A
-*                 (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = 1
-                  ITAUQ = ITAU
-                  ITAUP = ITAUQ + N
-                  IWORK = ITAUP + N
-*
-*                 Bidiagonalize R in VT, copying result to WORK(IR)
-*                 (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
-*                 (RWorkspace: need N)
-*
-                  CALL ZGEBRD( N, N, VT, LDVT, S, RWORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  CALL ZLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR )
-*
-*                 Generate left vectors bidiagonalizing R in WORK(IR)
-*                 (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
-     $                         WORK( ITAUQ ), WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-*
-*                 Generate right vectors bidiagonalizing R in VT
-*                 (CWorkspace: need N*N+3*N-1, prefer N*N+2*N+(N-1)*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IRWORK = IE + N
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of R in WORK(IR) and computing right
-*                 singular vectors of R in VT
-*                 (CWorkspace: need N*N)
-*                 (RWorkspace: need BDSPAC)
-*
-                  CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT,
-     $                         LDVT, WORK( IR ), LDWRKR, CDUM, 1,
-     $                         RWORK( IRWORK ), INFO )
-                  IU = ITAUQ
-*
-*                 Multiply Q in A by left singular vectors of R in
-*                 WORK(IR), storing result in WORK(IU) and copying to A
-*                 (CWorkspace: need N*N+N, prefer N*N+M*N)
-*                 (RWorkspace: 0)
-*
-                  DO 20 I = 1, M, LDWRKU
-                     CHUNK = MIN( M-I+1, LDWRKU )
-                     CALL ZGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, 1 ),
-     $                           LDA, WORK( IR ), LDWRKR, CZERO,
-     $                           WORK( IU ), LDWRKU )
-                     CALL ZLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
-     $                            A( I, 1 ), LDA )
-   20             CONTINUE
-*
-               ELSE
-*
-*                 Insufficient workspace for a fast algorithm
-*
-                  ITAU = 1
-                  IWORK = ITAU + N
-*
-*                 Compute A=Q*R
-*                 (CWorkspace: need 2*N, prefer N+N*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy R to VT, zeroing out below it
-*
-                  CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT )
-                  IF( N.GT.1 )
-     $               CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            VT( 2, 1 ), LDVT )
-*
-*                 Generate Q in A
-*                 (CWorkspace: need 2*N, prefer N+N*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = 1
-                  ITAUQ = ITAU
-                  ITAUP = ITAUQ + N
-                  IWORK = ITAUP + N
-*
-*                 Bidiagonalize R in VT
-*                 (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
-*                 (RWorkspace: N)
-*
-                  CALL ZGEBRD( N, N, VT, LDVT, S, RWORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Multiply Q in A by left vectors bidiagonalizing R
-*                 (CWorkspace: need 2*N+M, prefer 2*N+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
-     $                         WORK( ITAUQ ), A, LDA, WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-*
-*                 Generate right vectors bidiagonalizing R in VT
-*                 (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IRWORK = IE + N
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of A in A and computing right
-*                 singular vectors of A in VT
-*                 (CWorkspace: 0)
-*                 (RWorkspace: need BDSPAC)
-*
-                  CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT,
-     $                         LDVT, A, LDA, CDUM, 1, RWORK( IRWORK ),
-     $                         INFO )
-*
-               END IF
-*
-            ELSE IF( WNTUS ) THEN
-*
-               IF( WNTVN ) THEN
-*
-*                 Path 4 (M much larger than N, JOBU='S', JOBVT='N')
-*                 N left singular vectors to be computed in U and
-*                 no right singular vectors to be computed
-*
-                  IF( LWORK.GE.N*N+3*N ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IR = 1
-                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-*                       WORK(IR) is LDA by N
-*
-                        LDWRKR = LDA
-                     ELSE
-*
-*                       WORK(IR) is N by N
-*
-                        LDWRKR = N
-                     END IF
-                     ITAU = IR + LDWRKR*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R
-*                    (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to WORK(IR), zeroing out below it
-*
-                     CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ),
-     $                            LDWRKR )
-                     CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            WORK( IR+1 ), LDWRKR )
-*
-*                    Generate Q in A
-*                    (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IR)
-*                    (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
-*                    (RWorkspace: need N)
-*
-                     CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left vectors bidiagonalizing R in WORK(IR)
-*                    (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IR)
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM,
-     $                            1, WORK( IR ), LDWRKR, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-*                    Multiply Q in A by left singular vectors of R in
-*                    WORK(IR), storing result in U
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA,
-     $                           WORK( IR ), LDWRKR, CZERO, U, LDU )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (CWorkspace: need 2*N, prefer N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (CWorkspace: need 2*N, prefer N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, N, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Zero out below R in A
-*
-                     CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            A( 2, 1 ), LDA )
-*
-*                    Bidiagonalize R in A
-*                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
-*                    (RWorkspace: need N)
-*
-                     CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left vectors bidiagonalizing R
-*                    (CWorkspace: need 2*N+M, prefer 2*N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM,
-     $                            1, U, LDU, CDUM, 1, RWORK( IRWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTVO ) THEN
-*
-*                 Path 5 (M much larger than N, JOBU='S', JOBVT='O')
-*                 N left singular vectors to be computed in U and
-*                 N right singular vectors to be overwritten on A
-*
-                  IF( LWORK.GE.2*N*N+3*N ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
-*
-*                       WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*N
-                        LDWRKR = LDA
-                     ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
-*
-*                       WORK(IU) is LDA by N and WORK(IR) is N by N
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*N
-                        LDWRKR = N
-                     ELSE
-*
-*                       WORK(IU) is N by N and WORK(IR) is N by N
-*
-                        LDWRKU = N
-                        IR = IU + LDWRKU*N
-                        LDWRKR = N
-                     END IF
-                     ITAU = IR + LDWRKR*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R
-*                    (CWorkspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to WORK(IU), zeroing out below it
-*
-                     CALL ZLACPY( 'U', N, N, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            WORK( IU+1 ), LDWRKU )
-*
-*                    Generate Q in A
-*                    (CWorkspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IU), copying result to
-*                    WORK(IR)
-*                    (CWorkspace: need   2*N*N+3*N,
-*                                 prefer 2*N*N+2*N+2*N*NB)
-*                    (RWorkspace: need   N)
-*
-                     CALL ZGEBRD( N, N, WORK( IU ), LDWRKU, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', N, N, WORK( IU ), LDWRKU,
-     $                            WORK( IR ), LDWRKR )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IU)
-*                    (CWorkspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IR)
-*                    (CWorkspace: need   2*N*N+3*N-1,
-*                                 prefer 2*N*N+2*N+(N-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IU) and computing
-*                    right singular vectors of R in WORK(IR)
-*                    (CWorkspace: need 2*N*N)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ),
-     $                            WORK( IR ), LDWRKR, WORK( IU ),
-     $                            LDWRKU, CDUM, 1, RWORK( IRWORK ),
-     $                            INFO )
-*
-*                    Multiply Q in A by left singular vectors of R in
-*                    WORK(IU), storing result in U
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA,
-     $                           WORK( IU ), LDWRKU, CZERO, U, LDU )
-*
-*                    Copy right singular vectors of R to A
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: 0)
-*
-                     CALL ZLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
-     $                            LDA )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (CWorkspace: need 2*N, prefer N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (CWorkspace: need 2*N, prefer N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, N, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Zero out below R in A
-*
-                     CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            A( 2, 1 ), LDA )
-*
-*                    Bidiagonalize R in A
-*                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
-*                    (RWorkspace: need N)
-*
-                     CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left vectors bidiagonalizing R
-*                    (CWorkspace: need 2*N+M, prefer 2*N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right vectors bidiagonalizing R in A
-*                    (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in A
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), A,
-     $                            LDA, U, LDU, CDUM, 1, RWORK( IRWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTVAS ) THEN
-*
-*                 Path 6 (M much larger than N, JOBU='S', JOBVT='S'
-*                         or 'A')
-*                 N left singular vectors to be computed in U and
-*                 N right singular vectors to be computed in VT
-*
-                  IF( LWORK.GE.N*N+3*N ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-*                       WORK(IU) is LDA by N
-*
-                        LDWRKU = LDA
-                     ELSE
-*
-*                       WORK(IU) is N by N
-*
-                        LDWRKU = N
-                     END IF
-                     ITAU = IU + LDWRKU*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R
-*                    (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to WORK(IU), zeroing out below it
-*
-                     CALL ZLACPY( 'U', N, N, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            WORK( IU+1 ), LDWRKU )
-*
-*                    Generate Q in A
-*                    (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IU), copying result to VT
-*                    (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
-*                    (RWorkspace: need N)
-*
-                     CALL ZGEBRD( N, N, WORK( IU ), LDWRKU, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
-     $                            LDVT )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IU)
-*                    (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in VT
-*                    (CWorkspace: need   N*N+3*N-1,
-*                                 prefer N*N+2*N+(N-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IU) and computing
-*                    right singular vectors of R in VT
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT,
-     $                            LDVT, WORK( IU ), LDWRKU, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-*                    Multiply Q in A by left singular vectors of R in
-*                    WORK(IU), storing result in U
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA,
-     $                           WORK( IU ), LDWRKU, CZERO, U, LDU )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (CWorkspace: need 2*N, prefer N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (CWorkspace: need 2*N, prefer N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, N, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to VT, zeroing out below it
-*
-                     CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT )
-                     IF( N.GT.1 )
-     $                  CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                               VT( 2, 1 ), LDVT )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in VT
-*                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
-*                    (RWorkspace: need N)
-*
-                     CALL ZGEBRD( N, N, VT, LDVT, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left bidiagonalizing vectors
-*                    in VT
-*                    (CWorkspace: need 2*N+M, prefer 2*N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in VT
-*                    (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in VT
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT,
-     $                            LDVT, U, LDU, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-                  END IF
-*
-               END IF
-*
-            ELSE IF( WNTUA ) THEN
-*
-               IF( WNTVN ) THEN
-*
-*                 Path 7 (M much larger than N, JOBU='A', JOBVT='N')
-*                 M left singular vectors to be computed in U and
-*                 no right singular vectors to be computed
-*
-                  IF( LWORK.GE.N*N+MAX( N+M, 3*N ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IR = 1
-                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-*                       WORK(IR) is LDA by N
-*
-                        LDWRKR = LDA
-                     ELSE
-*
-*                       WORK(IR) is N by N
-*
-                        LDWRKR = N
-                     END IF
-                     ITAU = IR + LDWRKR*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Copy R to WORK(IR), zeroing out below it
-*
-                     CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ),
-     $                            LDWRKR )
-                     CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            WORK( IR+1 ), LDWRKR )
-*
-*                    Generate Q in U
-*                    (CWorkspace: need N*N+N+M, prefer N*N+N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IR)
-*                    (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
-*                    (RWorkspace: need N)
-*
-                     CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IR)
-*                    (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IR)
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM,
-     $                            1, WORK( IR ), LDWRKR, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-*                    Multiply Q in U by left singular vectors of R in
-*                    WORK(IR), storing result in A
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU,
-     $                           WORK( IR ), LDWRKR, CZERO, A, LDA )
-*
-*                    Copy left singular vectors of A from A to U
-*
-                     CALL ZLACPY( 'F', M, N, A, LDA, U, LDU )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (CWorkspace: need 2*N, prefer N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (CWorkspace: need N+M, prefer N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Zero out below R in A
-*
-                     CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            A( 2, 1 ), LDA )
-*
-*                    Bidiagonalize R in A
-*                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
-*                    (RWorkspace: need N)
-*
-                     CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left bidiagonalizing vectors
-*                    in A
-*                    (CWorkspace: need 2*N+M, prefer 2*N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM,
-     $                            1, U, LDU, CDUM, 1, RWORK( IRWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTVO ) THEN
-*
-*                 Path 8 (M much larger than N, JOBU='A', JOBVT='O')
-*                 M left singular vectors to be computed in U and
-*                 N right singular vectors to be overwritten on A
-*
-                  IF( LWORK.GE.2*N*N+MAX( N+M, 3*N ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
-*
-*                       WORK(IU) is LDA by N and WORK(IR) is LDA by N
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*N
-                        LDWRKR = LDA
-                     ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
-*
-*                       WORK(IU) is LDA by N and WORK(IR) is N by N
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*N
-                        LDWRKR = N
-                     ELSE
-*
-*                       WORK(IU) is N by N and WORK(IR) is N by N
-*
-                        LDWRKU = N
-                        IR = IU + LDWRKU*N
-                        LDWRKR = N
-                     END IF
-                     ITAU = IR + LDWRKR*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (CWorkspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (CWorkspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to WORK(IU), zeroing out below it
-*
-                     CALL ZLACPY( 'U', N, N, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            WORK( IU+1 ), LDWRKU )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IU), copying result to
-*                    WORK(IR)
-*                    (CWorkspace: need   2*N*N+3*N,
-*                                 prefer 2*N*N+2*N+2*N*NB)
-*                    (RWorkspace: need   N)
-*
-                     CALL ZGEBRD( N, N, WORK( IU ), LDWRKU, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', N, N, WORK( IU ), LDWRKU,
-     $                            WORK( IR ), LDWRKR )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IU)
-*                    (CWorkspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IR)
-*                    (CWorkspace: need   2*N*N+3*N-1,
-*                                 prefer 2*N*N+2*N+(N-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IU) and computing
-*                    right singular vectors of R in WORK(IR)
-*                    (CWorkspace: need 2*N*N)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ),
-     $                            WORK( IR ), LDWRKR, WORK( IU ),
-     $                            LDWRKU, CDUM, 1, RWORK( IRWORK ),
-     $                            INFO )
-*
-*                    Multiply Q in U by left singular vectors of R in
-*                    WORK(IU), storing result in A
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU,
-     $                           WORK( IU ), LDWRKU, CZERO, A, LDA )
-*
-*                    Copy left singular vectors of A from A to U
-*
-                     CALL ZLACPY( 'F', M, N, A, LDA, U, LDU )
-*
-*                    Copy right singular vectors of R from WORK(IR) to A
-*
-                     CALL ZLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
-     $                            LDA )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (CWorkspace: need 2*N, prefer N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (CWorkspace: need N+M, prefer N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Zero out below R in A
-*
-                     CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            A( 2, 1 ), LDA )
-*
-*                    Bidiagonalize R in A
-*                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
-*                    (RWorkspace: need N)
-*
-                     CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left bidiagonalizing vectors
-*                    in A
-*                    (CWorkspace: need 2*N+M, prefer 2*N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in A
-*                    (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in A
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), A,
-     $                            LDA, U, LDU, CDUM, 1, RWORK( IRWORK ),
-     $                            INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTVAS ) THEN
-*
-*                 Path 9 (M much larger than N, JOBU='A', JOBVT='S'
-*                         or 'A')
-*                 M left singular vectors to be computed in U and
-*                 N right singular vectors to be computed in VT
-*
-                  IF( LWORK.GE.N*N+MAX( N+M, 3*N ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
-*
-*                       WORK(IU) is LDA by N
-*
-                        LDWRKU = LDA
-                     ELSE
-*
-*                       WORK(IU) is N by N
-*
-                        LDWRKU = N
-                     END IF
-                     ITAU = IU + LDWRKU*N
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (CWorkspace: need N*N+N+M, prefer N*N+N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R to WORK(IU), zeroing out below it
-*
-                     CALL ZLACPY( 'U', N, N, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                            WORK( IU+1 ), LDWRKU )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in WORK(IU), copying result to VT
-*                    (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
-*                    (RWorkspace: need N)
-*
-                     CALL ZGEBRD( N, N, WORK( IU ), LDWRKU, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
-     $                            LDVT )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IU)
-*                    (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in VT
-*                    (CWorkspace: need   N*N+3*N-1,
-*                                 prefer N*N+2*N+(N-1)*NB)
-*                    (RWorkspace: need   0)
-*
-                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of R in WORK(IU) and computing
-*                    right singular vectors of R in VT
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT,
-     $                            LDVT, WORK( IU ), LDWRKU, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-*                    Multiply Q in U by left singular vectors of R in
-*                    WORK(IU), storing result in A
-*                    (CWorkspace: need N*N)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU,
-     $                           WORK( IU ), LDWRKU, CZERO, A, LDA )
-*
-*                    Copy left singular vectors of A from A to U
-*
-                     CALL ZLACPY( 'F', M, N, A, LDA, U, LDU )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + N
-*
-*                    Compute A=Q*R, copying result to U
-*                    (CWorkspace: need 2*N, prefer N+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
-*
-*                    Generate Q in U
-*                    (CWorkspace: need N+M, prefer N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy R from A to VT, zeroing out below it
-*
-                     CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT )
-                     IF( N.GT.1 )
-     $                  CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
-     $                               VT( 2, 1 ), LDVT )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + N
-                     IWORK = ITAUP + N
-*
-*                    Bidiagonalize R in VT
-*                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
-*                    (RWorkspace: need N)
-*
-                     CALL ZGEBRD( N, N, VT, LDVT, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply Q in U by left bidiagonalizing vectors
-*                    in VT
-*                    (CWorkspace: need 2*N+M, prefer 2*N+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
-     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in VT
-*                    (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + N
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in VT
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT,
-     $                            LDVT, U, LDU, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-                  END IF
-*
-               END IF
-*
-            END IF
-*
-         ELSE
-*
-*           M .LT. MNTHR
-*
-*           Path 10 (M at least N, but not much larger)
-*           Reduce to bidiagonal form without QR decomposition
-*
-            IE = 1
-            ITAUQ = 1
-            ITAUP = ITAUQ + N
-            IWORK = ITAUP + N
-*
-*           Bidiagonalize A
-*           (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB)
-*           (RWorkspace: need N)
-*
-            CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
-     $                   WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
-     $                   IERR )
-            IF( WNTUAS ) THEN
-*
-*              If left singular vectors desired in U, copy result to U
-*              and generate left bidiagonalizing vectors in U
-*              (CWorkspace: need 2*N+NCU, prefer 2*N+NCU*NB)
-*              (RWorkspace: 0)
-*
-               CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
-               IF( WNTUS )
-     $            NCU = N
-               IF( WNTUA )
-     $            NCU = M
-               CALL ZUNGBR( 'Q', M, NCU, N, U, LDU, WORK( ITAUQ ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTVAS ) THEN
-*
-*              If right singular vectors desired in VT, copy result to
-*              VT and generate right bidiagonalizing vectors in VT
-*              (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*              (RWorkspace: 0)
-*
-               CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT )
-               CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTUO ) THEN
-*
-*              If left singular vectors desired in A, generate left
-*              bidiagonalizing vectors in A
-*              (CWorkspace: need 3*N, prefer 2*N+N*NB)
-*              (RWorkspace: 0)
-*
-               CALL ZUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTVO ) THEN
-*
-*              If right singular vectors desired in A, generate right
-*              bidiagonalizing vectors in A
-*              (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
-*              (RWorkspace: 0)
-*
-               CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IRWORK = IE + N
-            IF( WNTUAS .OR. WNTUO )
-     $         NRU = M
-            IF( WNTUN )
-     $         NRU = 0
-            IF( WNTVAS .OR. WNTVO )
-     $         NCVT = N
-            IF( WNTVN )
-     $         NCVT = 0
-            IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in U and computing right singular
-*              vectors in VT
-*              (CWorkspace: 0)
-*              (RWorkspace: need BDSPAC)
-*
-               CALL ZBDSQR( 'U', N, NCVT, NRU, 0, S, RWORK( IE ), VT,
-     $                      LDVT, U, LDU, CDUM, 1, RWORK( IRWORK ),
-     $                      INFO )
-            ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in U and computing right singular
-*              vectors in A
-*              (CWorkspace: 0)
-*              (RWorkspace: need BDSPAC)
-*
-               CALL ZBDSQR( 'U', N, NCVT, NRU, 0, S, RWORK( IE ), A,
-     $                      LDA, U, LDU, CDUM, 1, RWORK( IRWORK ),
-     $                      INFO )
-            ELSE
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in A and computing right singular
-*              vectors in VT
-*              (CWorkspace: 0)
-*              (RWorkspace: need BDSPAC)
-*
-               CALL ZBDSQR( 'U', N, NCVT, NRU, 0, S, RWORK( IE ), VT,
-     $                      LDVT, A, LDA, CDUM, 1, RWORK( IRWORK ),
-     $                      INFO )
-            END IF
-*
-         END IF
-*
-      ELSE
-*
-*        A has more columns than rows. If A has sufficiently more
-*        columns than rows, first reduce using the LQ decomposition (if
-*        sufficient workspace available)
-*
-         IF( N.GE.MNTHR ) THEN
-*
-            IF( WNTVN ) THEN
-*
-*              Path 1t(N much larger than M, JOBVT='N')
-*              No right singular vectors to be computed
-*
-               ITAU = 1
-               IWORK = ITAU + M
-*
-*              Compute A=L*Q
-*              (CWorkspace: need 2*M, prefer M+M*NB)
-*              (RWorkspace: 0)
-*
-               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
-     $                      LWORK-IWORK+1, IERR )
-*
-*              Zero out above L
-*
-               CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, A( 1, 2 ),
-     $                      LDA )
-               IE = 1
-               ITAUQ = 1
-               ITAUP = ITAUQ + M
-               IWORK = ITAUP + M
-*
-*              Bidiagonalize L in A
-*              (CWorkspace: need 3*M, prefer 2*M+2*M*NB)
-*              (RWorkspace: need M)
-*
-               CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
-     $                      WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
-     $                      IERR )
-               IF( WNTUO .OR. WNTUAS ) THEN
-*
-*                 If left singular vectors desired, generate Q
-*                 (CWorkspace: need 3*M, prefer 2*M+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-               END IF
-               IRWORK = IE + M
-               NRU = 0
-               IF( WNTUO .OR. WNTUAS )
-     $            NRU = M
-*
-*              Perform bidiagonal QR iteration, computing left singular
-*              vectors of A in A if desired
-*              (CWorkspace: 0)
-*              (RWorkspace: need BDSPAC)
-*
-               CALL ZBDSQR( 'U', M, 0, NRU, 0, S, RWORK( IE ), CDUM, 1,
-     $                      A, LDA, CDUM, 1, RWORK( IRWORK ), INFO )
-*
-*              If left singular vectors desired in U, copy them there
-*
-               IF( WNTUAS )
-     $            CALL ZLACPY( 'F', M, M, A, LDA, U, LDU )
-*
-            ELSE IF( WNTVO .AND. WNTUN ) THEN
-*
-*              Path 2t(N much larger than M, JOBU='N', JOBVT='O')
-*              M right singular vectors to be overwritten on A and
-*              no left singular vectors to be computed
-*
-               IF( LWORK.GE.M*M+3*M ) THEN
-*
-*                 Sufficient workspace for a fast algorithm
-*
-                  IR = 1
-                  IF( LWORK.GE.MAX( WRKBL, LDA*N )+LDA*M ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is LDA by M
-*
-                     LDWRKU = LDA
-                     CHUNK = N
-                     LDWRKR = LDA
-                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N )+M*M ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is M by M
-*
-                     LDWRKU = LDA
-                     CHUNK = N
-                     LDWRKR = M
-                  ELSE
-*
-*                    WORK(IU) is M by CHUNK and WORK(IR) is M by M
-*
-                     LDWRKU = M
-                     CHUNK = ( LWORK-M*M ) / M
-                     LDWRKR = M
-                  END IF
-                  ITAU = IR + LDWRKR*M
-                  IWORK = ITAU + M
-*
-*                 Compute A=L*Q
-*                 (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy L to WORK(IR) and zero out above it
-*
-                  CALL ZLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR )
-                  CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                         WORK( IR+LDWRKR ), LDWRKR )
-*
-*                 Generate Q in A
-*                 (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = 1
-                  ITAUQ = ITAU
-                  ITAUP = ITAUQ + M
-                  IWORK = ITAUP + M
-*
-*                 Bidiagonalize L in WORK(IR)
-*                 (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
-*                 (RWorkspace: need M)
-*
-                  CALL ZGEBRD( M, M, WORK( IR ), LDWRKR, S, RWORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Generate right vectors bidiagonalizing L
-*                 (CWorkspace: need M*M+3*M-1, prefer M*M+2*M+(M-1)*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
-     $                         WORK( ITAUP ), WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-                  IRWORK = IE + M
-*
-*                 Perform bidiagonal QR iteration, computing right
-*                 singular vectors of L in WORK(IR)
-*                 (CWorkspace: need M*M)
-*                 (RWorkspace: need BDSPAC)
-*
-                  CALL ZBDSQR( 'U', M, M, 0, 0, S, RWORK( IE ),
-     $                         WORK( IR ), LDWRKR, CDUM, 1, CDUM, 1,
-     $                         RWORK( IRWORK ), INFO )
-                  IU = ITAUQ
-*
-*                 Multiply right singular vectors of L in WORK(IR) by Q
-*                 in A, storing result in WORK(IU) and copying to A
-*                 (CWorkspace: need M*M+M, prefer M*M+M*N)
-*                 (RWorkspace: 0)
-*
-                  DO 30 I = 1, N, CHUNK
-                     BLK = MIN( N-I+1, CHUNK )
-                     CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IR ),
-     $                           LDWRKR, A( 1, I ), LDA, CZERO,
-     $                           WORK( IU ), LDWRKU )
-                     CALL ZLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
-     $                            A( 1, I ), LDA )
-   30             CONTINUE
-*
-               ELSE
-*
-*                 Insufficient workspace for a fast algorithm
-*
-                  IE = 1
-                  ITAUQ = 1
-                  ITAUP = ITAUQ + M
-                  IWORK = ITAUP + M
-*
-*                 Bidiagonalize A
-*                 (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB)
-*                 (RWorkspace: need M)
-*
-                  CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Generate right vectors bidiagonalizing A
-*                 (CWorkspace: need 3*M, prefer 2*M+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IRWORK = IE + M
-*
-*                 Perform bidiagonal QR iteration, computing right
-*                 singular vectors of A in A
-*                 (CWorkspace: 0)
-*                 (RWorkspace: need BDSPAC)
-*
-                  CALL ZBDSQR( 'L', M, N, 0, 0, S, RWORK( IE ), A, LDA,
-     $                         CDUM, 1, CDUM, 1, RWORK( IRWORK ), INFO )
-*
-               END IF
-*
-            ELSE IF( WNTVO .AND. WNTUAS ) THEN
-*
-*              Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O')
-*              M right singular vectors to be overwritten on A and
-*              M left singular vectors to be computed in U
-*
-               IF( LWORK.GE.M*M+3*M ) THEN
-*
-*                 Sufficient workspace for a fast algorithm
-*
-                  IR = 1
-                  IF( LWORK.GE.MAX( WRKBL, LDA*N )+LDA*M ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is LDA by M
-*
-                     LDWRKU = LDA
-                     CHUNK = N
-                     LDWRKR = LDA
-                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N )+M*M ) THEN
-*
-*                    WORK(IU) is LDA by N and WORK(IR) is M by M
-*
-                     LDWRKU = LDA
-                     CHUNK = N
-                     LDWRKR = M
-                  ELSE
-*
-*                    WORK(IU) is M by CHUNK and WORK(IR) is M by M
-*
-                     LDWRKU = M
-                     CHUNK = ( LWORK-M*M ) / M
-                     LDWRKR = M
-                  END IF
-                  ITAU = IR + LDWRKR*M
-                  IWORK = ITAU + M
-*
-*                 Compute A=L*Q
-*                 (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy L to U, zeroing about above it
-*
-                  CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
-                  CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, 2 ),
-     $                         LDU )
-*
-*                 Generate Q in A
-*                 (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = 1
-                  ITAUQ = ITAU
-                  ITAUP = ITAUQ + M
-                  IWORK = ITAUP + M
-*
-*                 Bidiagonalize L in U, copying result to WORK(IR)
-*                 (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
-*                 (RWorkspace: need M)
-*
-                  CALL ZGEBRD( M, M, U, LDU, S, RWORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  CALL ZLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR )
-*
-*                 Generate right vectors bidiagonalizing L in WORK(IR)
-*                 (CWorkspace: need M*M+3*M-1, prefer M*M+2*M+(M-1)*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
-     $                         WORK( ITAUP ), WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-*
-*                 Generate left vectors bidiagonalizing L in U
-*                 (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IRWORK = IE + M
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of L in U, and computing right
-*                 singular vectors of L in WORK(IR)
-*                 (CWorkspace: need M*M)
-*                 (RWorkspace: need BDSPAC)
-*
-                  CALL ZBDSQR( 'U', M, M, M, 0, S, RWORK( IE ),
-     $                         WORK( IR ), LDWRKR, U, LDU, CDUM, 1,
-     $                         RWORK( IRWORK ), INFO )
-                  IU = ITAUQ
-*
-*                 Multiply right singular vectors of L in WORK(IR) by Q
-*                 in A, storing result in WORK(IU) and copying to A
-*                 (CWorkspace: need M*M+M, prefer M*M+M*N))
-*                 (RWorkspace: 0)
-*
-                  DO 40 I = 1, N, CHUNK
-                     BLK = MIN( N-I+1, CHUNK )
-                     CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IR ),
-     $                           LDWRKR, A( 1, I ), LDA, CZERO,
-     $                           WORK( IU ), LDWRKU )
-                     CALL ZLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
-     $                            A( 1, I ), LDA )
-   40             CONTINUE
-*
-               ELSE
-*
-*                 Insufficient workspace for a fast algorithm
-*
-                  ITAU = 1
-                  IWORK = ITAU + M
-*
-*                 Compute A=L*Q
-*                 (CWorkspace: need 2*M, prefer M+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Copy L to U, zeroing out above it
-*
-                  CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
-                  CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, 2 ),
-     $                         LDU )
-*
-*                 Generate Q in A
-*                 (CWorkspace: need 2*M, prefer M+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IE = 1
-                  ITAUQ = ITAU
-                  ITAUP = ITAUQ + M
-                  IWORK = ITAUP + M
-*
-*                 Bidiagonalize L in U
-*                 (CWorkspace: need 3*M, prefer 2*M+2*M*NB)
-*                 (RWorkspace: need M)
-*
-                  CALL ZGEBRD( M, M, U, LDU, S, RWORK( IE ),
-     $                         WORK( ITAUQ ), WORK( ITAUP ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                 Multiply right vectors bidiagonalizing L by Q in A
-*                 (CWorkspace: need 2*M+N, prefer 2*M+N*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNMBR( 'P', 'L', 'C', M, N, M, U, LDU,
-     $                         WORK( ITAUP ), A, LDA, WORK( IWORK ),
-     $                         LWORK-IWORK+1, IERR )
-*
-*                 Generate left vectors bidiagonalizing L in U
-*                 (CWorkspace: need 3*M, prefer 2*M+M*NB)
-*                 (RWorkspace: 0)
-*
-                  CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  IRWORK = IE + M
-*
-*                 Perform bidiagonal QR iteration, computing left
-*                 singular vectors of A in U and computing right
-*                 singular vectors of A in A
-*                 (CWorkspace: 0)
-*                 (RWorkspace: need BDSPAC)
-*
-                  CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), A, LDA,
-     $                         U, LDU, CDUM, 1, RWORK( IRWORK ), INFO )
-*
-               END IF
-*
-            ELSE IF( WNTVS ) THEN
-*
-               IF( WNTUN ) THEN
-*
-*                 Path 4t(N much larger than M, JOBU='N', JOBVT='S')
-*                 M right singular vectors to be computed in VT and
-*                 no left singular vectors to be computed
-*
-                  IF( LWORK.GE.M*M+3*M ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IR = 1
-                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-*                       WORK(IR) is LDA by M
-*
-                        LDWRKR = LDA
-                     ELSE
-*
-*                       WORK(IR) is M by M
-*
-                        LDWRKR = M
-                     END IF
-                     ITAU = IR + LDWRKR*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q
-*                    (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to WORK(IR), zeroing out above it
-*
-                     CALL ZLACPY( 'L', M, M, A, LDA, WORK( IR ),
-     $                            LDWRKR )
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            WORK( IR+LDWRKR ), LDWRKR )
-*
-*                    Generate Q in A
-*                    (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IR)
-*                    (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
-*                    (RWorkspace: need M)
-*
-                     CALL ZGEBRD( M, M, WORK( IR ), LDWRKR, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right vectors bidiagonalizing L in
-*                    WORK(IR)
-*                    (CWorkspace: need M*M+3*M, prefer M*M+2*M+(M-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing right
-*                    singular vectors of L in WORK(IR)
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, M, 0, 0, S, RWORK( IE ),
-     $                            WORK( IR ), LDWRKR, CDUM, 1, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IR) by
-*                    Q in A, storing result in VT
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IR ),
-     $                           LDWRKR, A, LDA, CZERO, VT, LDVT )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q
-*                    (CWorkspace: need 2*M, prefer M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy result to VT
-*
-                     CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (CWorkspace: need 2*M, prefer M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Zero out above L in A
-*
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            A( 1, 2 ), LDA )
-*
-*                    Bidiagonalize L in A
-*                    (CWorkspace: need 3*M, prefer 2*M+2*M*NB)
-*                    (RWorkspace: need M)
-*
-                     CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right vectors bidiagonalizing L by Q in VT
-*                    (CWorkspace: need 2*M+N, prefer 2*M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'P', 'L', 'C', M, N, M, A, LDA,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing right
-*                    singular vectors of A in VT
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), VT,
-     $                            LDVT, CDUM, 1, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTUO ) THEN
-*
-*                 Path 5t(N much larger than M, JOBU='O', JOBVT='S')
-*                 M right singular vectors to be computed in VT and
-*                 M left singular vectors to be overwritten on A
-*
-                  IF( LWORK.GE.2*M*M+3*M ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
-*
-*                       WORK(IU) is LDA by M and WORK(IR) is LDA by M
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*M
-                        LDWRKR = LDA
-                     ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
-*
-*                       WORK(IU) is LDA by M and WORK(IR) is M by M
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*M
-                        LDWRKR = M
-                     ELSE
-*
-*                       WORK(IU) is M by M and WORK(IR) is M by M
-*
-                        LDWRKU = M
-                        IR = IU + LDWRKU*M
-                        LDWRKR = M
-                     END IF
-                     ITAU = IR + LDWRKR*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q
-*                    (CWorkspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to WORK(IU), zeroing out below it
-*
-                     CALL ZLACPY( 'L', M, M, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            WORK( IU+LDWRKU ), LDWRKU )
-*
-*                    Generate Q in A
-*                    (CWorkspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IU), copying result to
-*                    WORK(IR)
-*                    (CWorkspace: need   2*M*M+3*M,
-*                                 prefer 2*M*M+2*M+2*M*NB)
-*                    (RWorkspace: need   M)
-*
-                     CALL ZGEBRD( M, M, WORK( IU ), LDWRKU, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, M, WORK( IU ), LDWRKU,
-     $                            WORK( IR ), LDWRKR )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IU)
-*                    (CWorkspace: need   2*M*M+3*M-1,
-*                                 prefer 2*M*M+2*M+(M-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IR)
-*                    (CWorkspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of L in WORK(IR) and computing
-*                    right singular vectors of L in WORK(IU)
-*                    (CWorkspace: need 2*M*M)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, M, M, 0, S, RWORK( IE ),
-     $                            WORK( IU ), LDWRKU, WORK( IR ),
-     $                            LDWRKR, CDUM, 1, RWORK( IRWORK ),
-     $                            INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IU) by
-*                    Q in A, storing result in VT
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IU ),
-     $                           LDWRKU, A, LDA, CZERO, VT, LDVT )
-*
-*                    Copy left singular vectors of L to A
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: 0)
-*
-                     CALL ZLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
-     $                            LDA )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (CWorkspace: need 2*M, prefer M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (CWorkspace: need 2*M, prefer M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Zero out above L in A
-*
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            A( 1, 2 ), LDA )
-*
-*                    Bidiagonalize L in A
-*                    (CWorkspace: need 3*M, prefer 2*M+2*M*NB)
-*                    (RWorkspace: need M)
-*
-                     CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right vectors bidiagonalizing L by Q in VT
-*                    (CWorkspace: need 2*M+N, prefer 2*M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'P', 'L', 'C', M, N, M, A, LDA,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors of L in A
-*                    (CWorkspace: need 3*M, prefer 2*M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in A and computing right
-*                    singular vectors of A in VT
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
-     $                            LDVT, A, LDA, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTUAS ) THEN
-*
-*                 Path 6t(N much larger than M, JOBU='S' or 'A',
-*                         JOBVT='S')
-*                 M right singular vectors to be computed in VT and
-*                 M left singular vectors to be computed in U
-*
-                  IF( LWORK.GE.M*M+3*M ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-*                       WORK(IU) is LDA by N
-*
-                        LDWRKU = LDA
-                     ELSE
-*
-*                       WORK(IU) is LDA by M
-*
-                        LDWRKU = M
-                     END IF
-                     ITAU = IU + LDWRKU*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q
-*                    (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to WORK(IU), zeroing out above it
-*
-                     CALL ZLACPY( 'L', M, M, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            WORK( IU+LDWRKU ), LDWRKU )
-*
-*                    Generate Q in A
-*                    (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IU), copying result to U
-*                    (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
-*                    (RWorkspace: need M)
-*
-                     CALL ZGEBRD( M, M, WORK( IU ), LDWRKU, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
-     $                            LDU )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IU)
-*                    (CWorkspace: need   M*M+3*M-1,
-*                                 prefer M*M+2*M+(M-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in U
-*                    (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of L in U and computing right
-*                    singular vectors of L in WORK(IU)
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, M, M, 0, S, RWORK( IE ),
-     $                            WORK( IU ), LDWRKU, U, LDU, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IU) by
-*                    Q in A, storing result in VT
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IU ),
-     $                           LDWRKU, A, LDA, CZERO, VT, LDVT )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (CWorkspace: need 2*M, prefer M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (CWorkspace: need 2*M, prefer M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to U, zeroing out above it
-*
-                     CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            U( 1, 2 ), LDU )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in U
-*                    (CWorkspace: need 3*M, prefer 2*M+2*M*NB)
-*                    (RWorkspace: need M)
-*
-                     CALL ZGEBRD( M, M, U, LDU, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right bidiagonalizing vectors in U by Q
-*                    in VT
-*                    (CWorkspace: need 2*M+N, prefer 2*M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'P', 'L', 'C', M, N, M, U, LDU,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in U
-*                    (CWorkspace: need 3*M, prefer 2*M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in VT
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
-     $                            LDVT, U, LDU, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-                  END IF
-*
-               END IF
-*
-            ELSE IF( WNTVA ) THEN
-*
-               IF( WNTUN ) THEN
-*
-*                 Path 7t(N much larger than M, JOBU='N', JOBVT='A')
-*                 N right singular vectors to be computed in VT and
-*                 no left singular vectors to be computed
-*
-                  IF( LWORK.GE.M*M+MAX( N+M, 3*M ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IR = 1
-                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-*                       WORK(IR) is LDA by M
-*
-                        LDWRKR = LDA
-                     ELSE
-*
-*                       WORK(IR) is M by M
-*
-                        LDWRKR = M
-                     END IF
-                     ITAU = IR + LDWRKR*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Copy L to WORK(IR), zeroing out above it
-*
-                     CALL ZLACPY( 'L', M, M, A, LDA, WORK( IR ),
-     $                            LDWRKR )
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            WORK( IR+LDWRKR ), LDWRKR )
-*
-*                    Generate Q in VT
-*                    (CWorkspace: need M*M+M+N, prefer M*M+M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IR)
-*                    (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
-*                    (RWorkspace: need M)
-*
-                     CALL ZGEBRD( M, M, WORK( IR ), LDWRKR, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IR)
-*                    (CWorkspace: need   M*M+3*M-1,
-*                                 prefer M*M+2*M+(M-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing right
-*                    singular vectors of L in WORK(IR)
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, M, 0, 0, S, RWORK( IE ),
-     $                            WORK( IR ), LDWRKR, CDUM, 1, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IR) by
-*                    Q in VT, storing result in A
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IR ),
-     $                           LDWRKR, VT, LDVT, CZERO, A, LDA )
-*
-*                    Copy right singular vectors of A from A to VT
-*
-                     CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (CWorkspace: need 2*M, prefer M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (CWorkspace: need M+N, prefer M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Zero out above L in A
-*
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            A( 1, 2 ), LDA )
-*
-*                    Bidiagonalize L in A
-*                    (CWorkspace: need 3*M, prefer 2*M+2*M*NB)
-*                    (RWorkspace: need M)
-*
-                     CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right bidiagonalizing vectors in A by Q
-*                    in VT
-*                    (CWorkspace: need 2*M+N, prefer 2*M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'P', 'L', 'C', M, N, M, A, LDA,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing right
-*                    singular vectors of A in VT
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), VT,
-     $                            LDVT, CDUM, 1, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTUO ) THEN
-*
-*                 Path 8t(N much larger than M, JOBU='O', JOBVT='A')
-*                 N right singular vectors to be computed in VT and
-*                 M left singular vectors to be overwritten on A
-*
-                  IF( LWORK.GE.2*M*M+MAX( N+M, 3*M ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
-*
-*                       WORK(IU) is LDA by M and WORK(IR) is LDA by M
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*M
-                        LDWRKR = LDA
-                     ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
-*
-*                       WORK(IU) is LDA by M and WORK(IR) is M by M
-*
-                        LDWRKU = LDA
-                        IR = IU + LDWRKU*M
-                        LDWRKR = M
-                     ELSE
-*
-*                       WORK(IU) is M by M and WORK(IR) is M by M
-*
-                        LDWRKU = M
-                        IR = IU + LDWRKU*M
-                        LDWRKR = M
-                     END IF
-                     ITAU = IR + LDWRKR*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (CWorkspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (CWorkspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to WORK(IU), zeroing out above it
-*
-                     CALL ZLACPY( 'L', M, M, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            WORK( IU+LDWRKU ), LDWRKU )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IU), copying result to
-*                    WORK(IR)
-*                    (CWorkspace: need   2*M*M+3*M,
-*                                 prefer 2*M*M+2*M+2*M*NB)
-*                    (RWorkspace: need   M)
-*
-                     CALL ZGEBRD( M, M, WORK( IU ), LDWRKU, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, M, WORK( IU ), LDWRKU,
-     $                            WORK( IR ), LDWRKR )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IU)
-*                    (CWorkspace: need   2*M*M+3*M-1,
-*                                 prefer 2*M*M+2*M+(M-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in WORK(IR)
-*                    (CWorkspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
-     $                            WORK( ITAUQ ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of L in WORK(IR) and computing
-*                    right singular vectors of L in WORK(IU)
-*                    (CWorkspace: need 2*M*M)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, M, M, 0, S, RWORK( IE ),
-     $                            WORK( IU ), LDWRKU, WORK( IR ),
-     $                            LDWRKR, CDUM, 1, RWORK( IRWORK ),
-     $                            INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IU) by
-*                    Q in VT, storing result in A
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IU ),
-     $                           LDWRKU, VT, LDVT, CZERO, A, LDA )
-*
-*                    Copy right singular vectors of A from A to VT
-*
-                     CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
-*                    Copy left singular vectors of A from WORK(IR) to A
-*
-                     CALL ZLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
-     $                            LDA )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (CWorkspace: need 2*M, prefer M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (CWorkspace: need M+N, prefer M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Zero out above L in A
-*
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            A( 1, 2 ), LDA )
-*
-*                    Bidiagonalize L in A
-*                    (CWorkspace: need 3*M, prefer 2*M+2*M*NB)
-*                    (RWorkspace: need M)
-*
-                     CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right bidiagonalizing vectors in A by Q
-*                    in VT
-*                    (CWorkspace: need 2*M+N, prefer 2*M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'P', 'L', 'C', M, N, M, A, LDA,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in A
-*                    (CWorkspace: need 3*M, prefer 2*M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in A and computing right
-*                    singular vectors of A in VT
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
-     $                            LDVT, A, LDA, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-                  END IF
-*
-               ELSE IF( WNTUAS ) THEN
-*
-*                 Path 9t(N much larger than M, JOBU='S' or 'A',
-*                         JOBVT='A')
-*                 N right singular vectors to be computed in VT and
-*                 M left singular vectors to be computed in U
-*
-                  IF( LWORK.GE.M*M+MAX( N+M, 3*M ) ) THEN
-*
-*                    Sufficient workspace for a fast algorithm
-*
-                     IU = 1
-                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
-*
-*                       WORK(IU) is LDA by M
-*
-                        LDWRKU = LDA
-                     ELSE
-*
-*                       WORK(IU) is M by M
-*
-                        LDWRKU = M
-                     END IF
-                     ITAU = IU + LDWRKU*M
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (CWorkspace: need M*M+M+N, prefer M*M+M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to WORK(IU), zeroing out above it
-*
-                     CALL ZLACPY( 'L', M, M, A, LDA, WORK( IU ),
-     $                            LDWRKU )
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            WORK( IU+LDWRKU ), LDWRKU )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in WORK(IU), copying result to U
-*                    (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
-*                    (RWorkspace: need M)
-*
-                     CALL ZGEBRD( M, M, WORK( IU ), LDWRKU, S,
-     $                            RWORK( IE ), WORK( ITAUQ ),
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
-     $                            LDU )
-*
-*                    Generate right bidiagonalizing vectors in WORK(IU)
-*                    (CWorkspace: need M*M+3*M, prefer M*M+2*M+(M-1)*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
-     $                            WORK( ITAUP ), WORK( IWORK ),
-     $                            LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in U
-*                    (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of L in U and computing right
-*                    singular vectors of L in WORK(IU)
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, M, M, 0, S, RWORK( IE ),
-     $                            WORK( IU ), LDWRKU, U, LDU, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-*                    Multiply right singular vectors of L in WORK(IU) by
-*                    Q in VT, storing result in A
-*                    (CWorkspace: need M*M)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IU ),
-     $                           LDWRKU, VT, LDVT, CZERO, A, LDA )
-*
-*                    Copy right singular vectors of A from A to VT
-*
-                     CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT )
-*
-                  ELSE
-*
-*                    Insufficient workspace for a fast algorithm
-*
-                     ITAU = 1
-                     IWORK = ITAU + M
-*
-*                    Compute A=L*Q, copying result to VT
-*                    (CWorkspace: need 2*M, prefer M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
-*
-*                    Generate Q in VT
-*                    (CWorkspace: need M+N, prefer M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Copy L to U, zeroing out above it
-*
-                     CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
-                     CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
-     $                            U( 1, 2 ), LDU )
-                     IE = 1
-                     ITAUQ = ITAU
-                     ITAUP = ITAUQ + M
-                     IWORK = ITAUP + M
-*
-*                    Bidiagonalize L in U
-*                    (CWorkspace: need 3*M, prefer 2*M+2*M*NB)
-*                    (RWorkspace: need M)
-*
-                     CALL ZGEBRD( M, M, U, LDU, S, RWORK( IE ),
-     $                            WORK( ITAUQ ), WORK( ITAUP ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Multiply right bidiagonalizing vectors in U by Q
-*                    in VT
-*                    (CWorkspace: need 2*M+N, prefer 2*M+N*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNMBR( 'P', 'L', 'C', M, N, M, U, LDU,
-     $                            WORK( ITAUP ), VT, LDVT,
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-*
-*                    Generate left bidiagonalizing vectors in U
-*                    (CWorkspace: need 3*M, prefer 2*M+M*NB)
-*                    (RWorkspace: 0)
-*
-                     CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
-     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
-                     IRWORK = IE + M
-*
-*                    Perform bidiagonal QR iteration, computing left
-*                    singular vectors of A in U and computing right
-*                    singular vectors of A in VT
-*                    (CWorkspace: 0)
-*                    (RWorkspace: need BDSPAC)
-*
-                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
-     $                            LDVT, U, LDU, CDUM, 1,
-     $                            RWORK( IRWORK ), INFO )
-*
-                  END IF
-*
-               END IF
-*
-            END IF
-*
-         ELSE
-*
-*           N .LT. MNTHR
-*
-*           Path 10t(N greater than M, but not much larger)
-*           Reduce to bidiagonal form without LQ decomposition
-*
-            IE = 1
-            ITAUQ = 1
-            ITAUP = ITAUQ + M
-            IWORK = ITAUP + M
-*
-*           Bidiagonalize A
-*           (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB)
-*           (RWorkspace: M)
-*
-            CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
-     $                   WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
-     $                   IERR )
-            IF( WNTUAS ) THEN
-*
-*              If left singular vectors desired in U, copy result to U
-*              and generate left bidiagonalizing vectors in U
-*              (CWorkspace: need 3*M-1, prefer 2*M+(M-1)*NB)
-*              (RWorkspace: 0)
-*
-               CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
-               CALL ZUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTVAS ) THEN
-*
-*              If right singular vectors desired in VT, copy result to
-*              VT and generate right bidiagonalizing vectors in VT
-*              (CWorkspace: need 2*M+NRVT, prefer 2*M+NRVT*NB)
-*              (RWorkspace: 0)
-*
-               CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
-               IF( WNTVA )
-     $            NRVT = N
-               IF( WNTVS )
-     $            NRVT = M
-               CALL ZUNGBR( 'P', NRVT, N, M, VT, LDVT, WORK( ITAUP ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTUO ) THEN
-*
-*              If left singular vectors desired in A, generate left
-*              bidiagonalizing vectors in A
-*              (CWorkspace: need 3*M-1, prefer 2*M+(M-1)*NB)
-*              (RWorkspace: 0)
-*
-               CALL ZUNGBR( 'Q', M, M, N, A, LDA, WORK( ITAUQ ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IF( WNTVO ) THEN
-*
-*              If right singular vectors desired in A, generate right
-*              bidiagonalizing vectors in A
-*              (CWorkspace: need 3*M, prefer 2*M+M*NB)
-*              (RWorkspace: 0)
-*
-               CALL ZUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
-     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
-            END IF
-            IRWORK = IE + M
-            IF( WNTUAS .OR. WNTUO )
-     $         NRU = M
-            IF( WNTUN )
-     $         NRU = 0
-            IF( WNTVAS .OR. WNTVO )
-     $         NCVT = N
-            IF( WNTVN )
-     $         NCVT = 0
-            IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in U and computing right singular
-*              vectors in VT
-*              (CWorkspace: 0)
-*              (RWorkspace: need BDSPAC)
-*
-               CALL ZBDSQR( 'L', M, NCVT, NRU, 0, S, RWORK( IE ), VT,
-     $                      LDVT, U, LDU, CDUM, 1, RWORK( IRWORK ),
-     $                      INFO )
-            ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in U and computing right singular
-*              vectors in A
-*              (CWorkspace: 0)
-*              (RWorkspace: need BDSPAC)
-*
-               CALL ZBDSQR( 'L', M, NCVT, NRU, 0, S, RWORK( IE ), A,
-     $                      LDA, U, LDU, CDUM, 1, RWORK( IRWORK ),
-     $                      INFO )
-            ELSE
-*
-*              Perform bidiagonal QR iteration, if desired, computing
-*              left singular vectors in A and computing right singular
-*              vectors in VT
-*              (CWorkspace: 0)
-*              (RWorkspace: need BDSPAC)
-*
-               CALL ZBDSQR( 'L', M, NCVT, NRU, 0, S, RWORK( IE ), VT,
-     $                      LDVT, A, LDA, CDUM, 1, RWORK( IRWORK ),
-     $                      INFO )
-            END IF
-*
-         END IF
-*
-      END IF
-*
-*     Undo scaling if necessary
-*
-      IF( ISCL.EQ.1 ) THEN
-         IF( ANRM.GT.BIGNUM )
-     $      CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
-     $                   IERR )
-         IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
-     $      CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1,
-     $                   RWORK( IE ), MINMN, IERR )
-         IF( ANRM.LT.SMLNUM )
-     $      CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
-     $                   IERR )
-         IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
-     $      CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1,
-     $                   RWORK( IE ), MINMN, IERR )
-      END IF
-*
-*     Return optimal workspace in WORK(1)
-*
-      WORK( 1 ) = MAXWRK
-*
-      RETURN
-*
-*     End of ZGESVD
-*
-      END
diff --git a/src/lib/lapack/zgetc2.f b/src/lib/lapack/zgetc2.f
deleted file mode 100644
index 35ac376c..00000000
--- a/src/lib/lapack/zgetc2.f
+++ /dev/null
@@ -1,145 +0,0 @@
-      SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * ), JPIV( * )
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGETC2 computes an LU factorization, using complete pivoting, of the
-*  n-by-n matrix A. The factorization has the form A = P * L * U * Q,
-*  where P and Q are permutation matrices, L is lower triangular with
-*  unit diagonal elements and U is upper triangular.
-*
-*  This is a level 1 BLAS version of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A. N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA, N)
-*          On entry, the n-by-n matrix to be factored.
-*          On exit, the factors L and U from the factorization
-*          A = P*L*U*Q; the unit diagonal elements of L are not stored.
-*          If U(k, k) appears to be less than SMIN, U(k, k) is given the
-*          value of SMIN, giving a nonsingular perturbed system.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1, N).
-*
-*  IPIV    (output) INTEGER array, dimension (N).
-*          The pivot indices; for 1 <= i <= N, row i of the
-*          matrix has been interchanged with row IPIV(i).
-*
-*  JPIV    (output) INTEGER array, dimension (N).
-*          The pivot indices; for 1 <= j <= N, column j of the
-*          matrix has been interchanged with column JPIV(j).
-*
-*  INFO    (output) INTEGER
-*           = 0: successful exit
-*           > 0: if INFO = k, U(k, k) is likely to produce overflow if
-*                one tries to solve for x in Ax = b. So U is perturbed
-*                to avoid the overflow.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, IP, IPV, J, JP, JPV
-      DOUBLE PRECISION   BIGNUM, EPS, SMIN, SMLNUM, XMAX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZGERU, ZSWAP
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DCMPLX, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Set constants to control overflow
-*
-      INFO = 0
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' ) / EPS
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-*
-*     Factorize A using complete pivoting.
-*     Set pivots less than SMIN to SMIN
-*
-      DO 40 I = 1, N - 1
-*
-*        Find max element in matrix A
-*
-         XMAX = ZERO
-         DO 20 IP = I, N
-            DO 10 JP = I, N
-               IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN
-                  XMAX = ABS( A( IP, JP ) )
-                  IPV = IP
-                  JPV = JP
-               END IF
-   10       CONTINUE
-   20    CONTINUE
-         IF( I.EQ.1 )
-     $      SMIN = MAX( EPS*XMAX, SMLNUM )
-*
-*        Swap rows
-*
-         IF( IPV.NE.I )
-     $      CALL ZSWAP( N, A( IPV, 1 ), LDA, A( I, 1 ), LDA )
-         IPIV( I ) = IPV
-*
-*        Swap columns
-*
-         IF( JPV.NE.I )
-     $      CALL ZSWAP( N, A( 1, JPV ), 1, A( 1, I ), 1 )
-         JPIV( I ) = JPV
-*
-*        Check for singularity
-*
-         IF( ABS( A( I, I ) ).LT.SMIN ) THEN
-            INFO = I
-            A( I, I ) = DCMPLX( SMIN, ZERO )
-         END IF
-         DO 30 J = I + 1, N
-            A( J, I ) = A( J, I ) / A( I, I )
-   30    CONTINUE
-         CALL ZGERU( N-I, N-I, -DCMPLX( ONE ), A( I+1, I ), 1,
-     $               A( I, I+1 ), LDA, A( I+1, I+1 ), LDA )
-   40 CONTINUE
-*
-      IF( ABS( A( N, N ) ).LT.SMIN ) THEN
-         INFO = N
-         A( N, N ) = DCMPLX( SMIN, ZERO )
-      END IF
-      RETURN
-*
-*     End of ZGETC2
-*
-      END
diff --git a/src/lib/lapack/zgetf2.f b/src/lib/lapack/zgetf2.f
deleted file mode 100644
index a2dc1834..00000000
--- a/src/lib/lapack/zgetf2.f
+++ /dev/null
@@ -1,148 +0,0 @@
-      SUBROUTINE ZGETF2( M, N, A, LDA, IPIV, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGETF2 computes an LU factorization of a general m-by-n matrix A
-*  using partial pivoting with row interchanges.
-*
-*  The factorization has the form
-*     A = P * L * U
-*  where P is a permutation matrix, L is lower triangular with unit
-*  diagonal elements (lower trapezoidal if m > n), and U is upper
-*  triangular (upper trapezoidal if m < n).
-*
-*  This is the right-looking Level 2 BLAS version of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the m by n matrix to be factored.
-*          On exit, the factors L and U from the factorization
-*          A = P*L*U; the unit diagonal elements of L are not stored.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  IPIV    (output) INTEGER array, dimension (min(M,N))
-*          The pivot indices; for 1 <= i <= min(M,N), row i of the
-*          matrix was interchanged with row IPIV(i).
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -k, the k-th argument had an illegal value
-*          > 0: if INFO = k, U(k,k) is exactly zero. The factorization
-*               has been completed, but the factor U is exactly
-*               singular, and division by zero will occur if it is used
-*               to solve a system of equations.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE, ZERO
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
-     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   SFMIN
-      INTEGER            I, J, JP
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      INTEGER            IZAMAX
-      EXTERNAL           DLAMCH, IZAMAX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGERU, ZSCAL, ZSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGETF2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 )
-     $   RETURN
-*
-*     Compute machine safe minimum
-*
-      SFMIN = DLAMCH('S') 
-*
-      DO 10 J = 1, MIN( M, N )
-*
-*        Find pivot and test for singularity.
-*
-         JP = J - 1 + IZAMAX( M-J+1, A( J, J ), 1 )
-         IPIV( J ) = JP
-         IF( A( JP, J ).NE.ZERO ) THEN
-*
-*           Apply the interchange to columns 1:N.
-*
-            IF( JP.NE.J )
-     $         CALL ZSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA )
-*
-*           Compute elements J+1:M of J-th column.
-*
-            IF( J.LT.M ) THEN
-               IF( ABS(A( J, J )) .GE. SFMIN ) THEN
-                  CALL ZSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
-               ELSE
-                  DO 20 I = 1, M-J
-                     A( J+I, J ) = A( J+I, J ) / A( J, J )
-   20             CONTINUE
-               END IF
-            END IF
-*
-         ELSE IF( INFO.EQ.0 ) THEN
-*
-            INFO = J
-         END IF
-*
-         IF( J.LT.MIN( M, N ) ) THEN
-*
-*           Update trailing submatrix.
-*
-            CALL ZGERU( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ),
-     $                  LDA, A( J+1, J+1 ), LDA )
-         END IF
-   10 CONTINUE
-      RETURN
-*
-*     End of ZGETF2
-*
-      END
diff --git a/src/lib/lapack/zgetrf.f b/src/lib/lapack/zgetrf.f
deleted file mode 100644
index 9c7bfbbf..00000000
--- a/src/lib/lapack/zgetrf.f
+++ /dev/null
@@ -1,159 +0,0 @@
-      SUBROUTINE ZGETRF( M, N, A, LDA, IPIV, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGETRF computes an LU factorization of a general M-by-N matrix A
-*  using partial pivoting with row interchanges.
-*
-*  The factorization has the form
-*     A = P * L * U
-*  where P is a permutation matrix, L is lower triangular with unit
-*  diagonal elements (lower trapezoidal if m > n), and U is upper
-*  triangular (upper trapezoidal if m < n).
-*
-*  This is the right-looking Level 3 BLAS version of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the M-by-N matrix to be factored.
-*          On exit, the factors L and U from the factorization
-*          A = P*L*U; the unit diagonal elements of L are not stored.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  IPIV    (output) INTEGER array, dimension (min(M,N))
-*          The pivot indices; for 1 <= i <= min(M,N), row i of the
-*          matrix was interchanged with row IPIV(i).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, U(i,i) is exactly zero. The factorization
-*                has been completed, but the factor U is exactly
-*                singular, and division by zero will occur if it is used
-*                to solve a system of equations.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, IINFO, J, JB, NB
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMM, ZGETF2, ZLASWP, ZTRSM
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGETRF', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 )
-     $   RETURN
-*
-*     Determine the block size for this environment.
-*
-      NB = ILAENV( 1, 'ZGETRF', ' ', M, N, -1, -1 )
-      IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
-*
-*        Use unblocked code.
-*
-         CALL ZGETF2( M, N, A, LDA, IPIV, INFO )
-      ELSE
-*
-*        Use blocked code.
-*
-         DO 20 J = 1, MIN( M, N ), NB
-            JB = MIN( MIN( M, N )-J+1, NB )
-*
-*           Factor diagonal and subdiagonal blocks and test for exact
-*           singularity.
-*
-            CALL ZGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
-*
-*           Adjust INFO and the pivot indices.
-*
-            IF( INFO.EQ.0 .AND. IINFO.GT.0 )
-     $         INFO = IINFO + J - 1
-            DO 10 I = J, MIN( M, J+JB-1 )
-               IPIV( I ) = J - 1 + IPIV( I )
-   10       CONTINUE
-*
-*           Apply interchanges to columns 1:J-1.
-*
-            CALL ZLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
-*
-            IF( J+JB.LE.N ) THEN
-*
-*              Apply interchanges to columns J+JB:N.
-*
-               CALL ZLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
-     $                      IPIV, 1 )
-*
-*              Compute block row of U.
-*
-               CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB,
-     $                     N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ),
-     $                     LDA )
-               IF( J+JB.LE.M ) THEN
-*
-*                 Update trailing submatrix.
-*
-                  CALL ZGEMM( 'No transpose', 'No transpose', M-J-JB+1,
-     $                        N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA,
-     $                        A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ),
-     $                        LDA )
-               END IF
-            END IF
-   20    CONTINUE
-      END IF
-      RETURN
-*
-*     End of ZGETRF
-*
-      END
diff --git a/src/lib/lapack/zgetri.f b/src/lib/lapack/zgetri.f
deleted file mode 100644
index 685518e6..00000000
--- a/src/lib/lapack/zgetri.f
+++ /dev/null
@@ -1,193 +0,0 @@
-      SUBROUTINE ZGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      COMPLEX*16         A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGETRI computes the inverse of a matrix using the LU factorization
-*  computed by ZGETRF.
-*
-*  This method inverts U and then computes inv(A) by solving the system
-*  inv(A)*L = inv(U) for inv(A).
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the factors L and U from the factorization
-*          A = P*L*U as computed by ZGETRF.
-*          On exit, if INFO = 0, the inverse of the original matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (input) INTEGER array, dimension (N)
-*          The pivot indices from ZGETRF; for 1<=i<=N, row i of the
-*          matrix was interchanged with row IPIV(i).
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO=0, then WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,N).
-*          For optimal performance LWORK >= N*NB, where NB is
-*          the optimal blocksize 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, U(i,i) is exactly zero; the matrix is
-*                singular and its inverse could not be computed.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IWS, J, JB, JJ, JP, LDWORK, LWKOPT, NB,
-     $                   NBMIN, NN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMM, ZGEMV, ZSWAP, ZTRSM, ZTRTRI
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      NB = ILAENV( 1, 'ZGETRI', ' ', N, -1, -1, -1 )
-      LWKOPT = N*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( N.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -3
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -6
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGETRI', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Form inv(U).  If INFO > 0 from ZTRTRI, then U is singular,
-*     and the inverse is not computed.
-*
-      CALL ZTRTRI( 'Upper', 'Non-unit', N, A, LDA, INFO )
-      IF( INFO.GT.0 )
-     $   RETURN
-*
-      NBMIN = 2
-      LDWORK = N
-      IF( NB.GT.1 .AND. NB.LT.N ) THEN
-         IWS = MAX( LDWORK*NB, 1 )
-         IF( LWORK.LT.IWS ) THEN
-            NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'ZGETRI', ' ', N, -1, -1, -1 ) )
-         END IF
-      ELSE
-         IWS = N
-      END IF
-*
-*     Solve the equation inv(A)*L = inv(U) for inv(A).
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.N ) THEN
-*
-*        Use unblocked code.
-*
-         DO 20 J = N, 1, -1
-*
-*           Copy current column of L to WORK and replace with zeros.
-*
-            DO 10 I = J + 1, N
-               WORK( I ) = A( I, J )
-               A( I, J ) = ZERO
-   10       CONTINUE
-*
-*           Compute current column of inv(A).
-*
-            IF( J.LT.N )
-     $         CALL ZGEMV( 'No transpose', N, N-J, -ONE, A( 1, J+1 ),
-     $                     LDA, WORK( J+1 ), 1, ONE, A( 1, J ), 1 )
-   20    CONTINUE
-      ELSE
-*
-*        Use blocked code.
-*
-         NN = ( ( N-1 ) / NB )*NB + 1
-         DO 50 J = NN, 1, -NB
-            JB = MIN( NB, N-J+1 )
-*
-*           Copy current block column of L to WORK and replace with
-*           zeros.
-*
-            DO 40 JJ = J, J + JB - 1
-               DO 30 I = JJ + 1, N
-                  WORK( I+( JJ-J )*LDWORK ) = A( I, JJ )
-                  A( I, JJ ) = ZERO
-   30          CONTINUE
-   40       CONTINUE
-*
-*           Compute current block column of inv(A).
-*
-            IF( J+JB.LE.N )
-     $         CALL ZGEMM( 'No transpose', 'No transpose', N, JB,
-     $                     N-J-JB+1, -ONE, A( 1, J+JB ), LDA,
-     $                     WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA )
-            CALL ZTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB,
-     $                  ONE, WORK( J ), LDWORK, A( 1, J ), LDA )
-   50    CONTINUE
-      END IF
-*
-*     Apply column interchanges.
-*
-      DO 60 J = N - 1, 1, -1
-         JP = IPIV( J )
-         IF( JP.NE.J )
-     $      CALL ZSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 )
-   60 CONTINUE
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of ZGETRI
-*
-      END
diff --git a/src/lib/lapack/zgetrs.f b/src/lib/lapack/zgetrs.f
deleted file mode 100644
index e32549cd..00000000
--- a/src/lib/lapack/zgetrs.f
+++ /dev/null
@@ -1,149 +0,0 @@
-      SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TRANS
-      INTEGER            INFO, LDA, LDB, N, NRHS
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      COMPLEX*16         A( LDA, * ), B( LDB, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGETRS solves a system of linear equations
-*     A * X = B,  A**T * X = B,  or  A**H * X = B
-*  with a general N-by-N matrix A using the LU factorization computed
-*  by ZGETRF.
-*
-*  Arguments
-*  =========
-*
-*  TRANS   (input) CHARACTER*1
-*          Specifies the form of the system of equations:
-*          = 'N':  A * X = B     (No transpose)
-*          = 'T':  A**T * X = B  (Transpose)
-*          = 'C':  A**H * X = B  (Conjugate transpose)
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  NRHS    (input) INTEGER
-*          The number of right hand sides, i.e., the number of columns
-*          of the matrix B.  NRHS >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA,N)
-*          The factors L and U from the factorization A = P*L*U
-*          as computed by ZGETRF.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  IPIV    (input) INTEGER array, dimension (N)
-*          The pivot indices from ZGETRF; for 1<=i<=N, row i of the
-*          matrix was interchanged with row IPIV(i).
-*
-*  B       (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
-*          On entry, the right hand side matrix B.
-*          On exit, the solution matrix X.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOTRAN
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLASWP, ZTRSM
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      NOTRAN = LSAME( TRANS, 'N' )
-      IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
-     $    LSAME( TRANS, 'C' ) ) 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
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGETRS', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 .OR. NRHS.EQ.0 )
-     $   RETURN
-*
-      IF( NOTRAN ) THEN
-*
-*        Solve A * X = B.
-*
-*        Apply row interchanges to the right hand sides.
-*
-         CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
-*
-*        Solve L*X = B, overwriting B with X.
-*
-         CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
-     $               ONE, A, LDA, B, LDB )
-*
-*        Solve U*X = B, overwriting B with X.
-*
-         CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
-     $               NRHS, ONE, A, LDA, B, LDB )
-      ELSE
-*
-*        Solve A**T * X = B  or A**H * X = B.
-*
-*        Solve U'*X = B, overwriting B with X.
-*
-         CALL ZTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, ONE,
-     $               A, LDA, B, LDB )
-*
-*        Solve L'*X = B, overwriting B with X.
-*
-         CALL ZTRSM( 'Left', 'Lower', TRANS, 'Unit', N, NRHS, ONE, A,
-     $               LDA, B, LDB )
-*
-*        Apply row interchanges to the solution vectors.
-*
-         CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
-      END IF
-*
-      RETURN
-*
-*     End of ZGETRS
-*
-      END
diff --git a/src/lib/lapack/zggbak.f b/src/lib/lapack/zggbak.f
deleted file mode 100644
index ad6dd032..00000000
--- a/src/lib/lapack/zggbak.f
+++ /dev/null
@@ -1,220 +0,0 @@
-      SUBROUTINE ZGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
-     $                   LDV, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOB, SIDE
-      INTEGER            IHI, ILO, INFO, LDV, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   LSCALE( * ), RSCALE( * )
-      COMPLEX*16         V( LDV, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGGBAK forms the right or left eigenvectors of a complex generalized
-*  eigenvalue problem A*x = lambda*B*x, by backward transformation on
-*  the computed eigenvectors of the balanced pair of matrices output by
-*  ZGGBAL.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          Specifies the type of backward transformation required:
-*          = 'N':  do nothing, return immediately;
-*          = 'P':  do backward transformation for permutation only;
-*          = 'S':  do backward transformation for scaling only;
-*          = 'B':  do backward transformations for both permutation and
-*                  scaling.
-*          JOB must be the same as the argument JOB supplied to ZGGBAL.
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'R':  V contains right eigenvectors;
-*          = 'L':  V contains left eigenvectors.
-*
-*  N       (input) INTEGER
-*          The number of rows of the matrix V.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          The integers ILO and IHI determined by ZGGBAL.
-*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-*  LSCALE  (input) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutations and/or scaling factors applied
-*          to the left side of A and B, as returned by ZGGBAL.
-*
-*  RSCALE  (input) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutations and/or scaling factors applied
-*          to the right side of A and B, as returned by ZGGBAL.
-*
-*  M       (input) INTEGER
-*          The number of columns of the matrix V.  M >= 0.
-*
-*  V       (input/output) COMPLEX*16 array, dimension (LDV,M)
-*          On entry, the matrix of right or left eigenvectors to be
-*          transformed, as returned by ZTGEVC.
-*          On exit, V is overwritten by the transformed eigenvectors.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the matrix V. LDV >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  See R.C. Ward, Balancing the generalized eigenvalue problem,
-*                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LEFTV, RIGHTV
-      INTEGER            I, K
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZDSCAL, ZSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      RIGHTV = LSAME( SIDE, 'R' )
-      LEFTV = LSAME( SIDE, 'L' )
-*
-      INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( ILO.LT.1 ) THEN
-         INFO = -4
-      ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
-         INFO = -4
-      ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
-     $   THEN
-         INFO = -5
-      ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
-         INFO = -5
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -8
-      ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGGBAK', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-      IF( M.EQ.0 )
-     $   RETURN
-      IF( LSAME( JOB, 'N' ) )
-     $   RETURN
-*
-      IF( ILO.EQ.IHI )
-     $   GO TO 30
-*
-*     Backward balance
-*
-      IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
-*        Backward transformation on right eigenvectors
-*
-         IF( RIGHTV ) THEN
-            DO 10 I = ILO, IHI
-               CALL ZDSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
-   10       CONTINUE
-         END IF
-*
-*        Backward transformation on left eigenvectors
-*
-         IF( LEFTV ) THEN
-            DO 20 I = ILO, IHI
-               CALL ZDSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
-   20       CONTINUE
-         END IF
-      END IF
-*
-*     Backward permutation
-*
-   30 CONTINUE
-      IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
-*
-*        Backward permutation on right eigenvectors
-*
-         IF( RIGHTV ) THEN
-            IF( ILO.EQ.1 )
-     $         GO TO 50
-            DO 40 I = ILO - 1, 1, -1
-               K = RSCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 40
-               CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-   40       CONTINUE
-*
-   50       CONTINUE
-            IF( IHI.EQ.N )
-     $         GO TO 70
-            DO 60 I = IHI + 1, N
-               K = RSCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 60
-               CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-   60       CONTINUE
-         END IF
-*
-*        Backward permutation on left eigenvectors
-*
-   70    CONTINUE
-         IF( LEFTV ) THEN
-            IF( ILO.EQ.1 )
-     $         GO TO 90
-            DO 80 I = ILO - 1, 1, -1
-               K = LSCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 80
-               CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-   80       CONTINUE
-*
-   90       CONTINUE
-            IF( IHI.EQ.N )
-     $         GO TO 110
-            DO 100 I = IHI + 1, N
-               K = LSCALE( I )
-               IF( K.EQ.I )
-     $            GO TO 100
-               CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
-  100       CONTINUE
-         END IF
-      END IF
-*
-  110 CONTINUE
-*
-      RETURN
-*
-*     End of ZGGBAK
-*
-      END
diff --git a/src/lib/lapack/zggbal.f b/src/lib/lapack/zggbal.f
deleted file mode 100644
index b75ae456..00000000
--- a/src/lib/lapack/zggbal.f
+++ /dev/null
@@ -1,482 +0,0 @@
-      SUBROUTINE ZGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE,
-     $                   RSCALE, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOB
-      INTEGER            IHI, ILO, INFO, LDA, LDB, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   LSCALE( * ), RSCALE( * ), WORK( * )
-      COMPLEX*16         A( LDA, * ), B( LDB, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGGBAL balances a pair of general complex matrices (A,B).  This
-*  involves, first, permuting A and B by similarity transformations to
-*  isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N
-*  elements on the diagonal; and second, applying a diagonal similarity
-*  transformation to rows and columns ILO to IHI to make the rows
-*  and columns as close in norm as possible. Both steps are optional.
-*
-*  Balancing may reduce the 1-norm of the matrices, and improve the
-*  accuracy of the computed eigenvalues and/or eigenvectors in the
-*  generalized eigenvalue problem A*x = lambda*B*x.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          Specifies the operations to be performed on A and B:
-*          = 'N':  none:  simply set ILO = 1, IHI = N, LSCALE(I) = 1.0
-*                  and RSCALE(I) = 1.0 for i=1,...,N;
-*          = 'P':  permute only;
-*          = 'S':  scale only;
-*          = 'B':  both permute and scale.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the input matrix A.
-*          On exit, A is overwritten by the balanced matrix.
-*          If JOB = 'N', A is not referenced.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  B       (input/output) COMPLEX*16 array, dimension (LDB,N)
-*          On entry, the input matrix B.
-*          On exit, B is overwritten by the balanced matrix.
-*          If JOB = 'N', B is not referenced.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1,N).
-*
-*  ILO     (output) INTEGER
-*  IHI     (output) INTEGER
-*          ILO and IHI are set to integers such that on exit
-*          A(i,j) = 0 and B(i,j) = 0 if i > j and
-*          j = 1,...,ILO-1 or i = IHI+1,...,N.
-*          If JOB = 'N' or 'S', ILO = 1 and IHI = N.
-*
-*  LSCALE  (output) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutations and scaling factors applied
-*          to the left side of A and B.  If P(j) is the index of the
-*          row interchanged with row j, and D(j) is the scaling factor
-*          applied to row j, then
-*            LSCALE(j) = P(j)    for J = 1,...,ILO-1
-*                      = D(j)    for J = ILO,...,IHI
-*                      = P(j)    for J = IHI+1,...,N.
-*          The order in which the interchanges are made is N to IHI+1,
-*          then 1 to ILO-1.
-*
-*  RSCALE  (output) DOUBLE PRECISION array, dimension (N)
-*          Details of the permutations and scaling factors applied
-*          to the right side of A and B.  If P(j) is the index of the
-*          column interchanged with column j, and D(j) is the scaling
-*          factor applied to column j, then
-*            RSCALE(j) = P(j)    for J = 1,...,ILO-1
-*                      = D(j)    for J = ILO,...,IHI
-*                      = P(j)    for J = IHI+1,...,N.
-*          The order in which the interchanges are made is N to IHI+1,
-*          then 1 to ILO-1.
-*
-*  WORK    (workspace) REAL array, dimension (lwork)
-*          lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and
-*          at least 1 when JOB = 'N' or 'P'.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  See R.C. WARD, Balancing the generalized eigenvalue problem,
-*                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, HALF, ONE
-      PARAMETER          ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
-      DOUBLE PRECISION   THREE, SCLFAC
-      PARAMETER          ( THREE = 3.0D+0, SCLFAC = 1.0D+1 )
-      COMPLEX*16         CZERO
-      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ICAB, IFLOW, IP1, IR, IRAB, IT, J, JC, JP1,
-     $                   K, KOUNT, L, LCAB, LM1, LRAB, LSFMAX, LSFMIN,
-     $                   M, NR, NRP2
-      DOUBLE PRECISION   ALPHA, BASL, BETA, CAB, CMAX, COEF, COEF2,
-     $                   COEF5, COR, EW, EWC, GAMMA, PGAMMA, RAB, SFMAX,
-     $                   SFMIN, SUM, T, TA, TB, TC
-      COMPLEX*16         CDUM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IZAMAX
-      DOUBLE PRECISION   DDOT, DLAMCH
-      EXTERNAL           LSAME, IZAMAX, DDOT, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DAXPY, DSCAL, XERBLA, ZDSCAL, ZSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DIMAG, INT, LOG10, MAX, MIN, SIGN
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -4
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGGBAL', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         ILO = 1
-         IHI = N
-         RETURN
-      END IF
-*
-      IF( N.EQ.1 ) THEN
-         ILO = 1
-         IHI = N
-         LSCALE( 1 ) = ONE
-         RSCALE( 1 ) = ONE
-         RETURN
-      END IF
-*
-      IF( LSAME( JOB, 'N' ) ) THEN
-         ILO = 1
-         IHI = N
-         DO 10 I = 1, N
-            LSCALE( I ) = ONE
-            RSCALE( I ) = ONE
-   10    CONTINUE
-         RETURN
-      END IF
-*
-      K = 1
-      L = N
-      IF( LSAME( JOB, 'S' ) )
-     $   GO TO 190
-*
-      GO TO 30
-*
-*     Permute the matrices A and B to isolate the eigenvalues.
-*
-*     Find row with one nonzero in columns 1 through L
-*
-   20 CONTINUE
-      L = LM1
-      IF( L.NE.1 )
-     $   GO TO 30
-*
-      RSCALE( 1 ) = 1
-      LSCALE( 1 ) = 1
-      GO TO 190
-*
-   30 CONTINUE
-      LM1 = L - 1
-      DO 80 I = L, 1, -1
-         DO 40 J = 1, LM1
-            JP1 = J + 1
-            IF( A( I, J ).NE.CZERO .OR. B( I, J ).NE.CZERO )
-     $         GO TO 50
-   40    CONTINUE
-         J = L
-         GO TO 70
-*
-   50    CONTINUE
-         DO 60 J = JP1, L
-            IF( A( I, J ).NE.CZERO .OR. B( I, J ).NE.CZERO )
-     $         GO TO 80
-   60    CONTINUE
-         J = JP1 - 1
-*
-   70    CONTINUE
-         M = L
-         IFLOW = 1
-         GO TO 160
-   80 CONTINUE
-      GO TO 100
-*
-*     Find column with one nonzero in rows K through N
-*
-   90 CONTINUE
-      K = K + 1
-*
-  100 CONTINUE
-      DO 150 J = K, L
-         DO 110 I = K, LM1
-            IP1 = I + 1
-            IF( A( I, J ).NE.CZERO .OR. B( I, J ).NE.CZERO )
-     $         GO TO 120
-  110    CONTINUE
-         I = L
-         GO TO 140
-  120    CONTINUE
-         DO 130 I = IP1, L
-            IF( A( I, J ).NE.CZERO .OR. B( I, J ).NE.CZERO )
-     $         GO TO 150
-  130    CONTINUE
-         I = IP1 - 1
-  140    CONTINUE
-         M = K
-         IFLOW = 2
-         GO TO 160
-  150 CONTINUE
-      GO TO 190
-*
-*     Permute rows M and I
-*
-  160 CONTINUE
-      LSCALE( M ) = I
-      IF( I.EQ.M )
-     $   GO TO 170
-      CALL ZSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA )
-      CALL ZSWAP( N-K+1, B( I, K ), LDB, B( M, K ), LDB )
-*
-*     Permute columns M and J
-*
-  170 CONTINUE
-      RSCALE( M ) = J
-      IF( J.EQ.M )
-     $   GO TO 180
-      CALL ZSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
-      CALL ZSWAP( L, B( 1, J ), 1, B( 1, M ), 1 )
-*
-  180 CONTINUE
-      GO TO ( 20, 90 )IFLOW
-*
-  190 CONTINUE
-      ILO = K
-      IHI = L
-*
-      IF( LSAME( JOB, 'P' ) ) THEN
-         DO 195 I = ILO, IHI
-            LSCALE( I ) = ONE
-            RSCALE( I ) = ONE
-  195    CONTINUE
-         RETURN
-      END IF
-*
-      IF( ILO.EQ.IHI )
-     $   RETURN
-*
-*     Balance the submatrix in rows ILO to IHI.
-*
-      NR = IHI - ILO + 1
-      DO 200 I = ILO, IHI
-         RSCALE( I ) = ZERO
-         LSCALE( I ) = ZERO
-*
-         WORK( I ) = ZERO
-         WORK( I+N ) = ZERO
-         WORK( I+2*N ) = ZERO
-         WORK( I+3*N ) = ZERO
-         WORK( I+4*N ) = ZERO
-         WORK( I+5*N ) = ZERO
-  200 CONTINUE
-*
-*     Compute right side vector in resulting linear equations
-*
-      BASL = LOG10( SCLFAC )
-      DO 240 I = ILO, IHI
-         DO 230 J = ILO, IHI
-            IF( A( I, J ).EQ.CZERO ) THEN
-               TA = ZERO
-               GO TO 210
-            END IF
-            TA = LOG10( CABS1( A( I, J ) ) ) / BASL
-*
-  210       CONTINUE
-            IF( B( I, J ).EQ.CZERO ) THEN
-               TB = ZERO
-               GO TO 220
-            END IF
-            TB = LOG10( CABS1( B( I, J ) ) ) / BASL
-*
-  220       CONTINUE
-            WORK( I+4*N ) = WORK( I+4*N ) - TA - TB
-            WORK( J+5*N ) = WORK( J+5*N ) - TA - TB
-  230    CONTINUE
-  240 CONTINUE
-*
-      COEF = ONE / DBLE( 2*NR )
-      COEF2 = COEF*COEF
-      COEF5 = HALF*COEF2
-      NRP2 = NR + 2
-      BETA = ZERO
-      IT = 1
-*
-*     Start generalized conjugate gradient iteration
-*
-  250 CONTINUE
-*
-      GAMMA = DDOT( NR, WORK( ILO+4*N ), 1, WORK( ILO+4*N ), 1 ) +
-     $        DDOT( NR, WORK( ILO+5*N ), 1, WORK( ILO+5*N ), 1 )
-*
-      EW = ZERO
-      EWC = ZERO
-      DO 260 I = ILO, IHI
-         EW = EW + WORK( I+4*N )
-         EWC = EWC + WORK( I+5*N )
-  260 CONTINUE
-*
-      GAMMA = COEF*GAMMA - COEF2*( EW**2+EWC**2 ) - COEF5*( EW-EWC )**2
-      IF( GAMMA.EQ.ZERO )
-     $   GO TO 350
-      IF( IT.NE.1 )
-     $   BETA = GAMMA / PGAMMA
-      T = COEF5*( EWC-THREE*EW )
-      TC = COEF5*( EW-THREE*EWC )
-*
-      CALL DSCAL( NR, BETA, WORK( ILO ), 1 )
-      CALL DSCAL( NR, BETA, WORK( ILO+N ), 1 )
-*
-      CALL DAXPY( NR, COEF, WORK( ILO+4*N ), 1, WORK( ILO+N ), 1 )
-      CALL DAXPY( NR, COEF, WORK( ILO+5*N ), 1, WORK( ILO ), 1 )
-*
-      DO 270 I = ILO, IHI
-         WORK( I ) = WORK( I ) + TC
-         WORK( I+N ) = WORK( I+N ) + T
-  270 CONTINUE
-*
-*     Apply matrix to vector
-*
-      DO 300 I = ILO, IHI
-         KOUNT = 0
-         SUM = ZERO
-         DO 290 J = ILO, IHI
-            IF( A( I, J ).EQ.CZERO )
-     $         GO TO 280
-            KOUNT = KOUNT + 1
-            SUM = SUM + WORK( J )
-  280       CONTINUE
-            IF( B( I, J ).EQ.CZERO )
-     $         GO TO 290
-            KOUNT = KOUNT + 1
-            SUM = SUM + WORK( J )
-  290    CONTINUE
-         WORK( I+2*N ) = DBLE( KOUNT )*WORK( I+N ) + SUM
-  300 CONTINUE
-*
-      DO 330 J = ILO, IHI
-         KOUNT = 0
-         SUM = ZERO
-         DO 320 I = ILO, IHI
-            IF( A( I, J ).EQ.CZERO )
-     $         GO TO 310
-            KOUNT = KOUNT + 1
-            SUM = SUM + WORK( I+N )
-  310       CONTINUE
-            IF( B( I, J ).EQ.CZERO )
-     $         GO TO 320
-            KOUNT = KOUNT + 1
-            SUM = SUM + WORK( I+N )
-  320    CONTINUE
-         WORK( J+3*N ) = DBLE( KOUNT )*WORK( J ) + SUM
-  330 CONTINUE
-*
-      SUM = DDOT( NR, WORK( ILO+N ), 1, WORK( ILO+2*N ), 1 ) +
-     $      DDOT( NR, WORK( ILO ), 1, WORK( ILO+3*N ), 1 )
-      ALPHA = GAMMA / SUM
-*
-*     Determine correction to current iteration
-*
-      CMAX = ZERO
-      DO 340 I = ILO, IHI
-         COR = ALPHA*WORK( I+N )
-         IF( ABS( COR ).GT.CMAX )
-     $      CMAX = ABS( COR )
-         LSCALE( I ) = LSCALE( I ) + COR
-         COR = ALPHA*WORK( I )
-         IF( ABS( COR ).GT.CMAX )
-     $      CMAX = ABS( COR )
-         RSCALE( I ) = RSCALE( I ) + COR
-  340 CONTINUE
-      IF( CMAX.LT.HALF )
-     $   GO TO 350
-*
-      CALL DAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), 1 )
-      CALL DAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), 1 )
-*
-      PGAMMA = GAMMA
-      IT = IT + 1
-      IF( IT.LE.NRP2 )
-     $   GO TO 250
-*
-*     End generalized conjugate gradient iteration
-*
-  350 CONTINUE
-      SFMIN = DLAMCH( 'S' )
-      SFMAX = ONE / SFMIN
-      LSFMIN = INT( LOG10( SFMIN ) / BASL+ONE )
-      LSFMAX = INT( LOG10( SFMAX ) / BASL )
-      DO 360 I = ILO, IHI
-         IRAB = IZAMAX( N-ILO+1, A( I, ILO ), LDA )
-         RAB = ABS( A( I, IRAB+ILO-1 ) )
-         IRAB = IZAMAX( N-ILO+1, B( I, ILO ), LDB )
-         RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) )
-         LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE )
-         IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) )
-         IR = MIN( MAX( IR, LSFMIN ), LSFMAX, LSFMAX-LRAB )
-         LSCALE( I ) = SCLFAC**IR
-         ICAB = IZAMAX( IHI, A( 1, I ), 1 )
-         CAB = ABS( A( ICAB, I ) )
-         ICAB = IZAMAX( IHI, B( 1, I ), 1 )
-         CAB = MAX( CAB, ABS( B( ICAB, I ) ) )
-         LCAB = INT( LOG10( CAB+SFMIN ) / BASL+ONE )
-         JC = RSCALE( I ) + SIGN( HALF, RSCALE( I ) )
-         JC = MIN( MAX( JC, LSFMIN ), LSFMAX, LSFMAX-LCAB )
-         RSCALE( I ) = SCLFAC**JC
-  360 CONTINUE
-*
-*     Row scaling of matrices A and B
-*
-      DO 370 I = ILO, IHI
-         CALL ZDSCAL( N-ILO+1, LSCALE( I ), A( I, ILO ), LDA )
-         CALL ZDSCAL( N-ILO+1, LSCALE( I ), B( I, ILO ), LDB )
-  370 CONTINUE
-*
-*     Column scaling of matrices A and B
-*
-      DO 380 J = ILO, IHI
-         CALL ZDSCAL( IHI, RSCALE( J ), A( 1, J ), 1 )
-         CALL ZDSCAL( IHI, RSCALE( J ), B( 1, J ), 1 )
-  380 CONTINUE
-*
-      RETURN
-*
-*     End of ZGGBAL
-*
-      END
diff --git a/src/lib/lapack/zgges.f b/src/lib/lapack/zgges.f
deleted file mode 100644
index c1499003..00000000
--- a/src/lib/lapack/zgges.f
+++ /dev/null
@@ -1,477 +0,0 @@
-      SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB,
-     $                  SDIM, ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK,
-     $                  LWORK, RWORK, BWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBVSL, JOBVSR, SORT
-      INTEGER            INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            BWORK( * )
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         A( LDA, * ), ALPHA( * ), B( LDB, * ),
-     $                   BETA( * ), VSL( LDVSL, * ), VSR( LDVSR, * ),
-     $                   WORK( * )
-*     ..
-*     .. Function Arguments ..
-      LOGICAL            SELCTG
-      EXTERNAL           SELCTG
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGGES computes for a pair of N-by-N complex nonsymmetric matrices
-*  (A,B), the generalized eigenvalues, the generalized complex Schur
-*  form (S, T), and optionally left and/or right Schur vectors (VSL
-*  and VSR). This gives the generalized Schur factorization
-*
-*          (A,B) = ( (VSL)*S*(VSR)**H, (VSL)*T*(VSR)**H )
-*
-*  where (VSR)**H is the conjugate-transpose of VSR.
-*
-*  Optionally, it also orders the eigenvalues so that a selected cluster
-*  of eigenvalues appears in the leading diagonal blocks of the upper
-*  triangular matrix S and the upper triangular matrix T. The leading
-*  columns of VSL and VSR then form an unitary basis for the
-*  corresponding left and right eigenspaces (deflating subspaces).
-*
-*  (If only the generalized eigenvalues are needed, use the driver
-*  ZGGEV instead, which is faster.)
-*
-*  A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
-*  or a ratio alpha/beta = w, such that  A - w*B is singular.  It is
-*  usually represented as the pair (alpha,beta), as there is a
-*  reasonable interpretation for beta=0, and even for both being zero.
-*
-*  A pair of matrices (S,T) is in generalized complex Schur form if S
-*  and T are upper triangular and, in addition, the diagonal elements
-*  of T are non-negative real numbers.
-*
-*  Arguments
-*  =========
-*
-*  JOBVSL  (input) CHARACTER*1
-*          = 'N':  do not compute the left Schur vectors;
-*          = 'V':  compute the left Schur vectors.
-*
-*  JOBVSR  (input) CHARACTER*1
-*          = 'N':  do not compute the right Schur vectors;
-*          = 'V':  compute the right Schur vectors.
-*
-*  SORT    (input) CHARACTER*1
-*          Specifies whether or not to order the eigenvalues on the
-*          diagonal of the generalized Schur form.
-*          = 'N':  Eigenvalues are not ordered;
-*          = 'S':  Eigenvalues are ordered (see SELCTG).
-*
-*  SELCTG  (external procedure) LOGICAL FUNCTION of two COMPLEX*16 arguments
-*          SELCTG must be declared EXTERNAL in the calling subroutine.
-*          If SORT = 'N', SELCTG is not referenced.
-*          If SORT = 'S', SELCTG is used to select eigenvalues to sort
-*          to the top left of the Schur form.
-*          An eigenvalue ALPHA(j)/BETA(j) is selected if
-*          SELCTG(ALPHA(j),BETA(j)) is true.
-*
-*          Note that a selected complex eigenvalue may no longer satisfy
-*          SELCTG(ALPHA(j),BETA(j)) = .TRUE. after ordering, since
-*          ordering may change the value of complex eigenvalues
-*          (especially if the eigenvalue is ill-conditioned), in this
-*          case INFO is set to N+2 (See INFO below).
-*
-*  N       (input) INTEGER
-*          The order of the matrices A, B, VSL, and VSR.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA, N)
-*          On entry, the first of the pair of matrices.
-*          On exit, A has been overwritten by its generalized Schur
-*          form S.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of A.  LDA >= max(1,N).
-*
-*  B       (input/output) COMPLEX*16 array, dimension (LDB, N)
-*          On entry, the second of the pair of matrices.
-*          On exit, B has been overwritten by its generalized Schur
-*          form T.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of B.  LDB >= max(1,N).
-*
-*  SDIM    (output) INTEGER
-*          If SORT = 'N', SDIM = 0.
-*          If SORT = 'S', SDIM = number of eigenvalues (after sorting)
-*          for which SELCTG is true.
-*
-*  ALPHA   (output) COMPLEX*16 array, dimension (N)
-*  BETA    (output) COMPLEX*16 array, dimension (N)
-*          On exit,  ALPHA(j)/BETA(j), j=1,...,N, will be the
-*          generalized eigenvalues.  ALPHA(j), j=1,...,N  and  BETA(j),
-*          j=1,...,N  are the diagonals of the complex Schur form (A,B)
-*          output by ZGGES. The  BETA(j) will be non-negative real.
-*
-*          Note: the quotients ALPHA(j)/BETA(j) may easily over- or
-*          underflow, and BETA(j) may even be zero.  Thus, the user
-*          should avoid naively computing the ratio alpha/beta.
-*          However, ALPHA will be always less than and usually
-*          comparable with norm(A) in magnitude, and BETA always less
-*          than and usually comparable with norm(B).
-*
-*  VSL     (output) COMPLEX*16 array, dimension (LDVSL,N)
-*          If JOBVSL = 'V', VSL will contain the left Schur vectors.
-*          Not referenced if JOBVSL = 'N'.
-*
-*  LDVSL   (input) INTEGER
-*          The leading dimension of the matrix VSL. LDVSL >= 1, and
-*          if JOBVSL = 'V', LDVSL >= N.
-*
-*  VSR     (output) COMPLEX*16 array, dimension (LDVSR,N)
-*          If JOBVSR = 'V', VSR will contain the right Schur vectors.
-*          Not referenced if JOBVSR = 'N'.
-*
-*  LDVSR   (input) INTEGER
-*          The leading dimension of the matrix VSR. LDVSR >= 1, and
-*          if JOBVSR = 'V', LDVSR >= N.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,2*N).
-*          For good performance, LWORK must generally be larger.
-*
-*          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.
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (8*N)
-*
-*  BWORK   (workspace) LOGICAL array, dimension (N)
-*          Not referenced if SORT = 'N'.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          =1,...,N:
-*                The QZ iteration failed.  (A,B) are not in Schur
-*                form, but ALPHA(j) and BETA(j) should be correct for
-*                j=INFO+1,...,N.
-*          > N:  =N+1: other than QZ iteration failed in ZHGEQZ
-*                =N+2: after reordering, roundoff changed values of
-*                      some complex eigenvalues so that leading
-*                      eigenvalues in the Generalized Schur form no
-*                      longer satisfy SELCTG=.TRUE.  This could also
-*                      be caused due to scaling.
-*                =N+3: reordering falied in ZTGSEN.
-*
-*  =====================================================================
-*
-*     .. 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            CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
-     $                   LQUERY, WANTST
-      INTEGER            I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
-     $                   ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKMIN,
-     $                   LWKOPT
-      DOUBLE PRECISION   ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL,
-     $                   PVSR, SMLNUM
-*     ..
-*     .. Local Arrays ..
-      INTEGER            IDUM( 1 )
-      DOUBLE PRECISION   DIF( 2 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD,
-     $                   ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR,
-     $                   ZUNMQR
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, ZLANGE
-      EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode the input arguments
-*
-      IF( LSAME( JOBVSL, 'N' ) ) THEN
-         IJOBVL = 1
-         ILVSL = .FALSE.
-      ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
-         IJOBVL = 2
-         ILVSL = .TRUE.
-      ELSE
-         IJOBVL = -1
-         ILVSL = .FALSE.
-      END IF
-*
-      IF( LSAME( JOBVSR, 'N' ) ) THEN
-         IJOBVR = 1
-         ILVSR = .FALSE.
-      ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
-         IJOBVR = 2
-         ILVSR = .TRUE.
-      ELSE
-         IJOBVR = -1
-         ILVSR = .FALSE.
-      END IF
-*
-      WANTST = LSAME( SORT, 'S' )
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( IJOBVL.LE.0 ) THEN
-         INFO = -1
-      ELSE IF( IJOBVR.LE.0 ) THEN
-         INFO = -2
-      ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
-         INFO = -14
-      ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
-         INFO = -16
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       NB refers to the optimal block size for the immediately
-*       following subroutine, as returned by ILAENV.)
-*
-      IF( INFO.EQ.0 ) THEN
-         LWKMIN = MAX( 1, 2*N )
-         LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 ) )
-         LWKOPT = MAX( LWKOPT, N +
-     $                 N*ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, -1 ) )
-         IF( ILVSL ) THEN
-            LWKOPT = MAX( LWKOPT, N +
-     $                    N*ILAENV( 1, 'ZUNGQR', ' ', N, 1, N, -1 ) )
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
-     $      INFO = -18
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGGES ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         SDIM = 0
-         RETURN
-      END IF
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SQRT( SMLNUM ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = ZLANGE( 'M', N, N, A, LDA, RWORK )
-      ILASCL = .FALSE.
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         ANRMTO = SMLNUM
-         ILASCL = .TRUE.
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         ANRMTO = BIGNUM
-         ILASCL = .TRUE.
-      END IF
-*
-      IF( ILASCL )
-     $   CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-*     Scale B if max element outside range [SMLNUM,BIGNUM]
-*
-      BNRM = ZLANGE( 'M', N, N, B, LDB, RWORK )
-      ILBSCL = .FALSE.
-      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-         BNRMTO = SMLNUM
-         ILBSCL = .TRUE.
-      ELSE IF( BNRM.GT.BIGNUM ) THEN
-         BNRMTO = BIGNUM
-         ILBSCL = .TRUE.
-      END IF
-*
-      IF( ILBSCL )
-     $   CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-*     Permute the matrix to make it more nearly triangular
-*     (Real Workspace: need 6*N)
-*
-      ILEFT = 1
-      IRIGHT = N + 1
-      IRWRK = IRIGHT + N
-      CALL ZGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, RWORK( ILEFT ),
-     $             RWORK( IRIGHT ), RWORK( IRWRK ), IERR )
-*
-*     Reduce B to triangular form (QR decomposition of B)
-*     (Complex Workspace: need N, prefer N*NB)
-*
-      IROWS = IHI + 1 - ILO
-      ICOLS = N + 1 - ILO
-      ITAU = 1
-      IWRK = ITAU + IROWS
-      CALL ZGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
-     $             WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-*     Apply the orthogonal transformation to matrix A
-*     (Complex Workspace: need N, prefer N*NB)
-*
-      CALL ZUNMQR( 'L', 'C', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
-     $             WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
-     $             LWORK+1-IWRK, IERR )
-*
-*     Initialize VSL
-*     (Complex Workspace: need N, prefer N*NB)
-*
-      IF( ILVSL ) THEN
-         CALL ZLASET( 'Full', N, N, CZERO, CONE, VSL, LDVSL )
-         IF( IROWS.GT.1 ) THEN
-            CALL ZLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
-     $                   VSL( ILO+1, ILO ), LDVSL )
-         END IF
-         CALL ZUNGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
-     $                WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
-      END IF
-*
-*     Initialize VSR
-*
-      IF( ILVSR )
-     $   CALL ZLASET( 'Full', N, N, CZERO, CONE, VSR, LDVSR )
-*
-*     Reduce to generalized Hessenberg form
-*     (Workspace: none needed)
-*
-      CALL ZGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
-     $             LDVSL, VSR, LDVSR, IERR )
-*
-      SDIM = 0
-*
-*     Perform QZ algorithm, computing Schur vectors if desired
-*     (Complex Workspace: need N)
-*     (Real Workspace: need N)
-*
-      IWRK = ITAU
-      CALL ZHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
-     $             ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK( IWRK ),
-     $             LWORK+1-IWRK, RWORK( IRWRK ), IERR )
-      IF( IERR.NE.0 ) THEN
-         IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
-            INFO = IERR
-         ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
-            INFO = IERR - N
-         ELSE
-            INFO = N + 1
-         END IF
-         GO TO 30
-      END IF
-*
-*     Sort eigenvalues ALPHA/BETA if desired
-*     (Workspace: none needed)
-*
-      IF( WANTST ) THEN
-*
-*        Undo scaling on eigenvalues before selecting
-*
-         IF( ILASCL )
-     $      CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N, IERR )
-         IF( ILBSCL )
-     $      CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N, IERR )
-*
-*        Select eigenvalues
-*
-         DO 10 I = 1, N
-            BWORK( I ) = SELCTG( ALPHA( I ), BETA( I ) )
-   10    CONTINUE
-*
-         CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHA,
-     $                BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL, PVSR,
-     $                DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1, IERR )
-         IF( IERR.EQ.1 )
-     $      INFO = N + 3
-*
-      END IF
-*
-*     Apply back-permutation to VSL and VSR
-*     (Workspace: none needed)
-*
-      IF( ILVSL )
-     $   CALL ZGGBAK( 'P', 'L', N, ILO, IHI, RWORK( ILEFT ),
-     $                RWORK( IRIGHT ), N, VSL, LDVSL, IERR )
-      IF( ILVSR )
-     $   CALL ZGGBAK( 'P', 'R', N, ILO, IHI, RWORK( ILEFT ),
-     $                RWORK( IRIGHT ), N, VSR, LDVSR, IERR )
-*
-*     Undo scaling
-*
-      IF( ILASCL ) THEN
-         CALL ZLASCL( 'U', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR )
-         CALL ZLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
-      END IF
-*
-      IF( ILBSCL ) THEN
-         CALL ZLASCL( 'U', 0, 0, BNRMTO, BNRM, N, N, B, LDB, IERR )
-         CALL ZLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
-      END IF
-*
-      IF( WANTST ) THEN
-*
-*        Check if reordering is correct
-*
-         LASTSL = .TRUE.
-         SDIM = 0
-         DO 20 I = 1, N
-            CURSL = SELCTG( ALPHA( I ), BETA( I ) )
-            IF( CURSL )
-     $         SDIM = SDIM + 1
-            IF( CURSL .AND. .NOT.LASTSL )
-     $         INFO = N + 2
-            LASTSL = CURSL
-   20    CONTINUE
-*
-      END IF
-*
-   30 CONTINUE
-*
-      WORK( 1 ) = LWKOPT
-*
-      RETURN
-*
-*     End of ZGGES
-*
-      END
diff --git a/src/lib/lapack/zggev.f b/src/lib/lapack/zggev.f
deleted file mode 100644
index 94fb3dc2..00000000
--- a/src/lib/lapack/zggev.f
+++ /dev/null
@@ -1,454 +0,0 @@
-      SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
-     $                  VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBVL, JOBVR
-      INTEGER            INFO, LDA, LDB, LDVL, LDVR, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         A( LDA, * ), ALPHA( * ), B( LDB, * ),
-     $                   BETA( * ), VL( LDVL, * ), VR( LDVR, * ),
-     $                   WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGGEV computes for a pair of N-by-N complex nonsymmetric matrices
-*  (A,B), the generalized eigenvalues, and optionally, the left and/or
-*  right generalized eigenvectors.
-*
-*  A generalized eigenvalue for a pair of matrices (A,B) is a scalar
-*  lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
-*  singular. It is usually represented as the pair (alpha,beta), as
-*  there is a reasonable interpretation for beta=0, and even for both
-*  being zero.
-*
-*  The right generalized eigenvector v(j) corresponding to the
-*  generalized eigenvalue lambda(j) of (A,B) satisfies
-*
-*               A * v(j) = lambda(j) * B * v(j).
-*
-*  The left generalized eigenvector u(j) corresponding to the
-*  generalized eigenvalues lambda(j) of (A,B) satisfies
-*
-*               u(j)**H * A = lambda(j) * u(j)**H * B
-*
-*  where u(j)**H is the conjugate-transpose of u(j).
-*
-*  Arguments
-*  =========
-*
-*  JOBVL   (input) CHARACTER*1
-*          = 'N':  do not compute the left generalized eigenvectors;
-*          = 'V':  compute the left generalized eigenvectors.
-*
-*  JOBVR   (input) CHARACTER*1
-*          = 'N':  do not compute the right generalized eigenvectors;
-*          = 'V':  compute the right generalized eigenvectors.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A, B, VL, and VR.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA, N)
-*          On entry, the matrix A in the pair (A,B).
-*          On exit, A has been overwritten.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of A.  LDA >= max(1,N).
-*
-*  B       (input/output) COMPLEX*16 array, dimension (LDB, N)
-*          On entry, the matrix B in the pair (A,B).
-*          On exit, B has been overwritten.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of B.  LDB >= max(1,N).
-*
-*  ALPHA   (output) COMPLEX*16 array, dimension (N)
-*  BETA    (output) COMPLEX*16 array, dimension (N)
-*          On exit, ALPHA(j)/BETA(j), j=1,...,N, will be the
-*          generalized eigenvalues.
-*
-*          Note: the quotients ALPHA(j)/BETA(j) may easily over- or
-*          underflow, and BETA(j) may even be zero.  Thus, the user
-*          should avoid naively computing the ratio alpha/beta.
-*          However, ALPHA will be always less than and usually
-*          comparable with norm(A) in magnitude, and BETA always less
-*          than and usually comparable with norm(B).
-*
-*  VL      (output) COMPLEX*16 array, dimension (LDVL,N)
-*          If JOBVL = 'V', the left generalized eigenvectors u(j) are
-*          stored one after another in the columns of VL, in the same
-*          order as their eigenvalues.
-*          Each eigenvector is scaled so the largest component has
-*          abs(real part) + abs(imag. part) = 1.
-*          Not referenced if JOBVL = 'N'.
-*
-*  LDVL    (input) INTEGER
-*          The leading dimension of the matrix VL. LDVL >= 1, and
-*          if JOBVL = 'V', LDVL >= N.
-*
-*  VR      (output) COMPLEX*16 array, dimension (LDVR,N)
-*          If JOBVR = 'V', the right generalized eigenvectors v(j) are
-*          stored one after another in the columns of VR, in the same
-*          order as their eigenvalues.
-*          Each eigenvector is scaled so the largest component has
-*          abs(real part) + abs(imag. part) = 1.
-*          Not referenced if JOBVR = 'N'.
-*
-*  LDVR    (input) INTEGER
-*          The leading dimension of the matrix VR. LDVR >= 1, and
-*          if JOBVR = 'V', LDVR >= N.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,2*N).
-*          For good performance, LWORK must generally be larger.
-*
-*          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.
-*
-*  RWORK   (workspace/output) DOUBLE PRECISION array, dimension (8*N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*          =1,...,N:
-*                The QZ iteration failed.  No eigenvectors have been
-*                calculated, but ALPHA(j) and BETA(j) should be
-*                correct for j=INFO+1,...,N.
-*          > N:  =N+1: other then QZ iteration failed in DHGEQZ,
-*                =N+2: error return from DTGEVC.
-*
-*  =====================================================================
-*
-*     .. 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            ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY
-      CHARACTER          CHTEMP
-      INTEGER            ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO,
-     $                   IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR,
-     $                   LWKMIN, LWKOPT
-      DOUBLE PRECISION   ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
-     $                   SMLNUM, TEMP
-      COMPLEX*16         X
-*     ..
-*     .. Local Arrays ..
-      LOGICAL            LDUMMA( 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD,
-     $                   ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR,
-     $                   ZUNMQR
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      DOUBLE PRECISION   DLAMCH, ZLANGE
-      EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANGE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DIMAG, MAX, SQRT
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   ABS1
-*     ..
-*     .. Statement Function definitions ..
-      ABS1( X ) = ABS( DBLE( X ) ) + ABS( DIMAG( X ) )
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode the input arguments
-*
-      IF( LSAME( JOBVL, 'N' ) ) THEN
-         IJOBVL = 1
-         ILVL = .FALSE.
-      ELSE IF( LSAME( JOBVL, 'V' ) ) THEN
-         IJOBVL = 2
-         ILVL = .TRUE.
-      ELSE
-         IJOBVL = -1
-         ILVL = .FALSE.
-      END IF
-*
-      IF( LSAME( JOBVR, 'N' ) ) THEN
-         IJOBVR = 1
-         ILVR = .FALSE.
-      ELSE IF( LSAME( JOBVR, 'V' ) ) THEN
-         IJOBVR = 2
-         ILVR = .TRUE.
-      ELSE
-         IJOBVR = -1
-         ILVR = .FALSE.
-      END IF
-      ILV = ILVL .OR. ILVR
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( IJOBVL.LE.0 ) THEN
-         INFO = -1
-      ELSE IF( IJOBVR.LE.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDVL.LT.1 .OR. ( ILVL .AND. LDVL.LT.N ) ) THEN
-         INFO = -11
-      ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN
-         INFO = -13
-      END IF
-*
-*     Compute workspace
-*      (Note: Comments in the code beginning "Workspace:" describe the
-*       minimal amount of workspace needed at that point in the code,
-*       as well as the preferred amount for good performance.
-*       NB refers to the optimal block size for the immediately
-*       following subroutine, as returned by ILAENV. The workspace is
-*       computed assuming ILO = 1 and IHI = N, the worst case.)
-*
-      IF( INFO.EQ.0 ) THEN
-         LWKMIN = MAX( 1, 2*N )
-         LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 ) )
-         LWKOPT = MAX( LWKOPT, N +
-     $                 N*ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, 0 ) )
-         IF( ILVL ) THEN
-            LWKOPT = MAX( LWKOPT, N +
-     $                    N*ILAENV( 1, 'ZUNGQR', ' ', N, 1, N, -1 ) )
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
-     $      INFO = -15
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGGEV ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Get machine constants
-*
-      EPS = DLAMCH( 'E' )*DLAMCH( 'B' )
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SQRT( SMLNUM ) / EPS
-      BIGNUM = ONE / SMLNUM
-*
-*     Scale A if max element outside range [SMLNUM,BIGNUM]
-*
-      ANRM = ZLANGE( 'M', N, N, A, LDA, RWORK )
-      ILASCL = .FALSE.
-      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
-         ANRMTO = SMLNUM
-         ILASCL = .TRUE.
-      ELSE IF( ANRM.GT.BIGNUM ) THEN
-         ANRMTO = BIGNUM
-         ILASCL = .TRUE.
-      END IF
-      IF( ILASCL )
-     $   CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
-*
-*     Scale B if max element outside range [SMLNUM,BIGNUM]
-*
-      BNRM = ZLANGE( 'M', N, N, B, LDB, RWORK )
-      ILBSCL = .FALSE.
-      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
-         BNRMTO = SMLNUM
-         ILBSCL = .TRUE.
-      ELSE IF( BNRM.GT.BIGNUM ) THEN
-         BNRMTO = BIGNUM
-         ILBSCL = .TRUE.
-      END IF
-      IF( ILBSCL )
-     $   CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
-*
-*     Permute the matrices A, B to isolate eigenvalues if possible
-*     (Real Workspace: need 6*N)
-*
-      ILEFT = 1
-      IRIGHT = N + 1
-      IRWRK = IRIGHT + N
-      CALL ZGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, RWORK( ILEFT ),
-     $             RWORK( IRIGHT ), RWORK( IRWRK ), IERR )
-*
-*     Reduce B to triangular form (QR decomposition of B)
-*     (Complex Workspace: need N, prefer N*NB)
-*
-      IROWS = IHI + 1 - ILO
-      IF( ILV ) THEN
-         ICOLS = N + 1 - ILO
-      ELSE
-         ICOLS = IROWS
-      END IF
-      ITAU = 1
-      IWRK = ITAU + IROWS
-      CALL ZGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
-     $             WORK( IWRK ), LWORK+1-IWRK, IERR )
-*
-*     Apply the orthogonal transformation to matrix A
-*     (Complex Workspace: need N, prefer N*NB)
-*
-      CALL ZUNMQR( 'L', 'C', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
-     $             WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
-     $             LWORK+1-IWRK, IERR )
-*
-*     Initialize VL
-*     (Complex Workspace: need N, prefer N*NB)
-*
-      IF( ILVL ) THEN
-         CALL ZLASET( 'Full', N, N, CZERO, CONE, VL, LDVL )
-         IF( IROWS.GT.1 ) THEN
-            CALL ZLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
-     $                   VL( ILO+1, ILO ), LDVL )
-         END IF
-         CALL ZUNGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL,
-     $                WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
-      END IF
-*
-*     Initialize VR
-*
-      IF( ILVR )
-     $   CALL ZLASET( 'Full', N, N, CZERO, CONE, VR, LDVR )
-*
-*     Reduce to generalized Hessenberg form
-*
-      IF( ILV ) THEN
-*
-*        Eigenvectors requested -- work on whole matrix.
-*
-         CALL ZGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
-     $                LDVL, VR, LDVR, IERR )
-      ELSE
-         CALL ZGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
-     $                B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
-      END IF
-*
-*     Perform QZ algorithm (Compute eigenvalues, and optionally, the
-*     Schur form and Schur vectors)
-*     (Complex Workspace: need N)
-*     (Real Workspace: need N)
-*
-      IWRK = ITAU
-      IF( ILV ) THEN
-         CHTEMP = 'S'
-      ELSE
-         CHTEMP = 'E'
-      END IF
-      CALL ZHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
-     $             ALPHA, BETA, VL, LDVL, VR, LDVR, WORK( IWRK ),
-     $             LWORK+1-IWRK, RWORK( IRWRK ), IERR )
-      IF( IERR.NE.0 ) THEN
-         IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
-            INFO = IERR
-         ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
-            INFO = IERR - N
-         ELSE
-            INFO = N + 1
-         END IF
-         GO TO 70
-      END IF
-*
-*     Compute Eigenvectors
-*     (Real Workspace: need 2*N)
-*     (Complex Workspace: need 2*N)
-*
-      IF( ILV ) THEN
-         IF( ILVL ) THEN
-            IF( ILVR ) THEN
-               CHTEMP = 'B'
-            ELSE
-               CHTEMP = 'L'
-            END IF
-         ELSE
-            CHTEMP = 'R'
-         END IF
-*
-         CALL ZTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL,
-     $                VR, LDVR, N, IN, WORK( IWRK ), RWORK( IRWRK ),
-     $                IERR )
-         IF( IERR.NE.0 ) THEN
-            INFO = N + 2
-            GO TO 70
-         END IF
-*
-*        Undo balancing on VL and VR and normalization
-*        (Workspace: none needed)
-*
-         IF( ILVL ) THEN
-            CALL ZGGBAK( 'P', 'L', N, ILO, IHI, RWORK( ILEFT ),
-     $                   RWORK( IRIGHT ), N, VL, LDVL, IERR )
-            DO 30 JC = 1, N
-               TEMP = ZERO
-               DO 10 JR = 1, N
-                  TEMP = MAX( TEMP, ABS1( VL( JR, JC ) ) )
-   10          CONTINUE
-               IF( TEMP.LT.SMLNUM )
-     $            GO TO 30
-               TEMP = ONE / TEMP
-               DO 20 JR = 1, N
-                  VL( JR, JC ) = VL( JR, JC )*TEMP
-   20          CONTINUE
-   30       CONTINUE
-         END IF
-         IF( ILVR ) THEN
-            CALL ZGGBAK( 'P', 'R', N, ILO, IHI, RWORK( ILEFT ),
-     $                   RWORK( IRIGHT ), N, VR, LDVR, IERR )
-            DO 60 JC = 1, N
-               TEMP = ZERO
-               DO 40 JR = 1, N
-                  TEMP = MAX( TEMP, ABS1( VR( JR, JC ) ) )
-   40          CONTINUE
-               IF( TEMP.LT.SMLNUM )
-     $            GO TO 60
-               TEMP = ONE / TEMP
-               DO 50 JR = 1, N
-                  VR( JR, JC ) = VR( JR, JC )*TEMP
-   50          CONTINUE
-   60       CONTINUE
-         END IF
-      END IF
-*
-*     Undo scaling if necessary
-*
-      IF( ILASCL )
-     $   CALL ZLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR )
-*
-      IF( ILBSCL )
-     $   CALL ZLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
-*
-   70 CONTINUE
-      WORK( 1 ) = LWKOPT
-*
-      RETURN
-*
-*     End of ZGGEV
-*
-      END
diff --git a/src/lib/lapack/zgghrd.f b/src/lib/lapack/zgghrd.f
deleted file mode 100644
index 652c09d7..00000000
--- a/src/lib/lapack/zgghrd.f
+++ /dev/null
@@ -1,264 +0,0 @@
-      SUBROUTINE ZGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
-     $                   LDQ, Z, LDZ, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          COMPQ, COMPZ
-      INTEGER            IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZGGHRD reduces a pair of complex matrices (A,B) to generalized upper
-*  Hessenberg form using unitary transformations, where A is a
-*  general matrix and B is upper triangular.  The form of the
-*  generalized eigenvalue problem is
-*     A*x = lambda*B*x,
-*  and B is typically made upper triangular by computing its QR
-*  factorization and moving the unitary matrix Q to the left side
-*  of the equation.
-*
-*  This subroutine simultaneously reduces A to a Hessenberg matrix H:
-*     Q**H*A*Z = H
-*  and transforms B to another upper triangular matrix T:
-*     Q**H*B*Z = T
-*  in order to reduce the problem to its standard form
-*     H*y = lambda*T*y
-*  where y = Z**H*x.
-*
-*  The unitary matrices Q and Z are determined as products of Givens
-*  rotations.  They may either be formed explicitly, or they may be
-*  postmultiplied into input matrices Q1 and Z1, so that
-*       Q1 * A * Z1**H = (Q1*Q) * H * (Z1*Z)**H
-*       Q1 * B * Z1**H = (Q1*Q) * T * (Z1*Z)**H
-*  If Q1 is the unitary matrix from the QR factorization of B in the
-*  original equation A*x = lambda*B*x, then ZGGHRD reduces the original
-*  problem to generalized Hessenberg form.
-*
-*  Arguments
-*  =========
-*
-*  COMPQ   (input) CHARACTER*1
-*          = 'N': do not compute Q;
-*          = 'I': Q is initialized to the unit matrix, and the
-*                 unitary matrix Q is returned;
-*          = 'V': Q must contain a unitary matrix Q1 on entry,
-*                 and the product Q1*Q is returned.
-*
-*  COMPZ   (input) CHARACTER*1
-*          = 'N': do not compute Q;
-*          = 'I': Q is initialized to the unit matrix, and the
-*                 unitary matrix Q is returned;
-*          = 'V': Q must contain a unitary matrix Q1 on entry,
-*                 and the product Q1*Q is returned.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          ILO and IHI mark the rows and columns of A which are to be
-*          reduced.  It is assumed that A is already upper triangular
-*          in rows and columns 1:ILO-1 and IHI+1:N.  ILO and IHI are
-*          normally set by a previous call to ZGGBAL; otherwise they
-*          should be set to 1 and N respectively.
-*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA, N)
-*          On entry, the N-by-N general matrix to be reduced.
-*          On exit, the upper triangle and the first subdiagonal of A
-*          are overwritten with the upper Hessenberg matrix H, and the
-*          rest is set to zero.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  B       (input/output) COMPLEX*16 array, dimension (LDB, N)
-*          On entry, the N-by-N upper triangular matrix B.
-*          On exit, the upper triangular matrix T = Q**H B Z.  The
-*          elements below the diagonal are set to zero.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,N).
-*
-*  Q       (input/output) COMPLEX*16 array, dimension (LDQ, N)
-*          On entry, if COMPQ = 'V', the unitary matrix Q1, typically
-*          from the QR factorization of B.
-*          On exit, if COMPQ='I', the unitary matrix Q, and if
-*          COMPQ = 'V', the product Q1*Q.
-*          Not referenced if COMPQ='N'.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q.
-*          LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
-*
-*  Z       (input/output) COMPLEX*16 array, dimension (LDZ, N)
-*          On entry, if COMPZ = 'V', the unitary matrix Z1.
-*          On exit, if COMPZ='I', the unitary matrix Z, and if
-*          COMPZ = 'V', the product Z1*Z.
-*          Not referenced if COMPZ='N'.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z.
-*          LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  This routine reduces A to Hessenberg and B to triangular form by
-*  an unblocked reduction, as described in _Matrix_Computations_,
-*  by Golub and van Loan (Johns Hopkins Press).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         CONE, CZERO
-      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ),
-     $                   CZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            ILQ, ILZ
-      INTEGER            ICOMPQ, ICOMPZ, JCOL, JROW
-      DOUBLE PRECISION   C
-      COMPLEX*16         CTEMP, S
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARTG, ZLASET, ZROT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode COMPQ
-*
-      IF( LSAME( COMPQ, 'N' ) ) THEN
-         ILQ = .FALSE.
-         ICOMPQ = 1
-      ELSE IF( LSAME( COMPQ, 'V' ) ) THEN
-         ILQ = .TRUE.
-         ICOMPQ = 2
-      ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
-         ILQ = .TRUE.
-         ICOMPQ = 3
-      ELSE
-         ICOMPQ = 0
-      END IF
-*
-*     Decode COMPZ
-*
-      IF( LSAME( COMPZ, 'N' ) ) THEN
-         ILZ = .FALSE.
-         ICOMPZ = 1
-      ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
-         ILZ = .TRUE.
-         ICOMPZ = 2
-      ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
-         ILZ = .TRUE.
-         ICOMPZ = 3
-      ELSE
-         ICOMPZ = 0
-      END IF
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      IF( ICOMPQ.LE.0 ) THEN
-         INFO = -1
-      ELSE IF( ICOMPZ.LE.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( ILO.LT.1 ) THEN
-         INFO = -4
-      ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      ELSE IF( ( ILQ .AND. LDQ.LT.N ) .OR. LDQ.LT.1 ) THEN
-         INFO = -11
-      ELSE IF( ( ILZ .AND. LDZ.LT.N ) .OR. LDZ.LT.1 ) THEN
-         INFO = -13
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZGGHRD', -INFO )
-         RETURN
-      END IF
-*
-*     Initialize Q and Z if desired.
-*
-      IF( ICOMPQ.EQ.3 )
-     $   CALL ZLASET( 'Full', N, N, CZERO, CONE, Q, LDQ )
-      IF( ICOMPZ.EQ.3 )
-     $   CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDZ )
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-*     Zero out lower triangle of B
-*
-      DO 20 JCOL = 1, N - 1
-         DO 10 JROW = JCOL + 1, N
-            B( JROW, JCOL ) = CZERO
-   10    CONTINUE
-   20 CONTINUE
-*
-*     Reduce A and B
-*
-      DO 40 JCOL = ILO, IHI - 2
-*
-         DO 30 JROW = IHI, JCOL + 2, -1
-*
-*           Step 1: rotate rows JROW-1, JROW to kill A(JROW,JCOL)
-*
-            CTEMP = A( JROW-1, JCOL )
-            CALL ZLARTG( CTEMP, A( JROW, JCOL ), C, S,
-     $                   A( JROW-1, JCOL ) )
-            A( JROW, JCOL ) = CZERO
-            CALL ZROT( N-JCOL, A( JROW-1, JCOL+1 ), LDA,
-     $                 A( JROW, JCOL+1 ), LDA, C, S )
-            CALL ZROT( N+2-JROW, B( JROW-1, JROW-1 ), LDB,
-     $                 B( JROW, JROW-1 ), LDB, C, S )
-            IF( ILQ )
-     $         CALL ZROT( N, Q( 1, JROW-1 ), 1, Q( 1, JROW ), 1, C,
-     $                    DCONJG( S ) )
-*
-*           Step 2: rotate columns JROW, JROW-1 to kill B(JROW,JROW-1)
-*
-            CTEMP = B( JROW, JROW )
-            CALL ZLARTG( CTEMP, B( JROW, JROW-1 ), C, S,
-     $                   B( JROW, JROW ) )
-            B( JROW, JROW-1 ) = CZERO
-            CALL ZROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S )
-            CALL ZROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C,
-     $                 S )
-            IF( ILZ )
-     $         CALL ZROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S )
-   30    CONTINUE
-   40 CONTINUE
-*
-      RETURN
-*
-*     End of ZGGHRD
-*
-      END
diff --git a/src/lib/lapack/zheev.f b/src/lib/lapack/zheev.f
deleted file mode 100644
index 324d1612..00000000
--- a/src/lib/lapack/zheev.f
+++ /dev/null
@@ -1,218 +0,0 @@
-      SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
-     $                  INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          JOBZ, UPLO
-      INTEGER            INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   RWORK( * ), W( * )
-      COMPLEX*16         A( LDA, * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZHEEV computes all eigenvalues and, optionally, eigenvectors of a
-*  complex Hermitian matrix A.
-*
-*  Arguments
-*  =========
-*
-*  JOBZ    (input) CHARACTER*1
-*          = 'N':  Compute eigenvalues only;
-*          = 'V':  Compute eigenvalues and eigenvectors.
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  W       (output) DOUBLE PRECISION array, dimension (N)
-*          If INFO = 0, the eigenvalues in ascending order.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The length of the array WORK.  LWORK >= max(1,2*N-1).
-*          For optimal efficiency, LWORK >= (NB+1)*N,
-*          where NB is the blocksize for ZHETRD 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.
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (max(1, 3*N-2))
-*
-*  INFO    (output) 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.
-*
-*  =====================================================================
-*
-*     .. 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, LWKOPT, NB
-      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, ZHETRD, ZLASCL, ZSTEQR,
-     $                   ZUNGTR
-*     ..
-*     .. 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.( WANTZ .OR. 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
-         NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
-         LWKOPT = MAX( 1, ( NB+1 )*N )
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, 2*N-1 ) .AND. .NOT.LQUERY )
-     $      INFO = -8
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZHEEV ', -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 ) = 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 to reduce Hermitian matrix to tridiagonal form.
-*
-      INDE = 1
-      INDTAU = 1
-      INDWRK = INDTAU + N
-      LLWORK = LWORK - INDWRK + 1
-      CALL ZHETRD( UPLO, N, A, LDA, W, RWORK( INDE ), WORK( INDTAU ),
-     $             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 ) = LWKOPT
-*
-      RETURN
-*
-*     End of ZHEEV
-*
-      END
diff --git a/src/lib/lapack/zhetd2.f b/src/lib/lapack/zhetd2.f
deleted file mode 100644
index 24b0a1df..00000000
--- a/src/lib/lapack/zhetd2.f
+++ /dev/null
@@ -1,258 +0,0 @@
-      SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * )
-      COMPLEX*16         A( LDA, * ), TAU( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZHETD2 reduces a complex Hermitian matrix A to real symmetric
-*  tridiagonal form T by a unitary similarity transformation:
-*  Q' * A * Q = T.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          Hermitian matrix A is stored:
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  D       (output) DOUBLE PRECISION array, dimension (N)
-*          The diagonal elements of the tridiagonal matrix T:
-*          D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (N-1)
-*          The off-diagonal elements of the tridiagonal matrix T:
-*          E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*
-*  TAU     (output) COMPLEX*16 array, dimension (N-1)
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  Further Details
-*  ===============
-*
-*  If UPLO = 'U', the matrix Q is represented as a product of elementary
-*  reflectors
-*
-*     Q = H(n-1) . . . H(2) H(1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
-*  A(1:i-1,i+1), 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(n-1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+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':
-*
-*    (  d   e   v2  v3  v4 )              (  d                  )
-*    (      d   e   v3  v4 )              (  e   d              )
-*    (          d   e   v4 )              (  v1  e   d          )
-*    (              d   e  )              (  v1  v2  e   d      )
-*    (                  d  )              (  v1  v2  v3  e   d  )
-*
-*  where d and e denote diagonal and off-diagonal elements of T, and vi
-*  denotes an element of the vector defining H(i).
-*
-*  =====================================================================
-*
-*     .. 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 ..
-      LOGICAL            UPPER
-      INTEGER            I
-      COMPLEX*16         ALPHA, TAUI
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZAXPY, ZHEMV, ZHER2, ZLARFG
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      COMPLEX*16         ZDOTC
-      EXTERNAL           LSAME, ZDOTC
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, MAX, MIN
-*     ..
-*     .. 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( 'ZHETD2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-      IF( UPPER ) THEN
-*
-*        Reduce the upper triangle of A
-*
-         A( N, N ) = DBLE( A( N, N ) )
-         DO 10 I = N - 1, 1, -1
-*
-*           Generate elementary reflector H(i) = I - tau * v * v'
-*           to annihilate A(1:i-1,i+1)
-*
-            ALPHA = A( I, I+1 )
-            CALL ZLARFG( I, ALPHA, A( 1, I+1 ), 1, TAUI )
-            E( I ) = ALPHA
-*
-            IF( TAUI.NE.ZERO ) THEN
-*
-*              Apply H(i) from both sides to A(1:i,1:i)
-*
-               A( I, I+1 ) = ONE
-*
-*              Compute  x := tau * A * v  storing x in TAU(1:i)
-*
-               CALL ZHEMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO,
-     $                     TAU, 1 )
-*
-*              Compute  w := x - 1/2 * tau * (x'*v) * v
-*
-               ALPHA = -HALF*TAUI*ZDOTC( I, TAU, 1, A( 1, I+1 ), 1 )
-               CALL ZAXPY( I, ALPHA, A( 1, I+1 ), 1, TAU, 1 )
-*
-*              Apply the transformation as a rank-2 update:
-*                 A := A - v * w' - w * v'
-*
-               CALL ZHER2( UPLO, I, -ONE, A( 1, I+1 ), 1, TAU, 1, A,
-     $                     LDA )
-*
-            ELSE
-               A( I, I ) = DBLE( A( I, I ) )
-            END IF
-            A( I, I+1 ) = E( I )
-            D( I+1 ) = A( I+1, I+1 )
-            TAU( I ) = TAUI
-   10    CONTINUE
-         D( 1 ) = A( 1, 1 )
-      ELSE
-*
-*        Reduce the lower triangle of A
-*
-         A( 1, 1 ) = DBLE( A( 1, 1 ) )
-         DO 20 I = 1, N - 1
-*
-*           Generate elementary reflector H(i) = I - tau * v * v'
-*           to annihilate A(i+2:n,i)
-*
-            ALPHA = A( I+1, I )
-            CALL ZLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAUI )
-            E( I ) = ALPHA
-*
-            IF( TAUI.NE.ZERO ) THEN
-*
-*              Apply H(i) from both sides to A(i+1:n,i+1:n)
-*
-               A( I+1, I ) = ONE
-*
-*              Compute  x := tau * A * v  storing y in TAU(i:n-1)
-*
-               CALL ZHEMV( UPLO, N-I, TAUI, A( I+1, I+1 ), LDA,
-     $                     A( I+1, I ), 1, ZERO, TAU( I ), 1 )
-*
-*              Compute  w := x - 1/2 * tau * (x'*v) * v
-*
-               ALPHA = -HALF*TAUI*ZDOTC( N-I, TAU( I ), 1, A( I+1, I ),
-     $                 1 )
-               CALL ZAXPY( N-I, ALPHA, A( I+1, I ), 1, TAU( I ), 1 )
-*
-*              Apply the transformation as a rank-2 update:
-*                 A := A - v * w' - w * v'
-*
-               CALL ZHER2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1,
-     $                     A( I+1, I+1 ), LDA )
-*
-            ELSE
-               A( I+1, I+1 ) = DBLE( A( I+1, I+1 ) )
-            END IF
-            A( I+1, I ) = E( I )
-            D( I ) = A( I, I )
-            TAU( I ) = TAUI
-   20    CONTINUE
-         D( N ) = A( N, N )
-      END IF
-*
-      RETURN
-*
-*     End of ZHETD2
-*
-      END
diff --git a/src/lib/lapack/zhetrd.f b/src/lib/lapack/zhetrd.f
deleted file mode 100644
index fb0cd0b2..00000000
--- a/src/lib/lapack/zhetrd.f
+++ /dev/null
@@ -1,296 +0,0 @@
-      SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * )
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZHETRD reduces a complex Hermitian matrix A to real symmetric
-*  tridiagonal form T by a unitary similarity transformation:
-*  Q**H * A * Q = T.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  D       (output) DOUBLE PRECISION array, dimension (N)
-*          The diagonal elements of the tridiagonal matrix T:
-*          D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (N-1)
-*          The off-diagonal elements of the tridiagonal matrix T:
-*          E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
-*
-*  TAU     (output) COMPLEX*16 array, dimension (N-1)
-*          The scalar factors of the elementary reflectors (see Further
-*          Details).
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= 1.
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  If UPLO = 'U', the matrix Q is represented as a product of elementary
-*  reflectors
-*
-*     Q = H(n-1) . . . H(2) H(1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
-*  A(1:i-1,i+1), 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(n-1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+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':
-*
-*    (  d   e   v2  v3  v4 )              (  d                  )
-*    (      d   e   v3  v4 )              (  e   d              )
-*    (          d   e   v4 )              (  v1  e   d          )
-*    (              d   e  )              (  v1  v2  e   d      )
-*    (                  d  )              (  v1  v2  v3  e   d  )
-*
-*  where d and e denote diagonal and off-diagonal elements of T, and vi
-*  denotes an element of the vector defining H(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-      COMPLEX*16         CONE
-      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, UPPER
-      INTEGER            I, IINFO, IWS, J, KK, LDWORK, LWKOPT, NB,
-     $                   NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZHER2K, ZHETD2, ZLATRD
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. 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 = -9
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-*
-*        Determine the block size.
-*
-         NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
-         LWKOPT = N*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZHETRD', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NX = N
-      IWS = 1
-      IF( NB.GT.1 .AND. NB.LT.N ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code
-*        (last block is always handled by unblocked code).
-*
-         NX = MAX( NB, ILAENV( 3, 'ZHETRD', UPLO, N, -1, -1, -1 ) )
-         IF( NX.LT.N ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = N
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  determine the
-*              minimum value of NB, and reduce NB or force use of
-*              unblocked code by setting NX = N.
-*
-               NB = MAX( LWORK / LDWORK, 1 )
-               NBMIN = ILAENV( 2, 'ZHETRD', UPLO, N, -1, -1, -1 )
-               IF( NB.LT.NBMIN )
-     $            NX = N
-            END IF
-         ELSE
-            NX = N
-         END IF
-      ELSE
-         NB = 1
-      END IF
-*
-      IF( UPPER ) THEN
-*
-*        Reduce the upper triangle of A.
-*        Columns 1:kk are handled by the unblocked method.
-*
-         KK = N - ( ( N-NX+NB-1 ) / NB )*NB
-         DO 20 I = N - NB + 1, KK + 1, -NB
-*
-*           Reduce columns i:i+nb-1 to tridiagonal form and form the
-*           matrix W which is needed to update the unreduced part of
-*           the matrix
-*
-            CALL ZLATRD( UPLO, I+NB-1, NB, A, LDA, E, TAU, WORK,
-     $                   LDWORK )
-*
-*           Update the unreduced submatrix A(1:i-1,1:i-1), using an
-*           update of the form:  A := A - V*W' - W*V'
-*
-            CALL ZHER2K( UPLO, 'No transpose', I-1, NB, -CONE,
-     $                   A( 1, I ), LDA, WORK, LDWORK, ONE, A, LDA )
-*
-*           Copy superdiagonal elements back into A, and diagonal
-*           elements into D
-*
-            DO 10 J = I, I + NB - 1
-               A( J-1, J ) = E( J-1 )
-               D( J ) = A( J, J )
-   10       CONTINUE
-   20    CONTINUE
-*
-*        Use unblocked code to reduce the last or only block
-*
-         CALL ZHETD2( UPLO, KK, A, LDA, D, E, TAU, IINFO )
-      ELSE
-*
-*        Reduce the lower triangle of A
-*
-         DO 40 I = 1, N - NX, NB
-*
-*           Reduce columns i:i+nb-1 to tridiagonal form and form the
-*           matrix W which is needed to update the unreduced part of
-*           the matrix
-*
-            CALL ZLATRD( UPLO, N-I+1, NB, A( I, I ), LDA, E( I ),
-     $                   TAU( I ), WORK, LDWORK )
-*
-*           Update the unreduced submatrix A(i+nb:n,i+nb:n), using
-*           an update of the form:  A := A - V*W' - W*V'
-*
-            CALL ZHER2K( UPLO, 'No transpose', N-I-NB+1, NB, -CONE,
-     $                   A( I+NB, I ), LDA, WORK( NB+1 ), LDWORK, ONE,
-     $                   A( I+NB, I+NB ), LDA )
-*
-*           Copy subdiagonal elements back into A, and diagonal
-*           elements into D
-*
-            DO 30 J = I, I + NB - 1
-               A( J+1, J ) = E( J )
-               D( J ) = A( J, J )
-   30       CONTINUE
-   40    CONTINUE
-*
-*        Use unblocked code to reduce the last or only block
-*
-         CALL ZHETD2( UPLO, N-I+1, A( I, I ), LDA, D( I ), E( I ),
-     $                TAU( I ), IINFO )
-      END IF
-*
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of ZHETRD
-*
-      END
diff --git a/src/lib/lapack/zhgeqz.f b/src/lib/lapack/zhgeqz.f
deleted file mode 100644
index 6a9403bd..00000000
--- a/src/lib/lapack/zhgeqz.f
+++ /dev/null
@@ -1,759 +0,0 @@
-      SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
-     $                   ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK,
-     $                   RWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          COMPQ, COMPZ, JOB
-      INTEGER            IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         ALPHA( * ), BETA( * ), H( LDH, * ),
-     $                   Q( LDQ, * ), T( LDT, * ), WORK( * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZHGEQZ computes the eigenvalues of a complex matrix pair (H,T),
-*  where H is an upper Hessenberg matrix and T is upper triangular,
-*  using the single-shift QZ method.
-*  Matrix pairs of this type are produced by the reduction to
-*  generalized upper Hessenberg form of a complex matrix pair (A,B):
-*  
-*     A = Q1*H*Z1**H,  B = Q1*T*Z1**H,
-*  
-*  as computed by ZGGHRD.
-*  
-*  If JOB='S', then the Hessenberg-triangular pair (H,T) is
-*  also reduced to generalized Schur form,
-*  
-*     H = Q*S*Z**H,  T = Q*P*Z**H,
-*  
-*  where Q and Z are unitary matrices and S and P are upper triangular.
-*  
-*  Optionally, the unitary matrix Q from the generalized Schur
-*  factorization may be postmultiplied into an input matrix Q1, and the
-*  unitary matrix Z may be postmultiplied into an input matrix Z1.
-*  If Q1 and Z1 are the unitary matrices from ZGGHRD that reduced
-*  the matrix pair (A,B) to generalized Hessenberg form, then the output
-*  matrices Q1*Q and Z1*Z are the unitary factors from the generalized
-*  Schur factorization of (A,B):
-*  
-*     A = (Q1*Q)*S*(Z1*Z)**H,  B = (Q1*Q)*P*(Z1*Z)**H.
-*  
-*  To avoid overflow, eigenvalues of the matrix pair (H,T)
-*  (equivalently, of (A,B)) are computed as a pair of complex values
-*  (alpha,beta).  If beta is nonzero, lambda = alpha / beta is an
-*  eigenvalue of the generalized nonsymmetric eigenvalue problem (GNEP)
-*     A*x = lambda*B*x
-*  and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
-*  alternate form of the GNEP
-*     mu*A*y = B*y.
-*  The values of alpha and beta for the i-th eigenvalue can be read
-*  directly from the generalized Schur form:  alpha = S(i,i),
-*  beta = P(i,i).
-*
-*  Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
-*       Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
-*       pp. 241--256.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          = 'E': Compute eigenvalues only;
-*          = 'S': Computer eigenvalues and the Schur form.
-*
-*  COMPQ   (input) CHARACTER*1
-*          = 'N': Left Schur vectors (Q) are not computed;
-*          = 'I': Q is initialized to the unit matrix and the matrix Q
-*                 of left Schur vectors of (H,T) is returned;
-*          = 'V': Q must contain a unitary matrix Q1 on entry and
-*                 the product Q1*Q is returned.
-*
-*  COMPZ   (input) CHARACTER*1
-*          = 'N': Right Schur vectors (Z) are not computed;
-*          = 'I': Q is initialized to the unit matrix and the matrix Z
-*                 of right Schur vectors of (H,T) is returned;
-*          = 'V': Z must contain a unitary matrix Z1 on entry and
-*                 the product Z1*Z is returned.
-*
-*  N       (input) INTEGER
-*          The order of the matrices H, T, Q, and Z.  N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          ILO and IHI mark the rows and columns of H which are in
-*          Hessenberg form.  It is assumed that A is already upper
-*          triangular in rows and columns 1:ILO-1 and IHI+1:N.
-*          If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
-*
-*  H       (input/output) COMPLEX*16 array, dimension (LDH, N)
-*          On entry, the N-by-N upper Hessenberg matrix H.
-*          On exit, if JOB = 'S', H contains the upper triangular
-*          matrix S from the generalized Schur factorization.
-*          If JOB = 'E', the diagonal of H matches that of S, but
-*          the rest of H is unspecified.
-*
-*  LDH     (input) INTEGER
-*          The leading dimension of the array H.  LDH >= max( 1, N ).
-*
-*  T       (input/output) COMPLEX*16 array, dimension (LDT, N)
-*          On entry, the N-by-N upper triangular matrix T.
-*          On exit, if JOB = 'S', T contains the upper triangular
-*          matrix P from the generalized Schur factorization.
-*          If JOB = 'E', the diagonal of T matches that of P, but
-*          the rest of T is unspecified.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T.  LDT >= max( 1, N ).
-*
-*  ALPHA   (output) COMPLEX*16 array, dimension (N)
-*          The complex scalars alpha that define the eigenvalues of
-*          GNEP.  ALPHA(i) = S(i,i) in the generalized Schur
-*          factorization.
-*
-*  BETA    (output) COMPLEX*16 array, dimension (N)
-*          The real non-negative scalars beta that define the
-*          eigenvalues of GNEP.  BETA(i) = P(i,i) in the generalized
-*          Schur factorization.
-*
-*          Together, the quantities alpha = ALPHA(j) and beta = BETA(j)
-*          represent the j-th eigenvalue of the matrix pair (A,B), in
-*          one of the forms lambda = alpha/beta or mu = beta/alpha.
-*          Since either lambda or mu may overflow, they should not,
-*          in general, be computed.
-*
-*  Q       (input/output) COMPLEX*16 array, dimension (LDQ, N)
-*          On entry, if COMPZ = 'V', the unitary matrix Q1 used in the
-*          reduction of (A,B) to generalized Hessenberg form.
-*          On exit, if COMPZ = 'I', the unitary matrix of left Schur
-*          vectors of (H,T), and if COMPZ = 'V', the unitary matrix of
-*          left Schur vectors of (A,B).
-*          Not referenced if COMPZ = 'N'.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q.  LDQ >= 1.
-*          If COMPQ='V' or 'I', then LDQ >= N.
-*
-*  Z       (input/output) COMPLEX*16 array, dimension (LDZ, N)
-*          On entry, if COMPZ = 'V', the unitary matrix Z1 used in the
-*          reduction of (A,B) to generalized Hessenberg form.
-*          On exit, if COMPZ = 'I', the unitary matrix of right Schur
-*          vectors of (H,T), and if COMPZ = 'V', the unitary matrix of
-*          right Schur vectors of (A,B).
-*          Not referenced if COMPZ = 'N'.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z.  LDZ >= 1.
-*          If COMPZ='V' or 'I', then LDZ >= N.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,N).
-*
-*          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.
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*          = 1,...,N: the QZ iteration did not converge.  (H,T) is not
-*                     in Schur form, but ALPHA(i) and BETA(i),
-*                     i=INFO+1,...,N should be correct.
-*          = N+1,...,2*N: the shift calculation failed.  (H,T) is not
-*                     in Schur form, but ALPHA(i) and BETA(i),
-*                     i=INFO-N+1,...,N should be correct.
-*
-*  Further Details
-*  ===============
-*
-*  We assume that complex ABS works as long as its value is less than
-*  overflow.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         CZERO, CONE
-      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-      DOUBLE PRECISION   HALF
-      PARAMETER          ( HALF = 0.5D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            ILAZR2, ILAZRO, ILQ, ILSCHR, ILZ, LQUERY
-      INTEGER            ICOMPQ, ICOMPZ, IFIRST, IFRSTM, IITER, ILAST,
-     $                   ILASTM, IN, ISCHUR, ISTART, J, JC, JCH, JITER,
-     $                   JR, MAXIT
-      DOUBLE PRECISION   ABSB, ANORM, ASCALE, ATOL, BNORM, BSCALE, BTOL,
-     $                   C, SAFMIN, TEMP, TEMP2, TEMPR, ULP
-      COMPLEX*16         ABI22, AD11, AD12, AD21, AD22, CTEMP, CTEMP2,
-     $                   CTEMP3, ESHIFT, RTDISC, S, SHIFT, SIGNBC, T1,
-     $                   U12, X
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH, ZLANHS
-      EXTERNAL           LSAME, DLAMCH, ZLANHS
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARTG, ZLASET, ZROT, ZSCAL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN,
-     $                   SQRT
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   ABS1
-*     ..
-*     .. Statement Function definitions ..
-      ABS1( X ) = ABS( DBLE( X ) ) + ABS( DIMAG( X ) )
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode JOB, COMPQ, COMPZ
-*
-      IF( LSAME( JOB, 'E' ) ) THEN
-         ILSCHR = .FALSE.
-         ISCHUR = 1
-      ELSE IF( LSAME( JOB, 'S' ) ) THEN
-         ILSCHR = .TRUE.
-         ISCHUR = 2
-      ELSE
-         ISCHUR = 0
-      END IF
-*
-      IF( LSAME( COMPQ, 'N' ) ) THEN
-         ILQ = .FALSE.
-         ICOMPQ = 1
-      ELSE IF( LSAME( COMPQ, 'V' ) ) THEN
-         ILQ = .TRUE.
-         ICOMPQ = 2
-      ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
-         ILQ = .TRUE.
-         ICOMPQ = 3
-      ELSE
-         ICOMPQ = 0
-      END IF
-*
-      IF( LSAME( COMPZ, 'N' ) ) THEN
-         ILZ = .FALSE.
-         ICOMPZ = 1
-      ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
-         ILZ = .TRUE.
-         ICOMPZ = 2
-      ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
-         ILZ = .TRUE.
-         ICOMPZ = 3
-      ELSE
-         ICOMPZ = 0
-      END IF
-*
-*     Check Argument Values
-*
-      INFO = 0
-      WORK( 1 ) = MAX( 1, N )
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( ISCHUR.EQ.0 ) THEN
-         INFO = -1
-      ELSE IF( ICOMPQ.EQ.0 ) THEN
-         INFO = -2
-      ELSE IF( ICOMPZ.EQ.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( ILO.LT.1 ) THEN
-         INFO = -5
-      ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
-         INFO = -6
-      ELSE IF( LDH.LT.N ) THEN
-         INFO = -8
-      ELSE IF( LDT.LT.N ) THEN
-         INFO = -10
-      ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
-         INFO = -14
-      ELSE IF( LDZ.LT.1 .OR. ( ILZ .AND. LDZ.LT.N ) ) THEN
-         INFO = -16
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -18
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZHGEQZ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-*     WORK( 1 ) = CMPLX( 1 )
-      IF( N.LE.0 ) THEN
-         WORK( 1 ) = DCMPLX( 1 )
-         RETURN
-      END IF
-*
-*     Initialize Q and Z
-*
-      IF( ICOMPQ.EQ.3 )
-     $   CALL ZLASET( 'Full', N, N, CZERO, CONE, Q, LDQ )
-      IF( ICOMPZ.EQ.3 )
-     $   CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDZ )
-*
-*     Machine Constants
-*
-      IN = IHI + 1 - ILO
-      SAFMIN = DLAMCH( 'S' )
-      ULP = DLAMCH( 'E' )*DLAMCH( 'B' )
-      ANORM = ZLANHS( 'F', IN, H( ILO, ILO ), LDH, RWORK )
-      BNORM = ZLANHS( 'F', IN, T( ILO, ILO ), LDT, RWORK )
-      ATOL = MAX( SAFMIN, ULP*ANORM )
-      BTOL = MAX( SAFMIN, ULP*BNORM )
-      ASCALE = ONE / MAX( SAFMIN, ANORM )
-      BSCALE = ONE / MAX( SAFMIN, BNORM )
-*
-*
-*     Set Eigenvalues IHI+1:N
-*
-      DO 10 J = IHI + 1, N
-         ABSB = ABS( T( J, J ) )
-         IF( ABSB.GT.SAFMIN ) THEN
-            SIGNBC = DCONJG( T( J, J ) / ABSB )
-            T( J, J ) = ABSB
-            IF( ILSCHR ) THEN
-               CALL ZSCAL( J-1, SIGNBC, T( 1, J ), 1 )
-               CALL ZSCAL( J, SIGNBC, H( 1, J ), 1 )
-            ELSE
-               H( J, J ) = H( J, J )*SIGNBC
-            END IF
-            IF( ILZ )
-     $         CALL ZSCAL( N, SIGNBC, Z( 1, J ), 1 )
-         ELSE
-            T( J, J ) = CZERO
-         END IF
-         ALPHA( J ) = H( J, J )
-         BETA( J ) = T( J, J )
-   10 CONTINUE
-*
-*     If IHI < ILO, skip QZ steps
-*
-      IF( IHI.LT.ILO )
-     $   GO TO 190
-*
-*     MAIN QZ ITERATION LOOP
-*
-*     Initialize dynamic indices
-*
-*     Eigenvalues ILAST+1:N have been found.
-*        Column operations modify rows IFRSTM:whatever
-*        Row operations modify columns whatever:ILASTM
-*
-*     If only eigenvalues are being computed, then
-*        IFRSTM is the row of the last splitting row above row ILAST;
-*        this is always at least ILO.
-*     IITER counts iterations since the last eigenvalue was found,
-*        to tell when to use an extraordinary shift.
-*     MAXIT is the maximum number of QZ sweeps allowed.
-*
-      ILAST = IHI
-      IF( ILSCHR ) THEN
-         IFRSTM = 1
-         ILASTM = N
-      ELSE
-         IFRSTM = ILO
-         ILASTM = IHI
-      END IF
-      IITER = 0
-      ESHIFT = CZERO
-      MAXIT = 30*( IHI-ILO+1 )
-*
-      DO 170 JITER = 1, MAXIT
-*
-*        Check for too many iterations.
-*
-         IF( JITER.GT.MAXIT )
-     $      GO TO 180
-*
-*        Split the matrix if possible.
-*
-*        Two tests:
-*           1: H(j,j-1)=0  or  j=ILO
-*           2: T(j,j)=0
-*
-*        Special case: j=ILAST
-*
-         IF( ILAST.EQ.ILO ) THEN
-            GO TO 60
-         ELSE
-            IF( ABS1( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
-               H( ILAST, ILAST-1 ) = CZERO
-               GO TO 60
-            END IF
-         END IF
-*
-         IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
-            T( ILAST, ILAST ) = CZERO
-            GO TO 50
-         END IF
-*
-*        General case: j<ILAST
-*
-         DO 40 J = ILAST - 1, ILO, -1
-*
-*           Test 1: for H(j,j-1)=0 or j=ILO
-*
-            IF( J.EQ.ILO ) THEN
-               ILAZRO = .TRUE.
-            ELSE
-               IF( ABS1( H( J, J-1 ) ).LE.ATOL ) THEN
-                  H( J, J-1 ) = CZERO
-                  ILAZRO = .TRUE.
-               ELSE
-                  ILAZRO = .FALSE.
-               END IF
-            END IF
-*
-*           Test 2: for T(j,j)=0
-*
-            IF( ABS( T( J, J ) ).LT.BTOL ) THEN
-               T( J, J ) = CZERO
-*
-*              Test 1a: Check for 2 consecutive small subdiagonals in A
-*
-               ILAZR2 = .FALSE.
-               IF( .NOT.ILAZRO ) THEN
-                  IF( ABS1( H( J, J-1 ) )*( ASCALE*ABS1( H( J+1,
-     $                J ) ) ).LE.ABS1( H( J, J ) )*( ASCALE*ATOL ) )
-     $                ILAZR2 = .TRUE.
-               END IF
-*
-*              If both tests pass (1 & 2), i.e., the leading diagonal
-*              element of B in the block is zero, split a 1x1 block off
-*              at the top. (I.e., at the J-th row/column) The leading
-*              diagonal element of the remainder can also be zero, so
-*              this may have to be done repeatedly.
-*
-               IF( ILAZRO .OR. ILAZR2 ) THEN
-                  DO 20 JCH = J, ILAST - 1
-                     CTEMP = H( JCH, JCH )
-                     CALL ZLARTG( CTEMP, H( JCH+1, JCH ), C, S,
-     $                            H( JCH, JCH ) )
-                     H( JCH+1, JCH ) = CZERO
-                     CALL ZROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
-     $                          H( JCH+1, JCH+1 ), LDH, C, S )
-                     CALL ZROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
-     $                          T( JCH+1, JCH+1 ), LDT, C, S )
-                     IF( ILQ )
-     $                  CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
-     $                             C, DCONJG( S ) )
-                     IF( ILAZR2 )
-     $                  H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
-                     ILAZR2 = .FALSE.
-                     IF( ABS1( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
-                        IF( JCH+1.GE.ILAST ) THEN
-                           GO TO 60
-                        ELSE
-                           IFIRST = JCH + 1
-                           GO TO 70
-                        END IF
-                     END IF
-                     T( JCH+1, JCH+1 ) = CZERO
-   20             CONTINUE
-                  GO TO 50
-               ELSE
-*
-*                 Only test 2 passed -- chase the zero to T(ILAST,ILAST)
-*                 Then process as in the case T(ILAST,ILAST)=0
-*
-                  DO 30 JCH = J, ILAST - 1
-                     CTEMP = T( JCH, JCH+1 )
-                     CALL ZLARTG( CTEMP, T( JCH+1, JCH+1 ), C, S,
-     $                            T( JCH, JCH+1 ) )
-                     T( JCH+1, JCH+1 ) = CZERO
-                     IF( JCH.LT.ILASTM-1 )
-     $                  CALL ZROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
-     $                             T( JCH+1, JCH+2 ), LDT, C, S )
-                     CALL ZROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
-     $                          H( JCH+1, JCH-1 ), LDH, C, S )
-                     IF( ILQ )
-     $                  CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
-     $                             C, DCONJG( S ) )
-                     CTEMP = H( JCH+1, JCH )
-                     CALL ZLARTG( CTEMP, H( JCH+1, JCH-1 ), C, S,
-     $                            H( JCH+1, JCH ) )
-                     H( JCH+1, JCH-1 ) = CZERO
-                     CALL ZROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
-     $                          H( IFRSTM, JCH-1 ), 1, C, S )
-                     CALL ZROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
-     $                          T( IFRSTM, JCH-1 ), 1, C, S )
-                     IF( ILZ )
-     $                  CALL ZROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
-     $                             C, S )
-   30             CONTINUE
-                  GO TO 50
-               END IF
-            ELSE IF( ILAZRO ) THEN
-*
-*              Only test 1 passed -- work on J:ILAST
-*
-               IFIRST = J
-               GO TO 70
-            END IF
-*
-*           Neither test passed -- try next J
-*
-   40    CONTINUE
-*
-*        (Drop-through is "impossible")
-*
-         INFO = 2*N + 1
-         GO TO 210
-*
-*        T(ILAST,ILAST)=0 -- clear H(ILAST,ILAST-1) to split off a
-*        1x1 block.
-*
-   50    CONTINUE
-         CTEMP = H( ILAST, ILAST )
-         CALL ZLARTG( CTEMP, H( ILAST, ILAST-1 ), C, S,
-     $                H( ILAST, ILAST ) )
-         H( ILAST, ILAST-1 ) = CZERO
-         CALL ZROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
-     $              H( IFRSTM, ILAST-1 ), 1, C, S )
-         CALL ZROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
-     $              T( IFRSTM, ILAST-1 ), 1, C, S )
-         IF( ILZ )
-     $      CALL ZROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
-*
-*        H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA
-*
-   60    CONTINUE
-         ABSB = ABS( T( ILAST, ILAST ) )
-         IF( ABSB.GT.SAFMIN ) THEN
-            SIGNBC = DCONJG( T( ILAST, ILAST ) / ABSB )
-            T( ILAST, ILAST ) = ABSB
-            IF( ILSCHR ) THEN
-               CALL ZSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ), 1 )
-               CALL ZSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM, ILAST ),
-     $                     1 )
-            ELSE
-               H( ILAST, ILAST ) = H( ILAST, ILAST )*SIGNBC
-            END IF
-            IF( ILZ )
-     $         CALL ZSCAL( N, SIGNBC, Z( 1, ILAST ), 1 )
-         ELSE
-            T( ILAST, ILAST ) = CZERO
-         END IF
-         ALPHA( ILAST ) = H( ILAST, ILAST )
-         BETA( ILAST ) = T( ILAST, ILAST )
-*
-*        Go to next block -- exit if finished.
-*
-         ILAST = ILAST - 1
-         IF( ILAST.LT.ILO )
-     $      GO TO 190
-*
-*        Reset counters
-*
-         IITER = 0
-         ESHIFT = CZERO
-         IF( .NOT.ILSCHR ) THEN
-            ILASTM = ILAST
-            IF( IFRSTM.GT.ILAST )
-     $         IFRSTM = ILO
-         END IF
-         GO TO 160
-*
-*        QZ step
-*
-*        This iteration only involves rows/columns IFIRST:ILAST.  We
-*        assume IFIRST < ILAST, and that the diagonal of B is non-zero.
-*
-   70    CONTINUE
-         IITER = IITER + 1
-         IF( .NOT.ILSCHR ) THEN
-            IFRSTM = IFIRST
-         END IF
-*
-*        Compute the Shift.
-*
-*        At this point, IFIRST < ILAST, and the diagonal elements of
-*        T(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
-*        magnitude)
-*
-         IF( ( IITER / 10 )*10.NE.IITER ) THEN
-*
-*           The Wilkinson shift (AEP p.512), i.e., the eigenvalue of
-*           the bottom-right 2x2 block of A inv(B) which is nearest to
-*           the bottom-right element.
-*
-*           We factor B as U*D, where U has unit diagonals, and
-*           compute (A*inv(D))*inv(U).
-*
-            U12 = ( BSCALE*T( ILAST-1, ILAST ) ) /
-     $            ( BSCALE*T( ILAST, ILAST ) )
-            AD11 = ( ASCALE*H( ILAST-1, ILAST-1 ) ) /
-     $             ( BSCALE*T( ILAST-1, ILAST-1 ) )
-            AD21 = ( ASCALE*H( ILAST, ILAST-1 ) ) /
-     $             ( BSCALE*T( ILAST-1, ILAST-1 ) )
-            AD12 = ( ASCALE*H( ILAST-1, ILAST ) ) /
-     $             ( BSCALE*T( ILAST, ILAST ) )
-            AD22 = ( ASCALE*H( ILAST, ILAST ) ) /
-     $             ( BSCALE*T( ILAST, ILAST ) )
-            ABI22 = AD22 - U12*AD21
-*
-            T1 = HALF*( AD11+ABI22 )
-            RTDISC = SQRT( T1**2+AD12*AD21-AD11*AD22 )
-            TEMP = DBLE( T1-ABI22 )*DBLE( RTDISC ) +
-     $             DIMAG( T1-ABI22 )*DIMAG( RTDISC )
-            IF( TEMP.LE.ZERO ) THEN
-               SHIFT = T1 + RTDISC
-            ELSE
-               SHIFT = T1 - RTDISC
-            END IF
-         ELSE
-*
-*           Exceptional shift.  Chosen for no particularly good reason.
-*
-            ESHIFT = ESHIFT + DCONJG( ( ASCALE*H( ILAST-1, ILAST ) ) /
-     $               ( BSCALE*T( ILAST-1, ILAST-1 ) ) )
-            SHIFT = ESHIFT
-         END IF
-*
-*        Now check for two consecutive small subdiagonals.
-*
-         DO 80 J = ILAST - 1, IFIRST + 1, -1
-            ISTART = J
-            CTEMP = ASCALE*H( J, J ) - SHIFT*( BSCALE*T( J, J ) )
-            TEMP = ABS1( CTEMP )
-            TEMP2 = ASCALE*ABS1( H( J+1, J ) )
-            TEMPR = MAX( TEMP, TEMP2 )
-            IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
-               TEMP = TEMP / TEMPR
-               TEMP2 = TEMP2 / TEMPR
-            END IF
-            IF( ABS1( H( J, J-1 ) )*TEMP2.LE.TEMP*ATOL )
-     $         GO TO 90
-   80    CONTINUE
-*
-         ISTART = IFIRST
-         CTEMP = ASCALE*H( IFIRST, IFIRST ) -
-     $           SHIFT*( BSCALE*T( IFIRST, IFIRST ) )
-   90    CONTINUE
-*
-*        Do an implicit-shift QZ sweep.
-*
-*        Initial Q
-*
-         CTEMP2 = ASCALE*H( ISTART+1, ISTART )
-         CALL ZLARTG( CTEMP, CTEMP2, C, S, CTEMP3 )
-*
-*        Sweep
-*
-         DO 150 J = ISTART, ILAST - 1
-            IF( J.GT.ISTART ) THEN
-               CTEMP = H( J, J-1 )
-               CALL ZLARTG( CTEMP, H( J+1, J-1 ), C, S, H( J, J-1 ) )
-               H( J+1, J-1 ) = CZERO
-            END IF
-*
-            DO 100 JC = J, ILASTM
-               CTEMP = C*H( J, JC ) + S*H( J+1, JC )
-               H( J+1, JC ) = -DCONJG( S )*H( J, JC ) + C*H( J+1, JC )
-               H( J, JC ) = CTEMP
-               CTEMP2 = C*T( J, JC ) + S*T( J+1, JC )
-               T( J+1, JC ) = -DCONJG( S )*T( J, JC ) + C*T( J+1, JC )
-               T( J, JC ) = CTEMP2
-  100       CONTINUE
-            IF( ILQ ) THEN
-               DO 110 JR = 1, N
-                  CTEMP = C*Q( JR, J ) + DCONJG( S )*Q( JR, J+1 )
-                  Q( JR, J+1 ) = -S*Q( JR, J ) + C*Q( JR, J+1 )
-                  Q( JR, J ) = CTEMP
-  110          CONTINUE
-            END IF
-*
-            CTEMP = T( J+1, J+1 )
-            CALL ZLARTG( CTEMP, T( J+1, J ), C, S, T( J+1, J+1 ) )
-            T( J+1, J ) = CZERO
-*
-            DO 120 JR = IFRSTM, MIN( J+2, ILAST )
-               CTEMP = C*H( JR, J+1 ) + S*H( JR, J )
-               H( JR, J ) = -DCONJG( S )*H( JR, J+1 ) + C*H( JR, J )
-               H( JR, J+1 ) = CTEMP
-  120       CONTINUE
-            DO 130 JR = IFRSTM, J
-               CTEMP = C*T( JR, J+1 ) + S*T( JR, J )
-               T( JR, J ) = -DCONJG( S )*T( JR, J+1 ) + C*T( JR, J )
-               T( JR, J+1 ) = CTEMP
-  130       CONTINUE
-            IF( ILZ ) THEN
-               DO 140 JR = 1, N
-                  CTEMP = C*Z( JR, J+1 ) + S*Z( JR, J )
-                  Z( JR, J ) = -DCONJG( S )*Z( JR, J+1 ) + C*Z( JR, J )
-                  Z( JR, J+1 ) = CTEMP
-  140          CONTINUE
-            END IF
-  150    CONTINUE
-*
-  160    CONTINUE
-*
-  170 CONTINUE
-*
-*     Drop-through = non-convergence
-*
-  180 CONTINUE
-      INFO = ILAST
-      GO TO 210
-*
-*     Successful completion of all QZ steps
-*
-  190 CONTINUE
-*
-*     Set Eigenvalues 1:ILO-1
-*
-      DO 200 J = 1, ILO - 1
-         ABSB = ABS( T( J, J ) )
-         IF( ABSB.GT.SAFMIN ) THEN
-            SIGNBC = DCONJG( T( J, J ) / ABSB )
-            T( J, J ) = ABSB
-            IF( ILSCHR ) THEN
-               CALL ZSCAL( J-1, SIGNBC, T( 1, J ), 1 )
-               CALL ZSCAL( J, SIGNBC, H( 1, J ), 1 )
-            ELSE
-               H( J, J ) = H( J, J )*SIGNBC
-            END IF
-            IF( ILZ )
-     $         CALL ZSCAL( N, SIGNBC, Z( 1, J ), 1 )
-         ELSE
-            T( J, J ) = CZERO
-         END IF
-         ALPHA( J ) = H( J, J )
-         BETA( J ) = T( J, J )
-  200 CONTINUE
-*
-*     Normal Termination
-*
-      INFO = 0
-*
-*     Exit (other than argument error) -- return optimal workspace size
-*
-  210 CONTINUE
-      WORK( 1 ) = DCMPLX( N )
-      RETURN
-*
-*     End of ZHGEQZ
-*
-      END
diff --git a/src/lib/lapack/zhseqr.f b/src/lib/lapack/zhseqr.f
deleted file mode 100644
index fb721dad..00000000
--- a/src/lib/lapack/zhseqr.f
+++ /dev/null
@@ -1,395 +0,0 @@
-      SUBROUTINE ZHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK driver routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, ILO, INFO, LDH, LDZ, LWORK, N
-      CHARACTER          COMPZ, JOB
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
-*     ..
-*     Purpose
-*     =======
-*
-*     ZHSEQR computes the eigenvalues of a Hessenberg matrix H
-*     and, optionally, the matrices T and Z from the Schur decomposition
-*     H = Z T Z**H, where T is an upper triangular matrix (the
-*     Schur form), and Z is the unitary matrix of Schur vectors.
-*
-*     Optionally Z may be postmultiplied into an input unitary
-*     matrix Q so that this routine can give the Schur factorization
-*     of a matrix A which has been reduced to the Hessenberg form H
-*     by the unitary matrix Q:  A = Q*H*Q**H = (QZ)*H*(QZ)**H.
-*
-*     Arguments
-*     =========
-*
-*     JOB   (input) CHARACTER*1
-*           = 'E':  compute eigenvalues only;
-*           = 'S':  compute eigenvalues and the Schur form T.
-*
-*     COMPZ (input) CHARACTER*1
-*           = 'N':  no Schur vectors are computed;
-*           = 'I':  Z is initialized to the unit matrix and the matrix Z
-*                   of Schur vectors of H is returned;
-*           = 'V':  Z must contain an unitary matrix Q on entry, and
-*                   the product Q*Z is returned.
-*
-*     N     (input) INTEGER
-*           The order of the matrix H.  N .GE. 0.
-*
-*     ILO   (input) INTEGER
-*     IHI   (input) INTEGER
-*           It is assumed that H is already upper triangular in rows
-*           and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
-*           set by a previous call to ZGEBAL, and then passed to ZGEHRD
-*           when the matrix output by ZGEBAL is reduced to Hessenberg
-*           form. Otherwise ILO and IHI should be set to 1 and N
-*           respectively.  If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*           If N = 0, then ILO = 1 and IHI = 0.
-*
-*     H     (input/output) COMPLEX*16 array, dimension (LDH,N)
-*           On entry, the upper Hessenberg matrix H.
-*           On exit, if INFO = 0 and JOB = 'S', H contains the upper
-*           triangular matrix T from the Schur decomposition (the
-*           Schur form). If INFO = 0 and JOB = 'E', the contents of
-*           H are unspecified on exit.  (The output value of H when
-*           INFO.GT.0 is given under the description of INFO below.)
-*
-*           Unlike earlier versions of ZHSEQR, this subroutine may
-*           explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
-*           or j = IHI+1, IHI+2, ... N.
-*
-*     LDH   (input) INTEGER
-*           The leading dimension of the array H. LDH .GE. max(1,N).
-*
-*     W        (output) COMPLEX*16 array, dimension (N)
-*           The computed eigenvalues. If JOB = 'S', the eigenvalues are
-*           stored in the same order as on the diagonal of the Schur
-*           form returned in H, with W(i) = H(i,i).
-*
-*     Z     (input/output) COMPLEX*16 array, dimension (LDZ,N)
-*           If COMPZ = 'N', Z is not referenced.
-*           If COMPZ = 'I', on entry Z need not be set and on exit,
-*           if INFO = 0, Z contains the unitary matrix Z of the Schur
-*           vectors of H.  If COMPZ = 'V', on entry Z must contain an
-*           N-by-N matrix Q, which is assumed to be equal to the unit
-*           matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
-*           if INFO = 0, Z contains Q*Z.
-*           Normally Q is the unitary matrix generated by ZUNGHR
-*           after the call to ZGEHRD which formed the Hessenberg matrix
-*           H. (The output value of Z when INFO.GT.0 is given under
-*           the description of INFO below.)
-*
-*     LDZ   (input) INTEGER
-*           The leading dimension of the array Z.  if COMPZ = 'I' or
-*           COMPZ = 'V', then LDZ.GE.MAX(1,N).  Otherwize, LDZ.GE.1.
-*
-*     WORK  (workspace/output) COMPLEX*16 array, dimension (LWORK)
-*           On exit, if INFO = 0, WORK(1) returns an estimate of
-*           the optimal value for LWORK.
-*
-*     LWORK (input) INTEGER
-*           The dimension of the array WORK.  LWORK .GE. max(1,N)
-*           is sufficient, but LWORK typically as large as 6*N may
-*           be required for optimal performance.  A workspace query
-*           to determine the optimal workspace size is recommended.
-*
-*           If LWORK = -1, then ZHSEQR does a workspace query.
-*           In this case, ZHSEQR checks the input parameters and
-*           estimates the optimal workspace size for the given
-*           values of N, ILO and IHI.  The estimate is returned
-*           in WORK(1).  No error message related to LWORK is
-*           issued by XERBLA.  Neither H nor Z are accessed.
-*
-*
-*     INFO  (output) INTEGER
-*             =  0:  successful exit
-*           .LT. 0:  if INFO = -i, the i-th argument had an illegal
-*                    value
-*           .GT. 0:  if INFO = i, ZHSEQR failed to compute all of
-*                the eigenvalues.  Elements 1:ilo-1 and i+1:n of WR
-*                and WI contain those eigenvalues which have been
-*                successfully computed.  (Failures are rare.)
-*
-*                If INFO .GT. 0 and JOB = 'E', then on exit, the
-*                remaining unconverged eigenvalues are the eigen-
-*                values of the upper Hessenberg matrix rows and
-*                columns ILO through INFO of the final, output
-*                value of H.
-*
-*                If INFO .GT. 0 and JOB   = 'S', then on exit
-*
-*           (*)  (initial value of H)*U  = U*(final value of H)
-*
-*                where U is a unitary matrix.  The final
-*                value of  H is upper Hessenberg and triangular in
-*                rows and columns INFO+1 through IHI.
-*
-*                If INFO .GT. 0 and COMPZ = 'V', then on exit
-*
-*                  (final value of Z)  =  (initial value of Z)*U
-*
-*                where U is the unitary matrix in (*) (regard-
-*                less of the value of JOB.)
-*
-*                If INFO .GT. 0 and COMPZ = 'I', then on exit
-*                      (final value of Z)  = U
-*                where U is the unitary matrix in (*) (regard-
-*                less of the value of JOB.)
-*
-*                If INFO .GT. 0 and COMPZ = 'N', then Z is not
-*                accessed.
-*
-*     ================================================================
-*             Default values supplied by
-*             ILAENV(ISPEC,'ZHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
-*             It is suggested that these defaults be adjusted in order
-*             to attain best performance in each particular
-*             computational environment.
-*
-*            ISPEC=1:  The ZLAHQR vs ZLAQR0 crossover point.
-*                      Default: 75. (Must be at least 11.)
-*
-*            ISPEC=2:  Recommended deflation window size.
-*                      This depends on ILO, IHI and NS.  NS is the
-*                      number of simultaneous shifts returned
-*                      by ILAENV(ISPEC=4).  (See ISPEC=4 below.)
-*                      The default for (IHI-ILO+1).LE.500 is NS.
-*                      The default for (IHI-ILO+1).GT.500 is 3*NS/2.
-*
-*            ISPEC=3:  Nibble crossover point. (See ILAENV for
-*                      details.)  Default: 14% of deflation window
-*                      size.
-*
-*            ISPEC=4:  Number of simultaneous shifts, NS, in
-*                      a multi-shift QR iteration.
-*
-*                      If IHI-ILO+1 is ...
-*
-*                      greater than      ...but less    ... the
-*                      or equal to ...      than        default is
-*
-*                           1               30          NS -   2(+)
-*                          30               60          NS -   4(+)
-*                          60              150          NS =  10(+)
-*                         150              590          NS =  **
-*                         590             3000          NS =  64
-*                        3000             6000          NS = 128
-*                        6000             infinity      NS = 256
-*
-*                  (+)  By default some or all matrices of this order 
-*                       are passed to the implicit double shift routine
-*                       ZLAHQR and NS is ignored.  See ISPEC=1 above 
-*                       and comments in IPARM for details.
-*
-*                       The asterisks (**) indicate an ad-hoc
-*                       function of N increasing from 10 to 64.
-*
-*            ISPEC=5:  Select structured matrix multiply.
-*                      (See ILAENV for details.) Default: 3.
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ================================================================
-*     References:
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*       Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*       929--947, 2002.
-*
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*       of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-*     ================================================================
-*     .. Parameters ..
-*
-*     ==== Matrices of order NTINY or smaller must be processed by
-*     .    ZLAHQR because of insufficient subdiagonal scratch space.
-*     .    (This is a hard limit.) ====
-*
-*     ==== NL allocates some local workspace to help small matrices
-*     .    through a rare ZLAHQR failure.  NL .GT. NTINY = 11 is
-*     .    required and NL .LE. NMIN = ILAENV(ISPEC=1,...) is recom-
-*     .    mended.  (The default value of NMIN is 75.)  Using NL = 49
-*     .    allows up to six simultaneous shifts and a 16-by-16
-*     .    deflation window.  ====
-*
-      INTEGER            NTINY
-      PARAMETER          ( NTINY = 11 )
-      INTEGER            NL
-      PARAMETER          ( NL = 49 )
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ),
-     $                   ONE = ( 1.0d0, 0.0d0 ) )
-      DOUBLE PRECISION   RZERO
-      PARAMETER          ( RZERO = 0.0d0 )
-*     ..
-*     .. Local Arrays ..
-      COMPLEX*16         HL( NL, NL ), WORKL( NL )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            KBOT, NMIN
-      LOGICAL            INITZ, LQUERY, WANTT, WANTZ
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      LOGICAL            LSAME
-      EXTERNAL           ILAENV, LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZCOPY, ZLACPY, ZLAHQR, ZLAQR0, ZLASET
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, DCMPLX, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     ==== Decode and check the input parameters. ====
-*
-      WANTT = LSAME( JOB, 'S' )
-      INITZ = LSAME( COMPZ, 'I' )
-      WANTZ = INITZ .OR. LSAME( COMPZ, 'V' )
-      WORK( 1 ) = DCMPLX( DBLE( MAX( 1, N ) ), RZERO )
-      LQUERY = LWORK.EQ.-1
-*
-      INFO = 0
-      IF( .NOT.LSAME( JOB, 'E' ) .AND. .NOT.WANTT ) THEN
-         INFO = -1
-      ELSE IF( .NOT.LSAME( COMPZ, 'N' ) .AND. .NOT.WANTZ ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
-         INFO = -4
-      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
-         INFO = -5
-      ELSE IF( LDH.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.MAX( 1, N ) ) ) THEN
-         INFO = -10
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -12
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-*
-*        ==== Quick return in case of invalid argument. ====
-*
-         CALL XERBLA( 'ZHSEQR', -INFO )
-         RETURN
-*
-      ELSE IF( N.EQ.0 ) THEN
-*
-*        ==== Quick return in case N = 0; nothing to do. ====
-*
-         RETURN
-*
-      ELSE IF( LQUERY ) THEN
-*
-*        ==== Quick return in case of a workspace query ====
-*
-         CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, Z,
-     $                LDZ, WORK, LWORK, INFO )
-*        ==== Ensure reported workspace size is backward-compatible with
-*        .    previous LAPACK versions. ====
-         WORK( 1 ) = DCMPLX( MAX( DBLE( WORK( 1 ) ), DBLE( MAX( 1,
-     $               N ) ) ), RZERO )
-         RETURN
-*
-      ELSE
-*
-*        ==== copy eigenvalues isolated by ZGEBAL ====
-*
-         IF( ILO.GT.1 )
-     $      CALL ZCOPY( ILO-1, H, LDH+1, W, 1 )
-         IF( IHI.LT.N )
-     $      CALL ZCOPY( N-IHI, H( IHI+1, IHI+1 ), LDH+1, W( IHI+1 ), 1 )
-*
-*        ==== Initialize Z, if requested ====
-*
-         IF( INITZ )
-     $      CALL ZLASET( 'A', N, N, ZERO, ONE, Z, LDZ )
-*
-*        ==== Quick return if possible ====
-*
-         IF( ILO.EQ.IHI ) THEN
-            W( ILO ) = H( ILO, ILO )
-            RETURN
-         END IF
-*
-*        ==== ZLAHQR/ZLAQR0 crossover point ====
-*
-         NMIN = ILAENV( 1, 'ZHSEQR', JOB( : 1 ) // COMPZ( : 1 ), N, ILO,
-     $          IHI, LWORK )
-         NMIN = MAX( NTINY, NMIN )
-*
-*        ==== ZLAQR0 for big matrices; ZLAHQR for small ones ====
-*
-         IF( N.GT.NMIN ) THEN
-            CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI,
-     $                   Z, LDZ, WORK, LWORK, INFO )
-         ELSE
-*
-*           ==== Small matrix ====
-*
-            CALL ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI,
-     $                   Z, LDZ, INFO )
-*
-            IF( INFO.GT.0 ) THEN
-*
-*              ==== A rare ZLAHQR failure!  ZLAQR0 sometimes succeeds
-*              .    when ZLAHQR fails. ====
-*
-               KBOT = INFO
-*
-               IF( N.GE.NL ) THEN
-*
-*                 ==== Larger matrices have enough subdiagonal scratch
-*                 .    space to call ZLAQR0 directly. ====
-*
-                  CALL ZLAQR0( WANTT, WANTZ, N, ILO, KBOT, H, LDH, W,
-     $                         ILO, IHI, Z, LDZ, WORK, LWORK, INFO )
-*
-               ELSE
-*
-*                 ==== Tiny matrices don't have enough subdiagonal
-*                 .    scratch space to benefit from ZLAQR0.  Hence,
-*                 .    tiny matrices must be copied into a larger
-*                 .    array before calling ZLAQR0. ====
-*
-                  CALL ZLACPY( 'A', N, N, H, LDH, HL, NL )
-                  HL( N+1, N ) = ZERO
-                  CALL ZLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ),
-     $                         NL )
-                  CALL ZLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, W,
-     $                         ILO, IHI, Z, LDZ, WORKL, NL, INFO )
-                  IF( WANTT .OR. INFO.NE.0 )
-     $               CALL ZLACPY( 'A', N, N, HL, NL, H, LDH )
-               END IF
-            END IF
-         END IF
-*
-*        ==== Clear out the trash, if necessary. ====
-*
-         IF( ( WANTT .OR. INFO.NE.0 ) .AND. N.GT.2 )
-     $      CALL ZLASET( 'L', N-2, N-2, ZERO, ZERO, H( 3, 1 ), LDH )
-*
-*        ==== Ensure reported workspace size is backward-compatible with
-*        .    previous LAPACK versions. ====
-*
-         WORK( 1 ) = DCMPLX( MAX( DBLE( MAX( 1, N ) ),
-     $               DBLE( WORK( 1 ) ) ), RZERO )
-      END IF
-*
-*     ==== End of ZHSEQR ====
-*
-      END
diff --git a/src/lib/lapack/zlabrd.f b/src/lib/lapack/zlabrd.f
deleted file mode 100644
index fb482c84..00000000
--- a/src/lib/lapack/zlabrd.f
+++ /dev/null
@@ -1,328 +0,0 @@
-      SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
-     $                   LDY )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            LDA, LDX, LDY, M, N, NB
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * )
-      COMPLEX*16         A( LDA, * ), TAUP( * ), TAUQ( * ), X( LDX, * ),
-     $                   Y( LDY, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLABRD reduces the first NB rows and columns of a complex general
-*  m by n matrix A to upper or lower real bidiagonal form by a unitary
-*  transformation Q' * A * P, and returns the matrices X and Y which
-*  are needed to apply the transformation to the unreduced part of A.
-*
-*  If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
-*  bidiagonal form.
-*
-*  This is an auxiliary routine called by ZGEBRD
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows in the matrix A.
-*
-*  N       (input) INTEGER
-*          The number of columns in the matrix A.
-*
-*  NB      (input) INTEGER
-*          The number of leading rows and columns of A to be reduced.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the m by n general matrix to be reduced.
-*          On exit, the first NB rows and columns of the matrix are
-*          overwritten; the rest of the array is unchanged.
-*          If m >= n, elements on and below the diagonal in the first NB
-*            columns, with the array TAUQ, represent the unitary
-*            matrix Q as a product of elementary reflectors; and
-*            elements above the diagonal in the first NB rows, with the
-*            array TAUP, represent the unitary matrix P as a product
-*            of elementary reflectors.
-*          If m < n, elements below the diagonal in the first NB
-*            columns, with the array TAUQ, represent the unitary
-*            matrix Q as a product of elementary reflectors, and
-*            elements on and above the diagonal in the first NB rows,
-*            with the array TAUP, represent the unitary matrix P as
-*            a product of elementary reflectors.
-*          See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  D       (output) DOUBLE PRECISION array, dimension (NB)
-*          The diagonal elements of the first NB rows and columns of
-*          the reduced matrix.  D(i) = A(i,i).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (NB)
-*          The off-diagonal elements of the first NB rows and columns of
-*          the reduced matrix.
-*
-*  TAUQ    (output) COMPLEX*16 array dimension (NB)
-*          The scalar factors of the elementary reflectors which
-*          represent the unitary matrix Q. See Further Details.
-*
-*  TAUP    (output) COMPLEX*16 array, dimension (NB)
-*          The scalar factors of the elementary reflectors which
-*          represent the unitary matrix P. See Further Details.
-*
-*  X       (output) COMPLEX*16 array, dimension (LDX,NB)
-*          The m-by-nb matrix X required to update the unreduced part
-*          of A.
-*
-*  LDX     (input) INTEGER
-*          The leading dimension of the array X. LDX >= max(1,M).
-*
-*  Y       (output) COMPLEX*16 array, dimension (LDY,NB)
-*          The n-by-nb matrix Y required to update the unreduced part
-*          of A.
-*
-*  LDY     (input) INTEGER
-*          The leading dimension of the array Y. LDY >= max(1,N).
-*
-*  Further Details
-*  ===============
-*
-*  The matrices Q and P are represented as products of elementary
-*  reflectors:
-*
-*     Q = H(1) H(2) . . . H(nb)  and  P = G(1) G(2) . . . G(nb)
-*
-*  Each H(i) and G(i) has the form:
-*
-*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'
-*
-*  where tauq and taup are complex scalars, and v and u are complex
-*  vectors.
-*
-*  If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
-*  A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
-*  A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
-*  A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
-*  A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
-*
-*  The elements of the vectors v and u together form the m-by-nb matrix
-*  V and the nb-by-n matrix U' which are needed, with X and Y, to apply
-*  the transformation to the unreduced part of the matrix, using a block
-*  update of the form:  A := A - V*Y' - X*U'.
-*
-*  The contents of A on exit are illustrated by the following examples
-*  with nb = 2:
-*
-*  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):
-*
-*    (  1   1   u1  u1  u1 )           (  1   u1  u1  u1  u1  u1 )
-*    (  v1  1   1   u2  u2 )           (  1   1   u2  u2  u2  u2 )
-*    (  v1  v2  a   a   a  )           (  v1  1   a   a   a   a  )
-*    (  v1  v2  a   a   a  )           (  v1  v2  a   a   a   a  )
-*    (  v1  v2  a   a   a  )           (  v1  v2  a   a   a   a  )
-*    (  v1  v2  a   a   a  )
-*
-*  where a denotes an element of the original matrix which is unchanged,
-*  vi denotes an element of the vector defining H(i), and ui an element
-*  of the vector defining G(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-      COMPLEX*16         ALPHA
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZGEMV, ZLACGV, ZLARFG, ZSCAL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 .OR. N.LE.0 )
-     $   RETURN
-*
-      IF( M.GE.N ) THEN
-*
-*        Reduce to upper bidiagonal form
-*
-         DO 10 I = 1, NB
-*
-*           Update A(i:m,i)
-*
-            CALL ZLACGV( I-1, Y( I, 1 ), LDY )
-            CALL ZGEMV( 'No transpose', M-I+1, I-1, -ONE, A( I, 1 ),
-     $                  LDA, Y( I, 1 ), LDY, ONE, A( I, I ), 1 )
-            CALL ZLACGV( I-1, Y( I, 1 ), LDY )
-            CALL ZGEMV( 'No transpose', M-I+1, I-1, -ONE, X( I, 1 ),
-     $                  LDX, A( 1, I ), 1, ONE, A( I, I ), 1 )
-*
-*           Generate reflection Q(i) to annihilate A(i+1:m,i)
-*
-            ALPHA = A( I, I )
-            CALL ZLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
-     $                   TAUQ( I ) )
-            D( I ) = ALPHA
-            IF( I.LT.N ) THEN
-               A( I, I ) = ONE
-*
-*              Compute Y(i+1:n,i)
-*
-               CALL ZGEMV( 'Conjugate transpose', M-I+1, N-I, ONE,
-     $                     A( I, I+1 ), LDA, A( I, I ), 1, ZERO,
-     $                     Y( I+1, I ), 1 )
-               CALL ZGEMV( 'Conjugate transpose', M-I+1, I-1, ONE,
-     $                     A( I, 1 ), LDA, A( I, I ), 1, ZERO,
-     $                     Y( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
-     $                     LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
-               CALL ZGEMV( 'Conjugate transpose', M-I+1, I-1, ONE,
-     $                     X( I, 1 ), LDX, A( I, I ), 1, ZERO,
-     $                     Y( 1, I ), 1 )
-               CALL ZGEMV( 'Conjugate transpose', I-1, N-I, -ONE,
-     $                     A( 1, I+1 ), LDA, Y( 1, I ), 1, ONE,
-     $                     Y( I+1, I ), 1 )
-               CALL ZSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
-*
-*              Update A(i,i+1:n)
-*
-               CALL ZLACGV( N-I, A( I, I+1 ), LDA )
-               CALL ZLACGV( I, A( I, 1 ), LDA )
-               CALL ZGEMV( 'No transpose', N-I, I, -ONE, Y( I+1, 1 ),
-     $                     LDY, A( I, 1 ), LDA, ONE, A( I, I+1 ), LDA )
-               CALL ZLACGV( I, A( I, 1 ), LDA )
-               CALL ZLACGV( I-1, X( I, 1 ), LDX )
-               CALL ZGEMV( 'Conjugate transpose', I-1, N-I, -ONE,
-     $                     A( 1, I+1 ), LDA, X( I, 1 ), LDX, ONE,
-     $                     A( I, I+1 ), LDA )
-               CALL ZLACGV( I-1, X( I, 1 ), LDX )
-*
-*              Generate reflection P(i) to annihilate A(i,i+2:n)
-*
-               ALPHA = A( I, I+1 )
-               CALL ZLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ), LDA,
-     $                      TAUP( I ) )
-               E( I ) = ALPHA
-               A( I, I+1 ) = ONE
-*
-*              Compute X(i+1:m,i)
-*
-               CALL ZGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, I+1 ),
-     $                     LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 )
-               CALL ZGEMV( 'Conjugate transpose', N-I, I, ONE,
-     $                     Y( I+1, 1 ), LDY, A( I, I+1 ), LDA, ZERO,
-     $                     X( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', M-I, I, -ONE, A( I+1, 1 ),
-     $                     LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
-               CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
-     $                     LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
-     $                     LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
-               CALL ZSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
-               CALL ZLACGV( N-I, A( I, I+1 ), LDA )
-            END IF
-   10    CONTINUE
-      ELSE
-*
-*        Reduce to lower bidiagonal form
-*
-         DO 20 I = 1, NB
-*
-*           Update A(i,i:n)
-*
-            CALL ZLACGV( N-I+1, A( I, I ), LDA )
-            CALL ZLACGV( I-1, A( I, 1 ), LDA )
-            CALL ZGEMV( 'No transpose', N-I+1, I-1, -ONE, Y( I, 1 ),
-     $                  LDY, A( I, 1 ), LDA, ONE, A( I, I ), LDA )
-            CALL ZLACGV( I-1, A( I, 1 ), LDA )
-            CALL ZLACGV( I-1, X( I, 1 ), LDX )
-            CALL ZGEMV( 'Conjugate transpose', I-1, N-I+1, -ONE,
-     $                  A( 1, I ), LDA, X( I, 1 ), LDX, ONE, A( I, I ),
-     $                  LDA )
-            CALL ZLACGV( I-1, X( I, 1 ), LDX )
-*
-*           Generate reflection P(i) to annihilate A(i,i+1:n)
-*
-            ALPHA = A( I, I )
-            CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
-     $                   TAUP( I ) )
-            D( I ) = ALPHA
-            IF( I.LT.M ) THEN
-               A( I, I ) = ONE
-*
-*              Compute X(i+1:m,i)
-*
-               CALL ZGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, I ),
-     $                     LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 )
-               CALL ZGEMV( 'Conjugate transpose', N-I+1, I-1, ONE,
-     $                     Y( I, 1 ), LDY, A( I, I ), LDA, ZERO,
-     $                     X( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
-     $                     LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
-               CALL ZGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, I ),
-     $                     LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
-     $                     LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
-               CALL ZSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
-               CALL ZLACGV( N-I+1, A( I, I ), LDA )
-*
-*              Update A(i+1:m,i)
-*
-               CALL ZLACGV( I-1, Y( I, 1 ), LDY )
-               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
-     $                     LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 )
-               CALL ZLACGV( I-1, Y( I, 1 ), LDY )
-               CALL ZGEMV( 'No transpose', M-I, I, -ONE, X( I+1, 1 ),
-     $                     LDX, A( 1, I ), 1, ONE, A( I+1, I ), 1 )
-*
-*              Generate reflection Q(i) to annihilate A(i+2:m,i)
-*
-               ALPHA = A( I+1, I )
-               CALL ZLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
-     $                      TAUQ( I ) )
-               E( I ) = ALPHA
-               A( I+1, I ) = ONE
-*
-*              Compute Y(i+1:n,i)
-*
-               CALL ZGEMV( 'Conjugate transpose', M-I, N-I, ONE,
-     $                     A( I+1, I+1 ), LDA, A( I+1, I ), 1, ZERO,
-     $                     Y( I+1, I ), 1 )
-               CALL ZGEMV( 'Conjugate transpose', M-I, I-1, ONE,
-     $                     A( I+1, 1 ), LDA, A( I+1, I ), 1, ZERO,
-     $                     Y( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
-     $                     LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
-               CALL ZGEMV( 'Conjugate transpose', M-I, I, ONE,
-     $                     X( I+1, 1 ), LDX, A( I+1, I ), 1, ZERO,
-     $                     Y( 1, I ), 1 )
-               CALL ZGEMV( 'Conjugate transpose', I, N-I, -ONE,
-     $                     A( 1, I+1 ), LDA, Y( 1, I ), 1, ONE,
-     $                     Y( I+1, I ), 1 )
-               CALL ZSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
-            ELSE
-               CALL ZLACGV( N-I+1, A( I, I ), LDA )
-            END IF
-   20    CONTINUE
-      END IF
-      RETURN
-*
-*     End of ZLABRD
-*
-      END
diff --git a/src/lib/lapack/zlacgv.f b/src/lib/lapack/zlacgv.f
deleted file mode 100644
index 0033e306..00000000
--- a/src/lib/lapack/zlacgv.f
+++ /dev/null
@@ -1,60 +0,0 @@
-      SUBROUTINE ZLACGV( N, X, INCX )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLACGV conjugates a complex vector of length N.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The length of the vector X.  N >= 0.
-*
-*  X       (input/output) COMPLEX*16 array, dimension
-*                         (1+(N-1)*abs(INCX))
-*          On entry, the vector of length N to be conjugated.
-*          On exit, X is overwritten with conjg(X).
-*
-*  INCX    (input) INTEGER
-*          The spacing between successive elements of X.
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, IOFF
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG
-*     ..
-*     .. Executable Statements ..
-*
-      IF( INCX.EQ.1 ) THEN
-         DO 10 I = 1, N
-            X( I ) = DCONJG( X( I ) )
-   10    CONTINUE
-      ELSE
-         IOFF = 1
-         IF( INCX.LT.0 )
-     $      IOFF = 1 - ( N-1 )*INCX
-         DO 20 I = 1, N
-            X( IOFF ) = DCONJG( X( IOFF ) )
-            IOFF = IOFF + INCX
-   20    CONTINUE
-      END IF
-      RETURN
-*
-*     End of ZLACGV
-*
-      END
diff --git a/src/lib/lapack/zlacn2.f b/src/lib/lapack/zlacn2.f
deleted file mode 100644
index 99f7ae35..00000000
--- a/src/lib/lapack/zlacn2.f
+++ /dev/null
@@ -1,221 +0,0 @@
-      SUBROUTINE ZLACN2( N, V, X, EST, KASE, ISAVE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            KASE, N
-      DOUBLE PRECISION   EST
-*     ..
-*     .. Array Arguments ..
-      INTEGER            ISAVE( 3 )
-      COMPLEX*16         V( * ), X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLACN2 estimates the 1-norm of a square, complex matrix A.
-*  Reverse communication is used for evaluating matrix-vector products.
-*
-*  Arguments
-*  =========
-*
-*  N      (input) INTEGER
-*         The order of the matrix.  N >= 1.
-*
-*  V      (workspace) COMPLEX*16 array, dimension (N)
-*         On the final return, V = A*W,  where  EST = norm(V)/norm(W)
-*         (W is not returned).
-*
-*  X      (input/output) COMPLEX*16 array, dimension (N)
-*         On an intermediate return, X should be overwritten by
-*               A * X,   if KASE=1,
-*               A' * X,  if KASE=2,
-*         where A' is the conjugate transpose of A, and ZLACN2 must be
-*         re-called with all the other parameters unchanged.
-*
-*  EST    (input/output) DOUBLE PRECISION
-*         On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
-*         unchanged from the previous call to ZLACN2.
-*         On exit, EST is an estimate (a lower bound) for norm(A). 
-*
-*  KASE   (input/output) INTEGER
-*         On the initial call to ZLACN2, KASE should be 0.
-*         On an intermediate return, KASE will be 1 or 2, indicating
-*         whether X should be overwritten by A * X  or A' * X.
-*         On the final return from ZLACN2, KASE will again be 0.
-*
-*  ISAVE  (input/output) INTEGER array, dimension (3)
-*         ISAVE is used to save variables between calls to ZLACN2
-*
-*  Further Details
-*  ======= =======
-*
-*  Contributed by Nick Higham, University of Manchester.
-*  Originally named CONEST, dated March 16, 1988.
-*
-*  Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
-*  a real or complex matrix, with applications to condition estimation",
-*  ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
-*
-*  Last modified:  April, 1999
-*
-*  This is a thread safe version of ZLACON, which uses the array ISAVE
-*  in place of a SAVE statement, as follows:
-*
-*     ZLACON     ZLACN2
-*      JUMP     ISAVE(1)
-*      J        ISAVE(2)
-*      ITER     ISAVE(3)
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER              ITMAX
-      PARAMETER          ( ITMAX = 5 )
-      DOUBLE PRECISION     ONE,         TWO
-      PARAMETER          ( ONE = 1.0D0, TWO = 2.0D0 )
-      COMPLEX*16           CZERO, CONE
-      PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ),
-     $                            CONE = ( 1.0D0, 0.0D0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, JLAST
-      DOUBLE PRECISION   ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP
-*     ..
-*     .. External Functions ..
-      INTEGER            IZMAX1
-      DOUBLE PRECISION   DLAMCH, DZSUM1
-      EXTERNAL           IZMAX1, DLAMCH, DZSUM1
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZCOPY
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DIMAG
-*     ..
-*     .. Executable Statements ..
-*
-      SAFMIN = DLAMCH( 'Safe minimum' )
-      IF( KASE.EQ.0 ) THEN
-         DO 10 I = 1, N
-            X( I ) = DCMPLX( ONE / DBLE( N ) )
-   10    CONTINUE
-         KASE = 1
-         ISAVE( 1 ) = 1
-         RETURN
-      END IF
-*
-      GO TO ( 20, 40, 70, 90, 120 )ISAVE( 1 )
-*
-*     ................ ENTRY   (ISAVE( 1 ) = 1)
-*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
-*
-   20 CONTINUE
-      IF( N.EQ.1 ) THEN
-         V( 1 ) = X( 1 )
-         EST = ABS( V( 1 ) )
-*        ... QUIT
-         GO TO 130
-      END IF
-      EST = DZSUM1( N, X, 1 )
-*
-      DO 30 I = 1, N
-         ABSXI = ABS( X( I ) )
-         IF( ABSXI.GT.SAFMIN ) THEN
-            X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI,
-     $               DIMAG( X( I ) ) / ABSXI )
-         ELSE
-            X( I ) = CONE
-         END IF
-   30 CONTINUE
-      KASE = 2
-      ISAVE( 1 ) = 2
-      RETURN
-*
-*     ................ ENTRY   (ISAVE( 1 ) = 2)
-*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
-*
-   40 CONTINUE
-      ISAVE( 2 ) = IZMAX1( N, X, 1 )
-      ISAVE( 3 ) = 2
-*
-*     MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
-*
-   50 CONTINUE
-      DO 60 I = 1, N
-         X( I ) = CZERO
-   60 CONTINUE
-      X( ISAVE( 2 ) ) = CONE
-      KASE = 1
-      ISAVE( 1 ) = 3
-      RETURN
-*
-*     ................ ENTRY   (ISAVE( 1 ) = 3)
-*     X HAS BEEN OVERWRITTEN BY A*X.
-*
-   70 CONTINUE
-      CALL ZCOPY( N, X, 1, V, 1 )
-      ESTOLD = EST
-      EST = DZSUM1( N, V, 1 )
-*
-*     TEST FOR CYCLING.
-      IF( EST.LE.ESTOLD )
-     $   GO TO 100
-*
-      DO 80 I = 1, N
-         ABSXI = ABS( X( I ) )
-         IF( ABSXI.GT.SAFMIN ) THEN
-            X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI,
-     $               DIMAG( X( I ) ) / ABSXI )
-         ELSE
-            X( I ) = CONE
-         END IF
-   80 CONTINUE
-      KASE = 2
-      ISAVE( 1 ) = 4
-      RETURN
-*
-*     ................ ENTRY   (ISAVE( 1 ) = 4)
-*     X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
-*
-   90 CONTINUE
-      JLAST = ISAVE( 2 )
-      ISAVE( 2 ) = IZMAX1( N, X, 1 )
-      IF( ( ABS( X( JLAST ) ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND.
-     $    ( ISAVE( 3 ).LT.ITMAX ) ) THEN
-         ISAVE( 3 ) = ISAVE( 3 ) + 1
-         GO TO 50
-      END IF
-*
-*     ITERATION COMPLETE.  FINAL STAGE.
-*
-  100 CONTINUE
-      ALTSGN = ONE
-      DO 110 I = 1, N
-         X( I ) = DCMPLX( ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) ) )
-         ALTSGN = -ALTSGN
-  110 CONTINUE
-      KASE = 1
-      ISAVE( 1 ) = 5
-      RETURN
-*
-*     ................ ENTRY   (ISAVE( 1 ) = 5)
-*     X HAS BEEN OVERWRITTEN BY A*X.
-*
-  120 CONTINUE
-      TEMP = TWO*( DZSUM1( N, X, 1 ) / DBLE( 3*N ) )
-      IF( TEMP.GT.EST ) THEN
-         CALL ZCOPY( N, X, 1, V, 1 )
-         EST = TEMP
-      END IF
-*
-  130 CONTINUE
-      KASE = 0
-      RETURN
-*
-*     End of ZLACN2
-*
-      END
diff --git a/src/lib/lapack/zlacon.f b/src/lib/lapack/zlacon.f
deleted file mode 100644
index 5773ef92..00000000
--- a/src/lib/lapack/zlacon.f
+++ /dev/null
@@ -1,212 +0,0 @@
-      SUBROUTINE ZLACON( N, V, X, EST, KASE )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            KASE, N
-      DOUBLE PRECISION   EST
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         V( N ), X( N )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLACON estimates the 1-norm of a square, complex matrix A.
-*  Reverse communication is used for evaluating matrix-vector products.
-*
-*  Arguments
-*  =========
-*
-*  N      (input) INTEGER
-*         The order of the matrix.  N >= 1.
-*
-*  V      (workspace) COMPLEX*16 array, dimension (N)
-*         On the final return, V = A*W,  where  EST = norm(V)/norm(W)
-*         (W is not returned).
-*
-*  X      (input/output) COMPLEX*16 array, dimension (N)
-*         On an intermediate return, X should be overwritten by
-*               A * X,   if KASE=1,
-*               A' * X,  if KASE=2,
-*         where A' is the conjugate transpose of A, and ZLACON must be
-*         re-called with all the other parameters unchanged.
-*
-*  EST    (input/output) DOUBLE PRECISION
-*         On entry with KASE = 1 or 2 and JUMP = 3, EST should be
-*         unchanged from the previous call to ZLACON.
-*         On exit, EST is an estimate (a lower bound) for norm(A). 
-*
-*  KASE   (input/output) INTEGER
-*         On the initial call to ZLACON, KASE should be 0.
-*         On an intermediate return, KASE will be 1 or 2, indicating
-*         whether X should be overwritten by A * X  or A' * X.
-*         On the final return from ZLACON, KASE will again be 0.
-*
-*  Further Details
-*  ======= =======
-*
-*  Contributed by Nick Higham, University of Manchester.
-*  Originally named CONEST, dated March 16, 1988.
-*
-*  Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
-*  a real or complex matrix, with applications to condition estimation",
-*  ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
-*
-*  Last modified:  April, 1999
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            ITMAX
-      PARAMETER          ( ITMAX = 5 )
-      DOUBLE PRECISION   ONE, TWO
-      PARAMETER          ( ONE = 1.0D0, TWO = 2.0D0 )
-      COMPLEX*16         CZERO, CONE
-      PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ),
-     $                   CONE = ( 1.0D0, 0.0D0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ITER, J, JLAST, JUMP
-      DOUBLE PRECISION   ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP
-*     ..
-*     .. External Functions ..
-      INTEGER            IZMAX1
-      DOUBLE PRECISION   DLAMCH, DZSUM1
-      EXTERNAL           IZMAX1, DLAMCH, DZSUM1
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZCOPY
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DIMAG
-*     ..
-*     .. Save statement ..
-      SAVE
-*     ..
-*     .. Executable Statements ..
-*
-      SAFMIN = DLAMCH( 'Safe minimum' )
-      IF( KASE.EQ.0 ) THEN
-         DO 10 I = 1, N
-            X( I ) = DCMPLX( ONE / DBLE( N ) )
-   10    CONTINUE
-         KASE = 1
-         JUMP = 1
-         RETURN
-      END IF
-*
-      GO TO ( 20, 40, 70, 90, 120 )JUMP
-*
-*     ................ ENTRY   (JUMP = 1)
-*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
-*
-   20 CONTINUE
-      IF( N.EQ.1 ) THEN
-         V( 1 ) = X( 1 )
-         EST = ABS( V( 1 ) )
-*        ... QUIT
-         GO TO 130
-      END IF
-      EST = DZSUM1( N, X, 1 )
-*
-      DO 30 I = 1, N
-         ABSXI = ABS( X( I ) )
-         IF( ABSXI.GT.SAFMIN ) THEN
-            X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI,
-     $               DIMAG( X( I ) ) / ABSXI )
-         ELSE
-            X( I ) = CONE
-         END IF
-   30 CONTINUE
-      KASE = 2
-      JUMP = 2
-      RETURN
-*
-*     ................ ENTRY   (JUMP = 2)
-*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
-*
-   40 CONTINUE
-      J = IZMAX1( N, X, 1 )
-      ITER = 2
-*
-*     MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
-*
-   50 CONTINUE
-      DO 60 I = 1, N
-         X( I ) = CZERO
-   60 CONTINUE
-      X( J ) = CONE
-      KASE = 1
-      JUMP = 3
-      RETURN
-*
-*     ................ ENTRY   (JUMP = 3)
-*     X HAS BEEN OVERWRITTEN BY A*X.
-*
-   70 CONTINUE
-      CALL ZCOPY( N, X, 1, V, 1 )
-      ESTOLD = EST
-      EST = DZSUM1( N, V, 1 )
-*
-*     TEST FOR CYCLING.
-      IF( EST.LE.ESTOLD )
-     $   GO TO 100
-*
-      DO 80 I = 1, N
-         ABSXI = ABS( X( I ) )
-         IF( ABSXI.GT.SAFMIN ) THEN
-            X( I ) = DCMPLX( DBLE( X( I ) ) / ABSXI,
-     $               DIMAG( X( I ) ) / ABSXI )
-         ELSE
-            X( I ) = CONE
-         END IF
-   80 CONTINUE
-      KASE = 2
-      JUMP = 4
-      RETURN
-*
-*     ................ ENTRY   (JUMP = 4)
-*     X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
-*
-   90 CONTINUE
-      JLAST = J
-      J = IZMAX1( N, X, 1 )
-      IF( ( ABS( X( JLAST ) ).NE.ABS( X( J ) ) ) .AND.
-     $    ( ITER.LT.ITMAX ) ) THEN
-         ITER = ITER + 1
-         GO TO 50
-      END IF
-*
-*     ITERATION COMPLETE.  FINAL STAGE.
-*
-  100 CONTINUE
-      ALTSGN = ONE
-      DO 110 I = 1, N
-         X( I ) = DCMPLX( ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) ) )
-         ALTSGN = -ALTSGN
-  110 CONTINUE
-      KASE = 1
-      JUMP = 5
-      RETURN
-*
-*     ................ ENTRY   (JUMP = 5)
-*     X HAS BEEN OVERWRITTEN BY A*X.
-*
-  120 CONTINUE
-      TEMP = TWO*( DZSUM1( N, X, 1 ) / DBLE( 3*N ) )
-      IF( TEMP.GT.EST ) THEN
-         CALL ZCOPY( N, X, 1, V, 1 )
-         EST = TEMP
-      END IF
-*
-  130 CONTINUE
-      KASE = 0
-      RETURN
-*
-*     End of ZLACON
-*
-      END
diff --git a/src/lib/lapack/zlacpy.f b/src/lib/lapack/zlacpy.f
deleted file mode 100644
index 8878311a..00000000
--- a/src/lib/lapack/zlacpy.f
+++ /dev/null
@@ -1,90 +0,0 @@
-      SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            LDA, LDB, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), B( LDB, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLACPY copies all or part of a two-dimensional matrix A to another
-*  matrix B.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies the part of the matrix A to be copied to B.
-*          = 'U':      Upper triangular part
-*          = 'L':      Lower triangular part
-*          Otherwise:  All of the matrix A
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA,N)
-*          The m by n matrix A.  If UPLO = 'U', only the upper trapezium
-*          is accessed; if UPLO = 'L', only the lower trapezium is
-*          accessed.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  B       (output) COMPLEX*16 array, dimension (LDB,N)
-*          On exit, B = A in the locations specified by UPLO.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B.  LDB >= max(1,M).
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, J
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-      IF( LSAME( UPLO, 'U' ) ) THEN
-         DO 20 J = 1, N
-            DO 10 I = 1, MIN( J, M )
-               B( I, J ) = A( I, J )
-   10       CONTINUE
-   20    CONTINUE
-*
-      ELSE IF( LSAME( UPLO, 'L' ) ) THEN
-         DO 40 J = 1, N
-            DO 30 I = J, M
-               B( I, J ) = A( I, J )
-   30       CONTINUE
-   40    CONTINUE
-*
-      ELSE
-         DO 60 J = 1, N
-            DO 50 I = 1, M
-               B( I, J ) = A( I, J )
-   50       CONTINUE
-   60    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of ZLACPY
-*
-      END
diff --git a/src/lib/lapack/zladiv.f b/src/lib/lapack/zladiv.f
deleted file mode 100644
index 4a12055e..00000000
--- a/src/lib/lapack/zladiv.f
+++ /dev/null
@@ -1,46 +0,0 @@
-      COMPLEX*16     FUNCTION ZLADIV( X, Y )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      COMPLEX*16         X, Y
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLADIV := X / Y, where X and Y are complex.  The computation of X / Y
-*  will not overflow on an intermediary step unless the results
-*  overflows.
-*
-*  Arguments
-*  =========
-*
-*  X       (input) COMPLEX*16
-*  Y       (input) COMPLEX*16
-*          The complex scalars X and Y.
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      DOUBLE PRECISION   ZI, ZR
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLADIV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, DCMPLX, DIMAG
-*     ..
-*     .. Executable Statements ..
-*
-      CALL DLADIV( DBLE( X ), DIMAG( X ), DBLE( Y ), DIMAG( Y ), ZR,
-     $             ZI )
-      ZLADIV = DCMPLX( ZR, ZI )
-*
-      RETURN
-*
-*     End of ZLADIV
-*
-      END
diff --git a/src/lib/lapack/zlahqr.f b/src/lib/lapack/zlahqr.f
deleted file mode 100644
index 9ce9be19..00000000
--- a/src/lib/lapack/zlahqr.f
+++ /dev/null
@@ -1,470 +0,0 @@
-      SUBROUTINE ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ,
-     $                   IHIZ, Z, LDZ, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         H( LDH, * ), W( * ), Z( LDZ, * )
-*     ..
-*
-*     Purpose
-*     =======
-*
-*     ZLAHQR is an auxiliary routine called by CHSEQR to update the
-*     eigenvalues and Schur decomposition already computed by CHSEQR, by
-*     dealing with the Hessenberg submatrix in rows and columns ILO to
-*     IHI.
-*
-*     Arguments
-*     =========
-*
-*     WANTT   (input) LOGICAL
-*          = .TRUE. : the full Schur form T is required;
-*          = .FALSE.: only eigenvalues are required.
-*
-*     WANTZ   (input) LOGICAL
-*          = .TRUE. : the matrix of Schur vectors Z is required;
-*          = .FALSE.: Schur vectors are not required.
-*
-*     N       (input) INTEGER
-*          The order of the matrix H.  N >= 0.
-*
-*     ILO     (input) INTEGER
-*     IHI     (input) INTEGER
-*          It is assumed that H is already upper triangular in rows and
-*          columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless ILO = 1).
-*          ZLAHQR works primarily with the Hessenberg submatrix in rows
-*          and columns ILO to IHI, but applies transformations to all of
-*          H if WANTT is .TRUE..
-*          1 <= ILO <= max(1,IHI); IHI <= N.
-*
-*     H       (input/output) COMPLEX*16 array, dimension (LDH,N)
-*          On entry, the upper Hessenberg matrix H.
-*          On exit, if INFO is zero and if WANTT is .TRUE., then H
-*          is upper triangular in rows and columns ILO:IHI.  If INFO
-*          is zero and if WANTT is .FALSE., then the contents of H
-*          are unspecified on exit.  The output state of H in case
-*          INF is positive is below under the description of INFO.
-*
-*     LDH     (input) INTEGER
-*          The leading dimension of the array H. LDH >= max(1,N).
-*
-*     W       (output) COMPLEX*16 array, dimension (N)
-*          The computed eigenvalues ILO to IHI are stored in the
-*          corresponding elements of W. If WANTT is .TRUE., the
-*          eigenvalues are stored in the same order as on the diagonal
-*          of the Schur form returned in H, with W(i) = H(i,i).
-*
-*     ILOZ    (input) INTEGER
-*     IHIZ    (input) INTEGER
-*          Specify the rows of Z to which transformations must be
-*          applied if WANTZ is .TRUE..
-*          1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
-*
-*     Z       (input/output) COMPLEX*16 array, dimension (LDZ,N)
-*          If WANTZ is .TRUE., on entry Z must contain the current
-*          matrix Z of transformations accumulated by CHSEQR, and on
-*          exit Z has been updated; transformations are applied only to
-*          the submatrix Z(ILOZ:IHIZ,ILO:IHI).
-*          If WANTZ is .FALSE., Z is not referenced.
-*
-*     LDZ     (input) INTEGER
-*          The leading dimension of the array Z. LDZ >= max(1,N).
-*
-*     INFO    (output) INTEGER
-*           =   0: successful exit
-*          .GT. 0: if INFO = i, ZLAHQR failed to compute all the
-*                  eigenvalues ILO to IHI in a total of 30 iterations
-*                  per eigenvalue; elements i+1:ihi of W contain
-*                  those eigenvalues which have been successfully
-*                  computed.
-*
-*                  If INFO .GT. 0 and WANTT is .FALSE., then on exit,
-*                  the remaining unconverged eigenvalues are the
-*                  eigenvalues of the upper Hessenberg matrix
-*                  rows and columns ILO thorugh INFO of the final,
-*                  output value of H.
-*
-*                  If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*          (*)       (initial value of H)*U  = U*(final value of H)
-*                  where U is an orthognal matrix.    The final
-*                  value of H is upper Hessenberg and triangular in
-*                  rows and columns INFO+1 through IHI.
-*
-*                  If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*                      (final value of Z)  = (initial value of Z)*U
-*                  where U is the orthogonal matrix in (*)
-*                  (regardless of the value of WANTT.)
-*
-*     Further Details
-*     ===============
-*
-*     02-96 Based on modifications by
-*     David Day, Sandia National Laboratory, USA
-*
-*     12-04 Further modifications by
-*     Ralph Byers, University of Kansas, USA
-*
-*       This is a modified version of ZLAHQR from LAPACK version 3.0.
-*       It is (1) more robust against overflow and underflow and
-*       (2) adopts the more conservative Ahues & Tisseur stopping
-*       criterion (LAWN 122, 1997).
-*
-*     =========================================================
-*
-*     .. Parameters ..
-      INTEGER            ITMAX
-      PARAMETER          ( ITMAX = 30 )
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ),
-     $                   ONE = ( 1.0d0, 0.0d0 ) )
-      DOUBLE PRECISION   RZERO, RONE, HALF
-      PARAMETER          ( RZERO = 0.0d0, RONE = 1.0d0, HALF = 0.5d0 )
-      DOUBLE PRECISION   DAT1
-      PARAMETER          ( DAT1 = 3.0d0 / 4.0d0 )
-*     ..
-*     .. Local Scalars ..
-      COMPLEX*16         CDUM, H11, H11S, H22, SC, SUM, T, T1, TEMP, U,
-     $                   V2, X, Y
-      DOUBLE PRECISION   AA, AB, BA, BB, H10, H21, RTEMP, S, SAFMAX,
-     $                   SAFMIN, SMLNUM, SX, T2, TST, ULP
-      INTEGER            I, I1, I2, ITS, J, JHI, JLO, K, L, M, NH, NZ
-*     ..
-*     .. Local Arrays ..
-      COMPLEX*16         V( 2 )
-*     ..
-*     .. External Functions ..
-      COMPLEX*16         ZLADIV
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           ZLADIV, DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, ZCOPY, ZLARFG, ZSCAL
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-      IF( ILO.EQ.IHI ) THEN
-         W( ILO ) = H( ILO, ILO )
-         RETURN
-      END IF
-*
-*     ==== clear out the trash ====
-      DO 10 J = ILO, IHI - 3
-         H( J+2, J ) = ZERO
-         H( J+3, J ) = ZERO
-   10 CONTINUE
-      IF( ILO.LE.IHI-2 )
-     $   H( IHI, IHI-2 ) = ZERO
-*     ==== ensure that subdiagonal entries are real ====
-      DO 20 I = ILO + 1, IHI
-         IF( DIMAG( H( I, I-1 ) ).NE.RZERO ) THEN
-*           ==== The following redundant normalization
-*           .    avoids problems with both gradual and
-*           .    sudden underflow in ABS(H(I,I-1)) ====
-            SC = H( I, I-1 ) / CABS1( H( I, I-1 ) )
-            SC = DCONJG( SC ) / ABS( SC )
-            H( I, I-1 ) = ABS( H( I, I-1 ) )
-            IF( WANTT ) THEN
-               JLO = 1
-               JHI = N
-            ELSE
-               JLO = ILO
-               JHI = IHI
-            END IF
-            CALL ZSCAL( JHI-I+1, SC, H( I, I ), LDH )
-            CALL ZSCAL( MIN( JHI, I+1 )-JLO+1, DCONJG( SC ),
-     $                  H( JLO, I ), 1 )
-            IF( WANTZ )
-     $         CALL ZSCAL( IHIZ-ILOZ+1, DCONJG( SC ), Z( ILOZ, I ), 1 )
-         END IF
-   20 CONTINUE
-*
-      NH = IHI - ILO + 1
-      NZ = IHIZ - ILOZ + 1
-*
-*     Set machine-dependent constants for the stopping criterion.
-*
-      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
-      SAFMAX = RONE / SAFMIN
-      CALL DLABAD( SAFMIN, SAFMAX )
-      ULP = DLAMCH( 'PRECISION' )
-      SMLNUM = SAFMIN*( DBLE( NH ) / ULP )
-*
-*     I1 and I2 are the indices of the first row and last column of H
-*     to which transformations must be applied. If eigenvalues only are
-*     being computed, I1 and I2 are set inside the main loop.
-*
-      IF( WANTT ) THEN
-         I1 = 1
-         I2 = N
-      END IF
-*
-*     The main loop begins here. I is the loop index and decreases from
-*     IHI to ILO in steps of 1. Each iteration of the loop works
-*     with the active submatrix in rows and columns L to I.
-*     Eigenvalues I+1 to IHI have already converged. Either L = ILO, or
-*     H(L,L-1) is negligible so that the matrix splits.
-*
-      I = IHI
-   30 CONTINUE
-      IF( I.LT.ILO )
-     $   GO TO 150
-*
-*     Perform QR iterations on rows and columns ILO to I until a
-*     submatrix of order 1 splits off at the bottom because a
-*     subdiagonal element has become negligible.
-*
-      L = ILO
-      DO 130 ITS = 0, ITMAX
-*
-*        Look for a single small subdiagonal element.
-*
-         DO 40 K = I, L + 1, -1
-            IF( CABS1( H( K, K-1 ) ).LE.SMLNUM )
-     $         GO TO 50
-            TST = CABS1( H( K-1, K-1 ) ) + CABS1( H( K, K ) )
-            IF( TST.EQ.ZERO ) THEN
-               IF( K-2.GE.ILO )
-     $            TST = TST + ABS( DBLE( H( K-1, K-2 ) ) )
-               IF( K+1.LE.IHI )
-     $            TST = TST + ABS( DBLE( H( K+1, K ) ) )
-            END IF
-*           ==== The following is a conservative small subdiagonal
-*           .    deflation criterion due to Ahues & Tisseur (LAWN 122,
-*           .    1997). It has better mathematical foundation and
-*           .    improves accuracy in some examples.  ====
-            IF( ABS( DBLE( H( K, K-1 ) ) ).LE.ULP*TST ) THEN
-               AB = MAX( CABS1( H( K, K-1 ) ), CABS1( H( K-1, K ) ) )
-               BA = MIN( CABS1( H( K, K-1 ) ), CABS1( H( K-1, K ) ) )
-               AA = MAX( CABS1( H( K, K ) ),
-     $              CABS1( H( K-1, K-1 )-H( K, K ) ) )
-               BB = MIN( CABS1( H( K, K ) ),
-     $              CABS1( H( K-1, K-1 )-H( K, K ) ) )
-               S = AA + AB
-               IF( BA*( AB / S ).LE.MAX( SMLNUM,
-     $             ULP*( BB*( AA / S ) ) ) )GO TO 50
-            END IF
-   40    CONTINUE
-   50    CONTINUE
-         L = K
-         IF( L.GT.ILO ) THEN
-*
-*           H(L,L-1) is negligible
-*
-            H( L, L-1 ) = ZERO
-         END IF
-*
-*        Exit from loop if a submatrix of order 1 has split off.
-*
-         IF( L.GE.I )
-     $      GO TO 140
-*
-*        Now the active submatrix is in rows and columns L to I. If
-*        eigenvalues only are being computed, only the active submatrix
-*        need be transformed.
-*
-         IF( .NOT.WANTT ) THEN
-            I1 = L
-            I2 = I
-         END IF
-*
-         IF( ITS.EQ.10 .OR. ITS.EQ.20 ) THEN
-*
-*           Exceptional shift.
-*
-            S = DAT1*ABS( DBLE( H( I, I-1 ) ) )
-            T = S + H( I, I )
-         ELSE
-*
-*           Wilkinson's shift.
-*
-            T = H( I, I )
-            U = SQRT( H( I-1, I ) )*SQRT( H( I, I-1 ) )
-            S = CABS1( U )
-            IF( S.NE.RZERO ) THEN
-               X = HALF*( H( I-1, I-1 )-T )
-               SX = CABS1( X )
-               S = MAX( S, CABS1( X ) )
-               Y = S*SQRT( ( X / S )**2+( U / S )**2 )
-               IF( SX.GT.RZERO ) THEN
-                  IF( DBLE( X / SX )*DBLE( Y )+DIMAG( X / SX )*
-     $                DIMAG( Y ).LT.RZERO )Y = -Y
-               END IF
-               T = T - U*ZLADIV( U, ( X+Y ) )
-            END IF
-         END IF
-*
-*        Look for two consecutive small subdiagonal elements.
-*
-         DO 60 M = I - 1, L + 1, -1
-*
-*           Determine the effect of starting the single-shift QR
-*           iteration at row M, and see if this would make H(M,M-1)
-*           negligible.
-*
-            H11 = H( M, M )
-            H22 = H( M+1, M+1 )
-            H11S = H11 - T
-            H21 = H( M+1, M )
-            S = CABS1( H11S ) + ABS( H21 )
-            H11S = H11S / S
-            H21 = H21 / S
-            V( 1 ) = H11S
-            V( 2 ) = H21
-            H10 = H( M, M-1 )
-            IF( ABS( H10 )*ABS( H21 ).LE.ULP*
-     $          ( CABS1( H11S )*( CABS1( H11 )+CABS1( H22 ) ) ) )
-     $          GO TO 70
-   60    CONTINUE
-         H11 = H( L, L )
-         H22 = H( L+1, L+1 )
-         H11S = H11 - T
-         H21 = H( L+1, L )
-         S = CABS1( H11S ) + ABS( H21 )
-         H11S = H11S / S
-         H21 = H21 / S
-         V( 1 ) = H11S
-         V( 2 ) = H21
-   70    CONTINUE
-*
-*        Single-shift QR step
-*
-         DO 120 K = M, I - 1
-*
-*           The first iteration of this loop determines a reflection G
-*           from the vector V and applies it from left and right to H,
-*           thus creating a nonzero bulge below the subdiagonal.
-*
-*           Each subsequent iteration determines a reflection G to
-*           restore the Hessenberg form in the (K-1)th column, and thus
-*           chases the bulge one step toward the bottom of the active
-*           submatrix.
-*
-*           V(2) is always real before the call to ZLARFG, and hence
-*           after the call T2 ( = T1*V(2) ) is also real.
-*
-            IF( K.GT.M )
-     $         CALL ZCOPY( 2, H( K, K-1 ), 1, V, 1 )
-            CALL ZLARFG( 2, V( 1 ), V( 2 ), 1, T1 )
-            IF( K.GT.M ) THEN
-               H( K, K-1 ) = V( 1 )
-               H( K+1, K-1 ) = ZERO
-            END IF
-            V2 = V( 2 )
-            T2 = DBLE( T1*V2 )
-*
-*           Apply G from the left to transform the rows of the matrix
-*           in columns K to I2.
-*
-            DO 80 J = K, I2
-               SUM = DCONJG( T1 )*H( K, J ) + T2*H( K+1, J )
-               H( K, J ) = H( K, J ) - SUM
-               H( K+1, J ) = H( K+1, J ) - SUM*V2
-   80       CONTINUE
-*
-*           Apply G from the right to transform the columns of the
-*           matrix in rows I1 to min(K+2,I).
-*
-            DO 90 J = I1, MIN( K+2, I )
-               SUM = T1*H( J, K ) + T2*H( J, K+1 )
-               H( J, K ) = H( J, K ) - SUM
-               H( J, K+1 ) = H( J, K+1 ) - SUM*DCONJG( V2 )
-   90       CONTINUE
-*
-            IF( WANTZ ) THEN
-*
-*              Accumulate transformations in the matrix Z
-*
-               DO 100 J = ILOZ, IHIZ
-                  SUM = T1*Z( J, K ) + T2*Z( J, K+1 )
-                  Z( J, K ) = Z( J, K ) - SUM
-                  Z( J, K+1 ) = Z( J, K+1 ) - SUM*DCONJG( V2 )
-  100          CONTINUE
-            END IF
-*
-            IF( K.EQ.M .AND. M.GT.L ) THEN
-*
-*              If the QR step was started at row M > L because two
-*              consecutive small subdiagonals were found, then extra
-*              scaling must be performed to ensure that H(M,M-1) remains
-*              real.
-*
-               TEMP = ONE - T1
-               TEMP = TEMP / ABS( TEMP )
-               H( M+1, M ) = H( M+1, M )*DCONJG( TEMP )
-               IF( M+2.LE.I )
-     $            H( M+2, M+1 ) = H( M+2, M+1 )*TEMP
-               DO 110 J = M, I
-                  IF( J.NE.M+1 ) THEN
-                     IF( I2.GT.J )
-     $                  CALL ZSCAL( I2-J, TEMP, H( J, J+1 ), LDH )
-                     CALL ZSCAL( J-I1, DCONJG( TEMP ), H( I1, J ), 1 )
-                     IF( WANTZ ) THEN
-                        CALL ZSCAL( NZ, DCONJG( TEMP ), Z( ILOZ, J ),
-     $                              1 )
-                     END IF
-                  END IF
-  110          CONTINUE
-            END IF
-  120    CONTINUE
-*
-*        Ensure that H(I,I-1) is real.
-*
-         TEMP = H( I, I-1 )
-         IF( DIMAG( TEMP ).NE.RZERO ) THEN
-            RTEMP = ABS( TEMP )
-            H( I, I-1 ) = RTEMP
-            TEMP = TEMP / RTEMP
-            IF( I2.GT.I )
-     $         CALL ZSCAL( I2-I, DCONJG( TEMP ), H( I, I+1 ), LDH )
-            CALL ZSCAL( I-I1, TEMP, H( I1, I ), 1 )
-            IF( WANTZ ) THEN
-               CALL ZSCAL( NZ, TEMP, Z( ILOZ, I ), 1 )
-            END IF
-         END IF
-*
-  130 CONTINUE
-*
-*     Failure to converge in remaining number of iterations
-*
-      INFO = I
-      RETURN
-*
-  140 CONTINUE
-*
-*     H(I,I-1) is negligible: one eigenvalue has converged.
-*
-      W( I ) = H( I, I )
-*
-*     return to start of the main loop with new value of I.
-*
-      I = L - 1
-      GO TO 30
-*
-  150 CONTINUE
-      RETURN
-*
-*     End of ZLAHQR
-*
-      END
diff --git a/src/lib/lapack/zlahr2.f b/src/lib/lapack/zlahr2.f
deleted file mode 100644
index f3cb5515..00000000
--- a/src/lib/lapack/zlahr2.f
+++ /dev/null
@@ -1,240 +0,0 @@
-      SUBROUTINE ZLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            K, LDA, LDT, LDY, N, NB
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16        A( LDA, * ), T( LDT, NB ), TAU( NB ),
-     $                   Y( LDY, NB )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLAHR2 reduces the first NB columns of A complex general n-BY-(n-k+1)
-*  matrix A so that elements below the k-th subdiagonal are zero. The
-*  reduction is performed by an unitary similarity transformation
-*  Q' * A * Q. The routine returns the matrices V and T which determine
-*  Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
-*
-*  This is an auxiliary routine called by ZGEHRD.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.
-*
-*  K       (input) INTEGER
-*          The offset for the reduction. Elements below the k-th
-*          subdiagonal in the first NB columns are reduced to zero.
-*          K < N.
-*
-*  NB      (input) INTEGER
-*          The number of columns to be reduced.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N-K+1)
-*          On entry, the n-by-(n-k+1) general matrix A.
-*          On exit, the elements on and above the k-th subdiagonal in
-*          the first NB columns are overwritten with the corresponding
-*          elements of the reduced matrix; the elements below the k-th
-*          subdiagonal, with the array TAU, represent the matrix Q as a
-*          product of elementary reflectors. The other columns of A are
-*          unchanged. See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  TAU     (output) COMPLEX*16 array, dimension (NB)
-*          The scalar factors of the elementary reflectors. See Further
-*          Details.
-*
-*  T       (output) COMPLEX*16 array, dimension (LDT,NB)
-*          The upper triangular matrix T.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T.  LDT >= NB.
-*
-*  Y       (output) COMPLEX*16 array, dimension (LDY,NB)
-*          The n-by-nb matrix Y.
-*
-*  LDY     (input) INTEGER
-*          The leading dimension of the array Y. LDY >= N.
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of nb elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(nb).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
-*  A(i+k+1:n,i), and tau in TAU(i).
-*
-*  The elements of the vectors v together form the (n-k+1)-by-nb matrix
-*  V which is needed, with T and Y, to apply the transformation to the
-*  unreduced part of the matrix, using an update of the form:
-*  A := (I - V*T*V') * (A - Y*V').
-*
-*  The contents of A on exit are illustrated by the following example
-*  with n = 7, k = 3 and nb = 2:
-*
-*     ( a   a   a   a   a )
-*     ( a   a   a   a   a )
-*     ( a   a   a   a   a )
-*     ( h   h   a   a   a )
-*     ( v1  h   a   a   a )
-*     ( v1  v2  a   a   a )
-*     ( v1  v2  a   a   a )
-*
-*  where a denotes an element of the original matrix A, h denotes a
-*  modified element of the upper Hessenberg matrix H, and vi denotes an
-*  element of the vector defining H(i).
-*
-*  This file is a slight modification of LAPACK-3.0's ZLAHRD
-*  incorporating improvements proposed by Quintana-Orti and Van de
-*  Gejin. Note that the entries of A(1:K,2:NB) differ from those
-*  returned by the original LAPACK routine. This function is
-*  not backward compatible with LAPACK3.0.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16        ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ), 
-     $                     ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-      COMPLEX*16        EI
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZAXPY, ZCOPY, ZGEMM, ZGEMV, ZLACPY,
-     $                   ZLARFG, ZSCAL, ZTRMM, ZTRMV, ZLACGV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-      DO 10 I = 1, NB
-         IF( I.GT.1 ) THEN
-*
-*           Update A(K+1:N,I)
-*
-*           Update I-th column of A - Y * V'
-*
-            CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA ) 
-            CALL ZGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY,
-     $                  A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 )
-            CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA ) 
-*
-*           Apply I - V * T' * V' to this column (call it b) from the
-*           left, using the last column of T as workspace
-*
-*           Let  V = ( V1 )   and   b = ( b1 )   (first I-1 rows)
-*                    ( V2 )             ( b2 )
-*
-*           where V1 is unit lower triangular
-*
-*           w := V1' * b1
-*
-            CALL ZCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 )
-            CALL ZTRMV( 'Lower', 'Conjugate transpose', 'UNIT', 
-     $                  I-1, A( K+1, 1 ),
-     $                  LDA, T( 1, NB ), 1 )
-*
-*           w := w + V2'*b2
-*
-            CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, 
-     $                  ONE, A( K+I, 1 ),
-     $                  LDA, A( K+I, I ), 1, ONE, T( 1, NB ), 1 )
-*
-*           w := T'*w
-*
-            CALL ZTRMV( 'Upper', 'Conjugate transpose', 'NON-UNIT', 
-     $                  I-1, T, LDT,
-     $                  T( 1, NB ), 1 )
-*
-*           b2 := b2 - V2*w
-*
-            CALL ZGEMV( 'NO TRANSPOSE', N-K-I+1, I-1, -ONE, 
-     $                  A( K+I, 1 ),
-     $                  LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 )
-*
-*           b1 := b1 - V1*w
-*
-            CALL ZTRMV( 'Lower', 'NO TRANSPOSE', 
-     $                  'UNIT', I-1,
-     $                  A( K+1, 1 ), LDA, T( 1, NB ), 1 )
-            CALL ZAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 )
-*
-            A( K+I-1, I-1 ) = EI
-         END IF
-*
-*        Generate the elementary reflector H(I) to annihilate
-*        A(K+I+1:N,I)
-*
-         CALL ZLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1,
-     $                TAU( I ) )
-         EI = A( K+I, I )
-         A( K+I, I ) = ONE
-*
-*        Compute  Y(K+1:N,I)
-*
-         CALL ZGEMV( 'NO TRANSPOSE', N-K, N-K-I+1, 
-     $               ONE, A( K+1, I+1 ),
-     $               LDA, A( K+I, I ), 1, ZERO, Y( K+1, I ), 1 )
-         CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, 
-     $               ONE, A( K+I, 1 ), LDA,
-     $               A( K+I, I ), 1, ZERO, T( 1, I ), 1 )
-         CALL ZGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, 
-     $               Y( K+1, 1 ), LDY,
-     $               T( 1, I ), 1, ONE, Y( K+1, I ), 1 )
-         CALL ZSCAL( N-K, TAU( I ), Y( K+1, I ), 1 )
-*
-*        Compute T(1:I,I)
-*
-         CALL ZSCAL( I-1, -TAU( I ), T( 1, I ), 1 )
-         CALL ZTRMV( 'Upper', 'No Transpose', 'NON-UNIT', 
-     $               I-1, T, LDT,
-     $               T( 1, I ), 1 )
-         T( I, I ) = TAU( I )
-*
-   10 CONTINUE
-      A( K+NB, NB ) = EI
-*
-*     Compute Y(1:K,1:NB)
-*
-      CALL ZLACPY( 'ALL', K, NB, A( 1, 2 ), LDA, Y, LDY )
-      CALL ZTRMM( 'RIGHT', 'Lower', 'NO TRANSPOSE', 
-     $            'UNIT', K, NB,
-     $            ONE, A( K+1, 1 ), LDA, Y, LDY )
-      IF( N.GT.K+NB )
-     $   CALL ZGEMM( 'NO TRANSPOSE', 'NO TRANSPOSE', K, 
-     $               NB, N-K-NB, ONE,
-     $               A( 1, 2+NB ), LDA, A( K+1+NB, 1 ), LDA, ONE, Y,
-     $               LDY )
-      CALL ZTRMM( 'RIGHT', 'Upper', 'NO TRANSPOSE', 
-     $            'NON-UNIT', K, NB,
-     $            ONE, T, LDT, Y, LDY )
-*
-      RETURN
-*
-*     End of ZLAHR2
-*
-      END
diff --git a/src/lib/lapack/zlahrd.f b/src/lib/lapack/zlahrd.f
deleted file mode 100644
index e7eb9de9..00000000
--- a/src/lib/lapack/zlahrd.f
+++ /dev/null
@@ -1,213 +0,0 @@
-      SUBROUTINE ZLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            K, LDA, LDT, LDY, N, NB
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), T( LDT, NB ), TAU( NB ),
-     $                   Y( LDY, NB )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLAHRD reduces the first NB columns of a complex general n-by-(n-k+1)
-*  matrix A so that elements below the k-th subdiagonal are zero. The
-*  reduction is performed by a unitary similarity transformation
-*  Q' * A * Q. The routine returns the matrices V and T which determine
-*  Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
-*
-*  This is an OBSOLETE auxiliary routine. 
-*  This routine will be 'deprecated' in a  future release.
-*  Please use the new routine ZLAHR2 instead.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.
-*
-*  K       (input) INTEGER
-*          The offset for the reduction. Elements below the k-th
-*          subdiagonal in the first NB columns are reduced to zero.
-*
-*  NB      (input) INTEGER
-*          The number of columns to be reduced.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N-K+1)
-*          On entry, the n-by-(n-k+1) general matrix A.
-*          On exit, the elements on and above the k-th subdiagonal in
-*          the first NB columns are overwritten with the corresponding
-*          elements of the reduced matrix; the elements below the k-th
-*          subdiagonal, with the array TAU, represent the matrix Q as a
-*          product of elementary reflectors. The other columns of A are
-*          unchanged. See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  TAU     (output) COMPLEX*16 array, dimension (NB)
-*          The scalar factors of the elementary reflectors. See Further
-*          Details.
-*
-*  T       (output) COMPLEX*16 array, dimension (LDT,NB)
-*          The upper triangular matrix T.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T.  LDT >= NB.
-*
-*  Y       (output) COMPLEX*16 array, dimension (LDY,NB)
-*          The n-by-nb matrix Y.
-*
-*  LDY     (input) INTEGER
-*          The leading dimension of the array Y. LDY >= max(1,N).
-*
-*  Further Details
-*  ===============
-*
-*  The matrix Q is represented as a product of nb elementary reflectors
-*
-*     Q = H(1) H(2) . . . H(nb).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
-*  A(i+k+1:n,i), and tau in TAU(i).
-*
-*  The elements of the vectors v together form the (n-k+1)-by-nb matrix
-*  V which is needed, with T and Y, to apply the transformation to the
-*  unreduced part of the matrix, using an update of the form:
-*  A := (I - V*T*V') * (A - Y*V').
-*
-*  The contents of A on exit are illustrated by the following example
-*  with n = 7, k = 3 and nb = 2:
-*
-*     ( a   h   a   a   a )
-*     ( a   h   a   a   a )
-*     ( a   h   a   a   a )
-*     ( h   h   a   a   a )
-*     ( v1  h   a   a   a )
-*     ( v1  v2  a   a   a )
-*     ( v1  v2  a   a   a )
-*
-*  where a denotes an element of the original matrix A, h denotes a
-*  modified element of the upper Hessenberg matrix H, and vi denotes an
-*  element of the vector defining H(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-      COMPLEX*16         EI
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZAXPY, ZCOPY, ZGEMV, ZLACGV, ZLARFG, ZSCAL,
-     $                   ZTRMV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-      DO 10 I = 1, NB
-         IF( I.GT.1 ) THEN
-*
-*           Update A(1:n,i)
-*
-*           Compute i-th column of A - Y * V'
-*
-            CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA )
-            CALL ZGEMV( 'No transpose', N, I-1, -ONE, Y, LDY,
-     $                  A( K+I-1, 1 ), LDA, ONE, A( 1, I ), 1 )
-            CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA )
-*
-*           Apply I - V * T' * V' to this column (call it b) from the
-*           left, using the last column of T as workspace
-*
-*           Let  V = ( V1 )   and   b = ( b1 )   (first I-1 rows)
-*                    ( V2 )             ( b2 )
-*
-*           where V1 is unit lower triangular
-*
-*           w := V1' * b1
-*
-            CALL ZCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 )
-            CALL ZTRMV( 'Lower', 'Conjugate transpose', 'Unit', I-1,
-     $                  A( K+1, 1 ), LDA, T( 1, NB ), 1 )
-*
-*           w := w + V2'*b2
-*
-            CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, ONE,
-     $                  A( K+I, 1 ), LDA, A( K+I, I ), 1, ONE,
-     $                  T( 1, NB ), 1 )
-*
-*           w := T'*w
-*
-            CALL ZTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', I-1,
-     $                  T, LDT, T( 1, NB ), 1 )
-*
-*           b2 := b2 - V2*w
-*
-            CALL ZGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ),
-     $                  LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 )
-*
-*           b1 := b1 - V1*w
-*
-            CALL ZTRMV( 'Lower', 'No transpose', 'Unit', I-1,
-     $                  A( K+1, 1 ), LDA, T( 1, NB ), 1 )
-            CALL ZAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 )
-*
-            A( K+I-1, I-1 ) = EI
-         END IF
-*
-*        Generate the elementary reflector H(i) to annihilate
-*        A(k+i+1:n,i)
-*
-         EI = A( K+I, I )
-         CALL ZLARFG( N-K-I+1, EI, A( MIN( K+I+1, N ), I ), 1,
-     $                TAU( I ) )
-         A( K+I, I ) = ONE
-*
-*        Compute  Y(1:n,i)
-*
-         CALL ZGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA,
-     $               A( K+I, I ), 1, ZERO, Y( 1, I ), 1 )
-         CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, ONE,
-     $               A( K+I, 1 ), LDA, A( K+I, I ), 1, ZERO, T( 1, I ),
-     $               1 )
-         CALL ZGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1,
-     $               ONE, Y( 1, I ), 1 )
-         CALL ZSCAL( N, TAU( I ), Y( 1, I ), 1 )
-*
-*        Compute T(1:i,i)
-*
-         CALL ZSCAL( I-1, -TAU( I ), T( 1, I ), 1 )
-         CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT,
-     $               T( 1, I ), 1 )
-         T( I, I ) = TAU( I )
-*
-   10 CONTINUE
-      A( K+NB, NB ) = EI
-*
-      RETURN
-*
-*     End of ZLAHRD
-*
-      END
diff --git a/src/lib/lapack/zlaic1.f b/src/lib/lapack/zlaic1.f
deleted file mode 100644
index 589f0889..00000000
--- a/src/lib/lapack/zlaic1.f
+++ /dev/null
@@ -1,295 +0,0 @@
-      SUBROUTINE ZLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            J, JOB
-      DOUBLE PRECISION   SEST, SESTPR
-      COMPLEX*16         C, GAMMA, S
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         W( J ), X( J )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLAIC1 applies one step of incremental condition estimation in
-*  its simplest version:
-*
-*  Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j
-*  lower triangular matrix L, such that
-*           twonorm(L*x) = sest
-*  Then ZLAIC1 computes sestpr, s, c such that
-*  the vector
-*                  [ s*x ]
-*           xhat = [  c  ]
-*  is an approximate singular vector of
-*                  [ L     0  ]
-*           Lhat = [ w' gamma ]
-*  in the sense that
-*           twonorm(Lhat*xhat) = sestpr.
-*
-*  Depending on JOB, an estimate for the largest or smallest singular
-*  value is computed.
-*
-*  Note that [s c]' and sestpr**2 is an eigenpair of the system
-*
-*      diag(sest*sest, 0) + [alpha  gamma] * [ conjg(alpha) ]
-*                                            [ conjg(gamma) ]
-*
-*  where  alpha =  conjg(x)'*w.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) INTEGER
-*          = 1: an estimate for the largest singular value is computed.
-*          = 2: an estimate for the smallest singular value is computed.
-*
-*  J       (input) INTEGER
-*          Length of X and W
-*
-*  X       (input) COMPLEX*16 array, dimension (J)
-*          The j-vector x.
-*
-*  SEST    (input) DOUBLE PRECISION
-*          Estimated singular value of j by j matrix L
-*
-*  W       (input) COMPLEX*16 array, dimension (J)
-*          The j-vector w.
-*
-*  GAMMA   (input) COMPLEX*16
-*          The diagonal element gamma.
-*
-*  SESTPR  (output) DOUBLE PRECISION
-*          Estimated singular value of (j+1) by (j+1) matrix Lhat.
-*
-*  S       (output) COMPLEX*16
-*          Sine needed in forming xhat.
-*
-*  C       (output) COMPLEX*16
-*          Cosine needed in forming xhat.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE, TWO
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0 )
-      DOUBLE PRECISION   HALF, FOUR
-      PARAMETER          ( HALF = 0.5D0, FOUR = 4.0D0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   ABSALP, ABSEST, ABSGAM, B, EPS, NORMA, S1, S2,
-     $                   SCL, T, TEST, TMP, ZETA1, ZETA2
-      COMPLEX*16         ALPHA, COSINE, SINE
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DCONJG, MAX, SQRT
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      COMPLEX*16         ZDOTC
-      EXTERNAL           DLAMCH, ZDOTC
-*     ..
-*     .. Executable Statements ..
-*
-      EPS = DLAMCH( 'Epsilon' )
-      ALPHA = ZDOTC( J, X, 1, W, 1 )
-*
-      ABSALP = ABS( ALPHA )
-      ABSGAM = ABS( GAMMA )
-      ABSEST = ABS( SEST )
-*
-      IF( JOB.EQ.1 ) THEN
-*
-*        Estimating largest singular value
-*
-*        special cases
-*
-         IF( SEST.EQ.ZERO ) THEN
-            S1 = MAX( ABSGAM, ABSALP )
-            IF( S1.EQ.ZERO ) THEN
-               S = ZERO
-               C = ONE
-               SESTPR = ZERO
-            ELSE
-               S = ALPHA / S1
-               C = GAMMA / S1
-               TMP = SQRT( S*DCONJG( S )+C*DCONJG( C ) )
-               S = S / TMP
-               C = C / TMP
-               SESTPR = S1*TMP
-            END IF
-            RETURN
-         ELSE IF( ABSGAM.LE.EPS*ABSEST ) THEN
-            S = ONE
-            C = ZERO
-            TMP = MAX( ABSEST, ABSALP )
-            S1 = ABSEST / TMP
-            S2 = ABSALP / TMP
-            SESTPR = TMP*SQRT( S1*S1+S2*S2 )
-            RETURN
-         ELSE IF( ABSALP.LE.EPS*ABSEST ) THEN
-            S1 = ABSGAM
-            S2 = ABSEST
-            IF( S1.LE.S2 ) THEN
-               S = ONE
-               C = ZERO
-               SESTPR = S2
-            ELSE
-               S = ZERO
-               C = ONE
-               SESTPR = S1
-            END IF
-            RETURN
-         ELSE IF( ABSEST.LE.EPS*ABSALP .OR. ABSEST.LE.EPS*ABSGAM ) THEN
-            S1 = ABSGAM
-            S2 = ABSALP
-            IF( S1.LE.S2 ) THEN
-               TMP = S1 / S2
-               SCL = SQRT( ONE+TMP*TMP )
-               SESTPR = S2*SCL
-               S = ( ALPHA / S2 ) / SCL
-               C = ( GAMMA / S2 ) / SCL
-            ELSE
-               TMP = S2 / S1
-               SCL = SQRT( ONE+TMP*TMP )
-               SESTPR = S1*SCL
-               S = ( ALPHA / S1 ) / SCL
-               C = ( GAMMA / S1 ) / SCL
-            END IF
-            RETURN
-         ELSE
-*
-*           normal case
-*
-            ZETA1 = ABSALP / ABSEST
-            ZETA2 = ABSGAM / ABSEST
-*
-            B = ( ONE-ZETA1*ZETA1-ZETA2*ZETA2 )*HALF
-            C = ZETA1*ZETA1
-            IF( B.GT.ZERO ) THEN
-               T = C / ( B+SQRT( B*B+C ) )
-            ELSE
-               T = SQRT( B*B+C ) - B
-            END IF
-*
-            SINE = -( ALPHA / ABSEST ) / T
-            COSINE = -( GAMMA / ABSEST ) / ( ONE+T )
-            TMP = SQRT( SINE*DCONJG( SINE )+COSINE*DCONJG( COSINE ) )
-            S = SINE / TMP
-            C = COSINE / TMP
-            SESTPR = SQRT( T+ONE )*ABSEST
-            RETURN
-         END IF
-*
-      ELSE IF( JOB.EQ.2 ) THEN
-*
-*        Estimating smallest singular value
-*
-*        special cases
-*
-         IF( SEST.EQ.ZERO ) THEN
-            SESTPR = ZERO
-            IF( MAX( ABSGAM, ABSALP ).EQ.ZERO ) THEN
-               SINE = ONE
-               COSINE = ZERO
-            ELSE
-               SINE = -DCONJG( GAMMA )
-               COSINE = DCONJG( ALPHA )
-            END IF
-            S1 = MAX( ABS( SINE ), ABS( COSINE ) )
-            S = SINE / S1
-            C = COSINE / S1
-            TMP = SQRT( S*DCONJG( S )+C*DCONJG( C ) )
-            S = S / TMP
-            C = C / TMP
-            RETURN
-         ELSE IF( ABSGAM.LE.EPS*ABSEST ) THEN
-            S = ZERO
-            C = ONE
-            SESTPR = ABSGAM
-            RETURN
-         ELSE IF( ABSALP.LE.EPS*ABSEST ) THEN
-            S1 = ABSGAM
-            S2 = ABSEST
-            IF( S1.LE.S2 ) THEN
-               S = ZERO
-               C = ONE
-               SESTPR = S1
-            ELSE
-               S = ONE
-               C = ZERO
-               SESTPR = S2
-            END IF
-            RETURN
-         ELSE IF( ABSEST.LE.EPS*ABSALP .OR. ABSEST.LE.EPS*ABSGAM ) THEN
-            S1 = ABSGAM
-            S2 = ABSALP
-            IF( S1.LE.S2 ) THEN
-               TMP = S1 / S2
-               SCL = SQRT( ONE+TMP*TMP )
-               SESTPR = ABSEST*( TMP / SCL )
-               S = -( DCONJG( GAMMA ) / S2 ) / SCL
-               C = ( DCONJG( ALPHA ) / S2 ) / SCL
-            ELSE
-               TMP = S2 / S1
-               SCL = SQRT( ONE+TMP*TMP )
-               SESTPR = ABSEST / SCL
-               S = -( DCONJG( GAMMA ) / S1 ) / SCL
-               C = ( DCONJG( ALPHA ) / S1 ) / SCL
-            END IF
-            RETURN
-         ELSE
-*
-*           normal case
-*
-            ZETA1 = ABSALP / ABSEST
-            ZETA2 = ABSGAM / ABSEST
-*
-            NORMA = MAX( ONE+ZETA1*ZETA1+ZETA1*ZETA2,
-     $              ZETA1*ZETA2+ZETA2*ZETA2 )
-*
-*           See if root is closer to zero or to ONE
-*
-            TEST = ONE + TWO*( ZETA1-ZETA2 )*( ZETA1+ZETA2 )
-            IF( TEST.GE.ZERO ) THEN
-*
-*              root is close to zero, compute directly
-*
-               B = ( ZETA1*ZETA1+ZETA2*ZETA2+ONE )*HALF
-               C = ZETA2*ZETA2
-               T = C / ( B+SQRT( ABS( B*B-C ) ) )
-               SINE = ( ALPHA / ABSEST ) / ( ONE-T )
-               COSINE = -( GAMMA / ABSEST ) / T
-               SESTPR = SQRT( T+FOUR*EPS*EPS*NORMA )*ABSEST
-            ELSE
-*
-*              root is closer to ONE, shift by that amount
-*
-               B = ( ZETA2*ZETA2+ZETA1*ZETA1-ONE )*HALF
-               C = ZETA1*ZETA1
-               IF( B.GE.ZERO ) THEN
-                  T = -C / ( B+SQRT( B*B+C ) )
-               ELSE
-                  T = B - SQRT( B*B+C )
-               END IF
-               SINE = -( ALPHA / ABSEST ) / T
-               COSINE = -( GAMMA / ABSEST ) / ( ONE+T )
-               SESTPR = SQRT( ONE+T+FOUR*EPS*EPS*NORMA )*ABSEST
-            END IF
-            TMP = SQRT( SINE*DCONJG( SINE )+COSINE*DCONJG( COSINE ) )
-            S = SINE / TMP
-            C = COSINE / TMP
-            RETURN
-*
-         END IF
-      END IF
-      RETURN
-*
-*     End of ZLAIC1
-*
-      END
diff --git a/src/lib/lapack/zlange.f b/src/lib/lapack/zlange.f
deleted file mode 100644
index 36cecbdc..00000000
--- a/src/lib/lapack/zlange.f
+++ /dev/null
@@ -1,145 +0,0 @@
-      DOUBLE PRECISION FUNCTION ZLANGE( NORM, M, N, A, LDA, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          NORM
-      INTEGER            LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   WORK( * )
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLANGE  returns the value of the one norm,  or the Frobenius norm, or
-*  the  infinity norm,  or the  element of  largest absolute value  of a
-*  complex matrix A.
-*
-*  Description
-*  ===========
-*
-*  ZLANGE returns the value
-*
-*     ZLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*              (
-*              ( norm1(A),         NORM = '1', 'O' or 'o'
-*              (
-*              ( normI(A),         NORM = 'I' or 'i'
-*              (
-*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
-*
-*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
-*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
-*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
-*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies the value to be returned in ZLANGE as described
-*          above.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.  When M = 0,
-*          ZLANGE is set to zero.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.  When N = 0,
-*          ZLANGE is set to zero.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA,N)
-*          The m by n matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(M,1).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*          where LWORK >= M when NORM = 'I'; otherwise, WORK is not
-*          referenced.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   SCALE, SUM, VALUE
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZLASSQ
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( MIN( M, N ).EQ.0 ) THEN
-         VALUE = ZERO
-      ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-*        Find max(abs(A(i,j))).
-*
-         VALUE = ZERO
-         DO 20 J = 1, N
-            DO 10 I = 1, M
-               VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   10       CONTINUE
-   20    CONTINUE
-      ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-*        Find norm1(A).
-*
-         VALUE = ZERO
-         DO 40 J = 1, N
-            SUM = ZERO
-            DO 30 I = 1, M
-               SUM = SUM + ABS( A( I, J ) )
-   30       CONTINUE
-            VALUE = MAX( VALUE, SUM )
-   40    CONTINUE
-      ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-*        Find normI(A).
-*
-         DO 50 I = 1, M
-            WORK( I ) = ZERO
-   50    CONTINUE
-         DO 70 J = 1, N
-            DO 60 I = 1, M
-               WORK( I ) = WORK( I ) + ABS( A( I, J ) )
-   60       CONTINUE
-   70    CONTINUE
-         VALUE = ZERO
-         DO 80 I = 1, M
-            VALUE = MAX( VALUE, WORK( I ) )
-   80    CONTINUE
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-*        Find normF(A).
-*
-         SCALE = ZERO
-         SUM = ONE
-         DO 90 J = 1, N
-            CALL ZLASSQ( M, A( 1, J ), 1, SCALE, SUM )
-   90    CONTINUE
-         VALUE = SCALE*SQRT( SUM )
-      END IF
-*
-      ZLANGE = VALUE
-      RETURN
-*
-*     End of ZLANGE
-*
-      END
diff --git a/src/lib/lapack/zlanhe.f b/src/lib/lapack/zlanhe.f
deleted file mode 100644
index 86e57fcd..00000000
--- a/src/lib/lapack/zlanhe.f
+++ /dev/null
@@ -1,187 +0,0 @@
-      DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          NORM, UPLO
-      INTEGER            LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   WORK( * )
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLANHE  returns the value of the one norm,  or the Frobenius norm, or
-*  the  infinity norm,  or the  element of  largest absolute value  of a
-*  complex hermitian matrix A.
-*
-*  Description
-*  ===========
-*
-*  ZLANHE returns the value
-*
-*     ZLANHE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*              (
-*              ( norm1(A),         NORM = '1', 'O' or 'o'
-*              (
-*              ( normI(A),         NORM = 'I' or 'i'
-*              (
-*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
-*
-*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
-*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
-*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
-*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies the value to be returned in ZLANHE as described
-*          above.
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          hermitian matrix A is to be referenced.
-*          = 'U':  Upper triangular part of A is referenced
-*          = 'L':  Lower triangular part of A is referenced
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.  When N = 0, ZLANHE is
-*          set to zero.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA,N)
-*          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. Note that the imaginary parts of the diagonal
-*          elements need not be set and are assumed to be zero.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(N,1).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
-*          WORK is not referenced.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   ABSA, SCALE, SUM, VALUE
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZLASSQ
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.EQ.0 ) THEN
-         VALUE = ZERO
-      ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-*        Find max(abs(A(i,j))).
-*
-         VALUE = ZERO
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            DO 20 J = 1, N
-               DO 10 I = 1, J - 1
-                  VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   10          CONTINUE
-               VALUE = MAX( VALUE, ABS( DBLE( A( J, J ) ) ) )
-   20       CONTINUE
-         ELSE
-            DO 40 J = 1, N
-               VALUE = MAX( VALUE, ABS( DBLE( A( J, J ) ) ) )
-               DO 30 I = J + 1, N
-                  VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   30          CONTINUE
-   40       CONTINUE
-         END IF
-      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
-     $         ( NORM.EQ.'1' ) ) THEN
-*
-*        Find normI(A) ( = norm1(A), since A is hermitian).
-*
-         VALUE = ZERO
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            DO 60 J = 1, N
-               SUM = ZERO
-               DO 50 I = 1, J - 1
-                  ABSA = ABS( A( I, J ) )
-                  SUM = SUM + ABSA
-                  WORK( I ) = WORK( I ) + ABSA
-   50          CONTINUE
-               WORK( J ) = SUM + ABS( DBLE( A( J, J ) ) )
-   60       CONTINUE
-            DO 70 I = 1, N
-               VALUE = MAX( VALUE, WORK( I ) )
-   70       CONTINUE
-         ELSE
-            DO 80 I = 1, N
-               WORK( I ) = ZERO
-   80       CONTINUE
-            DO 100 J = 1, N
-               SUM = WORK( J ) + ABS( DBLE( A( J, J ) ) )
-               DO 90 I = J + 1, N
-                  ABSA = ABS( A( I, J ) )
-                  SUM = SUM + ABSA
-                  WORK( I ) = WORK( I ) + ABSA
-   90          CONTINUE
-               VALUE = MAX( VALUE, SUM )
-  100       CONTINUE
-         END IF
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-*        Find normF(A).
-*
-         SCALE = ZERO
-         SUM = ONE
-         IF( LSAME( UPLO, 'U' ) ) THEN
-            DO 110 J = 2, N
-               CALL ZLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
-  110       CONTINUE
-         ELSE
-            DO 120 J = 1, N - 1
-               CALL ZLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
-  120       CONTINUE
-         END IF
-         SUM = 2*SUM
-         DO 130 I = 1, N
-            IF( DBLE( A( I, I ) ).NE.ZERO ) THEN
-               ABSA = ABS( DBLE( A( I, I ) ) )
-               IF( SCALE.LT.ABSA ) THEN
-                  SUM = ONE + SUM*( SCALE / ABSA )**2
-                  SCALE = ABSA
-               ELSE
-                  SUM = SUM + ( ABSA / SCALE )**2
-               END IF
-            END IF
-  130    CONTINUE
-         VALUE = SCALE*SQRT( SUM )
-      END IF
-*
-      ZLANHE = VALUE
-      RETURN
-*
-*     End of ZLANHE
-*
-      END
diff --git a/src/lib/lapack/zlanhs.f b/src/lib/lapack/zlanhs.f
deleted file mode 100644
index d7b187a5..00000000
--- a/src/lib/lapack/zlanhs.f
+++ /dev/null
@@ -1,142 +0,0 @@
-      DOUBLE PRECISION FUNCTION ZLANHS( NORM, N, A, LDA, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          NORM
-      INTEGER            LDA, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   WORK( * )
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLANHS  returns the value of the one norm,  or the Frobenius norm, or
-*  the  infinity norm,  or the  element of  largest absolute value  of a
-*  Hessenberg matrix A.
-*
-*  Description
-*  ===========
-*
-*  ZLANHS returns the value
-*
-*     ZLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
-*              (
-*              ( norm1(A),         NORM = '1', 'O' or 'o'
-*              (
-*              ( normI(A),         NORM = 'I' or 'i'
-*              (
-*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
-*
-*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
-*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
-*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
-*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
-*
-*  Arguments
-*  =========
-*
-*  NORM    (input) CHARACTER*1
-*          Specifies the value to be returned in ZLANHS as described
-*          above.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.  When N = 0, ZLANHS is
-*          set to zero.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA,N)
-*          The n by n upper Hessenberg matrix A; the part of A below the
-*          first sub-diagonal is not referenced.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(N,1).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
-*          where LWORK >= N when NORM = 'I'; otherwise, WORK is not
-*          referenced.
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      DOUBLE PRECISION   SCALE, SUM, VALUE
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZLASSQ
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.EQ.0 ) THEN
-         VALUE = ZERO
-      ELSE IF( LSAME( NORM, 'M' ) ) THEN
-*
-*        Find max(abs(A(i,j))).
-*
-         VALUE = ZERO
-         DO 20 J = 1, N
-            DO 10 I = 1, MIN( N, J+1 )
-               VALUE = MAX( VALUE, ABS( A( I, J ) ) )
-   10       CONTINUE
-   20    CONTINUE
-      ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
-*
-*        Find norm1(A).
-*
-         VALUE = ZERO
-         DO 40 J = 1, N
-            SUM = ZERO
-            DO 30 I = 1, MIN( N, J+1 )
-               SUM = SUM + ABS( A( I, J ) )
-   30       CONTINUE
-            VALUE = MAX( VALUE, SUM )
-   40    CONTINUE
-      ELSE IF( LSAME( NORM, 'I' ) ) THEN
-*
-*        Find normI(A).
-*
-         DO 50 I = 1, N
-            WORK( I ) = ZERO
-   50    CONTINUE
-         DO 70 J = 1, N
-            DO 60 I = 1, MIN( N, J+1 )
-               WORK( I ) = WORK( I ) + ABS( A( I, J ) )
-   60       CONTINUE
-   70    CONTINUE
-         VALUE = ZERO
-         DO 80 I = 1, N
-            VALUE = MAX( VALUE, WORK( I ) )
-   80    CONTINUE
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
-*
-*        Find normF(A).
-*
-         SCALE = ZERO
-         SUM = ONE
-         DO 90 J = 1, N
-            CALL ZLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM )
-   90    CONTINUE
-         VALUE = SCALE*SQRT( SUM )
-      END IF
-*
-      ZLANHS = VALUE
-      RETURN
-*
-*     End of ZLANHS
-*
-      END
diff --git a/src/lib/lapack/zlaqp2.f b/src/lib/lapack/zlaqp2.f
deleted file mode 100644
index 46f6d95c..00000000
--- a/src/lib/lapack/zlaqp2.f
+++ /dev/null
@@ -1,179 +0,0 @@
-      SUBROUTINE ZLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
-     $                   WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            LDA, M, N, OFFSET
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   VN1( * ), VN2( * )
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLAQP2 computes a QR factorization with column pivoting of
-*  the block A(OFFSET+1:M,1:N).
-*  The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A. N >= 0.
-*
-*  OFFSET  (input) INTEGER
-*          The number of rows of the matrix A that must be pivoted
-*          but no factorized. OFFSET >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, the upper triangle of block A(OFFSET+1:M,1:N) is
-*          the triangular factor obtained; the elements in block
-*          A(OFFSET+1:M,1:N) below the diagonal, together with the
-*          array TAU, represent the orthogonal matrix Q as a product of
-*          elementary reflectors. Block A(1:OFFSET,1:N) has been
-*          accordingly pivoted, but no factorized.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
-*          to the front of A*P (a leading column); if JPVT(i) = 0,
-*          the i-th column of A is a free column.
-*          On exit, if JPVT(i) = k, then the i-th column of A*P
-*          was the k-th column of A.
-*
-*  TAU     (output) COMPLEX*16 array, dimension (min(M,N))
-*          The scalar factors of the elementary reflectors.
-*
-*  VN1     (input/output) DOUBLE PRECISION array, dimension (N)
-*          The vector with the partial column norms.
-*
-*  VN2     (input/output) DOUBLE PRECISION array, dimension (N)
-*          The vector with the exact column norms.
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (N)
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*    X. Sun, Computer Science Dept., Duke University, USA
-*
-*  Partial column norm updating strategy modified by
-*    Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
-*    University of Zagreb, Croatia.
-*    June 2006.
-*  For more details see LAPACK Working Note 176.
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      COMPLEX*16         CONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0,
-     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ITEMP, J, MN, OFFPI, PVT
-      DOUBLE PRECISION   TEMP, TEMP2, TOL3Z
-      COMPLEX*16         AII
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZLARF, ZLARFG, ZSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DCONJG, MAX, MIN, SQRT
-*     ..
-*     .. External Functions ..
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH, DZNRM2
-      EXTERNAL           IDAMAX, DLAMCH, DZNRM2
-*     ..
-*     .. Executable Statements ..
-*
-      MN = MIN( M-OFFSET, N )
-      TOL3Z = SQRT(DLAMCH('Epsilon'))
-*
-*     Compute factorization.
-*
-      DO 20 I = 1, MN
-*
-         OFFPI = OFFSET + I
-*
-*        Determine ith pivot column and swap if necessary.
-*
-         PVT = ( I-1 ) + IDAMAX( N-I+1, VN1( I ), 1 )
-*
-         IF( PVT.NE.I ) THEN
-            CALL ZSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
-            ITEMP = JPVT( PVT )
-            JPVT( PVT ) = JPVT( I )
-            JPVT( I ) = ITEMP
-            VN1( PVT ) = VN1( I )
-            VN2( PVT ) = VN2( I )
-         END IF
-*
-*        Generate elementary reflector H(i).
-*
-         IF( OFFPI.LT.M ) THEN
-            CALL ZLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1,
-     $                   TAU( I ) )
-         ELSE
-            CALL ZLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) )
-         END IF
-*
-         IF( I.LT.N ) THEN
-*
-*           Apply H(i)' to A(offset+i:m,i+1:n) from the left.
-*
-            AII = A( OFFPI, I )
-            A( OFFPI, I ) = CONE
-            CALL ZLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
-     $                  DCONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA,
-     $                  WORK( 1 ) )
-            A( OFFPI, I ) = AII
-         END IF
-*
-*        Update partial column norms.
-*
-         DO 10 J = I + 1, N
-            IF( VN1( J ).NE.ZERO ) THEN
-*
-*              NOTE: The following 4 lines follow from the analysis in
-*              Lapack Working Note 176.
-*
-               TEMP = ONE - ( ABS( A( OFFPI, J ) ) / VN1( J ) )**2
-               TEMP = MAX( TEMP, ZERO )
-               TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
-               IF( TEMP2 .LE. TOL3Z ) THEN
-                  IF( OFFPI.LT.M ) THEN
-                     VN1( J ) = DZNRM2( M-OFFPI, A( OFFPI+1, J ), 1 )
-                     VN2( J ) = VN1( J )
-                  ELSE
-                     VN1( J ) = ZERO
-                     VN2( J ) = ZERO
-                  END IF
-               ELSE
-                  VN1( J ) = VN1( J )*SQRT( TEMP )
-               END IF
-            END IF
-   10    CONTINUE
-*
-   20 CONTINUE
-*
-      RETURN
-*
-*     End of ZLAQP2
-*
-      END
diff --git a/src/lib/lapack/zlaqps.f b/src/lib/lapack/zlaqps.f
deleted file mode 100644
index 40414503..00000000
--- a/src/lib/lapack/zlaqps.f
+++ /dev/null
@@ -1,266 +0,0 @@
-      SUBROUTINE ZLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1,
-     $                   VN2, AUXV, F, LDF )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            KB, LDA, LDF, M, N, NB, OFFSET
-*     ..
-*     .. Array Arguments ..
-      INTEGER            JPVT( * )
-      DOUBLE PRECISION   VN1( * ), VN2( * )
-      COMPLEX*16         A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLAQPS computes a step of QR factorization with column pivoting
-*  of a complex M-by-N matrix A by using Blas-3.  It tries to factorize
-*  NB columns from A starting from the row OFFSET+1, and updates all
-*  of the matrix with Blas-3 xGEMM.
-*
-*  In some cases, due to catastrophic cancellations, it cannot
-*  factorize NB columns.  Hence, the actual number of factorized
-*  columns is returned in KB.
-*
-*  Block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A. N >= 0
-*
-*  OFFSET  (input) INTEGER
-*          The number of rows of A that have been factorized in
-*          previous steps.
-*
-*  NB      (input) INTEGER
-*          The number of columns to factorize.
-*
-*  KB      (output) INTEGER
-*          The number of columns actually factorized.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the M-by-N matrix A.
-*          On exit, block A(OFFSET+1:M,1:KB) is the triangular
-*          factor obtained and block A(1:OFFSET,1:N) has been
-*          accordingly pivoted, but no factorized.
-*          The rest of the matrix, block A(OFFSET+1:M,KB+1:N) has
-*          been updated.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  JPVT    (input/output) INTEGER array, dimension (N)
-*          JPVT(I) = K <==> Column K of the full matrix A has been
-*          permuted into position I in AP.
-*
-*  TAU     (output) COMPLEX*16 array, dimension (KB)
-*          The scalar factors of the elementary reflectors.
-*
-*  VN1     (input/output) DOUBLE PRECISION array, dimension (N)
-*          The vector with the partial column norms.
-*
-*  VN2     (input/output) DOUBLE PRECISION array, dimension (N)
-*          The vector with the exact column norms.
-*
-*  AUXV    (input/output) COMPLEX*16 array, dimension (NB)
-*          Auxiliar vector.
-*
-*  F       (input/output) COMPLEX*16 array, dimension (LDF,NB)
-*          Matrix F' = L*Y'*A.
-*
-*  LDF     (input) INTEGER
-*          The leading dimension of the array F. LDF >= max(1,N).
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
-*    X. Sun, Computer Science Dept., Duke University, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      COMPLEX*16         CZERO, CONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0,
-     $                   CZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            ITEMP, J, K, LASTRK, LSTICC, PVT, RK
-      DOUBLE PRECISION   TEMP, TEMP2, TOL3Z
-      COMPLEX*16         AKK
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZGEMM, ZGEMV, ZLARFG, ZSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCONJG, MAX, MIN, NINT, SQRT
-*     ..
-*     .. External Functions ..
-      INTEGER            IDAMAX
-      DOUBLE PRECISION   DLAMCH, DZNRM2
-      EXTERNAL           IDAMAX, DLAMCH, DZNRM2
-*     ..
-*     .. Executable Statements ..
-*
-      LASTRK = MIN( M, N+OFFSET )
-      LSTICC = 0
-      K = 0
-      TOL3Z = SQRT(DLAMCH('Epsilon'))
-*
-*     Beginning of while loop.
-*
-   10 CONTINUE
-      IF( ( K.LT.NB ) .AND. ( LSTICC.EQ.0 ) ) THEN
-         K = K + 1
-         RK = OFFSET + K
-*
-*        Determine ith pivot column and swap if necessary
-*
-         PVT = ( K-1 ) + IDAMAX( N-K+1, VN1( K ), 1 )
-         IF( PVT.NE.K ) THEN
-            CALL ZSWAP( M, A( 1, PVT ), 1, A( 1, K ), 1 )
-            CALL ZSWAP( K-1, F( PVT, 1 ), LDF, F( K, 1 ), LDF )
-            ITEMP = JPVT( PVT )
-            JPVT( PVT ) = JPVT( K )
-            JPVT( K ) = ITEMP
-            VN1( PVT ) = VN1( K )
-            VN2( PVT ) = VN2( K )
-         END IF
-*
-*        Apply previous Householder reflectors to column K:
-*        A(RK:M,K) := A(RK:M,K) - A(RK:M,1:K-1)*F(K,1:K-1)'.
-*
-         IF( K.GT.1 ) THEN
-            DO 20 J = 1, K - 1
-               F( K, J ) = DCONJG( F( K, J ) )
-   20       CONTINUE
-            CALL ZGEMV( 'No transpose', M-RK+1, K-1, -CONE, A( RK, 1 ),
-     $                  LDA, F( K, 1 ), LDF, CONE, A( RK, K ), 1 )
-            DO 30 J = 1, K - 1
-               F( K, J ) = DCONJG( F( K, J ) )
-   30       CONTINUE
-         END IF
-*
-*        Generate elementary reflector H(k).
-*
-         IF( RK.LT.M ) THEN
-            CALL ZLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, TAU( K ) )
-         ELSE
-            CALL ZLARFG( 1, A( RK, K ), A( RK, K ), 1, TAU( K ) )
-         END IF
-*
-         AKK = A( RK, K )
-         A( RK, K ) = CONE
-*
-*        Compute Kth column of F:
-*
-*        Compute  F(K+1:N,K) := tau(K)*A(RK:M,K+1:N)'*A(RK:M,K).
-*
-         IF( K.LT.N ) THEN
-            CALL ZGEMV( 'Conjugate transpose', M-RK+1, N-K, TAU( K ),
-     $                  A( RK, K+1 ), LDA, A( RK, K ), 1, CZERO,
-     $                  F( K+1, K ), 1 )
-         END IF
-*
-*        Padding F(1:K,K) with zeros.
-*
-         DO 40 J = 1, K
-            F( J, K ) = CZERO
-   40    CONTINUE
-*
-*        Incremental updating of F:
-*        F(1:N,K) := F(1:N,K) - tau(K)*F(1:N,1:K-1)*A(RK:M,1:K-1)'
-*                    *A(RK:M,K).
-*
-         IF( K.GT.1 ) THEN
-            CALL ZGEMV( 'Conjugate transpose', M-RK+1, K-1, -TAU( K ),
-     $                  A( RK, 1 ), LDA, A( RK, K ), 1, CZERO,
-     $                  AUXV( 1 ), 1 )
-*
-            CALL ZGEMV( 'No transpose', N, K-1, CONE, F( 1, 1 ), LDF,
-     $                  AUXV( 1 ), 1, CONE, F( 1, K ), 1 )
-         END IF
-*
-*        Update the current row of A:
-*        A(RK,K+1:N) := A(RK,K+1:N) - A(RK,1:K)*F(K+1:N,1:K)'.
-*
-         IF( K.LT.N ) THEN
-            CALL ZGEMM( 'No transpose', 'Conjugate transpose', 1, N-K,
-     $                  K, -CONE, A( RK, 1 ), LDA, F( K+1, 1 ), LDF,
-     $                  CONE, A( RK, K+1 ), LDA )
-         END IF
-*
-*        Update partial column norms.
-*
-         IF( RK.LT.LASTRK ) THEN
-            DO 50 J = K + 1, N
-               IF( VN1( J ).NE.ZERO ) THEN
-*
-*                 NOTE: The following 4 lines follow from the analysis in
-*                 Lapack Working Note 176.
-*
-                  TEMP = ABS( A( RK, J ) ) / VN1( J )
-                  TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
-                  TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
-                  IF( TEMP2 .LE. TOL3Z ) THEN
-                     VN2( J ) = DBLE( LSTICC )
-                     LSTICC = J
-                  ELSE
-                     VN1( J ) = VN1( J )*SQRT( TEMP )
-                  END IF
-               END IF
-   50       CONTINUE
-         END IF
-*
-         A( RK, K ) = AKK
-*
-*        End of while loop.
-*
-         GO TO 10
-      END IF
-      KB = K
-      RK = OFFSET + KB
-*
-*     Apply the block reflector to the rest of the matrix:
-*     A(OFFSET+KB+1:M,KB+1:N) := A(OFFSET+KB+1:M,KB+1:N) -
-*                         A(OFFSET+KB+1:M,1:KB)*F(KB+1:N,1:KB)'.
-*
-      IF( KB.LT.MIN( N, M-OFFSET ) ) THEN
-         CALL ZGEMM( 'No transpose', 'Conjugate transpose', M-RK, N-KB,
-     $               KB, -CONE, A( RK+1, 1 ), LDA, F( KB+1, 1 ), LDF,
-     $               CONE, A( RK+1, KB+1 ), LDA )
-      END IF
-*
-*     Recomputation of difficult columns.
-*
-   60 CONTINUE
-      IF( LSTICC.GT.0 ) THEN
-         ITEMP = NINT( VN2( LSTICC ) )
-         VN1( LSTICC ) = DZNRM2( M-RK, A( RK+1, LSTICC ), 1 )
-*
-*        NOTE: The computation of VN1( LSTICC ) relies on the fact that 
-*        SNRM2 does not fail on vectors with norm below the value of
-*        SQRT(DLAMCH('S')) 
-*
-         VN2( LSTICC ) = VN1( LSTICC )
-         LSTICC = ITEMP
-         GO TO 60
-      END IF
-*
-      RETURN
-*
-*     End of ZLAQPS
-*
-      END
diff --git a/src/lib/lapack/zlaqr0.f b/src/lib/lapack/zlaqr0.f
deleted file mode 100644
index 2a35a725..00000000
--- a/src/lib/lapack/zlaqr0.f
+++ /dev/null
@@ -1,601 +0,0 @@
-      SUBROUTINE ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ,
-     $                   IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
-*     ..
-*
-*     Purpose
-*     =======
-*
-*     ZLAQR0 computes the eigenvalues of a Hessenberg matrix H
-*     and, optionally, the matrices T and Z from the Schur decomposition
-*     H = Z T Z**H, where T is an upper triangular matrix (the
-*     Schur form), and Z is the unitary matrix of Schur vectors.
-*
-*     Optionally Z may be postmultiplied into an input unitary
-*     matrix Q so that this routine can give the Schur factorization
-*     of a matrix A which has been reduced to the Hessenberg form H
-*     by the unitary matrix Q:  A = Q*H*Q**H = (QZ)*H*(QZ)**H.
-*
-*     Arguments
-*     =========
-*
-*     WANTT   (input) LOGICAL
-*          = .TRUE. : the full Schur form T is required;
-*          = .FALSE.: only eigenvalues are required.
-*
-*     WANTZ   (input) LOGICAL
-*          = .TRUE. : the matrix of Schur vectors Z is required;
-*          = .FALSE.: Schur vectors are not required.
-*
-*     N     (input) INTEGER
-*           The order of the matrix H.  N .GE. 0.
-*
-*     ILO   (input) INTEGER
-*     IHI   (input) INTEGER
-*           It is assumed that H is already upper triangular in rows
-*           and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
-*           H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
-*           previous call to ZGEBAL, and then passed to ZGEHRD when the
-*           matrix output by ZGEBAL is reduced to Hessenberg form.
-*           Otherwise, ILO and IHI should be set to 1 and N,
-*           respectively.  If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*           If N = 0, then ILO = 1 and IHI = 0.
-*
-*     H     (input/output) COMPLEX*16 array, dimension (LDH,N)
-*           On entry, the upper Hessenberg matrix H.
-*           On exit, if INFO = 0 and WANTT is .TRUE., then H
-*           contains the upper triangular matrix T from the Schur
-*           decomposition (the Schur form). If INFO = 0 and WANT is
-*           .FALSE., then the contents of H are unspecified on exit.
-*           (The output value of H when INFO.GT.0 is given under the
-*           description of INFO below.)
-*
-*           This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
-*           j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
-*
-*     LDH   (input) INTEGER
-*           The leading dimension of the array H. LDH .GE. max(1,N).
-*
-*     W        (output) COMPLEX*16 array, dimension (N)
-*           The computed eigenvalues of H(ILO:IHI,ILO:IHI) are stored
-*           in W(ILO:IHI). If WANTT is .TRUE., then the eigenvalues are
-*           stored in the same order as on the diagonal of the Schur
-*           form returned in H, with W(i) = H(i,i).
-*
-*     Z     (input/output) COMPLEX*16 array, dimension (LDZ,IHI)
-*           If WANTZ is .FALSE., then Z is not referenced.
-*           If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
-*           replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
-*           orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
-*           (The output value of Z when INFO.GT.0 is given under
-*           the description of INFO below.)
-*
-*     LDZ   (input) INTEGER
-*           The leading dimension of the array Z.  if WANTZ is .TRUE.
-*           then LDZ.GE.MAX(1,IHIZ).  Otherwize, LDZ.GE.1.
-*
-*     WORK  (workspace/output) COMPLEX*16 array, dimension LWORK
-*           On exit, if LWORK = -1, WORK(1) returns an estimate of
-*           the optimal value for LWORK.
-*
-*     LWORK (input) INTEGER
-*           The dimension of the array WORK.  LWORK .GE. max(1,N)
-*           is sufficient, but LWORK typically as large as 6*N may
-*           be required for optimal performance.  A workspace query
-*           to determine the optimal workspace size is recommended.
-*
-*           If LWORK = -1, then ZLAQR0 does a workspace query.
-*           In this case, ZLAQR0 checks the input parameters and
-*           estimates the optimal workspace size for the given
-*           values of N, ILO and IHI.  The estimate is returned
-*           in WORK(1).  No error message related to LWORK is
-*           issued by XERBLA.  Neither H nor Z are accessed.
-*
-*
-*     INFO  (output) INTEGER
-*             =  0:  successful exit
-*           .GT. 0:  if INFO = i, ZLAQR0 failed to compute all of
-*                the eigenvalues.  Elements 1:ilo-1 and i+1:n of WR
-*                and WI contain those eigenvalues which have been
-*                successfully computed.  (Failures are rare.)
-*
-*                If INFO .GT. 0 and WANT is .FALSE., then on exit,
-*                the remaining unconverged eigenvalues are the eigen-
-*                values of the upper Hessenberg matrix rows and
-*                columns ILO through INFO of the final, output
-*                value of H.
-*
-*                If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*
-*           (*)  (initial value of H)*U  = U*(final value of H)
-*
-*                where U is a unitary matrix.  The final
-*                value of  H is upper Hessenberg and triangular in
-*                rows and columns INFO+1 through IHI.
-*
-*                If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*
-*                  (final value of Z(ILO:IHI,ILOZ:IHIZ)
-*                   =  (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
-*
-*                where U is the unitary matrix in (*) (regard-
-*                less of the value of WANTT.)
-*
-*                If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
-*                accessed.
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ================================================================
-*     References:
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*       Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*       929--947, 2002.
-*
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*       of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-*     ================================================================
-*     .. Parameters ..
-*
-*     ==== Matrices of order NTINY or smaller must be processed by
-*     .    ZLAHQR because of insufficient subdiagonal scratch space.
-*     .    (This is a hard limit.) ====
-*
-*     ==== Exceptional deflation windows:  try to cure rare
-*     .    slow convergence by increasing the size of the
-*     .    deflation window after KEXNW iterations. =====
-*
-*     ==== Exceptional shifts: try to cure rare slow convergence
-*     .    with ad-hoc exceptional shifts every KEXSH iterations.
-*     .    The constants WILK1 and WILK2 are used to form the
-*     .    exceptional shifts. ====
-*
-      INTEGER            NTINY
-      PARAMETER          ( NTINY = 11 )
-      INTEGER            KEXNW, KEXSH
-      PARAMETER          ( KEXNW = 5, KEXSH = 6 )
-      DOUBLE PRECISION   WILK1
-      PARAMETER          ( WILK1 = 0.75d0 )
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ),
-     $                   ONE = ( 1.0d0, 0.0d0 ) )
-      DOUBLE PRECISION   TWO
-      PARAMETER          ( TWO = 2.0d0 )
-*     ..
-*     .. Local Scalars ..
-      COMPLEX*16         AA, BB, CC, CDUM, DD, DET, RTDISC, SWAP, TR2
-      DOUBLE PRECISION   S
-      INTEGER            I, INF, IT, ITMAX, K, KACC22, KBOT, KDU, KS,
-     $                   KT, KTOP, KU, KV, KWH, KWTOP, KWV, LD, LS,
-     $                   LWKOPT, NDFL, NH, NHO, NIBBLE, NMIN, NS, NSMAX,
-     $                   NSR, NVE, NW, NWMAX, NWR
-      LOGICAL            NWINC, SORTED
-      CHARACTER          JBCMPZ*2
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Local Arrays ..
-      COMPLEX*16         ZDUM( 1, 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZLACPY, ZLAHQR, ZLAQR3, ZLAQR4, ZLAQR5
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DIMAG, INT, MAX, MIN, MOD,
-     $                   SQRT
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
-*     ..
-*     .. Executable Statements ..
-      INFO = 0
-*
-*     ==== Quick return for N = 0: nothing to do. ====
-*
-      IF( N.EQ.0 ) THEN
-         WORK( 1 ) = ONE
-         RETURN
-      END IF
-*
-*     ==== Set up job flags for ILAENV. ====
-*
-      IF( WANTT ) THEN
-         JBCMPZ( 1: 1 ) = 'S'
-      ELSE
-         JBCMPZ( 1: 1 ) = 'E'
-      END IF
-      IF( WANTZ ) THEN
-         JBCMPZ( 2: 2 ) = 'V'
-      ELSE
-         JBCMPZ( 2: 2 ) = 'N'
-      END IF
-*
-*     ==== Tiny matrices must use ZLAHQR. ====
-*
-      IF( N.LE.NTINY ) THEN
-*
-*        ==== Estimate optimal workspace. ====
-*
-         LWKOPT = 1
-         IF( LWORK.NE.-1 )
-     $      CALL ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ,
-     $                   IHIZ, Z, LDZ, INFO )
-      ELSE
-*
-*        ==== Use small bulge multi-shift QR with aggressive early
-*        .    deflation on larger-than-tiny matrices. ====
-*
-*        ==== Hope for the best. ====
-*
-         INFO = 0
-*
-*        ==== NWR = recommended deflation window size.  At this
-*        .    point,  N .GT. NTINY = 11, so there is enough
-*        .    subdiagonal workspace for NWR.GE.2 as required.
-*        .    (In fact, there is enough subdiagonal space for
-*        .    NWR.GE.3.) ====
-*
-         NWR = ILAENV( 13, 'ZLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
-         NWR = MAX( 2, NWR )
-         NWR = MIN( IHI-ILO+1, ( N-1 ) / 3, NWR )
-         NW = NWR
-*
-*        ==== NSR = recommended number of simultaneous shifts.
-*        .    At this point N .GT. NTINY = 11, so there is at
-*        .    enough subdiagonal workspace for NSR to be even
-*        .    and greater than or equal to two as required. ====
-*
-         NSR = ILAENV( 15, 'ZLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
-         NSR = MIN( NSR, ( N+6 ) / 9, IHI-ILO )
-         NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
-*
-*        ==== Estimate optimal workspace ====
-*
-*        ==== Workspace query call to ZLAQR3 ====
-*
-         CALL ZLAQR3( WANTT, WANTZ, N, ILO, IHI, NWR+1, H, LDH, ILOZ,
-     $                IHIZ, Z, LDZ, LS, LD, W, H, LDH, N, H, LDH, N, H,
-     $                LDH, WORK, -1 )
-*
-*        ==== Optimal workspace = MAX(ZLAQR5, ZLAQR3) ====
-*
-         LWKOPT = MAX( 3*NSR / 2, INT( WORK( 1 ) ) )
-*
-*        ==== Quick return in case of workspace query. ====
-*
-         IF( LWORK.EQ.-1 ) THEN
-            WORK( 1 ) = DCMPLX( LWKOPT, 0 )
-            RETURN
-         END IF
-*
-*        ==== ZLAHQR/ZLAQR0 crossover point ====
-*
-         NMIN = ILAENV( 12, 'ZLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
-         NMIN = MAX( NTINY, NMIN )
-*
-*        ==== Nibble crossover point ====
-*
-         NIBBLE = ILAENV( 14, 'ZLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
-         NIBBLE = MAX( 0, NIBBLE )
-*
-*        ==== Accumulate reflections during ttswp?  Use block
-*        .    2-by-2 structure during matrix-matrix multiply? ====
-*
-         KACC22 = ILAENV( 16, 'ZLAQR0', JBCMPZ, N, ILO, IHI, LWORK )
-         KACC22 = MAX( 0, KACC22 )
-         KACC22 = MIN( 2, KACC22 )
-*
-*        ==== NWMAX = the largest possible deflation window for
-*        .    which there is sufficient workspace. ====
-*
-         NWMAX = MIN( ( N-1 ) / 3, LWORK / 2 )
-*
-*        ==== NSMAX = the Largest number of simultaneous shifts
-*        .    for which there is sufficient workspace. ====
-*
-         NSMAX = MIN( ( N+6 ) / 9, 2*LWORK / 3 )
-         NSMAX = NSMAX - MOD( NSMAX, 2 )
-*
-*        ==== NDFL: an iteration count restarted at deflation. ====
-*
-         NDFL = 1
-*
-*        ==== ITMAX = iteration limit ====
-*
-         ITMAX = MAX( 30, 2*KEXSH )*MAX( 10, ( IHI-ILO+1 ) )
-*
-*        ==== Last row and column in the active block ====
-*
-         KBOT = IHI
-*
-*        ==== Main Loop ====
-*
-         DO 70 IT = 1, ITMAX
-*
-*           ==== Done when KBOT falls below ILO ====
-*
-            IF( KBOT.LT.ILO )
-     $         GO TO 80
-*
-*           ==== Locate active block ====
-*
-            DO 10 K = KBOT, ILO + 1, -1
-               IF( H( K, K-1 ).EQ.ZERO )
-     $            GO TO 20
-   10       CONTINUE
-            K = ILO
-   20       CONTINUE
-            KTOP = K
-*
-*           ==== Select deflation window size ====
-*
-            NH = KBOT - KTOP + 1
-            IF( NDFL.LT.KEXNW .OR. NH.LT.NW ) THEN
-*
-*              ==== Typical deflation window.  If possible and
-*              .    advisable, nibble the entire active block.
-*              .    If not, use size NWR or NWR+1 depending upon
-*              .    which has the smaller corresponding subdiagonal
-*              .    entry (a heuristic). ====
-*
-               NWINC = .TRUE.
-               IF( NH.LE.MIN( NMIN, NWMAX ) ) THEN
-                  NW = NH
-               ELSE
-                  NW = MIN( NWR, NH, NWMAX )
-                  IF( NW.LT.NWMAX ) THEN
-                     IF( NW.GE.NH-1 ) THEN
-                        NW = NH
-                     ELSE
-                        KWTOP = KBOT - NW + 1
-                        IF( CABS1( H( KWTOP, KWTOP-1 ) ).GT.
-     $                      CABS1( H( KWTOP-1, KWTOP-2 ) ) )NW = NW + 1
-                     END IF
-                  END IF
-               END IF
-            ELSE
-*
-*              ==== Exceptional deflation window.  If there have
-*              .    been no deflations in KEXNW or more iterations,
-*              .    then vary the deflation window size.   At first,
-*              .    because, larger windows are, in general, more
-*              .    powerful than smaller ones, rapidly increase the
-*              .    window up to the maximum reasonable and possible.
-*              .    Then maybe try a slightly smaller window.  ====
-*
-               IF( NWINC .AND. NW.LT.MIN( NWMAX, NH ) ) THEN
-                  NW = MIN( NWMAX, NH, 2*NW )
-               ELSE
-                  NWINC = .FALSE.
-                  IF( NW.EQ.NH .AND. NH.GT.2 )
-     $               NW = NH - 1
-               END IF
-            END IF
-*
-*           ==== Aggressive early deflation:
-*           .    split workspace under the subdiagonal into
-*           .      - an nw-by-nw work array V in the lower
-*           .        left-hand-corner,
-*           .      - an NW-by-at-least-NW-but-more-is-better
-*           .        (NW-by-NHO) horizontal work array along
-*           .        the bottom edge,
-*           .      - an at-least-NW-but-more-is-better (NHV-by-NW)
-*           .        vertical work array along the left-hand-edge.
-*           .        ====
-*
-            KV = N - NW + 1
-            KT = NW + 1
-            NHO = ( N-NW-1 ) - KT + 1
-            KWV = NW + 2
-            NVE = ( N-NW ) - KWV + 1
-*
-*           ==== Aggressive early deflation ====
-*
-            CALL ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-     $                   IHIZ, Z, LDZ, LS, LD, W, H( KV, 1 ), LDH, NHO,
-     $                   H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, WORK,
-     $                   LWORK )
-*
-*           ==== Adjust KBOT accounting for new deflations. ====
-*
-            KBOT = KBOT - LD
-*
-*           ==== KS points to the shifts. ====
-*
-            KS = KBOT - LS + 1
-*
-*           ==== Skip an expensive QR sweep if there is a (partly
-*           .    heuristic) reason to expect that many eigenvalues
-*           .    will deflate without it.  Here, the QR sweep is
-*           .    skipped if many eigenvalues have just been deflated
-*           .    or if the remaining active block is small.
-*
-            IF( ( LD.EQ.0 ) .OR. ( ( 100*LD.LE.NW*NIBBLE ) .AND. ( KBOT-
-     $          KTOP+1.GT.MIN( NMIN, NWMAX ) ) ) ) THEN
-*
-*              ==== NS = nominal number of simultaneous shifts.
-*              .    This may be lowered (slightly) if ZLAQR3
-*              .    did not provide that many shifts. ====
-*
-               NS = MIN( NSMAX, NSR, MAX( 2, KBOT-KTOP ) )
-               NS = NS - MOD( NS, 2 )
-*
-*              ==== If there have been no deflations
-*              .    in a multiple of KEXSH iterations,
-*              .    then try exceptional shifts.
-*              .    Otherwise use shifts provided by
-*              .    ZLAQR3 above or from the eigenvalues
-*              .    of a trailing principal submatrix. ====
-*
-               IF( MOD( NDFL, KEXSH ).EQ.0 ) THEN
-                  KS = KBOT - NS + 1
-                  DO 30 I = KBOT, KS + 1, -2
-                     W( I ) = H( I, I ) + WILK1*CABS1( H( I, I-1 ) )
-                     W( I-1 ) = W( I )
-   30             CONTINUE
-               ELSE
-*
-*                 ==== Got NS/2 or fewer shifts? Use ZLAQR4 or
-*                 .    ZLAHQR on a trailing principal submatrix to
-*                 .    get more. (Since NS.LE.NSMAX.LE.(N+6)/9,
-*                 .    there is enough space below the subdiagonal
-*                 .    to fit an NS-by-NS scratch array.) ====
-*
-                  IF( KBOT-KS+1.LE.NS / 2 ) THEN
-                     KS = KBOT - NS + 1
-                     KT = N - NS + 1
-                     CALL ZLACPY( 'A', NS, NS, H( KS, KS ), LDH,
-     $                            H( KT, 1 ), LDH )
-                     IF( NS.GT.NMIN ) THEN
-                        CALL ZLAQR4( .false., .false., NS, 1, NS,
-     $                               H( KT, 1 ), LDH, W( KS ), 1, 1,
-     $                               ZDUM, 1, WORK, LWORK, INF )
-                     ELSE
-                        CALL ZLAHQR( .false., .false., NS, 1, NS,
-     $                               H( KT, 1 ), LDH, W( KS ), 1, 1,
-     $                               ZDUM, 1, INF )
-                     END IF
-                     KS = KS + INF
-*
-*                    ==== In case of a rare QR failure use
-*                    .    eigenvalues of the trailing 2-by-2
-*                    .    principal submatrix.  Scale to avoid
-*                    .    overflows, underflows and subnormals.
-*                    .    (The scale factor S can not be zero,
-*                    .    because H(KBOT,KBOT-1) is nonzero.) ====
-*
-                     IF( KS.GE.KBOT ) THEN
-                        S = CABS1( H( KBOT-1, KBOT-1 ) ) +
-     $                      CABS1( H( KBOT, KBOT-1 ) ) +
-     $                      CABS1( H( KBOT-1, KBOT ) ) +
-     $                      CABS1( H( KBOT, KBOT ) )
-                        AA = H( KBOT-1, KBOT-1 ) / S
-                        CC = H( KBOT, KBOT-1 ) / S
-                        BB = H( KBOT-1, KBOT ) / S
-                        DD = H( KBOT, KBOT ) / S
-                        TR2 = ( AA+DD ) / TWO
-                        DET = ( AA-TR2 )*( DD-TR2 ) - BB*CC
-                        RTDISC = SQRT( -DET )
-                        W( KBOT-1 ) = ( TR2+RTDISC )*S
-                        W( KBOT ) = ( TR2-RTDISC )*S
-*
-                        KS = KBOT - 1
-                     END IF
-                  END IF
-*
-                  IF( KBOT-KS+1.GT.NS ) THEN
-*
-*                    ==== Sort the shifts (Helps a little) ====
-*
-                     SORTED = .false.
-                     DO 50 K = KBOT, KS + 1, -1
-                        IF( SORTED )
-     $                     GO TO 60
-                        SORTED = .true.
-                        DO 40 I = KS, K - 1
-                           IF( CABS1( W( I ) ).LT.CABS1( W( I+1 ) ) )
-     $                          THEN
-                              SORTED = .false.
-                              SWAP = W( I )
-                              W( I ) = W( I+1 )
-                              W( I+1 ) = SWAP
-                           END IF
-   40                   CONTINUE
-   50                CONTINUE
-   60                CONTINUE
-                  END IF
-               END IF
-*
-*              ==== If there are only two shifts, then use
-*              .    only one.  ====
-*
-               IF( KBOT-KS+1.EQ.2 ) THEN
-                  IF( CABS1( W( KBOT )-H( KBOT, KBOT ) ).LT.
-     $                CABS1( W( KBOT-1 )-H( KBOT, KBOT ) ) ) THEN
-                     W( KBOT-1 ) = W( KBOT )
-                  ELSE
-                     W( KBOT ) = W( KBOT-1 )
-                  END IF
-               END IF
-*
-*              ==== Use up to NS of the the smallest magnatiude
-*              .    shifts.  If there aren't NS shifts available,
-*              .    then use them all, possibly dropping one to
-*              .    make the number of shifts even. ====
-*
-               NS = MIN( NS, KBOT-KS+1 )
-               NS = NS - MOD( NS, 2 )
-               KS = KBOT - NS + 1
-*
-*              ==== Small-bulge multi-shift QR sweep:
-*              .    split workspace under the subdiagonal into
-*              .    - a KDU-by-KDU work array U in the lower
-*              .      left-hand-corner,
-*              .    - a KDU-by-at-least-KDU-but-more-is-better
-*              .      (KDU-by-NHo) horizontal work array WH along
-*              .      the bottom edge,
-*              .    - and an at-least-KDU-but-more-is-better-by-KDU
-*              .      (NVE-by-KDU) vertical work WV arrow along
-*              .      the left-hand-edge. ====
-*
-               KDU = 3*NS - 3
-               KU = N - KDU + 1
-               KWH = KDU + 1
-               NHO = ( N-KDU+1-4 ) - ( KDU+1 ) + 1
-               KWV = KDU + 4
-               NVE = N - KDU - KWV + 1
-*
-*              ==== Small-bulge multi-shift QR sweep ====
-*
-               CALL ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NS,
-     $                      W( KS ), H, LDH, ILOZ, IHIZ, Z, LDZ, WORK,
-     $                      3, H( KU, 1 ), LDH, NVE, H( KWV, 1 ), LDH,
-     $                      NHO, H( KU, KWH ), LDH )
-            END IF
-*
-*           ==== Note progress (or the lack of it). ====
-*
-            IF( LD.GT.0 ) THEN
-               NDFL = 1
-            ELSE
-               NDFL = NDFL + 1
-            END IF
-*
-*           ==== End of main loop ====
-   70    CONTINUE
-*
-*        ==== Iteration limit exceeded.  Set INFO to show where
-*        .    the problem occurred and exit. ====
-*
-         INFO = KBOT
-   80    CONTINUE
-      END IF
-*
-*     ==== Return the optimal value of LWORK. ====
-*
-      WORK( 1 ) = DCMPLX( LWKOPT, 0 )
-*
-*     ==== End of ZLAQR0 ====
-*
-      END
diff --git a/src/lib/lapack/zlaqr1.f b/src/lib/lapack/zlaqr1.f
deleted file mode 100644
index b8c1c3d4..00000000
--- a/src/lib/lapack/zlaqr1.f
+++ /dev/null
@@ -1,97 +0,0 @@
-      SUBROUTINE ZLAQR1( N, H, LDH, S1, S2, V )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      COMPLEX*16         S1, S2
-      INTEGER            LDH, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         H( LDH, * ), V( * )
-*     ..
-*
-*       Given a 2-by-2 or 3-by-3 matrix H, ZLAQR1 sets v to a
-*       scalar multiple of the first column of the product
-*
-*       (*)  K = (H - s1*I)*(H - s2*I)
-*
-*       scaling to avoid overflows and most underflows.
-*
-*       This is useful for starting double implicit shift bulges
-*       in the QR algorithm.
-*
-*
-*       N      (input) integer
-*              Order of the matrix H. N must be either 2 or 3.
-*
-*       H      (input) COMPLEX*16 array of dimension (LDH,N)
-*              The 2-by-2 or 3-by-3 matrix H in (*).
-*
-*       LDH    (input) integer
-*              The leading dimension of H as declared in
-*              the calling procedure.  LDH.GE.N
-*
-*       S1     (input) COMPLEX*16
-*       S2     S1 and S2 are the shifts defining K in (*) above.
-*
-*       V      (output) COMPLEX*16 array of dimension N
-*              A scalar multiple of the first column of the
-*              matrix K in (*).
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO
-      PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ) )
-      DOUBLE PRECISION   RZERO
-      PARAMETER          ( RZERO = 0.0d0 )
-*     ..
-*     .. Local Scalars ..
-      COMPLEX*16         CDUM
-      DOUBLE PRECISION   H21S, H31S, S
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DIMAG
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
-*     ..
-*     .. Executable Statements ..
-      IF( N.EQ.2 ) THEN
-         S = CABS1( H( 1, 1 )-S2 ) + CABS1( H( 2, 1 ) )
-         IF( S.EQ.RZERO ) THEN
-            V( 1 ) = ZERO
-            V( 2 ) = ZERO
-         ELSE
-            H21S = H( 2, 1 ) / S
-            V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-S1 )*
-     $               ( ( H( 1, 1 )-S2 ) / S )
-            V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-S1-S2 )
-         END IF
-      ELSE
-         S = CABS1( H( 1, 1 )-S2 ) + CABS1( H( 2, 1 ) ) +
-     $       CABS1( H( 3, 1 ) )
-         IF( S.EQ.ZERO ) THEN
-            V( 1 ) = ZERO
-            V( 2 ) = ZERO
-            V( 3 ) = ZERO
-         ELSE
-            H21S = H( 2, 1 ) / S
-            H31S = H( 3, 1 ) / S
-            V( 1 ) = ( H( 1, 1 )-S1 )*( ( H( 1, 1 )-S2 ) / S ) +
-     $               H( 1, 2 )*H21S + H( 1, 3 )*H31S
-            V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-S1-S2 ) + H( 2, 3 )*H31S
-            V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-S1-S2 ) + H21S*H( 3, 2 )
-         END IF
-      END IF
-      END
diff --git a/src/lib/lapack/zlaqr2.f b/src/lib/lapack/zlaqr2.f
deleted file mode 100644
index 0add51ae..00000000
--- a/src/lib/lapack/zlaqr2.f
+++ /dev/null
@@ -1,437 +0,0 @@
-      SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-     $                   IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
-     $                   NV, WV, LDWV, WORK, LWORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
-     $                   LDZ, LWORK, N, ND, NH, NS, NV, NW
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         H( LDH, * ), SH( * ), T( LDT, * ), V( LDV, * ),
-     $                   WORK( * ), WV( LDWV, * ), Z( LDZ, * )
-*     ..
-*
-*     This subroutine is identical to ZLAQR3 except that it avoids
-*     recursion by calling ZLAHQR instead of ZLAQR4.
-*
-*
-*     ******************************************************************
-*     Aggressive early deflation:
-*
-*     This subroutine accepts as input an upper Hessenberg matrix
-*     H and performs an unitary similarity transformation
-*     designed to detect and deflate fully converged eigenvalues from
-*     a trailing principal submatrix.  On output H has been over-
-*     written by a new Hessenberg matrix that is a perturbation of
-*     an unitary similarity transformation of H.  It is to be
-*     hoped that the final version of H has many zero subdiagonal
-*     entries.
-*
-*     ******************************************************************
-*     WANTT   (input) LOGICAL
-*          If .TRUE., then the Hessenberg matrix H is fully updated
-*          so that the triangular Schur factor may be
-*          computed (in cooperation with the calling subroutine).
-*          If .FALSE., then only enough of H is updated to preserve
-*          the eigenvalues.
-*
-*     WANTZ   (input) LOGICAL
-*          If .TRUE., then the unitary matrix Z is updated so
-*          so that the unitary Schur factor may be computed
-*          (in cooperation with the calling subroutine).
-*          If .FALSE., then Z is not referenced.
-*
-*     N       (input) INTEGER
-*          The order of the matrix H and (if WANTZ is .TRUE.) the
-*          order of the unitary matrix Z.
-*
-*     KTOP    (input) INTEGER
-*          It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
-*          KBOT and KTOP together determine an isolated block
-*          along the diagonal of the Hessenberg matrix.
-*
-*     KBOT    (input) INTEGER
-*          It is assumed without a check that either
-*          KBOT = N or H(KBOT+1,KBOT)=0.  KBOT and KTOP together
-*          determine an isolated block along the diagonal of the
-*          Hessenberg matrix.
-*
-*     NW      (input) INTEGER
-*          Deflation window size.  1 .LE. NW .LE. (KBOT-KTOP+1).
-*
-*     H       (input/output) COMPLEX*16 array, dimension (LDH,N)
-*          On input the initial N-by-N section of H stores the
-*          Hessenberg matrix undergoing aggressive early deflation.
-*          On output H has been transformed by a unitary
-*          similarity transformation, perturbed, and the returned
-*          to Hessenberg form that (it is to be hoped) has some
-*          zero subdiagonal entries.
-*
-*     LDH     (input) integer
-*          Leading dimension of H just as declared in the calling
-*          subroutine.  N .LE. LDH
-*
-*     ILOZ    (input) INTEGER
-*     IHIZ    (input) INTEGER
-*          Specify the rows of Z to which transformations must be
-*          applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
-*
-*     Z       (input/output) COMPLEX*16 array, dimension (LDZ,IHI)
-*          IF WANTZ is .TRUE., then on output, the unitary
-*          similarity transformation mentioned above has been
-*          accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*          If WANTZ is .FALSE., then Z is unreferenced.
-*
-*     LDZ     (input) integer
-*          The leading dimension of Z just as declared in the
-*          calling subroutine.  1 .LE. LDZ.
-*
-*     NS      (output) integer
-*          The number of unconverged (ie approximate) eigenvalues
-*          returned in SR and SI that may be used as shifts by the
-*          calling subroutine.
-*
-*     ND      (output) integer
-*          The number of converged eigenvalues uncovered by this
-*          subroutine.
-*
-*     SH      (output) COMPLEX*16 array, dimension KBOT
-*          On output, approximate eigenvalues that may
-*          be used for shifts are stored in SH(KBOT-ND-NS+1)
-*          through SR(KBOT-ND).  Converged eigenvalues are
-*          stored in SH(KBOT-ND+1) through SH(KBOT).
-*
-*     V       (workspace) COMPLEX*16 array, dimension (LDV,NW)
-*          An NW-by-NW work array.
-*
-*     LDV     (input) integer scalar
-*          The leading dimension of V just as declared in the
-*          calling subroutine.  NW .LE. LDV
-*
-*     NH      (input) integer scalar
-*          The number of columns of T.  NH.GE.NW.
-*
-*     T       (workspace) COMPLEX*16 array, dimension (LDT,NW)
-*
-*     LDT     (input) integer
-*          The leading dimension of T just as declared in the
-*          calling subroutine.  NW .LE. LDT
-*
-*     NV      (input) integer
-*          The number of rows of work array WV available for
-*          workspace.  NV.GE.NW.
-*
-*     WV      (workspace) COMPLEX*16 array, dimension (LDWV,NW)
-*
-*     LDWV    (input) integer
-*          The leading dimension of W just as declared in the
-*          calling subroutine.  NW .LE. LDV
-*
-*     WORK    (workspace) COMPLEX*16 array, dimension LWORK.
-*          On exit, WORK(1) is set to an estimate of the optimal value
-*          of LWORK for the given values of N, NW, KTOP and KBOT.
-*
-*     LWORK   (input) integer
-*          The dimension of the work array WORK.  LWORK = 2*NW
-*          suffices, but greater efficiency may result from larger
-*          values of LWORK.
-*
-*          If LWORK = -1, then a workspace query is assumed; ZLAQR2
-*          only estimates the optimal workspace size for the given
-*          values of N, NW, KTOP and KBOT.  The estimate is returned
-*          in WORK(1).  No error message related to LWORK is issued
-*          by XERBLA.  Neither H nor Z are accessed.
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ==================================================================
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ),
-     $                   ONE = ( 1.0d0, 0.0d0 ) )
-      DOUBLE PRECISION   RZERO, RONE
-      PARAMETER          ( RZERO = 0.0d0, RONE = 1.0d0 )
-*     ..
-*     .. Local Scalars ..
-      COMPLEX*16         BETA, CDUM, S, TAU
-      DOUBLE PRECISION   FOO, SAFMAX, SAFMIN, SMLNUM, ULP
-      INTEGER            I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN,
-     $                   KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWKOPT
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR,
-     $                   ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNGHR
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, MAX, MIN
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
-*     ..
-*     .. Executable Statements ..
-*
-*     ==== Estimate optimal workspace. ====
-*
-      JW = MIN( NW, KBOT-KTOP+1 )
-      IF( JW.LE.2 ) THEN
-         LWKOPT = 1
-      ELSE
-*
-*        ==== Workspace query call to ZGEHRD ====
-*
-         CALL ZGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
-         LWK1 = INT( WORK( 1 ) )
-*
-*        ==== Workspace query call to ZUNGHR ====
-*
-         CALL ZUNGHR( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
-         LWK2 = INT( WORK( 1 ) )
-*
-*        ==== Optimal workspace ====
-*
-         LWKOPT = JW + MAX( LWK1, LWK2 )
-      END IF
-*
-*     ==== Quick return in case of workspace query. ====
-*
-      IF( LWORK.EQ.-1 ) THEN
-         WORK( 1 ) = DCMPLX( LWKOPT, 0 )
-         RETURN
-      END IF
-*
-*     ==== Nothing to do ...
-*     ... for an empty active block ... ====
-      NS = 0
-      ND = 0
-      IF( KTOP.GT.KBOT )
-     $   RETURN
-*     ... nor for an empty deflation window. ====
-      IF( NW.LT.1 )
-     $   RETURN
-*
-*     ==== Machine constants ====
-*
-      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
-      SAFMAX = RONE / SAFMIN
-      CALL DLABAD( SAFMIN, SAFMAX )
-      ULP = DLAMCH( 'PRECISION' )
-      SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-*     ==== Setup deflation window ====
-*
-      JW = MIN( NW, KBOT-KTOP+1 )
-      KWTOP = KBOT - JW + 1
-      IF( KWTOP.EQ.KTOP ) THEN
-         S = ZERO
-      ELSE
-         S = H( KWTOP, KWTOP-1 )
-      END IF
-*
-      IF( KBOT.EQ.KWTOP ) THEN
-*
-*        ==== 1-by-1 deflation window: not much to do ====
-*
-         SH( KWTOP ) = H( KWTOP, KWTOP )
-         NS = 1
-         ND = 0
-         IF( CABS1( S ).LE.MAX( SMLNUM, ULP*CABS1( H( KWTOP,
-     $       KWTOP ) ) ) ) THEN
-            NS = 0
-            ND = 1
-            IF( KWTOP.GT.KTOP )
-     $         H( KWTOP, KWTOP-1 ) = ZERO
-         END IF
-         RETURN
-      END IF
-*
-*     ==== Convert to spike-triangular form.  (In case of a
-*     .    rare QR failure, this routine continues to do
-*     .    aggressive early deflation using that part of
-*     .    the deflation window that converged using INFQR
-*     .    here and there to keep track.) ====
-*
-      CALL ZLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
-      CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
-*
-      CALL ZLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
-      CALL ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1,
-     $             JW, V, LDV, INFQR )
-*
-*     ==== Deflation detection loop ====
-*
-      NS = JW
-      ILST = INFQR + 1
-      DO 10 KNT = INFQR + 1, JW
-*
-*        ==== Small spike tip deflation test ====
-*
-         FOO = CABS1( T( NS, NS ) )
-         IF( FOO.EQ.RZERO )
-     $      FOO = CABS1( S )
-         IF( CABS1( S )*CABS1( V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) )
-     $        THEN
-*
-*           ==== One more converged eigenvalue ====
-*
-            NS = NS - 1
-         ELSE
-*
-*           ==== One undflatable eigenvalue.  Move it up out of the
-*           .    way.   (ZTREXC can not fail in this case.) ====
-*
-            IFST = NS
-            CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
-            ILST = ILST + 1
-         END IF
-   10 CONTINUE
-*
-*        ==== Return to Hessenberg form ====
-*
-      IF( NS.EQ.0 )
-     $   S = ZERO
-*
-      IF( NS.LT.JW ) THEN
-*
-*        ==== sorting the diagonal of T improves accuracy for
-*        .    graded matrices.  ====
-*
-         DO 30 I = INFQR + 1, NS
-            IFST = I
-            DO 20 J = I + 1, NS
-               IF( CABS1( T( J, J ) ).GT.CABS1( T( IFST, IFST ) ) )
-     $            IFST = J
-   20       CONTINUE
-            ILST = I
-            IF( IFST.NE.ILST )
-     $         CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
-   30    CONTINUE
-      END IF
-*
-*     ==== Restore shift/eigenvalue array from T ====
-*
-      DO 40 I = INFQR + 1, JW
-         SH( KWTOP+I-1 ) = T( I, I )
-   40 CONTINUE
-*
-*
-      IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
-         IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-*
-*           ==== Reflect spike back into lower triangle ====
-*
-            CALL ZCOPY( NS, V, LDV, WORK, 1 )
-            DO 50 I = 1, NS
-               WORK( I ) = DCONJG( WORK( I ) )
-   50       CONTINUE
-            BETA = WORK( 1 )
-            CALL ZLARFG( NS, BETA, WORK( 2 ), 1, TAU )
-            WORK( 1 ) = ONE
-*
-            CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
-*
-            CALL ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T, LDT,
-     $                  WORK( JW+1 ) )
-            CALL ZLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
-     $                  WORK( JW+1 ) )
-            CALL ZLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
-     $                  WORK( JW+1 ) )
-*
-            CALL ZGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
-     $                   LWORK-JW, INFO )
-         END IF
-*
-*        ==== Copy updated reduced window into place ====
-*
-         IF( KWTOP.GT.1 )
-     $      H( KWTOP, KWTOP-1 ) = S*DCONJG( V( 1, 1 ) )
-         CALL ZLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
-         CALL ZCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
-     $               LDH+1 )
-*
-*        ==== Accumulate orthogonal matrix in order update
-*        .    H and Z, if requested.  (A modified version
-*        .    of  ZUNGHR that accumulates block Householder
-*        .    transformations into V directly might be
-*        .    marginally more efficient than the following.) ====
-*
-         IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-            CALL ZUNGHR( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
-     $                   LWORK-JW, INFO )
-            CALL ZGEMM( 'N', 'N', JW, NS, NS, ONE, V, LDV, T, LDT, ZERO,
-     $                  WV, LDWV )
-            CALL ZLACPY( 'A', JW, NS, WV, LDWV, V, LDV )
-         END IF
-*
-*        ==== Update vertical slab in H ====
-*
-         IF( WANTT ) THEN
-            LTOP = 1
-         ELSE
-            LTOP = KTOP
-         END IF
-         DO 60 KROW = LTOP, KWTOP - 1, NV
-            KLN = MIN( NV, KWTOP-KROW )
-            CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
-     $                  LDH, V, LDV, ZERO, WV, LDWV )
-            CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
-   60    CONTINUE
-*
-*        ==== Update horizontal slab in H ====
-*
-         IF( WANTT ) THEN
-            DO 70 KCOL = KBOT + 1, N, NH
-               KLN = MIN( NH, N-KCOL+1 )
-               CALL ZGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
-     $                     H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
-               CALL ZLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
-     $                      LDH )
-   70       CONTINUE
-         END IF
-*
-*        ==== Update vertical slab in Z ====
-*
-         IF( WANTZ ) THEN
-            DO 80 KROW = ILOZ, IHIZ, NV
-               KLN = MIN( NV, IHIZ-KROW+1 )
-               CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
-     $                     LDZ, V, LDV, ZERO, WV, LDWV )
-               CALL ZLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
-     $                      LDZ )
-   80       CONTINUE
-         END IF
-      END IF
-*
-*     ==== Return the number of deflations ... ====
-*
-      ND = JW - NS
-*
-*     ==== ... and the number of shifts. (Subtracting
-*     .    INFQR from the spike length takes care
-*     .    of the case of a rare QR failure while
-*     .    calculating eigenvalues of the deflation
-*     .    window.)  ====
-*
-      NS = NS - INFQR
-*
-*      ==== Return optimal workspace. ====
-*
-      WORK( 1 ) = DCMPLX( LWKOPT, 0 )
-*
-*     ==== End of ZLAQR2 ====
-*
-      END
diff --git a/src/lib/lapack/zlaqr3.f b/src/lib/lapack/zlaqr3.f
deleted file mode 100644
index e9bf393a..00000000
--- a/src/lib/lapack/zlaqr3.f
+++ /dev/null
@@ -1,448 +0,0 @@
-      SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-     $                   IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
-     $                   NV, WV, LDWV, WORK, LWORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
-     $                   LDZ, LWORK, N, ND, NH, NS, NV, NW
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         H( LDH, * ), SH( * ), T( LDT, * ), V( LDV, * ),
-     $                   WORK( * ), WV( LDWV, * ), Z( LDZ, * )
-*     ..
-*
-*     ******************************************************************
-*     Aggressive early deflation:
-*
-*     This subroutine accepts as input an upper Hessenberg matrix
-*     H and performs an unitary similarity transformation
-*     designed to detect and deflate fully converged eigenvalues from
-*     a trailing principal submatrix.  On output H has been over-
-*     written by a new Hessenberg matrix that is a perturbation of
-*     an unitary similarity transformation of H.  It is to be
-*     hoped that the final version of H has many zero subdiagonal
-*     entries.
-*
-*     ******************************************************************
-*     WANTT   (input) LOGICAL
-*          If .TRUE., then the Hessenberg matrix H is fully updated
-*          so that the triangular Schur factor may be
-*          computed (in cooperation with the calling subroutine).
-*          If .FALSE., then only enough of H is updated to preserve
-*          the eigenvalues.
-*
-*     WANTZ   (input) LOGICAL
-*          If .TRUE., then the unitary matrix Z is updated so
-*          so that the unitary Schur factor may be computed
-*          (in cooperation with the calling subroutine).
-*          If .FALSE., then Z is not referenced.
-*
-*     N       (input) INTEGER
-*          The order of the matrix H and (if WANTZ is .TRUE.) the
-*          order of the unitary matrix Z.
-*
-*     KTOP    (input) INTEGER
-*          It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
-*          KBOT and KTOP together determine an isolated block
-*          along the diagonal of the Hessenberg matrix.
-*
-*     KBOT    (input) INTEGER
-*          It is assumed without a check that either
-*          KBOT = N or H(KBOT+1,KBOT)=0.  KBOT and KTOP together
-*          determine an isolated block along the diagonal of the
-*          Hessenberg matrix.
-*
-*     NW      (input) INTEGER
-*          Deflation window size.  1 .LE. NW .LE. (KBOT-KTOP+1).
-*
-*     H       (input/output) COMPLEX*16 array, dimension (LDH,N)
-*          On input the initial N-by-N section of H stores the
-*          Hessenberg matrix undergoing aggressive early deflation.
-*          On output H has been transformed by a unitary
-*          similarity transformation, perturbed, and the returned
-*          to Hessenberg form that (it is to be hoped) has some
-*          zero subdiagonal entries.
-*
-*     LDH     (input) integer
-*          Leading dimension of H just as declared in the calling
-*          subroutine.  N .LE. LDH
-*
-*     ILOZ    (input) INTEGER
-*     IHIZ    (input) INTEGER
-*          Specify the rows of Z to which transformations must be
-*          applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
-*
-*     Z       (input/output) COMPLEX*16 array, dimension (LDZ,IHI)
-*          IF WANTZ is .TRUE., then on output, the unitary
-*          similarity transformation mentioned above has been
-*          accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*          If WANTZ is .FALSE., then Z is unreferenced.
-*
-*     LDZ     (input) integer
-*          The leading dimension of Z just as declared in the
-*          calling subroutine.  1 .LE. LDZ.
-*
-*     NS      (output) integer
-*          The number of unconverged (ie approximate) eigenvalues
-*          returned in SR and SI that may be used as shifts by the
-*          calling subroutine.
-*
-*     ND      (output) integer
-*          The number of converged eigenvalues uncovered by this
-*          subroutine.
-*
-*     SH      (output) COMPLEX*16 array, dimension KBOT
-*          On output, approximate eigenvalues that may
-*          be used for shifts are stored in SH(KBOT-ND-NS+1)
-*          through SR(KBOT-ND).  Converged eigenvalues are
-*          stored in SH(KBOT-ND+1) through SH(KBOT).
-*
-*     V       (workspace) COMPLEX*16 array, dimension (LDV,NW)
-*          An NW-by-NW work array.
-*
-*     LDV     (input) integer scalar
-*          The leading dimension of V just as declared in the
-*          calling subroutine.  NW .LE. LDV
-*
-*     NH      (input) integer scalar
-*          The number of columns of T.  NH.GE.NW.
-*
-*     T       (workspace) COMPLEX*16 array, dimension (LDT,NW)
-*
-*     LDT     (input) integer
-*          The leading dimension of T just as declared in the
-*          calling subroutine.  NW .LE. LDT
-*
-*     NV      (input) integer
-*          The number of rows of work array WV available for
-*          workspace.  NV.GE.NW.
-*
-*     WV      (workspace) COMPLEX*16 array, dimension (LDWV,NW)
-*
-*     LDWV    (input) integer
-*          The leading dimension of W just as declared in the
-*          calling subroutine.  NW .LE. LDV
-*
-*     WORK    (workspace) COMPLEX*16 array, dimension LWORK.
-*          On exit, WORK(1) is set to an estimate of the optimal value
-*          of LWORK for the given values of N, NW, KTOP and KBOT.
-*
-*     LWORK   (input) integer
-*          The dimension of the work array WORK.  LWORK = 2*NW
-*          suffices, but greater efficiency may result from larger
-*          values of LWORK.
-*
-*          If LWORK = -1, then a workspace query is assumed; ZLAQR3
-*          only estimates the optimal workspace size for the given
-*          values of N, NW, KTOP and KBOT.  The estimate is returned
-*          in WORK(1).  No error message related to LWORK is issued
-*          by XERBLA.  Neither H nor Z are accessed.
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ==================================================================
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ),
-     $                   ONE = ( 1.0d0, 0.0d0 ) )
-      DOUBLE PRECISION   RZERO, RONE
-      PARAMETER          ( RZERO = 0.0d0, RONE = 1.0d0 )
-*     ..
-*     .. Local Scalars ..
-      COMPLEX*16         BETA, CDUM, S, TAU
-      DOUBLE PRECISION   FOO, SAFMAX, SAFMIN, SMLNUM, ULP
-      INTEGER            I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN,
-     $                   KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3,
-     $                   LWKOPT, NMIN
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      INTEGER            ILAENV
-      EXTERNAL           DLAMCH, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR,
-     $                   ZLAQR4, ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNGHR
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, MAX, MIN
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
-*     ..
-*     .. Executable Statements ..
-*
-*     ==== Estimate optimal workspace. ====
-*
-      JW = MIN( NW, KBOT-KTOP+1 )
-      IF( JW.LE.2 ) THEN
-         LWKOPT = 1
-      ELSE
-*
-*        ==== Workspace query call to ZGEHRD ====
-*
-         CALL ZGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
-         LWK1 = INT( WORK( 1 ) )
-*
-*        ==== Workspace query call to ZUNGHR ====
-*
-         CALL ZUNGHR( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
-         LWK2 = INT( WORK( 1 ) )
-*
-*        ==== Workspace query call to ZLAQR4 ====
-*
-         CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1, JW, V,
-     $                LDV, WORK, -1, INFQR )
-         LWK3 = INT( WORK( 1 ) )
-*
-*        ==== Optimal workspace ====
-*
-         LWKOPT = MAX( JW+MAX( LWK1, LWK2 ), LWK3 )
-      END IF
-*
-*     ==== Quick return in case of workspace query. ====
-*
-      IF( LWORK.EQ.-1 ) THEN
-         WORK( 1 ) = DCMPLX( LWKOPT, 0 )
-         RETURN
-      END IF
-*
-*     ==== Nothing to do ...
-*     ... for an empty active block ... ====
-      NS = 0
-      ND = 0
-      IF( KTOP.GT.KBOT )
-     $   RETURN
-*     ... nor for an empty deflation window. ====
-      IF( NW.LT.1 )
-     $   RETURN
-*
-*     ==== Machine constants ====
-*
-      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
-      SAFMAX = RONE / SAFMIN
-      CALL DLABAD( SAFMIN, SAFMAX )
-      ULP = DLAMCH( 'PRECISION' )
-      SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-*     ==== Setup deflation window ====
-*
-      JW = MIN( NW, KBOT-KTOP+1 )
-      KWTOP = KBOT - JW + 1
-      IF( KWTOP.EQ.KTOP ) THEN
-         S = ZERO
-      ELSE
-         S = H( KWTOP, KWTOP-1 )
-      END IF
-*
-      IF( KBOT.EQ.KWTOP ) THEN
-*
-*        ==== 1-by-1 deflation window: not much to do ====
-*
-         SH( KWTOP ) = H( KWTOP, KWTOP )
-         NS = 1
-         ND = 0
-         IF( CABS1( S ).LE.MAX( SMLNUM, ULP*CABS1( H( KWTOP,
-     $       KWTOP ) ) ) ) THEN
-
-            NS = 0
-            ND = 1
-            IF( KWTOP.GT.KTOP )
-     $         H( KWTOP, KWTOP-1 ) = ZERO
-         END IF
-         RETURN
-      END IF
-*
-*     ==== Convert to spike-triangular form.  (In case of a
-*     .    rare QR failure, this routine continues to do
-*     .    aggressive early deflation using that part of
-*     .    the deflation window that converged using INFQR
-*     .    here and there to keep track.) ====
-*
-      CALL ZLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
-      CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
-*
-      CALL ZLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
-      NMIN = ILAENV( 12, 'ZLAQR3', 'SV', JW, 1, JW, LWORK )
-      IF( JW.GT.NMIN ) THEN
-         CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1,
-     $                JW, V, LDV, WORK, LWORK, INFQR )
-      ELSE
-         CALL ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1,
-     $                JW, V, LDV, INFQR )
-      END IF
-*
-*     ==== Deflation detection loop ====
-*
-      NS = JW
-      ILST = INFQR + 1
-      DO 10 KNT = INFQR + 1, JW
-*
-*        ==== Small spike tip deflation test ====
-*
-         FOO = CABS1( T( NS, NS ) )
-         IF( FOO.EQ.RZERO )
-     $      FOO = CABS1( S )
-         IF( CABS1( S )*CABS1( V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) )
-     $        THEN
-*
-*           ==== One more converged eigenvalue ====
-*
-            NS = NS - 1
-         ELSE
-*
-*           ==== One undflatable eigenvalue.  Move it up out of the
-*           .    way.   (ZTREXC can not fail in this case.) ====
-*
-            IFST = NS
-            CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
-            ILST = ILST + 1
-         END IF
-   10 CONTINUE
-*
-*        ==== Return to Hessenberg form ====
-*
-      IF( NS.EQ.0 )
-     $   S = ZERO
-*
-      IF( NS.LT.JW ) THEN
-*
-*        ==== sorting the diagonal of T improves accuracy for
-*        .    graded matrices.  ====
-*
-         DO 30 I = INFQR + 1, NS
-            IFST = I
-            DO 20 J = I + 1, NS
-               IF( CABS1( T( J, J ) ).GT.CABS1( T( IFST, IFST ) ) )
-     $            IFST = J
-   20       CONTINUE
-            ILST = I
-            IF( IFST.NE.ILST )
-     $         CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
-   30    CONTINUE
-      END IF
-*
-*     ==== Restore shift/eigenvalue array from T ====
-*
-      DO 40 I = INFQR + 1, JW
-         SH( KWTOP+I-1 ) = T( I, I )
-   40 CONTINUE
-*
-*
-      IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
-         IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-*
-*           ==== Reflect spike back into lower triangle ====
-*
-            CALL ZCOPY( NS, V, LDV, WORK, 1 )
-            DO 50 I = 1, NS
-               WORK( I ) = DCONJG( WORK( I ) )
-   50       CONTINUE
-            BETA = WORK( 1 )
-            CALL ZLARFG( NS, BETA, WORK( 2 ), 1, TAU )
-            WORK( 1 ) = ONE
-*
-            CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
-*
-            CALL ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T, LDT,
-     $                  WORK( JW+1 ) )
-            CALL ZLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
-     $                  WORK( JW+1 ) )
-            CALL ZLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
-     $                  WORK( JW+1 ) )
-*
-            CALL ZGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
-     $                   LWORK-JW, INFO )
-         END IF
-*
-*        ==== Copy updated reduced window into place ====
-*
-         IF( KWTOP.GT.1 )
-     $      H( KWTOP, KWTOP-1 ) = S*DCONJG( V( 1, 1 ) )
-         CALL ZLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
-         CALL ZCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
-     $               LDH+1 )
-*
-*        ==== Accumulate orthogonal matrix in order update
-*        .    H and Z, if requested.  (A modified version
-*        .    of  ZUNGHR that accumulates block Householder
-*        .    transformations into V directly might be
-*        .    marginally more efficient than the following.) ====
-*
-         IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
-            CALL ZUNGHR( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
-     $                   LWORK-JW, INFO )
-            CALL ZGEMM( 'N', 'N', JW, NS, NS, ONE, V, LDV, T, LDT, ZERO,
-     $                  WV, LDWV )
-            CALL ZLACPY( 'A', JW, NS, WV, LDWV, V, LDV )
-         END IF
-*
-*        ==== Update vertical slab in H ====
-*
-         IF( WANTT ) THEN
-            LTOP = 1
-         ELSE
-            LTOP = KTOP
-         END IF
-         DO 60 KROW = LTOP, KWTOP - 1, NV
-            KLN = MIN( NV, KWTOP-KROW )
-            CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
-     $                  LDH, V, LDV, ZERO, WV, LDWV )
-            CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
-   60    CONTINUE
-*
-*        ==== Update horizontal slab in H ====
-*
-         IF( WANTT ) THEN
-            DO 70 KCOL = KBOT + 1, N, NH
-               KLN = MIN( NH, N-KCOL+1 )
-               CALL ZGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
-     $                     H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
-               CALL ZLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
-     $                      LDH )
-   70       CONTINUE
-         END IF
-*
-*        ==== Update vertical slab in Z ====
-*
-         IF( WANTZ ) THEN
-            DO 80 KROW = ILOZ, IHIZ, NV
-               KLN = MIN( NV, IHIZ-KROW+1 )
-               CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
-     $                     LDZ, V, LDV, ZERO, WV, LDWV )
-               CALL ZLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
-     $                      LDZ )
-   80       CONTINUE
-         END IF
-      END IF
-*
-*     ==== Return the number of deflations ... ====
-*
-      ND = JW - NS
-*
-*     ==== ... and the number of shifts. (Subtracting
-*     .    INFQR from the spike length takes care
-*     .    of the case of a rare QR failure while
-*     .    calculating eigenvalues of the deflation
-*     .    window.)  ====
-*
-      NS = NS - INFQR
-*
-*      ==== Return optimal workspace. ====
-*
-      WORK( 1 ) = DCMPLX( LWKOPT, 0 )
-*
-*     ==== End of ZLAQR3 ====
-*
-      END
diff --git a/src/lib/lapack/zlaqr4.f b/src/lib/lapack/zlaqr4.f
deleted file mode 100644
index eef7f00a..00000000
--- a/src/lib/lapack/zlaqr4.f
+++ /dev/null
@@ -1,602 +0,0 @@
-      SUBROUTINE ZLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ,
-     $                   IHIZ, Z, LDZ, WORK, LWORK, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
-*     ..
-*
-*     This subroutine implements one level of recursion for ZLAQR0.
-*     It is a complete implementation of the small bulge multi-shift
-*     QR algorithm.  It may be called by ZLAQR0 and, for large enough
-*     deflation window size, it may be called by ZLAQR3.  This
-*     subroutine is identical to ZLAQR0 except that it calls ZLAQR2
-*     instead of ZLAQR3.
-*
-*     Purpose
-*     =======
-*
-*     ZLAQR4 computes the eigenvalues of a Hessenberg matrix H
-*     and, optionally, the matrices T and Z from the Schur decomposition
-*     H = Z T Z**H, where T is an upper triangular matrix (the
-*     Schur form), and Z is the unitary matrix of Schur vectors.
-*
-*     Optionally Z may be postmultiplied into an input unitary
-*     matrix Q so that this routine can give the Schur factorization
-*     of a matrix A which has been reduced to the Hessenberg form H
-*     by the unitary matrix Q:  A = Q*H*Q**H = (QZ)*H*(QZ)**H.
-*
-*     Arguments
-*     =========
-*
-*     WANTT   (input) LOGICAL
-*          = .TRUE. : the full Schur form T is required;
-*          = .FALSE.: only eigenvalues are required.
-*
-*     WANTZ   (input) LOGICAL
-*          = .TRUE. : the matrix of Schur vectors Z is required;
-*          = .FALSE.: Schur vectors are not required.
-*
-*     N     (input) INTEGER
-*           The order of the matrix H.  N .GE. 0.
-*
-*     ILO   (input) INTEGER
-*     IHI   (input) INTEGER
-*           It is assumed that H is already upper triangular in rows
-*           and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1,
-*           H(ILO,ILO-1) is zero. ILO and IHI are normally set by a
-*           previous call to ZGEBAL, and then passed to ZGEHRD when the
-*           matrix output by ZGEBAL is reduced to Hessenberg form.
-*           Otherwise, ILO and IHI should be set to 1 and N,
-*           respectively.  If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
-*           If N = 0, then ILO = 1 and IHI = 0.
-*
-*     H     (input/output) COMPLEX*16 array, dimension (LDH,N)
-*           On entry, the upper Hessenberg matrix H.
-*           On exit, if INFO = 0 and WANTT is .TRUE., then H
-*           contains the upper triangular matrix T from the Schur
-*           decomposition (the Schur form). If INFO = 0 and WANT is
-*           .FALSE., then the contents of H are unspecified on exit.
-*           (The output value of H when INFO.GT.0 is given under the
-*           description of INFO below.)
-*
-*           This subroutine may explicitly set H(i,j) = 0 for i.GT.j and
-*           j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N.
-*
-*     LDH   (input) INTEGER
-*           The leading dimension of the array H. LDH .GE. max(1,N).
-*
-*     W        (output) COMPLEX*16 array, dimension (N)
-*           The computed eigenvalues of H(ILO:IHI,ILO:IHI) are stored
-*           in W(ILO:IHI). If WANTT is .TRUE., then the eigenvalues are
-*           stored in the same order as on the diagonal of the Schur
-*           form returned in H, with W(i) = H(i,i).
-*
-*     Z     (input/output) COMPLEX*16 array, dimension (LDZ,IHI)
-*           If WANTZ is .FALSE., then Z is not referenced.
-*           If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is
-*           replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the
-*           orthogonal Schur factor of H(ILO:IHI,ILO:IHI).
-*           (The output value of Z when INFO.GT.0 is given under
-*           the description of INFO below.)
-*
-*     LDZ   (input) INTEGER
-*           The leading dimension of the array Z.  if WANTZ is .TRUE.
-*           then LDZ.GE.MAX(1,IHIZ).  Otherwize, LDZ.GE.1.
-*
-*     WORK  (workspace/output) COMPLEX*16 array, dimension LWORK
-*           On exit, if LWORK = -1, WORK(1) returns an estimate of
-*           the optimal value for LWORK.
-*
-*     LWORK (input) INTEGER
-*           The dimension of the array WORK.  LWORK .GE. max(1,N)
-*           is sufficient, but LWORK typically as large as 6*N may
-*           be required for optimal performance.  A workspace query
-*           to determine the optimal workspace size is recommended.
-*
-*           If LWORK = -1, then ZLAQR4 does a workspace query.
-*           In this case, ZLAQR4 checks the input parameters and
-*           estimates the optimal workspace size for the given
-*           values of N, ILO and IHI.  The estimate is returned
-*           in WORK(1).  No error message related to LWORK is
-*           issued by XERBLA.  Neither H nor Z are accessed.
-*
-*
-*     INFO  (output) INTEGER
-*             =  0:  successful exit
-*           .GT. 0:  if INFO = i, ZLAQR4 failed to compute all of
-*                the eigenvalues.  Elements 1:ilo-1 and i+1:n of WR
-*                and WI contain those eigenvalues which have been
-*                successfully computed.  (Failures are rare.)
-*
-*                If INFO .GT. 0 and WANT is .FALSE., then on exit,
-*                the remaining unconverged eigenvalues are the eigen-
-*                values of the upper Hessenberg matrix rows and
-*                columns ILO through INFO of the final, output
-*                value of H.
-*
-*                If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*
-*           (*)  (initial value of H)*U  = U*(final value of H)
-*
-*                where U is a unitary matrix.  The final
-*                value of  H is upper Hessenberg and triangular in
-*                rows and columns INFO+1 through IHI.
-*
-*                If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*
-*                  (final value of Z(ILO:IHI,ILOZ:IHIZ)
-*                   =  (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U
-*
-*                where U is the unitary matrix in (*) (regard-
-*                less of the value of WANTT.)
-*
-*                If INFO .GT. 0 and WANTZ is .FALSE., then Z is not
-*                accessed.
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*     ================================================================
-*     References:
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
-*       Performance, SIAM Journal of Matrix Analysis, volume 23, pages
-*       929--947, 2002.
-*
-*       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*       Algorithm Part II: Aggressive Early Deflation, SIAM Journal
-*       of Matrix Analysis, volume 23, pages 948--973, 2002.
-*
-*     ================================================================
-*     .. Parameters ..
-*
-*     ==== Matrices of order NTINY or smaller must be processed by
-*     .    ZLAHQR because of insufficient subdiagonal scratch space.
-*     .    (This is a hard limit.) ====
-*
-*     ==== Exceptional deflation windows:  try to cure rare
-*     .    slow convergence by increasing the size of the
-*     .    deflation window after KEXNW iterations. =====
-*
-*     ==== Exceptional shifts: try to cure rare slow convergence
-*     .    with ad-hoc exceptional shifts every KEXSH iterations.
-*     .    The constants WILK1 and WILK2 are used to form the
-*     .    exceptional shifts. ====
-*
-      INTEGER            NTINY
-      PARAMETER          ( NTINY = 11 )
-      INTEGER            KEXNW, KEXSH
-      PARAMETER          ( KEXNW = 5, KEXSH = 6 )
-      DOUBLE PRECISION   WILK1
-      PARAMETER          ( WILK1 = 0.75d0 )
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ),
-     $                   ONE = ( 1.0d0, 0.0d0 ) )
-      DOUBLE PRECISION   TWO
-      PARAMETER          ( TWO = 2.0d0 )
-*     ..
-*     .. Local Scalars ..
-      COMPLEX*16         AA, BB, CC, CDUM, DD, DET, RTDISC, SWAP, TR2
-      DOUBLE PRECISION   S
-      INTEGER            I, INF, IT, ITMAX, K, KACC22, KBOT, KDU, KS,
-     $                   KT, KTOP, KU, KV, KWH, KWTOP, KWV, LD, LS,
-     $                   LWKOPT, NDFL, NH, NHO, NIBBLE, NMIN, NS, NSMAX,
-     $                   NSR, NVE, NW, NWMAX, NWR
-      LOGICAL            NWINC, SORTED
-      CHARACTER          JBCMPZ*2
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Local Arrays ..
-      COMPLEX*16         ZDUM( 1, 1 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZLACPY, ZLAHQR, ZLAQR2, ZLAQR5
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DIMAG, INT, MAX, MIN, MOD,
-     $                   SQRT
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
-*     ..
-*     .. Executable Statements ..
-      INFO = 0
-*
-*     ==== Quick return for N = 0: nothing to do. ====
-*
-      IF( N.EQ.0 ) THEN
-         WORK( 1 ) = ONE
-         RETURN
-      END IF
-*
-*     ==== Set up job flags for ILAENV. ====
-*
-      IF( WANTT ) THEN
-         JBCMPZ( 1: 1 ) = 'S'
-      ELSE
-         JBCMPZ( 1: 1 ) = 'E'
-      END IF
-      IF( WANTZ ) THEN
-         JBCMPZ( 2: 2 ) = 'V'
-      ELSE
-         JBCMPZ( 2: 2 ) = 'N'
-      END IF
-*
-*     ==== Tiny matrices must use ZLAHQR. ====
-*
-      IF( N.LE.NTINY ) THEN
-*
-*        ==== Estimate optimal workspace. ====
-*
-         LWKOPT = 1
-         IF( LWORK.NE.-1 )
-     $      CALL ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ,
-     $                   IHIZ, Z, LDZ, INFO )
-      ELSE
-*
-*        ==== Use small bulge multi-shift QR with aggressive early
-*        .    deflation on larger-than-tiny matrices. ====
-*
-*        ==== Hope for the best. ====
-*
-         INFO = 0
-*
-*        ==== NWR = recommended deflation window size.  At this
-*        .    point,  N .GT. NTINY = 11, so there is enough
-*        .    subdiagonal workspace for NWR.GE.2 as required.
-*        .    (In fact, there is enough subdiagonal space for
-*        .    NWR.GE.3.) ====
-*
-         NWR = ILAENV( 13, 'ZLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
-         NWR = MAX( 2, NWR )
-         NWR = MIN( IHI-ILO+1, ( N-1 ) / 3, NWR )
-         NW = NWR
-*
-*        ==== NSR = recommended number of simultaneous shifts.
-*        .    At this point N .GT. NTINY = 11, so there is at
-*        .    enough subdiagonal workspace for NSR to be even
-*        .    and greater than or equal to two as required. ====
-*
-         NSR = ILAENV( 15, 'ZLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
-         NSR = MIN( NSR, ( N+6 ) / 9, IHI-ILO )
-         NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
-*
-*        ==== Estimate optimal workspace ====
-*
-*        ==== Workspace query call to ZLAQR2 ====
-*
-         CALL ZLAQR2( WANTT, WANTZ, N, ILO, IHI, NWR+1, H, LDH, ILOZ,
-     $                IHIZ, Z, LDZ, LS, LD, W, H, LDH, N, H, LDH, N, H,
-     $                LDH, WORK, -1 )
-*
-*        ==== Optimal workspace = MAX(ZLAQR5, ZLAQR2) ====
-*
-         LWKOPT = MAX( 3*NSR / 2, INT( WORK( 1 ) ) )
-*
-*        ==== Quick return in case of workspace query. ====
-*
-         IF( LWORK.EQ.-1 ) THEN
-            WORK( 1 ) = DCMPLX( LWKOPT, 0 )
-            RETURN
-         END IF
-*
-*        ==== ZLAHQR/ZLAQR0 crossover point ====
-*
-         NMIN = ILAENV( 12, 'ZLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
-         NMIN = MAX( NTINY, NMIN )
-*
-*        ==== Nibble crossover point ====
-*
-         NIBBLE = ILAENV( 14, 'ZLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
-         NIBBLE = MAX( 0, NIBBLE )
-*
-*        ==== Accumulate reflections during ttswp?  Use block
-*        .    2-by-2 structure during matrix-matrix multiply? ====
-*
-         KACC22 = ILAENV( 16, 'ZLAQR4', JBCMPZ, N, ILO, IHI, LWORK )
-         KACC22 = MAX( 0, KACC22 )
-         KACC22 = MIN( 2, KACC22 )
-*
-*        ==== NWMAX = the largest possible deflation window for
-*        .    which there is sufficient workspace. ====
-*
-         NWMAX = MIN( ( N-1 ) / 3, LWORK / 2 )
-*
-*        ==== NSMAX = the Largest number of simultaneous shifts
-*        .    for which there is sufficient workspace. ====
-*
-         NSMAX = MIN( ( N+6 ) / 9, 2*LWORK / 3 )
-         NSMAX = NSMAX - MOD( NSMAX, 2 )
-*
-*        ==== NDFL: an iteration count restarted at deflation. ====
-*
-         NDFL = 1
-*
-*        ==== ITMAX = iteration limit ====
-*
-         ITMAX = MAX( 30, 2*KEXSH )*MAX( 10, ( IHI-ILO+1 ) )
-*
-*        ==== Last row and column in the active block ====
-*
-         KBOT = IHI
-*
-*        ==== Main Loop ====
-*
-         DO 70 IT = 1, ITMAX
-*
-*           ==== Done when KBOT falls below ILO ====
-*
-            IF( KBOT.LT.ILO )
-     $         GO TO 80
-*
-*           ==== Locate active block ====
-*
-            DO 10 K = KBOT, ILO + 1, -1
-               IF( H( K, K-1 ).EQ.ZERO )
-     $            GO TO 20
-   10       CONTINUE
-            K = ILO
-   20       CONTINUE
-            KTOP = K
-*
-*           ==== Select deflation window size ====
-*
-            NH = KBOT - KTOP + 1
-            IF( NDFL.LT.KEXNW .OR. NH.LT.NW ) THEN
-*
-*              ==== Typical deflation window.  If possible and
-*              .    advisable, nibble the entire active block.
-*              .    If not, use size NWR or NWR+1 depending upon
-*              .    which has the smaller corresponding subdiagonal
-*              .    entry (a heuristic). ====
-*
-               NWINC = .TRUE.
-               IF( NH.LE.MIN( NMIN, NWMAX ) ) THEN
-                  NW = NH
-               ELSE
-                  NW = MIN( NWR, NH, NWMAX )
-                  IF( NW.LT.NWMAX ) THEN
-                     IF( NW.GE.NH-1 ) THEN
-                        NW = NH
-                     ELSE
-                        KWTOP = KBOT - NW + 1
-                        IF( CABS1( H( KWTOP, KWTOP-1 ) ).GT.
-     $                      CABS1( H( KWTOP-1, KWTOP-2 ) ) )NW = NW + 1
-                     END IF
-                  END IF
-               END IF
-            ELSE
-*
-*              ==== Exceptional deflation window.  If there have
-*              .    been no deflations in KEXNW or more iterations,
-*              .    then vary the deflation window size.   At first,
-*              .    because, larger windows are, in general, more
-*              .    powerful than smaller ones, rapidly increase the
-*              .    window up to the maximum reasonable and possible.
-*              .    Then maybe try a slightly smaller window.  ====
-*
-               IF( NWINC .AND. NW.LT.MIN( NWMAX, NH ) ) THEN
-                  NW = MIN( NWMAX, NH, 2*NW )
-               ELSE
-                  NWINC = .FALSE.
-                  IF( NW.EQ.NH .AND. NH.GT.2 )
-     $               NW = NH - 1
-               END IF
-            END IF
-*
-*           ==== Aggressive early deflation:
-*           .    split workspace under the subdiagonal into
-*           .      - an nw-by-nw work array V in the lower
-*           .        left-hand-corner,
-*           .      - an NW-by-at-least-NW-but-more-is-better
-*           .        (NW-by-NHO) horizontal work array along
-*           .        the bottom edge,
-*           .      - an at-least-NW-but-more-is-better (NHV-by-NW)
-*           .        vertical work array along the left-hand-edge.
-*           .        ====
-*
-            KV = N - NW + 1
-            KT = NW + 1
-            NHO = ( N-NW-1 ) - KT + 1
-            KWV = NW + 2
-            NVE = ( N-NW ) - KWV + 1
-*
-*           ==== Aggressive early deflation ====
-*
-            CALL ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
-     $                   IHIZ, Z, LDZ, LS, LD, W, H( KV, 1 ), LDH, NHO,
-     $                   H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, WORK,
-     $                   LWORK )
-*
-*           ==== Adjust KBOT accounting for new deflations. ====
-*
-            KBOT = KBOT - LD
-*
-*           ==== KS points to the shifts. ====
-*
-            KS = KBOT - LS + 1
-*
-*           ==== Skip an expensive QR sweep if there is a (partly
-*           .    heuristic) reason to expect that many eigenvalues
-*           .    will deflate without it.  Here, the QR sweep is
-*           .    skipped if many eigenvalues have just been deflated
-*           .    or if the remaining active block is small.
-*
-            IF( ( LD.EQ.0 ) .OR. ( ( 100*LD.LE.NW*NIBBLE ) .AND. ( KBOT-
-     $          KTOP+1.GT.MIN( NMIN, NWMAX ) ) ) ) THEN
-*
-*              ==== NS = nominal number of simultaneous shifts.
-*              .    This may be lowered (slightly) if ZLAQR2
-*              .    did not provide that many shifts. ====
-*
-               NS = MIN( NSMAX, NSR, MAX( 2, KBOT-KTOP ) )
-               NS = NS - MOD( NS, 2 )
-*
-*              ==== If there have been no deflations
-*              .    in a multiple of KEXSH iterations,
-*              .    then try exceptional shifts.
-*              .    Otherwise use shifts provided by
-*              .    ZLAQR2 above or from the eigenvalues
-*              .    of a trailing principal submatrix. ====
-*
-               IF( MOD( NDFL, KEXSH ).EQ.0 ) THEN
-                  KS = KBOT - NS + 1
-                  DO 30 I = KBOT, KS + 1, -2
-                     W( I ) = H( I, I ) + WILK1*CABS1( H( I, I-1 ) )
-                     W( I-1 ) = W( I )
-   30             CONTINUE
-               ELSE
-*
-*                 ==== Got NS/2 or fewer shifts? Use ZLAHQR
-*                 .    on a trailing principal submatrix to
-*                 .    get more. (Since NS.LE.NSMAX.LE.(N+6)/9,
-*                 .    there is enough space below the subdiagonal
-*                 .    to fit an NS-by-NS scratch array.) ====
-*
-                  IF( KBOT-KS+1.LE.NS / 2 ) THEN
-                     KS = KBOT - NS + 1
-                     KT = N - NS + 1
-                     CALL ZLACPY( 'A', NS, NS, H( KS, KS ), LDH,
-     $                            H( KT, 1 ), LDH )
-                     CALL ZLAHQR( .false., .false., NS, 1, NS,
-     $                            H( KT, 1 ), LDH, W( KS ), 1, 1, ZDUM,
-     $                            1, INF )
-                     KS = KS + INF
-*
-*                    ==== In case of a rare QR failure use
-*                    .    eigenvalues of the trailing 2-by-2
-*                    .    principal submatrix.  Scale to avoid
-*                    .    overflows, underflows and subnormals.
-*                    .    (The scale factor S can not be zero,
-*                    .    because H(KBOT,KBOT-1) is nonzero.) ====
-*
-                     IF( KS.GE.KBOT ) THEN
-                        S = CABS1( H( KBOT-1, KBOT-1 ) ) +
-     $                      CABS1( H( KBOT, KBOT-1 ) ) +
-     $                      CABS1( H( KBOT-1, KBOT ) ) +
-     $                      CABS1( H( KBOT, KBOT ) )
-                        AA = H( KBOT-1, KBOT-1 ) / S
-                        CC = H( KBOT, KBOT-1 ) / S
-                        BB = H( KBOT-1, KBOT ) / S
-                        DD = H( KBOT, KBOT ) / S
-                        TR2 = ( AA+DD ) / TWO
-                        DET = ( AA-TR2 )*( DD-TR2 ) - BB*CC
-                        RTDISC = SQRT( -DET )
-                        W( KBOT-1 ) = ( TR2+RTDISC )*S
-                        W( KBOT ) = ( TR2-RTDISC )*S
-*
-                        KS = KBOT - 1
-                     END IF
-                  END IF
-*
-                  IF( KBOT-KS+1.GT.NS ) THEN
-*
-*                    ==== Sort the shifts (Helps a little) ====
-*
-                     SORTED = .false.
-                     DO 50 K = KBOT, KS + 1, -1
-                        IF( SORTED )
-     $                     GO TO 60
-                        SORTED = .true.
-                        DO 40 I = KS, K - 1
-                           IF( CABS1( W( I ) ).LT.CABS1( W( I+1 ) ) )
-     $                          THEN
-                              SORTED = .false.
-                              SWAP = W( I )
-                              W( I ) = W( I+1 )
-                              W( I+1 ) = SWAP
-                           END IF
-   40                   CONTINUE
-   50                CONTINUE
-   60                CONTINUE
-                  END IF
-               END IF
-*
-*              ==== If there are only two shifts, then use
-*              .    only one.  ====
-*
-               IF( KBOT-KS+1.EQ.2 ) THEN
-                  IF( CABS1( W( KBOT )-H( KBOT, KBOT ) ).LT.
-     $                CABS1( W( KBOT-1 )-H( KBOT, KBOT ) ) ) THEN
-                     W( KBOT-1 ) = W( KBOT )
-                  ELSE
-                     W( KBOT ) = W( KBOT-1 )
-                  END IF
-               END IF
-*
-*              ==== Use up to NS of the the smallest magnatiude
-*              .    shifts.  If there aren't NS shifts available,
-*              .    then use them all, possibly dropping one to
-*              .    make the number of shifts even. ====
-*
-               NS = MIN( NS, KBOT-KS+1 )
-               NS = NS - MOD( NS, 2 )
-               KS = KBOT - NS + 1
-*
-*              ==== Small-bulge multi-shift QR sweep:
-*              .    split workspace under the subdiagonal into
-*              .    - a KDU-by-KDU work array U in the lower
-*              .      left-hand-corner,
-*              .    - a KDU-by-at-least-KDU-but-more-is-better
-*              .      (KDU-by-NHo) horizontal work array WH along
-*              .      the bottom edge,
-*              .    - and an at-least-KDU-but-more-is-better-by-KDU
-*              .      (NVE-by-KDU) vertical work WV arrow along
-*              .      the left-hand-edge. ====
-*
-               KDU = 3*NS - 3
-               KU = N - KDU + 1
-               KWH = KDU + 1
-               NHO = ( N-KDU+1-4 ) - ( KDU+1 ) + 1
-               KWV = KDU + 4
-               NVE = N - KDU - KWV + 1
-*
-*              ==== Small-bulge multi-shift QR sweep ====
-*
-               CALL ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NS,
-     $                      W( KS ), H, LDH, ILOZ, IHIZ, Z, LDZ, WORK,
-     $                      3, H( KU, 1 ), LDH, NVE, H( KWV, 1 ), LDH,
-     $                      NHO, H( KU, KWH ), LDH )
-            END IF
-*
-*           ==== Note progress (or the lack of it). ====
-*
-            IF( LD.GT.0 ) THEN
-               NDFL = 1
-            ELSE
-               NDFL = NDFL + 1
-            END IF
-*
-*           ==== End of main loop ====
-   70    CONTINUE
-*
-*        ==== Iteration limit exceeded.  Set INFO to show where
-*        .    the problem occurred and exit. ====
-*
-         INFO = KBOT
-   80    CONTINUE
-      END IF
-*
-*     ==== Return the optimal value of LWORK. ====
-*
-      WORK( 1 ) = DCMPLX( LWKOPT, 0 )
-*
-*     ==== End of ZLAQR4 ====
-*
-      END
diff --git a/src/lib/lapack/zlaqr5.f b/src/lib/lapack/zlaqr5.f
deleted file mode 100644
index fa8de7bb..00000000
--- a/src/lib/lapack/zlaqr5.f
+++ /dev/null
@@ -1,809 +0,0 @@
-      SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
-     $                   H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV,
-     $                   WV, LDWV, NH, WH, LDWH )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV,
-     $                   LDWH, LDWV, LDZ, N, NH, NSHFTS, NV
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         H( LDH, * ), S( * ), U( LDU, * ), V( LDV, * ),
-     $                   WH( LDWH, * ), WV( LDWV, * ), Z( LDZ, * )
-*     ..
-*
-*     This auxiliary subroutine called by ZLAQR0 performs a
-*     single small-bulge multi-shift QR sweep.
-*
-*      WANTT  (input) logical scalar
-*             WANTT = .true. if the triangular Schur factor
-*             is being computed.  WANTT is set to .false. otherwise.
-*
-*      WANTZ  (input) logical scalar
-*             WANTZ = .true. if the unitary Schur factor is being
-*             computed.  WANTZ is set to .false. otherwise.
-*
-*      KACC22 (input) integer with value 0, 1, or 2.
-*             Specifies the computation mode of far-from-diagonal
-*             orthogonal updates.
-*        = 0: ZLAQR5 does not accumulate reflections and does not
-*             use matrix-matrix multiply to update far-from-diagonal
-*             matrix entries.
-*        = 1: ZLAQR5 accumulates reflections and uses matrix-matrix
-*             multiply to update the far-from-diagonal matrix entries.
-*        = 2: ZLAQR5 accumulates reflections, uses matrix-matrix
-*             multiply to update the far-from-diagonal matrix entries,
-*             and takes advantage of 2-by-2 block structure during
-*             matrix multiplies.
-*
-*      N      (input) integer scalar
-*             N is the order of the Hessenberg matrix H upon which this
-*             subroutine operates.
-*
-*      KTOP   (input) integer scalar
-*      KBOT   (input) integer scalar
-*             These are the first and last rows and columns of an
-*             isolated diagonal block upon which the QR sweep is to be
-*             applied. It is assumed without a check that
-*                       either KTOP = 1  or   H(KTOP,KTOP-1) = 0
-*             and
-*                       either KBOT = N  or   H(KBOT+1,KBOT) = 0.
-*
-*      NSHFTS (input) integer scalar
-*             NSHFTS gives the number of simultaneous shifts.  NSHFTS
-*             must be positive and even.
-*
-*      S      (input) COMPLEX*16 array of size (NSHFTS)
-*             S contains the shifts of origin that define the multi-
-*             shift QR sweep.
-*
-*      H      (input/output) COMPLEX*16 array of size (LDH,N)
-*             On input H contains a Hessenberg matrix.  On output a
-*             multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
-*             to the isolated diagonal block in rows and columns KTOP
-*             through KBOT.
-*
-*      LDH    (input) integer scalar
-*             LDH is the leading dimension of H just as declared in the
-*             calling procedure.  LDH.GE.MAX(1,N).
-*
-*      ILOZ   (input) INTEGER
-*      IHIZ   (input) INTEGER
-*             Specify the rows of Z to which transformations must be
-*             applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N
-*
-*      Z      (input/output) COMPLEX*16 array of size (LDZ,IHI)
-*             If WANTZ = .TRUE., then the QR Sweep unitary
-*             similarity transformation is accumulated into
-*             Z(ILOZ:IHIZ,ILO:IHI) from the right.
-*             If WANTZ = .FALSE., then Z is unreferenced.
-*
-*      LDZ    (input) integer scalar
-*             LDA is the leading dimension of Z just as declared in
-*             the calling procedure. LDZ.GE.N.
-*
-*      V      (workspace) COMPLEX*16 array of size (LDV,NSHFTS/2)
-*
-*      LDV    (input) integer scalar
-*             LDV is the leading dimension of V as declared in the
-*             calling procedure.  LDV.GE.3.
-*
-*      U      (workspace) COMPLEX*16 array of size
-*             (LDU,3*NSHFTS-3)
-*
-*      LDU    (input) integer scalar
-*             LDU is the leading dimension of U just as declared in the
-*             in the calling subroutine.  LDU.GE.3*NSHFTS-3.
-*
-*      NH     (input) integer scalar
-*             NH is the number of columns in array WH available for
-*             workspace. NH.GE.1.
-*
-*      WH     (workspace) COMPLEX*16 array of size (LDWH,NH)
-*
-*      LDWH   (input) integer scalar
-*             Leading dimension of WH just as declared in the
-*             calling procedure.  LDWH.GE.3*NSHFTS-3.
-*
-*      NV     (input) integer scalar
-*             NV is the number of rows in WV agailable for workspace.
-*             NV.GE.1.
-*
-*      WV     (workspace) COMPLEX*16 array of size
-*             (LDWV,3*NSHFTS-3)
-*
-*      LDWV   (input) integer scalar
-*             LDWV is the leading dimension of WV as declared in the
-*             in the calling subroutine.  LDWV.GE.NV.
-*
-*     ================================================================
-*     Based on contributions by
-*        Karen Braman and Ralph Byers, Department of Mathematics,
-*        University of Kansas, USA
-*
-*      ============================================================
-*      Reference:
-*
-*      K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
-*      Algorithm Part I: Maintaining Well Focused Shifts, and
-*      Level 3 Performance, SIAM Journal of Matrix Analysis,
-*      volume 23, pages 929--947, 2002.
-*
-*      ============================================================
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ),
-     $                   ONE = ( 1.0d0, 0.0d0 ) )
-      DOUBLE PRECISION   RZERO, RONE
-      PARAMETER          ( RZERO = 0.0d0, RONE = 1.0d0 )
-*     ..
-*     .. Local Scalars ..
-      COMPLEX*16         ALPHA, BETA, CDUM, REFSUM
-      DOUBLE PRECISION   H11, H12, H21, H22, SAFMAX, SAFMIN, SCL,
-     $                   SMLNUM, TST1, TST2, ULP
-      INTEGER            I2, I4, INCOL, J, J2, J4, JBOT, JCOL, JLEN,
-     $                   JROW, JTOP, K, K1, KDU, KMS, KNZ, KRCOL, KZS,
-     $                   M, M22, MBOT, MEND, MSTART, MTOP, NBMPS, NDCOL,
-     $                   NS, NU
-      LOGICAL            ACCUM, BLK22, BMP22
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-*
-      INTRINSIC          ABS, DBLE, DCONJG, DIMAG, MAX, MIN, MOD
-*     ..
-*     .. Local Arrays ..
-      COMPLEX*16         VT( 3 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, ZGEMM, ZLACPY, ZLAQR1, ZLARFG, ZLASET,
-     $                   ZTRMM
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
-*     ..
-*     .. Executable Statements ..
-*
-*     ==== If there are no shifts, then there is nothing to do. ====
-*
-      IF( NSHFTS.LT.2 )
-     $   RETURN
-*
-*     ==== If the active block is empty or 1-by-1, then there
-*     .    is nothing to do. ====
-*
-      IF( KTOP.GE.KBOT )
-     $   RETURN
-*
-*     ==== NSHFTS is supposed to be even, but if is odd,
-*     .    then simply reduce it by one.  ====
-*
-      NS = NSHFTS - MOD( NSHFTS, 2 )
-*
-*     ==== Machine constants for deflation ====
-*
-      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
-      SAFMAX = RONE / SAFMIN
-      CALL DLABAD( SAFMIN, SAFMAX )
-      ULP = DLAMCH( 'PRECISION' )
-      SMLNUM = SAFMIN*( DBLE( N ) / ULP )
-*
-*     ==== Use accumulated reflections to update far-from-diagonal
-*     .    entries ? ====
-*
-      ACCUM = ( KACC22.EQ.1 ) .OR. ( KACC22.EQ.2 )
-*
-*     ==== If so, exploit the 2-by-2 block structure? ====
-*
-      BLK22 = ( NS.GT.2 ) .AND. ( KACC22.EQ.2 )
-*
-*     ==== clear trash ====
-*
-      IF( KTOP+2.LE.KBOT )
-     $   H( KTOP+2, KTOP ) = ZERO
-*
-*     ==== NBMPS = number of 2-shift bulges in the chain ====
-*
-      NBMPS = NS / 2
-*
-*     ==== KDU = width of slab ====
-*
-      KDU = 6*NBMPS - 3
-*
-*     ==== Create and chase chains of NBMPS bulges ====
-*
-      DO 210 INCOL = 3*( 1-NBMPS ) + KTOP - 1, KBOT - 2, 3*NBMPS - 2
-         NDCOL = INCOL + KDU
-         IF( ACCUM )
-     $      CALL ZLASET( 'ALL', KDU, KDU, ZERO, ONE, U, LDU )
-*
-*        ==== Near-the-diagonal bulge chase.  The following loop
-*        .    performs the near-the-diagonal part of a small bulge
-*        .    multi-shift QR sweep.  Each 6*NBMPS-2 column diagonal
-*        .    chunk extends from column INCOL to column NDCOL
-*        .    (including both column INCOL and column NDCOL). The
-*        .    following loop chases a 3*NBMPS column long chain of
-*        .    NBMPS bulges 3*NBMPS-2 columns to the right.  (INCOL
-*        .    may be less than KTOP and and NDCOL may be greater than
-*        .    KBOT indicating phantom columns from which to chase
-*        .    bulges before they are actually introduced or to which
-*        .    to chase bulges beyond column KBOT.)  ====
-*
-         DO 140 KRCOL = INCOL, MIN( INCOL+3*NBMPS-3, KBOT-2 )
-*
-*           ==== Bulges number MTOP to MBOT are active double implicit
-*           .    shift bulges.  There may or may not also be small
-*           .    2-by-2 bulge, if there is room.  The inactive bulges
-*           .    (if any) must wait until the active bulges have moved
-*           .    down the diagonal to make room.  The phantom matrix
-*           .    paradigm described above helps keep track.  ====
-*
-            MTOP = MAX( 1, ( ( KTOP-1 )-KRCOL+2 ) / 3+1 )
-            MBOT = MIN( NBMPS, ( KBOT-KRCOL ) / 3 )
-            M22 = MBOT + 1
-            BMP22 = ( MBOT.LT.NBMPS ) .AND. ( KRCOL+3*( M22-1 ) ).EQ.
-     $              ( KBOT-2 )
-*
-*           ==== Generate reflections to chase the chain right
-*           .    one column.  (The minimum value of K is KTOP-1.) ====
-*
-            DO 10 M = MTOP, MBOT
-               K = KRCOL + 3*( M-1 )
-               IF( K.EQ.KTOP-1 ) THEN
-                  CALL ZLAQR1( 3, H( KTOP, KTOP ), LDH, S( 2*M-1 ),
-     $                         S( 2*M ), V( 1, M ) )
-                  ALPHA = V( 1, M )
-                  CALL ZLARFG( 3, ALPHA, V( 2, M ), 1, V( 1, M ) )
-               ELSE
-                  BETA = H( K+1, K )
-                  V( 2, M ) = H( K+2, K )
-                  V( 3, M ) = H( K+3, K )
-                  CALL ZLARFG( 3, BETA, V( 2, M ), 1, V( 1, M ) )
-*
-*                 ==== A Bulge may collapse because of vigilant
-*                 .    deflation or destructive underflow.  (The
-*                 .    initial bulge is always collapsed.) Use
-*                 .    the two-small-subdiagonals trick to try
-*                 .    to get it started again. If V(2,M).NE.0 and
-*                 .    V(3,M) = H(K+3,K+1) = H(K+3,K+2) = 0, then
-*                 .    this bulge is collapsing into a zero
-*                 .    subdiagonal.  It will be restarted next
-*                 .    trip through the loop.)
-*
-                  IF( V( 1, M ).NE.ZERO .AND.
-     $                ( V( 3, M ).NE.ZERO .OR. ( H( K+3,
-     $                K+1 ).EQ.ZERO .AND. H( K+3, K+2 ).EQ.ZERO ) ) )
-     $                 THEN
-*
-*                    ==== Typical case: not collapsed (yet). ====
-*
-                     H( K+1, K ) = BETA
-                     H( K+2, K ) = ZERO
-                     H( K+3, K ) = ZERO
-                  ELSE
-*
-*                    ==== Atypical case: collapsed.  Attempt to
-*                    .    reintroduce ignoring H(K+1,K).  If the
-*                    .    fill resulting from the new reflector
-*                    .    is too large, then abandon it.
-*                    .    Otherwise, use the new one. ====
-*
-                     CALL ZLAQR1( 3, H( K+1, K+1 ), LDH, S( 2*M-1 ),
-     $                            S( 2*M ), VT )
-                     SCL = CABS1( VT( 1 ) ) + CABS1( VT( 2 ) ) +
-     $                     CABS1( VT( 3 ) )
-                     IF( SCL.NE.RZERO ) THEN
-                        VT( 1 ) = VT( 1 ) / SCL
-                        VT( 2 ) = VT( 2 ) / SCL
-                        VT( 3 ) = VT( 3 ) / SCL
-                     END IF
-*
-*                    ==== The following is the traditional and
-*                    .    conservative two-small-subdiagonals
-*                    .    test.  ====
-*                    .
-                     IF( CABS1( H( K+1, K ) )*
-     $                   ( CABS1( VT( 2 ) )+CABS1( VT( 3 ) ) ).GT.ULP*
-     $                   CABS1( VT( 1 ) )*( CABS1( H( K,
-     $                   K ) )+CABS1( H( K+1, K+1 ) )+CABS1( H( K+2,
-     $                   K+2 ) ) ) ) THEN
-*
-*                       ==== Starting a new bulge here would
-*                       .    create non-negligible fill.   If
-*                       .    the old reflector is diagonal (only
-*                       .    possible with underflows), then
-*                       .    change it to I.  Otherwise, use
-*                       .    it with trepidation. ====
-*
-                        IF( V( 2, M ).EQ.ZERO .AND. V( 3, M ).EQ.ZERO )
-     $                       THEN
-                           V( 1, M ) = ZERO
-                        ELSE
-                           H( K+1, K ) = BETA
-                           H( K+2, K ) = ZERO
-                           H( K+3, K ) = ZERO
-                        END IF
-                     ELSE
-*
-*                       ==== Stating a new bulge here would
-*                       .    create only negligible fill.
-*                       .    Replace the old reflector with
-*                       .    the new one. ====
-*
-                        ALPHA = VT( 1 )
-                        CALL ZLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
-                        REFSUM = H( K+1, K ) +
-     $                           H( K+2, K )*DCONJG( VT( 2 ) ) +
-     $                           H( K+3, K )*DCONJG( VT( 3 ) )
-                        H( K+1, K ) = H( K+1, K ) -
-     $                                DCONJG( VT( 1 ) )*REFSUM
-                        H( K+2, K ) = ZERO
-                        H( K+3, K ) = ZERO
-                        V( 1, M ) = VT( 1 )
-                        V( 2, M ) = VT( 2 )
-                        V( 3, M ) = VT( 3 )
-                     END IF
-                  END IF
-               END IF
-   10       CONTINUE
-*
-*           ==== Generate a 2-by-2 reflection, if needed. ====
-*
-            K = KRCOL + 3*( M22-1 )
-            IF( BMP22 ) THEN
-               IF( K.EQ.KTOP-1 ) THEN
-                  CALL ZLAQR1( 2, H( K+1, K+1 ), LDH, S( 2*M22-1 ),
-     $                         S( 2*M22 ), V( 1, M22 ) )
-                  BETA = V( 1, M22 )
-                  CALL ZLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
-               ELSE
-                  BETA = H( K+1, K )
-                  V( 2, M22 ) = H( K+2, K )
-                  CALL ZLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
-                  H( K+1, K ) = BETA
-                  H( K+2, K ) = ZERO
-               END IF
-            ELSE
-*
-*              ==== Initialize V(1,M22) here to avoid possible undefined
-*              .    variable problems later. ====
-*
-               V( 1, M22 ) = ZERO
-            END IF
-*
-*           ==== Multiply H by reflections from the left ====
-*
-            IF( ACCUM ) THEN
-               JBOT = MIN( NDCOL, KBOT )
-            ELSE IF( WANTT ) THEN
-               JBOT = N
-            ELSE
-               JBOT = KBOT
-            END IF
-            DO 30 J = MAX( KTOP, KRCOL ), JBOT
-               MEND = MIN( MBOT, ( J-KRCOL+2 ) / 3 )
-               DO 20 M = MTOP, MEND
-                  K = KRCOL + 3*( M-1 )
-                  REFSUM = DCONJG( V( 1, M ) )*
-     $                     ( H( K+1, J )+DCONJG( V( 2, M ) )*
-     $                     H( K+2, J )+DCONJG( V( 3, M ) )*H( K+3, J ) )
-                  H( K+1, J ) = H( K+1, J ) - REFSUM
-                  H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M )
-                  H( K+3, J ) = H( K+3, J ) - REFSUM*V( 3, M )
-   20          CONTINUE
-   30       CONTINUE
-            IF( BMP22 ) THEN
-               K = KRCOL + 3*( M22-1 )
-               DO 40 J = MAX( K+1, KTOP ), JBOT
-                  REFSUM = DCONJG( V( 1, M22 ) )*
-     $                     ( H( K+1, J )+DCONJG( V( 2, M22 ) )*
-     $                     H( K+2, J ) )
-                  H( K+1, J ) = H( K+1, J ) - REFSUM
-                  H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M22 )
-   40          CONTINUE
-            END IF
-*
-*           ==== Multiply H by reflections from the right.
-*           .    Delay filling in the last row until the
-*           .    vigilant deflation check is complete. ====
-*
-            IF( ACCUM ) THEN
-               JTOP = MAX( KTOP, INCOL )
-            ELSE IF( WANTT ) THEN
-               JTOP = 1
-            ELSE
-               JTOP = KTOP
-            END IF
-            DO 80 M = MTOP, MBOT
-               IF( V( 1, M ).NE.ZERO ) THEN
-                  K = KRCOL + 3*( M-1 )
-                  DO 50 J = JTOP, MIN( KBOT, K+3 )
-                     REFSUM = V( 1, M )*( H( J, K+1 )+V( 2, M )*
-     $                        H( J, K+2 )+V( 3, M )*H( J, K+3 ) )
-                     H( J, K+1 ) = H( J, K+1 ) - REFSUM
-                     H( J, K+2 ) = H( J, K+2 ) -
-     $                             REFSUM*DCONJG( V( 2, M ) )
-                     H( J, K+3 ) = H( J, K+3 ) -
-     $                             REFSUM*DCONJG( V( 3, M ) )
-   50             CONTINUE
-*
-                  IF( ACCUM ) THEN
-*
-*                    ==== Accumulate U. (If necessary, update Z later
-*                    .    with with an efficient matrix-matrix
-*                    .    multiply.) ====
-*
-                     KMS = K - INCOL
-                     DO 60 J = MAX( 1, KTOP-INCOL ), KDU
-                        REFSUM = V( 1, M )*( U( J, KMS+1 )+V( 2, M )*
-     $                           U( J, KMS+2 )+V( 3, M )*U( J, KMS+3 ) )
-                        U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
-                        U( J, KMS+2 ) = U( J, KMS+2 ) -
-     $                                  REFSUM*DCONJG( V( 2, M ) )
-                        U( J, KMS+3 ) = U( J, KMS+3 ) -
-     $                                  REFSUM*DCONJG( V( 3, M ) )
-   60                CONTINUE
-                  ELSE IF( WANTZ ) THEN
-*
-*                    ==== U is not accumulated, so update Z
-*                    .    now by multiplying by reflections
-*                    .    from the right. ====
-*
-                     DO 70 J = ILOZ, IHIZ
-                        REFSUM = V( 1, M )*( Z( J, K+1 )+V( 2, M )*
-     $                           Z( J, K+2 )+V( 3, M )*Z( J, K+3 ) )
-                        Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
-                        Z( J, K+2 ) = Z( J, K+2 ) -
-     $                                REFSUM*DCONJG( V( 2, M ) )
-                        Z( J, K+3 ) = Z( J, K+3 ) -
-     $                                REFSUM*DCONJG( V( 3, M ) )
-   70                CONTINUE
-                  END IF
-               END IF
-   80       CONTINUE
-*
-*           ==== Special case: 2-by-2 reflection (if needed) ====
-*
-            K = KRCOL + 3*( M22-1 )
-            IF( BMP22 .AND. ( V( 1, M22 ).NE.ZERO ) ) THEN
-               DO 90 J = JTOP, MIN( KBOT, K+3 )
-                  REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )*
-     $                     H( J, K+2 ) )
-                  H( J, K+1 ) = H( J, K+1 ) - REFSUM
-                  H( J, K+2 ) = H( J, K+2 ) -
-     $                          REFSUM*DCONJG( V( 2, M22 ) )
-   90          CONTINUE
-*
-               IF( ACCUM ) THEN
-                  KMS = K - INCOL
-                  DO 100 J = MAX( 1, KTOP-INCOL ), KDU
-                     REFSUM = V( 1, M22 )*( U( J, KMS+1 )+V( 2, M22 )*
-     $                        U( J, KMS+2 ) )
-                     U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
-                     U( J, KMS+2 ) = U( J, KMS+2 ) -
-     $                               REFSUM*DCONJG( V( 2, M22 ) )
-  100             CONTINUE
-               ELSE IF( WANTZ ) THEN
-                  DO 110 J = ILOZ, IHIZ
-                     REFSUM = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )*
-     $                        Z( J, K+2 ) )
-                     Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
-                     Z( J, K+2 ) = Z( J, K+2 ) -
-     $                             REFSUM*DCONJG( V( 2, M22 ) )
-  110             CONTINUE
-               END IF
-            END IF
-*
-*           ==== Vigilant deflation check ====
-*
-            MSTART = MTOP
-            IF( KRCOL+3*( MSTART-1 ).LT.KTOP )
-     $         MSTART = MSTART + 1
-            MEND = MBOT
-            IF( BMP22 )
-     $         MEND = MEND + 1
-            IF( KRCOL.EQ.KBOT-2 )
-     $         MEND = MEND + 1
-            DO 120 M = MSTART, MEND
-               K = MIN( KBOT-1, KRCOL+3*( M-1 ) )
-*
-*              ==== The following convergence test requires that
-*              .    the tradition small-compared-to-nearby-diagonals
-*              .    criterion and the Ahues & Tisseur (LAWN 122, 1997)
-*              .    criteria both be satisfied.  The latter improves
-*              .    accuracy in some examples. Falling back on an
-*              .    alternate convergence criterion when TST1 or TST2
-*              .    is zero (as done here) is traditional but probably
-*              .    unnecessary. ====
-*
-               IF( H( K+1, K ).NE.ZERO ) THEN
-                  TST1 = CABS1( H( K, K ) ) + CABS1( H( K+1, K+1 ) )
-                  IF( TST1.EQ.RZERO ) THEN
-                     IF( K.GE.KTOP+1 )
-     $                  TST1 = TST1 + CABS1( H( K, K-1 ) )
-                     IF( K.GE.KTOP+2 )
-     $                  TST1 = TST1 + CABS1( H( K, K-2 ) )
-                     IF( K.GE.KTOP+3 )
-     $                  TST1 = TST1 + CABS1( H( K, K-3 ) )
-                     IF( K.LE.KBOT-2 )
-     $                  TST1 = TST1 + CABS1( H( K+2, K+1 ) )
-                     IF( K.LE.KBOT-3 )
-     $                  TST1 = TST1 + CABS1( H( K+3, K+1 ) )
-                     IF( K.LE.KBOT-4 )
-     $                  TST1 = TST1 + CABS1( H( K+4, K+1 ) )
-                  END IF
-                  IF( CABS1( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) )
-     $                 THEN
-                     H12 = MAX( CABS1( H( K+1, K ) ),
-     $                     CABS1( H( K, K+1 ) ) )
-                     H21 = MIN( CABS1( H( K+1, K ) ),
-     $                     CABS1( H( K, K+1 ) ) )
-                     H11 = MAX( CABS1( H( K+1, K+1 ) ),
-     $                     CABS1( H( K, K )-H( K+1, K+1 ) ) )
-                     H22 = MIN( CABS1( H( K+1, K+1 ) ),
-     $                     CABS1( H( K, K )-H( K+1, K+1 ) ) )
-                     SCL = H11 + H12
-                     TST2 = H22*( H11 / SCL )
-*
-                     IF( TST2.EQ.RZERO .OR. H21*( H12 / SCL ).LE.
-     $                   MAX( SMLNUM, ULP*TST2 ) )H( K+1, K ) = ZERO
-                  END IF
-               END IF
-  120       CONTINUE
-*
-*           ==== Fill in the last row of each bulge. ====
-*
-            MEND = MIN( NBMPS, ( KBOT-KRCOL-1 ) / 3 )
-            DO 130 M = MTOP, MEND
-               K = KRCOL + 3*( M-1 )
-               REFSUM = V( 1, M )*V( 3, M )*H( K+4, K+3 )
-               H( K+4, K+1 ) = -REFSUM
-               H( K+4, K+2 ) = -REFSUM*DCONJG( V( 2, M ) )
-               H( K+4, K+3 ) = H( K+4, K+3 ) -
-     $                         REFSUM*DCONJG( V( 3, M ) )
-  130       CONTINUE
-*
-*           ==== End of near-the-diagonal bulge chase. ====
-*
-  140    CONTINUE
-*
-*        ==== Use U (if accumulated) to update far-from-diagonal
-*        .    entries in H.  If required, use U to update Z as
-*        .    well. ====
-*
-         IF( ACCUM ) THEN
-            IF( WANTT ) THEN
-               JTOP = 1
-               JBOT = N
-            ELSE
-               JTOP = KTOP
-               JBOT = KBOT
-            END IF
-            IF( ( .NOT.BLK22 ) .OR. ( INCOL.LT.KTOP ) .OR.
-     $          ( NDCOL.GT.KBOT ) .OR. ( NS.LE.2 ) ) THEN
-*
-*              ==== Updates not exploiting the 2-by-2 block
-*              .    structure of U.  K1 and NU keep track of
-*              .    the location and size of U in the special
-*              .    cases of introducing bulges and chasing
-*              .    bulges off the bottom.  In these special
-*              .    cases and in case the number of shifts
-*              .    is NS = 2, there is no 2-by-2 block
-*              .    structure to exploit.  ====
-*
-               K1 = MAX( 1, KTOP-INCOL )
-               NU = ( KDU-MAX( 0, NDCOL-KBOT ) ) - K1 + 1
-*
-*              ==== Horizontal Multiply ====
-*
-               DO 150 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
-                  JLEN = MIN( NH, JBOT-JCOL+1 )
-                  CALL ZGEMM( 'C', 'N', NU, JLEN, NU, ONE, U( K1, K1 ),
-     $                        LDU, H( INCOL+K1, JCOL ), LDH, ZERO, WH,
-     $                        LDWH )
-                  CALL ZLACPY( 'ALL', NU, JLEN, WH, LDWH,
-     $                         H( INCOL+K1, JCOL ), LDH )
-  150          CONTINUE
-*
-*              ==== Vertical multiply ====
-*
-               DO 160 JROW = JTOP, MAX( KTOP, INCOL ) - 1, NV
-                  JLEN = MIN( NV, MAX( KTOP, INCOL )-JROW )
-                  CALL ZGEMM( 'N', 'N', JLEN, NU, NU, ONE,
-     $                        H( JROW, INCOL+K1 ), LDH, U( K1, K1 ),
-     $                        LDU, ZERO, WV, LDWV )
-                  CALL ZLACPY( 'ALL', JLEN, NU, WV, LDWV,
-     $                         H( JROW, INCOL+K1 ), LDH )
-  160          CONTINUE
-*
-*              ==== Z multiply (also vertical) ====
-*
-               IF( WANTZ ) THEN
-                  DO 170 JROW = ILOZ, IHIZ, NV
-                     JLEN = MIN( NV, IHIZ-JROW+1 )
-                     CALL ZGEMM( 'N', 'N', JLEN, NU, NU, ONE,
-     $                           Z( JROW, INCOL+K1 ), LDZ, U( K1, K1 ),
-     $                           LDU, ZERO, WV, LDWV )
-                     CALL ZLACPY( 'ALL', JLEN, NU, WV, LDWV,
-     $                            Z( JROW, INCOL+K1 ), LDZ )
-  170             CONTINUE
-               END IF
-            ELSE
-*
-*              ==== Updates exploiting U's 2-by-2 block structure.
-*              .    (I2, I4, J2, J4 are the last rows and columns
-*              .    of the blocks.) ====
-*
-               I2 = ( KDU+1 ) / 2
-               I4 = KDU
-               J2 = I4 - I2
-               J4 = KDU
-*
-*              ==== KZS and KNZ deal with the band of zeros
-*              .    along the diagonal of one of the triangular
-*              .    blocks. ====
-*
-               KZS = ( J4-J2 ) - ( NS+1 )
-               KNZ = NS + 1
-*
-*              ==== Horizontal multiply ====
-*
-               DO 180 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
-                  JLEN = MIN( NH, JBOT-JCOL+1 )
-*
-*                 ==== Copy bottom of H to top+KZS of scratch ====
-*                  (The first KZS rows get multiplied by zero.) ====
-*
-                  CALL ZLACPY( 'ALL', KNZ, JLEN, H( INCOL+1+J2, JCOL ),
-     $                         LDH, WH( KZS+1, 1 ), LDWH )
-*
-*                 ==== Multiply by U21' ====
-*
-                  CALL ZLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH )
-                  CALL ZTRMM( 'L', 'U', 'C', 'N', KNZ, JLEN, ONE,
-     $                        U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ),
-     $                        LDWH )
-*
-*                 ==== Multiply top of H by U11' ====
-*
-                  CALL ZGEMM( 'C', 'N', I2, JLEN, J2, ONE, U, LDU,
-     $                        H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH )
-*
-*                 ==== Copy top of H bottom of WH ====
-*
-                  CALL ZLACPY( 'ALL', J2, JLEN, H( INCOL+1, JCOL ), LDH,
-     $                         WH( I2+1, 1 ), LDWH )
-*
-*                 ==== Multiply by U21' ====
-*
-                  CALL ZTRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE,
-     $                        U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH )
-*
-*                 ==== Multiply by U22 ====
-*
-                  CALL ZGEMM( 'C', 'N', I4-I2, JLEN, J4-J2, ONE,
-     $                        U( J2+1, I2+1 ), LDU,
-     $                        H( INCOL+1+J2, JCOL ), LDH, ONE,
-     $                        WH( I2+1, 1 ), LDWH )
-*
-*                 ==== Copy it back ====
-*
-                  CALL ZLACPY( 'ALL', KDU, JLEN, WH, LDWH,
-     $                         H( INCOL+1, JCOL ), LDH )
-  180          CONTINUE
-*
-*              ==== Vertical multiply ====
-*
-               DO 190 JROW = JTOP, MAX( INCOL, KTOP ) - 1, NV
-                  JLEN = MIN( NV, MAX( INCOL, KTOP )-JROW )
-*
-*                 ==== Copy right of H to scratch (the first KZS
-*                 .    columns get multiplied by zero) ====
-*
-                  CALL ZLACPY( 'ALL', JLEN, KNZ, H( JROW, INCOL+1+J2 ),
-     $                         LDH, WV( 1, 1+KZS ), LDWV )
-*
-*                 ==== Multiply by U21 ====
-*
-                  CALL ZLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV, LDWV )
-                  CALL ZTRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE,
-     $                        U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
-     $                        LDWV )
-*
-*                 ==== Multiply by U11 ====
-*
-                  CALL ZGEMM( 'N', 'N', JLEN, I2, J2, ONE,
-     $                        H( JROW, INCOL+1 ), LDH, U, LDU, ONE, WV,
-     $                        LDWV )
-*
-*                 ==== Copy left of H to right of scratch ====
-*
-                  CALL ZLACPY( 'ALL', JLEN, J2, H( JROW, INCOL+1 ), LDH,
-     $                         WV( 1, 1+I2 ), LDWV )
-*
-*                 ==== Multiply by U21 ====
-*
-                  CALL ZTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,
-     $                        U( 1, I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )
-*
-*                 ==== Multiply by U22 ====
-*
-                  CALL ZGEMM( 'N', 'N', JLEN, I4-I2, J4-J2, ONE,
-     $                        H( JROW, INCOL+1+J2 ), LDH,
-     $                        U( J2+1, I2+1 ), LDU, ONE, WV( 1, 1+I2 ),
-     $                        LDWV )
-*
-*                 ==== Copy it back ====
-*
-                  CALL ZLACPY( 'ALL', JLEN, KDU, WV, LDWV,
-     $                         H( JROW, INCOL+1 ), LDH )
-  190          CONTINUE
-*
-*              ==== Multiply Z (also vertical) ====
-*
-               IF( WANTZ ) THEN
-                  DO 200 JROW = ILOZ, IHIZ, NV
-                     JLEN = MIN( NV, IHIZ-JROW+1 )
-*
-*                    ==== Copy right of Z to left of scratch (first
-*                    .     KZS columns get multiplied by zero) ====
-*
-                     CALL ZLACPY( 'ALL', JLEN, KNZ,
-     $                            Z( JROW, INCOL+1+J2 ), LDZ,
-     $                            WV( 1, 1+KZS ), LDWV )
-*
-*                    ==== Multiply by U12 ====
-*
-                     CALL ZLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV,
-     $                            LDWV )
-                     CALL ZTRMM( 'R', 'U', 'N', 'N', JLEN, KNZ, ONE,
-     $                           U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
-     $                           LDWV )
-*
-*                    ==== Multiply by U11 ====
-*
-                     CALL ZGEMM( 'N', 'N', JLEN, I2, J2, ONE,
-     $                           Z( JROW, INCOL+1 ), LDZ, U, LDU, ONE,
-     $                           WV, LDWV )
-*
-*                    ==== Copy left of Z to right of scratch ====
-*
-                     CALL ZLACPY( 'ALL', JLEN, J2, Z( JROW, INCOL+1 ),
-     $                            LDZ, WV( 1, 1+I2 ), LDWV )
-*
-*                    ==== Multiply by U21 ====
-*
-                     CALL ZTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,
-     $                           U( 1, I2+1 ), LDU, WV( 1, 1+I2 ),
-     $                           LDWV )
-*
-*                    ==== Multiply by U22 ====
-*
-                     CALL ZGEMM( 'N', 'N', JLEN, I4-I2, J4-J2, ONE,
-     $                           Z( JROW, INCOL+1+J2 ), LDZ,
-     $                           U( J2+1, I2+1 ), LDU, ONE,
-     $                           WV( 1, 1+I2 ), LDWV )
-*
-*                    ==== Copy the result back to Z ====
-*
-                     CALL ZLACPY( 'ALL', JLEN, KDU, WV, LDWV,
-     $                            Z( JROW, INCOL+1 ), LDZ )
-  200             CONTINUE
-               END IF
-            END IF
-         END IF
-  210 CONTINUE
-*
-*     ==== End of ZLAQR5 ====
-*
-      END
diff --git a/src/lib/lapack/zlarf.f b/src/lib/lapack/zlarf.f
deleted file mode 100644
index d5233c8c..00000000
--- a/src/lib/lapack/zlarf.f
+++ /dev/null
@@ -1,120 +0,0 @@
-      SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE
-      INTEGER            INCV, LDC, M, N
-      COMPLEX*16         TAU
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLARF applies a complex elementary reflector H to a complex M-by-N
-*  matrix C, from either the left or the right. H is represented in the
-*  form
-*
-*        H = I - tau * v * v'
-*
-*  where tau is a complex scalar and v is a complex vector.
-*
-*  If tau = 0, then H is taken to be the unit matrix.
-*
-*  To apply H' (the conjugate transpose of H), supply conjg(tau) instead
-*  tau.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': form  H * C
-*          = 'R': form  C * H
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  V       (input) COMPLEX*16 array, dimension
-*                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
-*                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
-*          The vector v in the representation of H. V is not used if
-*          TAU = 0.
-*
-*  INCV    (input) INTEGER
-*          The increment between elements of v. INCV <> 0.
-*
-*  TAU     (input) COMPLEX*16
-*          The value tau in the representation of H.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*          or C * H if SIDE = 'R'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension
-*                         (N) if SIDE = 'L'
-*                      or (M) if SIDE = 'R'
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE, ZERO
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
-     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZGEMV, ZGERC
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Executable Statements ..
-*
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        Form  H * C
-*
-         IF( TAU.NE.ZERO ) THEN
-*
-*           w := C' * v
-*
-            CALL ZGEMV( 'Conjugate transpose', M, N, ONE, C, LDC, V,
-     $                  INCV, ZERO, WORK, 1 )
-*
-*           C := C - v * w'
-*
-            CALL ZGERC( M, N, -TAU, V, INCV, WORK, 1, C, LDC )
-         END IF
-      ELSE
-*
-*        Form  C * H
-*
-         IF( TAU.NE.ZERO ) THEN
-*
-*           w := C * v
-*
-            CALL ZGEMV( 'No transpose', M, N, ONE, C, LDC, V, INCV,
-     $                  ZERO, WORK, 1 )
-*
-*           C := C - w * v'
-*
-            CALL ZGERC( M, N, -TAU, WORK, 1, V, INCV, C, LDC )
-         END IF
-      END IF
-      RETURN
-*
-*     End of ZLARF
-*
-      END
diff --git a/src/lib/lapack/zlarfb.f b/src/lib/lapack/zlarfb.f
deleted file mode 100644
index af93ea58..00000000
--- a/src/lib/lapack/zlarfb.f
+++ /dev/null
@@ -1,608 +0,0 @@
-      SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
-     $                   T, LDT, C, LDC, WORK, LDWORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, SIDE, STOREV, TRANS
-      INTEGER            K, LDC, LDT, LDV, LDWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         C( LDC, * ), T( LDT, * ), V( LDV, * ),
-     $                   WORK( LDWORK, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLARFB applies a complex block reflector H or its transpose H' to a
-*  complex M-by-N matrix C, from either the left or the right.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply H or H' from the Left
-*          = 'R': apply H or H' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply H (No transpose)
-*          = 'C': apply H' (Conjugate transpose)
-*
-*  DIRECT  (input) CHARACTER*1
-*          Indicates how H is formed from a product of elementary
-*          reflectors
-*          = 'F': H = H(1) H(2) . . . H(k) (Forward)
-*          = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*
-*  STOREV  (input) CHARACTER*1
-*          Indicates how the vectors which define the elementary
-*          reflectors are stored:
-*          = 'C': Columnwise
-*          = 'R': Rowwise
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  K       (input) INTEGER
-*          The order of the matrix T (= the number of elementary
-*          reflectors whose product defines the block reflector).
-*
-*  V       (input) COMPLEX*16 array, dimension
-*                                (LDV,K) if STOREV = 'C'
-*                                (LDV,M) if STOREV = 'R' and SIDE = 'L'
-*                                (LDV,N) if STOREV = 'R' and SIDE = 'R'
-*          The matrix V. See further details.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V.
-*          If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
-*          if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
-*          if STOREV = 'R', LDV >= K.
-*
-*  T       (input) COMPLEX*16 array, dimension (LDT,K)
-*          The triangular K-by-K matrix T in the representation of the
-*          block reflector.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= K.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (LDWORK,K)
-*
-*  LDWORK  (input) INTEGER
-*          The leading dimension of the array WORK.
-*          If SIDE = 'L', LDWORK >= max(1,N);
-*          if SIDE = 'R', LDWORK >= max(1,M).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      CHARACTER          TRANST
-      INTEGER            I, J
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZCOPY, ZGEMM, ZLACGV, ZTRMM
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 .OR. N.LE.0 )
-     $   RETURN
-*
-      IF( LSAME( TRANS, 'N' ) ) THEN
-         TRANST = 'C'
-      ELSE
-         TRANST = 'N'
-      END IF
-*
-      IF( LSAME( STOREV, 'C' ) ) THEN
-*
-         IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-*           Let  V =  ( V1 )    (first K rows)
-*                     ( V2 )
-*           where  V1  is unit lower triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
-*
-*              W := C1'
-*
-               DO 10 J = 1, K
-                  CALL ZCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
-                  CALL ZLACGV( N, WORK( 1, J ), 1 )
-   10          CONTINUE
-*
-*              W := W * V1
-*
-               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C2'*V2
-*
-                  CALL ZGEMM( 'Conjugate transpose', 'No transpose', N,
-     $                        K, M-K, ONE, C( K+1, 1 ), LDC,
-     $                        V( K+1, 1 ), LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C2 := C2 - V2 * W'
-*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
-     $                        M-K, N, K, -ONE, V( K+1, 1 ), LDV, WORK,
-     $                        LDWORK, ONE, C( K+1, 1 ), LDC )
-               END IF
-*
-*              W := W * V1'
-*
-               CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
-     $                     'Unit', N, K, ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W'
-*
-               DO 30 J = 1, K
-                  DO 20 I = 1, N
-                     C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
-   20             CONTINUE
-   30          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
-*
-*              W := C1
-*
-               DO 40 J = 1, K
-                  CALL ZCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
-   40          CONTINUE
-*
-*              W := W * V1
-*
-               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C2 * V2
-*
-                  CALL ZGEMM( 'No transpose', 'No transpose', M, K, N-K,
-     $                        ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
-     $                        ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V'
-*
-               IF( N.GT.K ) THEN
-*
-*                 C2 := C2 - W * V2'
-*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
-     $                        N-K, K, -ONE, WORK, LDWORK, V( K+1, 1 ),
-     $                        LDV, ONE, C( 1, K+1 ), LDC )
-               END IF
-*
-*              W := W * V1'
-*
-               CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
-     $                     'Unit', M, K, ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W
-*
-               DO 60 J = 1, K
-                  DO 50 I = 1, M
-                     C( I, J ) = C( I, J ) - WORK( I, J )
-   50             CONTINUE
-   60          CONTINUE
-            END IF
-*
-         ELSE
-*
-*           Let  V =  ( V1 )
-*                     ( V2 )    (last K rows)
-*           where  V2  is unit upper triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
-*
-*              W := C2'
-*
-               DO 70 J = 1, K
-                  CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
-                  CALL ZLACGV( N, WORK( 1, J ), 1 )
-   70          CONTINUE
-*
-*              W := W * V2
-*
-               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
-     $                     K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C1'*V1
-*
-                  CALL ZGEMM( 'Conjugate transpose', 'No transpose', N,
-     $                        K, M-K, ONE, C, LDC, V, LDV, ONE, WORK,
-     $                        LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C1 := C1 - V1 * W'
-*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
-     $                        M-K, N, K, -ONE, V, LDV, WORK, LDWORK,
-     $                        ONE, C, LDC )
-               END IF
-*
-*              W := W * V2'
-*
-               CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
-     $                     'Unit', N, K, ONE, V( M-K+1, 1 ), LDV, WORK,
-     $                     LDWORK )
-*
-*              C2 := C2 - W'
-*
-               DO 90 J = 1, K
-                  DO 80 I = 1, N
-                     C( M-K+J, I ) = C( M-K+J, I ) -
-     $                               DCONJG( WORK( I, J ) )
-   80             CONTINUE
-   90          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
-*
-*              W := C2
-*
-               DO 100 J = 1, K
-                  CALL ZCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
-  100          CONTINUE
-*
-*              W := W * V2
-*
-               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
-     $                     K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C1 * V1
-*
-                  CALL ZGEMM( 'No transpose', 'No transpose', M, K, N-K,
-     $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V'
-*
-               IF( N.GT.K ) THEN
-*
-*                 C1 := C1 - W * V1'
-*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
-     $                        N-K, K, -ONE, WORK, LDWORK, V, LDV, ONE,
-     $                        C, LDC )
-               END IF
-*
-*              W := W * V2'
-*
-               CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
-     $                     'Unit', M, K, ONE, V( N-K+1, 1 ), LDV, WORK,
-     $                     LDWORK )
-*
-*              C2 := C2 - W
-*
-               DO 120 J = 1, K
-                  DO 110 I = 1, M
-                     C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
-  110             CONTINUE
-  120          CONTINUE
-            END IF
-         END IF
-*
-      ELSE IF( LSAME( STOREV, 'R' ) ) THEN
-*
-         IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-*           Let  V =  ( V1  V2 )    (V1: first K columns)
-*           where  V1  is unit upper triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
-*
-*              W := C1'
-*
-               DO 130 J = 1, K
-                  CALL ZCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
-                  CALL ZLACGV( N, WORK( 1, J ), 1 )
-  130          CONTINUE
-*
-*              W := W * V1'
-*
-               CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
-     $                     'Unit', N, K, ONE, V, LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C2'*V2'
-*
-                  CALL ZGEMM( 'Conjugate transpose',
-     $                        'Conjugate transpose', N, K, M-K, ONE,
-     $                        C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE,
-     $                        WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V' * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C2 := C2 - V2' * W'
-*
-                  CALL ZGEMM( 'Conjugate transpose',
-     $                        'Conjugate transpose', M-K, N, K, -ONE,
-     $                        V( 1, K+1 ), LDV, WORK, LDWORK, ONE,
-     $                        C( K+1, 1 ), LDC )
-               END IF
-*
-*              W := W * V1
-*
-               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W'
-*
-               DO 150 J = 1, K
-                  DO 140 I = 1, N
-                     C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
-  140             CONTINUE
-  150          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
-*
-*              W := C1
-*
-               DO 160 J = 1, K
-                  CALL ZCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
-  160          CONTINUE
-*
-*              W := W * V1'
-*
-               CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
-     $                     'Unit', M, K, ONE, V, LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C2 * V2'
-*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
-     $                        K, N-K, ONE, C( 1, K+1 ), LDC,
-     $                        V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V
-*
-               IF( N.GT.K ) THEN
-*
-*                 C2 := C2 - W * V2
-*
-                  CALL ZGEMM( 'No transpose', 'No transpose', M, N-K, K,
-     $                        -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE,
-     $                        C( 1, K+1 ), LDC )
-               END IF
-*
-*              W := W * V1
-*
-               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W
-*
-               DO 180 J = 1, K
-                  DO 170 I = 1, M
-                     C( I, J ) = C( I, J ) - WORK( I, J )
-  170             CONTINUE
-  180          CONTINUE
-*
-            END IF
-*
-         ELSE
-*
-*           Let  V =  ( V1  V2 )    (V2: last K columns)
-*           where  V2  is unit lower triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
-*
-*              W := C2'
-*
-               DO 190 J = 1, K
-                  CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
-                  CALL ZLACGV( N, WORK( 1, J ), 1 )
-  190          CONTINUE
-*
-*              W := W * V2'
-*
-               CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
-     $                     'Unit', N, K, ONE, V( 1, M-K+1 ), LDV, WORK,
-     $                     LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C1'*V1'
-*
-                  CALL ZGEMM( 'Conjugate transpose',
-     $                        'Conjugate transpose', N, K, M-K, ONE, C,
-     $                        LDC, V, LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V' * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C1 := C1 - V1' * W'
-*
-                  CALL ZGEMM( 'Conjugate transpose',
-     $                        'Conjugate transpose', M-K, N, K, -ONE, V,
-     $                        LDV, WORK, LDWORK, ONE, C, LDC )
-               END IF
-*
-*              W := W * V2
-*
-               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
-     $                     K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
-*
-*              C2 := C2 - W'
-*
-               DO 210 J = 1, K
-                  DO 200 I = 1, N
-                     C( M-K+J, I ) = C( M-K+J, I ) -
-     $                               DCONJG( WORK( I, J ) )
-  200             CONTINUE
-  210          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
-*
-*              W := C2
-*
-               DO 220 J = 1, K
-                  CALL ZCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
-  220          CONTINUE
-*
-*              W := W * V2'
-*
-               CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
-     $                     'Unit', M, K, ONE, V( 1, N-K+1 ), LDV, WORK,
-     $                     LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C1 * V1'
-*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
-     $                        K, N-K, ONE, C, LDC, V, LDV, ONE, WORK,
-     $                        LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V
-*
-               IF( N.GT.K ) THEN
-*
-*                 C1 := C1 - W * V1
-*
-                  CALL ZGEMM( 'No transpose', 'No transpose', M, N-K, K,
-     $                        -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
-               END IF
-*
-*              W := W * V2
-*
-               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
-     $                     K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W
-*
-               DO 240 J = 1, K
-                  DO 230 I = 1, M
-                     C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
-  230             CONTINUE
-  240          CONTINUE
-*
-            END IF
-*
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of ZLARFB
-*
-      END
diff --git a/src/lib/lapack/zlarfg.f b/src/lib/lapack/zlarfg.f
deleted file mode 100644
index d024f928..00000000
--- a/src/lib/lapack/zlarfg.f
+++ /dev/null
@@ -1,145 +0,0 @@
-      SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-      COMPLEX*16         ALPHA, TAU
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLARFG generates a complex elementary reflector H of order n, such
-*  that
-*
-*        H' * ( alpha ) = ( beta ),   H' * H = I.
-*             (   x   )   (   0  )
-*
-*  where alpha and beta are scalars, with beta real, and x is an
-*  (n-1)-element complex vector. H is represented in the form
-*
-*        H = I - tau * ( 1 ) * ( 1 v' ) ,
-*                      ( v )
-*
-*  where tau is a complex scalar and v is a complex (n-1)-element
-*  vector. Note that H is not hermitian.
-*
-*  If the elements of x are all zero and alpha is real, then tau = 0
-*  and H is taken to be the unit matrix.
-*
-*  Otherwise  1 <= real(tau) <= 2  and  abs(tau-1) <= 1 .
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the elementary reflector.
-*
-*  ALPHA   (input/output) COMPLEX*16
-*          On entry, the value alpha.
-*          On exit, it is overwritten with the value beta.
-*
-*  X       (input/output) COMPLEX*16 array, dimension
-*                         (1+(N-2)*abs(INCX))
-*          On entry, the vector x.
-*          On exit, it is overwritten with the vector v.
-*
-*  INCX    (input) INTEGER
-*          The increment between elements of X. INCX > 0.
-*
-*  TAU     (output) COMPLEX*16
-*          The value tau.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            J, KNT
-      DOUBLE PRECISION   ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH, DLAPY3, DZNRM2
-      COMPLEX*16         ZLADIV
-      EXTERNAL           DLAMCH, DLAPY3, DZNRM2, ZLADIV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DIMAG, SIGN
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZDSCAL, ZSCAL
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.LE.0 ) THEN
-         TAU = ZERO
-         RETURN
-      END IF
-*
-      XNORM = DZNRM2( N-1, X, INCX )
-      ALPHR = DBLE( ALPHA )
-      ALPHI = DIMAG( ALPHA )
-*
-      IF( XNORM.EQ.ZERO .AND. ALPHI.EQ.ZERO ) THEN
-*
-*        H  =  I
-*
-         TAU = ZERO
-      ELSE
-*
-*        general case
-*
-         BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
-         SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )
-         RSAFMN = ONE / SAFMIN
-*
-         IF( ABS( BETA ).LT.SAFMIN ) THEN
-*
-*           XNORM, BETA may be inaccurate; scale X and recompute them
-*
-            KNT = 0
-   10       CONTINUE
-            KNT = KNT + 1
-            CALL ZDSCAL( N-1, RSAFMN, X, INCX )
-            BETA = BETA*RSAFMN
-            ALPHI = ALPHI*RSAFMN
-            ALPHR = ALPHR*RSAFMN
-            IF( ABS( BETA ).LT.SAFMIN )
-     $         GO TO 10
-*
-*           New BETA is at most 1, at least SAFMIN
-*
-            XNORM = DZNRM2( N-1, X, INCX )
-            ALPHA = DCMPLX( ALPHR, ALPHI )
-            BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
-            TAU = DCMPLX( ( BETA-ALPHR ) / BETA, -ALPHI / BETA )
-            ALPHA = ZLADIV( DCMPLX( ONE ), ALPHA-BETA )
-            CALL ZSCAL( N-1, ALPHA, X, INCX )
-*
-*           If ALPHA is subnormal, it may lose relative accuracy
-*
-            ALPHA = BETA
-            DO 20 J = 1, KNT
-               ALPHA = ALPHA*SAFMIN
-   20       CONTINUE
-         ELSE
-            TAU = DCMPLX( ( BETA-ALPHR ) / BETA, -ALPHI / BETA )
-            ALPHA = ZLADIV( DCMPLX( ONE ), ALPHA-BETA )
-            CALL ZSCAL( N-1, ALPHA, X, INCX )
-            ALPHA = BETA
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of ZLARFG
-*
-      END
diff --git a/src/lib/lapack/zlarft.f b/src/lib/lapack/zlarft.f
deleted file mode 100644
index 412265e3..00000000
--- a/src/lib/lapack/zlarft.f
+++ /dev/null
@@ -1,224 +0,0 @@
-      SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, STOREV
-      INTEGER            K, LDT, LDV, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         T( LDT, * ), TAU( * ), V( LDV, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLARFT forms the triangular factor T of a complex block reflector H
-*  of order n, which is defined as a product of k elementary reflectors.
-*
-*  If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
-*
-*  If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
-*
-*  If STOREV = 'C', the vector which defines the elementary reflector
-*  H(i) is stored in the i-th column of the array V, and
-*
-*     H  =  I - V * T * V'
-*
-*  If STOREV = 'R', the vector which defines the elementary reflector
-*  H(i) is stored in the i-th row of the array V, and
-*
-*     H  =  I - V' * T * V
-*
-*  Arguments
-*  =========
-*
-*  DIRECT  (input) CHARACTER*1
-*          Specifies the order in which the elementary reflectors are
-*          multiplied to form the block reflector:
-*          = 'F': H = H(1) H(2) . . . H(k) (Forward)
-*          = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*
-*  STOREV  (input) CHARACTER*1
-*          Specifies how the vectors which define the elementary
-*          reflectors are stored (see also Further Details):
-*          = 'C': columnwise
-*          = 'R': rowwise
-*
-*  N       (input) INTEGER
-*          The order of the block reflector H. N >= 0.
-*
-*  K       (input) INTEGER
-*          The order of the triangular factor T (= the number of
-*          elementary reflectors). K >= 1.
-*
-*  V       (input/output) COMPLEX*16 array, dimension
-*                               (LDV,K) if STOREV = 'C'
-*                               (LDV,N) if STOREV = 'R'
-*          The matrix V. See further details.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V.
-*          If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i).
-*
-*  T       (output) COMPLEX*16 array, dimension (LDT,K)
-*          The k by k triangular factor T of the block reflector.
-*          If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
-*          lower triangular. The rest of the array is not used.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= K.
-*
-*  Further Details
-*  ===============
-*
-*  The shape of the matrix V and the storage of the vectors which define
-*  the H(i) is best illustrated by the following example with n = 5 and
-*  k = 3. The elements equal to 1 are not stored; the corresponding
-*  array elements are modified but restored on exit. The rest of the
-*  array is not used.
-*
-*  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
-*
-*               V = (  1       )                 V = (  1 v1 v1 v1 v1 )
-*                   ( v1  1    )                     (     1 v2 v2 v2 )
-*                   ( v1 v2  1 )                     (        1 v3 v3 )
-*                   ( v1 v2 v3 )
-*                   ( v1 v2 v3 )
-*
-*  DIRECT = 'B' and STOREV = 'C':         DIRECT = 'B' and STOREV = 'R':
-*
-*               V = ( v1 v2 v3 )                 V = ( v1 v1  1       )
-*                   ( v1 v2 v3 )                     ( v2 v2 v2  1    )
-*                   (  1 v2 v3 )                     ( v3 v3 v3 v3  1 )
-*                   (     1 v3 )
-*                   (        1 )
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE, ZERO
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
-     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J
-      COMPLEX*16         VII
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZGEMV, ZLACGV, ZTRMV
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      IF( LSAME( DIRECT, 'F' ) ) THEN
-         DO 20 I = 1, K
-            IF( TAU( I ).EQ.ZERO ) THEN
-*
-*              H(i)  =  I
-*
-               DO 10 J = 1, I
-                  T( J, I ) = ZERO
-   10          CONTINUE
-            ELSE
-*
-*              general case
-*
-               VII = V( I, I )
-               V( I, I ) = ONE
-               IF( LSAME( STOREV, 'C' ) ) THEN
-*
-*                 T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i)
-*
-                  CALL ZGEMV( 'Conjugate transpose', N-I+1, I-1,
-     $                        -TAU( I ), V( I, 1 ), LDV, V( I, I ), 1,
-     $                        ZERO, T( 1, I ), 1 )
-               ELSE
-*
-*                 T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)'
-*
-                  IF( I.LT.N )
-     $               CALL ZLACGV( N-I, V( I, I+1 ), LDV )
-                  CALL ZGEMV( 'No transpose', I-1, N-I+1, -TAU( I ),
-     $                        V( 1, I ), LDV, V( I, I ), LDV, ZERO,
-     $                        T( 1, I ), 1 )
-                  IF( I.LT.N )
-     $               CALL ZLACGV( N-I, V( I, I+1 ), LDV )
-               END IF
-               V( I, I ) = VII
-*
-*              T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
-*
-               CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
-     $                     LDT, T( 1, I ), 1 )
-               T( I, I ) = TAU( I )
-            END IF
-   20    CONTINUE
-      ELSE
-         DO 40 I = K, 1, -1
-            IF( TAU( I ).EQ.ZERO ) THEN
-*
-*              H(i)  =  I
-*
-               DO 30 J = I, K
-                  T( J, I ) = ZERO
-   30          CONTINUE
-            ELSE
-*
-*              general case
-*
-               IF( I.LT.K ) THEN
-                  IF( LSAME( STOREV, 'C' ) ) THEN
-                     VII = V( N-K+I, I )
-                     V( N-K+I, I ) = ONE
-*
-*                    T(i+1:k,i) :=
-*                            - tau(i) * V(1:n-k+i,i+1:k)' * V(1:n-k+i,i)
-*
-                     CALL ZGEMV( 'Conjugate transpose', N-K+I, K-I,
-     $                           -TAU( I ), V( 1, I+1 ), LDV, V( 1, I ),
-     $                           1, ZERO, T( I+1, I ), 1 )
-                     V( N-K+I, I ) = VII
-                  ELSE
-                     VII = V( I, N-K+I )
-                     V( I, N-K+I ) = ONE
-*
-*                    T(i+1:k,i) :=
-*                            - tau(i) * V(i+1:k,1:n-k+i) * V(i,1:n-k+i)'
-*
-                     CALL ZLACGV( N-K+I-1, V( I, 1 ), LDV )
-                     CALL ZGEMV( 'No transpose', K-I, N-K+I, -TAU( I ),
-     $                           V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO,
-     $                           T( I+1, I ), 1 )
-                     CALL ZLACGV( N-K+I-1, V( I, 1 ), LDV )
-                     V( I, N-K+I ) = VII
-                  END IF
-*
-*                 T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
-*
-                  CALL ZTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
-     $                        T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
-               END IF
-               T( I, I ) = TAU( I )
-            END IF
-   40    CONTINUE
-      END IF
-      RETURN
-*
-*     End of ZLARFT
-*
-      END
diff --git a/src/lib/lapack/zlarfx.f b/src/lib/lapack/zlarfx.f
deleted file mode 100644
index 327b9d03..00000000
--- a/src/lib/lapack/zlarfx.f
+++ /dev/null
@@ -1,641 +0,0 @@
-      SUBROUTINE ZLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE
-      INTEGER            LDC, M, N
-      COMPLEX*16         TAU
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLARFX applies a complex elementary reflector H to a complex m by n
-*  matrix C, from either the left or the right. H is represented in the
-*  form
-*
-*        H = I - tau * v * v'
-*
-*  where tau is a complex scalar and v is a complex vector.
-*
-*  If tau = 0, then H is taken to be the unit matrix
-*
-*  This version uses inline code if H has order < 11.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': form  H * C
-*          = 'R': form  C * H
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  V       (input) COMPLEX*16 array, dimension (M) if SIDE = 'L'
-*                                        or (N) if SIDE = 'R'
-*          The vector v in the representation of H.
-*
-*  TAU     (input) COMPLEX*16
-*          The value tau in the representation of H.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the m by n matrix C.
-*          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*          or C * H if SIDE = 'R'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDA >= max(1,M).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (N) if SIDE = 'L'
-*                                            or (M) if SIDE = 'R'
-*          WORK is not referenced if H has order < 11.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            J
-      COMPLEX*16         SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
-     $                   V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZGEMV, ZGERC
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG
-*     ..
-*     .. Executable Statements ..
-*
-      IF( TAU.EQ.ZERO )
-     $   RETURN
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        Form  H * C, where H has order m.
-*
-         GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
-     $           170, 190 )M
-*
-*        Code for general M
-*
-*        w := C'*v
-*
-         CALL ZGEMV( 'Conjugate transpose', M, N, ONE, C, LDC, V, 1,
-     $               ZERO, WORK, 1 )
-*
-*        C := C - tau * v * w'
-*
-         CALL ZGERC( M, N, -TAU, V, 1, WORK, 1, C, LDC )
-         GO TO 410
-   10    CONTINUE
-*
-*        Special code for 1 x 1 Householder
-*
-         T1 = ONE - TAU*V( 1 )*DCONJG( V( 1 ) )
-         DO 20 J = 1, N
-            C( 1, J ) = T1*C( 1, J )
-   20    CONTINUE
-         GO TO 410
-   30    CONTINUE
-*
-*        Special code for 2 x 2 Householder
-*
-         V1 = DCONJG( V( 1 ) )
-         T1 = TAU*DCONJG( V1 )
-         V2 = DCONJG( V( 2 ) )
-         T2 = TAU*DCONJG( V2 )
-         DO 40 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-   40    CONTINUE
-         GO TO 410
-   50    CONTINUE
-*
-*        Special code for 3 x 3 Householder
-*
-         V1 = DCONJG( V( 1 ) )
-         T1 = TAU*DCONJG( V1 )
-         V2 = DCONJG( V( 2 ) )
-         T2 = TAU*DCONJG( V2 )
-         V3 = DCONJG( V( 3 ) )
-         T3 = TAU*DCONJG( V3 )
-         DO 60 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-   60    CONTINUE
-         GO TO 410
-   70    CONTINUE
-*
-*        Special code for 4 x 4 Householder
-*
-         V1 = DCONJG( V( 1 ) )
-         T1 = TAU*DCONJG( V1 )
-         V2 = DCONJG( V( 2 ) )
-         T2 = TAU*DCONJG( V2 )
-         V3 = DCONJG( V( 3 ) )
-         T3 = TAU*DCONJG( V3 )
-         V4 = DCONJG( V( 4 ) )
-         T4 = TAU*DCONJG( V4 )
-         DO 80 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-   80    CONTINUE
-         GO TO 410
-   90    CONTINUE
-*
-*        Special code for 5 x 5 Householder
-*
-         V1 = DCONJG( V( 1 ) )
-         T1 = TAU*DCONJG( V1 )
-         V2 = DCONJG( V( 2 ) )
-         T2 = TAU*DCONJG( V2 )
-         V3 = DCONJG( V( 3 ) )
-         T3 = TAU*DCONJG( V3 )
-         V4 = DCONJG( V( 4 ) )
-         T4 = TAU*DCONJG( V4 )
-         V5 = DCONJG( V( 5 ) )
-         T5 = TAU*DCONJG( V5 )
-         DO 100 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-  100    CONTINUE
-         GO TO 410
-  110    CONTINUE
-*
-*        Special code for 6 x 6 Householder
-*
-         V1 = DCONJG( V( 1 ) )
-         T1 = TAU*DCONJG( V1 )
-         V2 = DCONJG( V( 2 ) )
-         T2 = TAU*DCONJG( V2 )
-         V3 = DCONJG( V( 3 ) )
-         T3 = TAU*DCONJG( V3 )
-         V4 = DCONJG( V( 4 ) )
-         T4 = TAU*DCONJG( V4 )
-         V5 = DCONJG( V( 5 ) )
-         T5 = TAU*DCONJG( V5 )
-         V6 = DCONJG( V( 6 ) )
-         T6 = TAU*DCONJG( V6 )
-         DO 120 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-            C( 6, J ) = C( 6, J ) - SUM*T6
-  120    CONTINUE
-         GO TO 410
-  130    CONTINUE
-*
-*        Special code for 7 x 7 Householder
-*
-         V1 = DCONJG( V( 1 ) )
-         T1 = TAU*DCONJG( V1 )
-         V2 = DCONJG( V( 2 ) )
-         T2 = TAU*DCONJG( V2 )
-         V3 = DCONJG( V( 3 ) )
-         T3 = TAU*DCONJG( V3 )
-         V4 = DCONJG( V( 4 ) )
-         T4 = TAU*DCONJG( V4 )
-         V5 = DCONJG( V( 5 ) )
-         T5 = TAU*DCONJG( V5 )
-         V6 = DCONJG( V( 6 ) )
-         T6 = TAU*DCONJG( V6 )
-         V7 = DCONJG( V( 7 ) )
-         T7 = TAU*DCONJG( V7 )
-         DO 140 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
-     $            V7*C( 7, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-            C( 6, J ) = C( 6, J ) - SUM*T6
-            C( 7, J ) = C( 7, J ) - SUM*T7
-  140    CONTINUE
-         GO TO 410
-  150    CONTINUE
-*
-*        Special code for 8 x 8 Householder
-*
-         V1 = DCONJG( V( 1 ) )
-         T1 = TAU*DCONJG( V1 )
-         V2 = DCONJG( V( 2 ) )
-         T2 = TAU*DCONJG( V2 )
-         V3 = DCONJG( V( 3 ) )
-         T3 = TAU*DCONJG( V3 )
-         V4 = DCONJG( V( 4 ) )
-         T4 = TAU*DCONJG( V4 )
-         V5 = DCONJG( V( 5 ) )
-         T5 = TAU*DCONJG( V5 )
-         V6 = DCONJG( V( 6 ) )
-         T6 = TAU*DCONJG( V6 )
-         V7 = DCONJG( V( 7 ) )
-         T7 = TAU*DCONJG( V7 )
-         V8 = DCONJG( V( 8 ) )
-         T8 = TAU*DCONJG( V8 )
-         DO 160 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
-     $            V7*C( 7, J ) + V8*C( 8, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-            C( 6, J ) = C( 6, J ) - SUM*T6
-            C( 7, J ) = C( 7, J ) - SUM*T7
-            C( 8, J ) = C( 8, J ) - SUM*T8
-  160    CONTINUE
-         GO TO 410
-  170    CONTINUE
-*
-*        Special code for 9 x 9 Householder
-*
-         V1 = DCONJG( V( 1 ) )
-         T1 = TAU*DCONJG( V1 )
-         V2 = DCONJG( V( 2 ) )
-         T2 = TAU*DCONJG( V2 )
-         V3 = DCONJG( V( 3 ) )
-         T3 = TAU*DCONJG( V3 )
-         V4 = DCONJG( V( 4 ) )
-         T4 = TAU*DCONJG( V4 )
-         V5 = DCONJG( V( 5 ) )
-         T5 = TAU*DCONJG( V5 )
-         V6 = DCONJG( V( 6 ) )
-         T6 = TAU*DCONJG( V6 )
-         V7 = DCONJG( V( 7 ) )
-         T7 = TAU*DCONJG( V7 )
-         V8 = DCONJG( V( 8 ) )
-         T8 = TAU*DCONJG( V8 )
-         V9 = DCONJG( V( 9 ) )
-         T9 = TAU*DCONJG( V9 )
-         DO 180 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
-     $            V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-            C( 6, J ) = C( 6, J ) - SUM*T6
-            C( 7, J ) = C( 7, J ) - SUM*T7
-            C( 8, J ) = C( 8, J ) - SUM*T8
-            C( 9, J ) = C( 9, J ) - SUM*T9
-  180    CONTINUE
-         GO TO 410
-  190    CONTINUE
-*
-*        Special code for 10 x 10 Householder
-*
-         V1 = DCONJG( V( 1 ) )
-         T1 = TAU*DCONJG( V1 )
-         V2 = DCONJG( V( 2 ) )
-         T2 = TAU*DCONJG( V2 )
-         V3 = DCONJG( V( 3 ) )
-         T3 = TAU*DCONJG( V3 )
-         V4 = DCONJG( V( 4 ) )
-         T4 = TAU*DCONJG( V4 )
-         V5 = DCONJG( V( 5 ) )
-         T5 = TAU*DCONJG( V5 )
-         V6 = DCONJG( V( 6 ) )
-         T6 = TAU*DCONJG( V6 )
-         V7 = DCONJG( V( 7 ) )
-         T7 = TAU*DCONJG( V7 )
-         V8 = DCONJG( V( 8 ) )
-         T8 = TAU*DCONJG( V8 )
-         V9 = DCONJG( V( 9 ) )
-         T9 = TAU*DCONJG( V9 )
-         V10 = DCONJG( V( 10 ) )
-         T10 = TAU*DCONJG( V10 )
-         DO 200 J = 1, N
-            SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
-     $            V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
-     $            V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J ) +
-     $            V10*C( 10, J )
-            C( 1, J ) = C( 1, J ) - SUM*T1
-            C( 2, J ) = C( 2, J ) - SUM*T2
-            C( 3, J ) = C( 3, J ) - SUM*T3
-            C( 4, J ) = C( 4, J ) - SUM*T4
-            C( 5, J ) = C( 5, J ) - SUM*T5
-            C( 6, J ) = C( 6, J ) - SUM*T6
-            C( 7, J ) = C( 7, J ) - SUM*T7
-            C( 8, J ) = C( 8, J ) - SUM*T8
-            C( 9, J ) = C( 9, J ) - SUM*T9
-            C( 10, J ) = C( 10, J ) - SUM*T10
-  200    CONTINUE
-         GO TO 410
-      ELSE
-*
-*        Form  C * H, where H has order n.
-*
-         GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
-     $           370, 390 )N
-*
-*        Code for general N
-*
-*        w := C * v
-*
-         CALL ZGEMV( 'No transpose', M, N, ONE, C, LDC, V, 1, ZERO,
-     $               WORK, 1 )
-*
-*        C := C - tau * w * v'
-*
-         CALL ZGERC( M, N, -TAU, WORK, 1, V, 1, C, LDC )
-         GO TO 410
-  210    CONTINUE
-*
-*        Special code for 1 x 1 Householder
-*
-         T1 = ONE - TAU*V( 1 )*DCONJG( V( 1 ) )
-         DO 220 J = 1, M
-            C( J, 1 ) = T1*C( J, 1 )
-  220    CONTINUE
-         GO TO 410
-  230    CONTINUE
-*
-*        Special code for 2 x 2 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*DCONJG( V1 )
-         V2 = V( 2 )
-         T2 = TAU*DCONJG( V2 )
-         DO 240 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-  240    CONTINUE
-         GO TO 410
-  250    CONTINUE
-*
-*        Special code for 3 x 3 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*DCONJG( V1 )
-         V2 = V( 2 )
-         T2 = TAU*DCONJG( V2 )
-         V3 = V( 3 )
-         T3 = TAU*DCONJG( V3 )
-         DO 260 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-  260    CONTINUE
-         GO TO 410
-  270    CONTINUE
-*
-*        Special code for 4 x 4 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*DCONJG( V1 )
-         V2 = V( 2 )
-         T2 = TAU*DCONJG( V2 )
-         V3 = V( 3 )
-         T3 = TAU*DCONJG( V3 )
-         V4 = V( 4 )
-         T4 = TAU*DCONJG( V4 )
-         DO 280 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-  280    CONTINUE
-         GO TO 410
-  290    CONTINUE
-*
-*        Special code for 5 x 5 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*DCONJG( V1 )
-         V2 = V( 2 )
-         T2 = TAU*DCONJG( V2 )
-         V3 = V( 3 )
-         T3 = TAU*DCONJG( V3 )
-         V4 = V( 4 )
-         T4 = TAU*DCONJG( V4 )
-         V5 = V( 5 )
-         T5 = TAU*DCONJG( V5 )
-         DO 300 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-  300    CONTINUE
-         GO TO 410
-  310    CONTINUE
-*
-*        Special code for 6 x 6 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*DCONJG( V1 )
-         V2 = V( 2 )
-         T2 = TAU*DCONJG( V2 )
-         V3 = V( 3 )
-         T3 = TAU*DCONJG( V3 )
-         V4 = V( 4 )
-         T4 = TAU*DCONJG( V4 )
-         V5 = V( 5 )
-         T5 = TAU*DCONJG( V5 )
-         V6 = V( 6 )
-         T6 = TAU*DCONJG( V6 )
-         DO 320 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-            C( J, 6 ) = C( J, 6 ) - SUM*T6
-  320    CONTINUE
-         GO TO 410
-  330    CONTINUE
-*
-*        Special code for 7 x 7 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*DCONJG( V1 )
-         V2 = V( 2 )
-         T2 = TAU*DCONJG( V2 )
-         V3 = V( 3 )
-         T3 = TAU*DCONJG( V3 )
-         V4 = V( 4 )
-         T4 = TAU*DCONJG( V4 )
-         V5 = V( 5 )
-         T5 = TAU*DCONJG( V5 )
-         V6 = V( 6 )
-         T6 = TAU*DCONJG( V6 )
-         V7 = V( 7 )
-         T7 = TAU*DCONJG( V7 )
-         DO 340 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
-     $            V7*C( J, 7 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-            C( J, 6 ) = C( J, 6 ) - SUM*T6
-            C( J, 7 ) = C( J, 7 ) - SUM*T7
-  340    CONTINUE
-         GO TO 410
-  350    CONTINUE
-*
-*        Special code for 8 x 8 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*DCONJG( V1 )
-         V2 = V( 2 )
-         T2 = TAU*DCONJG( V2 )
-         V3 = V( 3 )
-         T3 = TAU*DCONJG( V3 )
-         V4 = V( 4 )
-         T4 = TAU*DCONJG( V4 )
-         V5 = V( 5 )
-         T5 = TAU*DCONJG( V5 )
-         V6 = V( 6 )
-         T6 = TAU*DCONJG( V6 )
-         V7 = V( 7 )
-         T7 = TAU*DCONJG( V7 )
-         V8 = V( 8 )
-         T8 = TAU*DCONJG( V8 )
-         DO 360 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
-     $            V7*C( J, 7 ) + V8*C( J, 8 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-            C( J, 6 ) = C( J, 6 ) - SUM*T6
-            C( J, 7 ) = C( J, 7 ) - SUM*T7
-            C( J, 8 ) = C( J, 8 ) - SUM*T8
-  360    CONTINUE
-         GO TO 410
-  370    CONTINUE
-*
-*        Special code for 9 x 9 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*DCONJG( V1 )
-         V2 = V( 2 )
-         T2 = TAU*DCONJG( V2 )
-         V3 = V( 3 )
-         T3 = TAU*DCONJG( V3 )
-         V4 = V( 4 )
-         T4 = TAU*DCONJG( V4 )
-         V5 = V( 5 )
-         T5 = TAU*DCONJG( V5 )
-         V6 = V( 6 )
-         T6 = TAU*DCONJG( V6 )
-         V7 = V( 7 )
-         T7 = TAU*DCONJG( V7 )
-         V8 = V( 8 )
-         T8 = TAU*DCONJG( V8 )
-         V9 = V( 9 )
-         T9 = TAU*DCONJG( V9 )
-         DO 380 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
-     $            V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-            C( J, 6 ) = C( J, 6 ) - SUM*T6
-            C( J, 7 ) = C( J, 7 ) - SUM*T7
-            C( J, 8 ) = C( J, 8 ) - SUM*T8
-            C( J, 9 ) = C( J, 9 ) - SUM*T9
-  380    CONTINUE
-         GO TO 410
-  390    CONTINUE
-*
-*        Special code for 10 x 10 Householder
-*
-         V1 = V( 1 )
-         T1 = TAU*DCONJG( V1 )
-         V2 = V( 2 )
-         T2 = TAU*DCONJG( V2 )
-         V3 = V( 3 )
-         T3 = TAU*DCONJG( V3 )
-         V4 = V( 4 )
-         T4 = TAU*DCONJG( V4 )
-         V5 = V( 5 )
-         T5 = TAU*DCONJG( V5 )
-         V6 = V( 6 )
-         T6 = TAU*DCONJG( V6 )
-         V7 = V( 7 )
-         T7 = TAU*DCONJG( V7 )
-         V8 = V( 8 )
-         T8 = TAU*DCONJG( V8 )
-         V9 = V( 9 )
-         T9 = TAU*DCONJG( V9 )
-         V10 = V( 10 )
-         T10 = TAU*DCONJG( V10 )
-         DO 400 J = 1, M
-            SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
-     $            V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
-     $            V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 ) +
-     $            V10*C( J, 10 )
-            C( J, 1 ) = C( J, 1 ) - SUM*T1
-            C( J, 2 ) = C( J, 2 ) - SUM*T2
-            C( J, 3 ) = C( J, 3 ) - SUM*T3
-            C( J, 4 ) = C( J, 4 ) - SUM*T4
-            C( J, 5 ) = C( J, 5 ) - SUM*T5
-            C( J, 6 ) = C( J, 6 ) - SUM*T6
-            C( J, 7 ) = C( J, 7 ) - SUM*T7
-            C( J, 8 ) = C( J, 8 ) - SUM*T8
-            C( J, 9 ) = C( J, 9 ) - SUM*T9
-            C( J, 10 ) = C( J, 10 ) - SUM*T10
-  400    CONTINUE
-         GO TO 410
-      END IF
-  410 CONTINUE
-      RETURN
-*
-*     End of ZLARFX
-*
-      END
diff --git a/src/lib/lapack/zlartg.f b/src/lib/lapack/zlartg.f
deleted file mode 100644
index 6d3a850e..00000000
--- a/src/lib/lapack/zlartg.f
+++ /dev/null
@@ -1,195 +0,0 @@
-      SUBROUTINE ZLARTG( F, G, CS, SN, R )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      DOUBLE PRECISION   CS
-      COMPLEX*16         F, G, R, SN
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLARTG generates a plane rotation so that
-*
-*     [  CS  SN  ]     [ F ]     [ R ]
-*     [  __      ]  .  [   ]  =  [   ]   where CS**2 + |SN|**2 = 1.
-*     [ -SN  CS  ]     [ G ]     [ 0 ]
-*
-*  This is a faster version of the BLAS1 routine ZROTG, except for
-*  the following differences:
-*     F and G are unchanged on return.
-*     If G=0, then CS=1 and SN=0.
-*     If F=0, then CS=0 and SN is chosen so that R is real.
-*
-*  Arguments
-*  =========
-*
-*  F       (input) COMPLEX*16
-*          The first component of vector to be rotated.
-*
-*  G       (input) COMPLEX*16
-*          The second component of vector to be rotated.
-*
-*  CS      (output) DOUBLE PRECISION
-*          The cosine of the rotation.
-*
-*  SN      (output) COMPLEX*16
-*          The sine of the rotation.
-*
-*  R       (output) COMPLEX*16
-*          The nonzero component of the rotated vector.
-*
-*  Further Details
-*  ======= =======
-*
-*  3-5-96 - Modified with a new algorithm by W. Kahan and J. Demmel
-*
-*  This version has a few statements commented out for thread safety
-*  (machine parameters are computed on each entry). 10 feb 03, SJH.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   TWO, ONE, ZERO
-      PARAMETER          ( TWO = 2.0D+0, ONE = 1.0D+0, ZERO = 0.0D+0 )
-      COMPLEX*16         CZERO
-      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-*     LOGICAL            FIRST
-      INTEGER            COUNT, I
-      DOUBLE PRECISION   D, DI, DR, EPS, F2, F2S, G2, G2S, SAFMIN,
-     $                   SAFMN2, SAFMX2, SCALE
-      COMPLEX*16         FF, FS, GS
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH, DLAPY2
-      EXTERNAL           DLAMCH, DLAPY2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, LOG,
-     $                   MAX, SQRT
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   ABS1, ABSSQ
-*     ..
-*     .. Save statement ..
-*     SAVE               FIRST, SAFMX2, SAFMIN, SAFMN2
-*     ..
-*     .. Data statements ..
-*     DATA               FIRST / .TRUE. /
-*     ..
-*     .. Statement Function definitions ..
-      ABS1( FF ) = MAX( ABS( DBLE( FF ) ), ABS( DIMAG( FF ) ) )
-      ABSSQ( FF ) = DBLE( FF )**2 + DIMAG( FF )**2
-*     ..
-*     .. Executable Statements ..
-*
-*     IF( FIRST ) THEN
-         SAFMIN = DLAMCH( 'S' )
-         EPS = DLAMCH( 'E' )
-         SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
-     $            LOG( DLAMCH( 'B' ) ) / TWO )
-         SAFMX2 = ONE / SAFMN2
-*        FIRST = .FALSE.
-*     END IF
-      SCALE = MAX( ABS1( F ), ABS1( G ) )
-      FS = F
-      GS = G
-      COUNT = 0
-      IF( SCALE.GE.SAFMX2 ) THEN
-   10    CONTINUE
-         COUNT = COUNT + 1
-         FS = FS*SAFMN2
-         GS = GS*SAFMN2
-         SCALE = SCALE*SAFMN2
-         IF( SCALE.GE.SAFMX2 )
-     $      GO TO 10
-      ELSE IF( SCALE.LE.SAFMN2 ) THEN
-         IF( G.EQ.CZERO ) THEN
-            CS = ONE
-            SN = CZERO
-            R = F
-            RETURN
-         END IF
-   20    CONTINUE
-         COUNT = COUNT - 1
-         FS = FS*SAFMX2
-         GS = GS*SAFMX2
-         SCALE = SCALE*SAFMX2
-         IF( SCALE.LE.SAFMN2 )
-     $      GO TO 20
-      END IF
-      F2 = ABSSQ( FS )
-      G2 = ABSSQ( GS )
-      IF( F2.LE.MAX( G2, ONE )*SAFMIN ) THEN
-*
-*        This is a rare case: F is very small.
-*
-         IF( F.EQ.CZERO ) THEN
-            CS = ZERO
-            R = DLAPY2( DBLE( G ), DIMAG( G ) )
-*           Do complex/real division explicitly with two real divisions
-            D = DLAPY2( DBLE( GS ), DIMAG( GS ) )
-            SN = DCMPLX( DBLE( GS ) / D, -DIMAG( GS ) / D )
-            RETURN
-         END IF
-         F2S = DLAPY2( DBLE( FS ), DIMAG( FS ) )
-*        G2 and G2S are accurate
-*        G2 is at least SAFMIN, and G2S is at least SAFMN2
-         G2S = SQRT( G2 )
-*        Error in CS from underflow in F2S is at most
-*        UNFL / SAFMN2 .lt. sqrt(UNFL*EPS) .lt. EPS
-*        If MAX(G2,ONE)=G2, then F2 .lt. G2*SAFMIN,
-*        and so CS .lt. sqrt(SAFMIN)
-*        If MAX(G2,ONE)=ONE, then F2 .lt. SAFMIN
-*        and so CS .lt. sqrt(SAFMIN)/SAFMN2 = sqrt(EPS)
-*        Therefore, CS = F2S/G2S / sqrt( 1 + (F2S/G2S)**2 ) = F2S/G2S
-         CS = F2S / G2S
-*        Make sure abs(FF) = 1
-*        Do complex/real division explicitly with 2 real divisions
-         IF( ABS1( F ).GT.ONE ) THEN
-            D = DLAPY2( DBLE( F ), DIMAG( F ) )
-            FF = DCMPLX( DBLE( F ) / D, DIMAG( F ) / D )
-         ELSE
-            DR = SAFMX2*DBLE( F )
-            DI = SAFMX2*DIMAG( F )
-            D = DLAPY2( DR, DI )
-            FF = DCMPLX( DR / D, DI / D )
-         END IF
-         SN = FF*DCMPLX( DBLE( GS ) / G2S, -DIMAG( GS ) / G2S )
-         R = CS*F + SN*G
-      ELSE
-*
-*        This is the most common case.
-*        Neither F2 nor F2/G2 are less than SAFMIN
-*        F2S cannot overflow, and it is accurate
-*
-         F2S = SQRT( ONE+G2 / F2 )
-*        Do the F2S(real)*FS(complex) multiply with two real multiplies
-         R = DCMPLX( F2S*DBLE( FS ), F2S*DIMAG( FS ) )
-         CS = ONE / F2S
-         D = F2 + G2
-*        Do complex/real division explicitly with two real divisions
-         SN = DCMPLX( DBLE( R ) / D, DIMAG( R ) / D )
-         SN = SN*DCONJG( GS )
-         IF( COUNT.NE.0 ) THEN
-            IF( COUNT.GT.0 ) THEN
-               DO 30 I = 1, COUNT
-                  R = R*SAFMX2
-   30          CONTINUE
-            ELSE
-               DO 40 I = 1, -COUNT
-                  R = R*SAFMN2
-   40          CONTINUE
-            END IF
-         END IF
-      END IF
-      RETURN
-*
-*     End of ZLARTG
-*
-      END
diff --git a/src/lib/lapack/zlarz.f b/src/lib/lapack/zlarz.f
deleted file mode 100644
index 18124672..00000000
--- a/src/lib/lapack/zlarz.f
+++ /dev/null
@@ -1,157 +0,0 @@
-      SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE
-      INTEGER            INCV, L, LDC, M, N
-      COMPLEX*16         TAU
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLARZ applies a complex elementary reflector H to a complex
-*  M-by-N matrix C, from either the left or the right. H is represented
-*  in the form
-*
-*        H = I - tau * v * v'
-*
-*  where tau is a complex scalar and v is a complex vector.
-*
-*  If tau = 0, then H is taken to be the unit matrix.
-*
-*  To apply H' (the conjugate transpose of H), supply conjg(tau) instead
-*  tau.
-*
-*  H is a product of k elementary reflectors as returned by ZTZRZF.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': form  H * C
-*          = 'R': form  C * H
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  L       (input) INTEGER
-*          The number of entries of the vector V containing
-*          the meaningful part of the Householder vectors.
-*          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*
-*  V       (input) COMPLEX*16 array, dimension (1+(L-1)*abs(INCV))
-*          The vector v in the representation of H as returned by
-*          ZTZRZF. V is not used if TAU = 0.
-*
-*  INCV    (input) INTEGER
-*          The increment between elements of v. INCV <> 0.
-*
-*  TAU     (input) COMPLEX*16
-*          The value tau in the representation of H.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
-*          or C * H if SIDE = 'R'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension
-*                         (N) if SIDE = 'L'
-*                      or (M) if SIDE = 'R'
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE, ZERO
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
-     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Executable Statements ..
-*
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        Form  H * C
-*
-         IF( TAU.NE.ZERO ) THEN
-*
-*           w( 1:n ) = conjg( C( 1, 1:n ) )
-*
-            CALL ZCOPY( N, C, LDC, WORK, 1 )
-            CALL ZLACGV( N, WORK, 1 )
-*
-*           w( 1:n ) = conjg( w( 1:n ) + C( m-l+1:m, 1:n )' * v( 1:l ) )
-*
-            CALL ZGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, 1 ),
-     $                  LDC, V, INCV, ONE, WORK, 1 )
-            CALL ZLACGV( N, WORK, 1 )
-*
-*           C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
-*
-            CALL ZAXPY( N, -TAU, WORK, 1, C, LDC )
-*
-*           C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
-*                               tau * v( 1:l ) * conjg( w( 1:n )' )
-*
-            CALL ZGERU( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
-     $                  LDC )
-         END IF
-*
-      ELSE
-*
-*        Form  C * H
-*
-         IF( TAU.NE.ZERO ) THEN
-*
-*           w( 1:m ) = C( 1:m, 1 )
-*
-            CALL ZCOPY( M, C, 1, WORK, 1 )
-*
-*           w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
-*
-            CALL ZGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
-     $                  V, INCV, ONE, WORK, 1 )
-*
-*           C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
-*
-            CALL ZAXPY( M, -TAU, WORK, 1, C, 1 )
-*
-*           C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
-*                               tau * w( 1:m ) * v( 1:l )'
-*
-            CALL ZGERC( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
-     $                  LDC )
-*
-         END IF
-*
-      END IF
-*
-      RETURN
-*
-*     End of ZLARZ
-*
-      END
diff --git a/src/lib/lapack/zlarzb.f b/src/lib/lapack/zlarzb.f
deleted file mode 100644
index 05d2a0e3..00000000
--- a/src/lib/lapack/zlarzb.f
+++ /dev/null
@@ -1,234 +0,0 @@
-      SUBROUTINE ZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
-     $                   LDV, T, LDT, C, LDC, WORK, LDWORK )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, SIDE, STOREV, TRANS
-      INTEGER            K, L, LDC, LDT, LDV, LDWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         C( LDC, * ), T( LDT, * ), V( LDV, * ),
-     $                   WORK( LDWORK, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLARZB applies a complex block reflector H or its transpose H**H
-*  to a complex distributed M-by-N  C from the left or the right.
-*
-*  Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply H or H' from the Left
-*          = 'R': apply H or H' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply H (No transpose)
-*          = 'C': apply H' (Conjugate transpose)
-*
-*  DIRECT  (input) CHARACTER*1
-*          Indicates how H is formed from a product of elementary
-*          reflectors
-*          = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
-*          = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*
-*  STOREV  (input) CHARACTER*1
-*          Indicates how the vectors which define the elementary
-*          reflectors are stored:
-*          = 'C': Columnwise                        (not supported yet)
-*          = 'R': Rowwise
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  K       (input) INTEGER
-*          The order of the matrix T (= the number of elementary
-*          reflectors whose product defines the block reflector).
-*
-*  L       (input) INTEGER
-*          The number of columns of the matrix V containing the
-*          meaningful part of the Householder reflectors.
-*          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*
-*  V       (input) COMPLEX*16 array, dimension (LDV,NV).
-*          If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V.
-*          If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
-*
-*  T       (input) COMPLEX*16 array, dimension (LDT,K)
-*          The triangular K-by-K matrix T in the representation of the
-*          block reflector.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= K.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (LDWORK,K)
-*
-*  LDWORK  (input) INTEGER
-*          The leading dimension of the array WORK.
-*          If SIDE = 'L', LDWORK >= max(1,N);
-*          if SIDE = 'R', LDWORK >= max(1,M).
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      CHARACTER          TRANST
-      INTEGER            I, INFO, J
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZCOPY, ZGEMM, ZLACGV, ZTRMM
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 .OR. N.LE.0 )
-     $   RETURN
-*
-*     Check for currently supported options
-*
-      INFO = 0
-      IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
-         INFO = -3
-      ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
-         INFO = -4
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZLARZB', -INFO )
-         RETURN
-      END IF
-*
-      IF( LSAME( TRANS, 'N' ) ) THEN
-         TRANST = 'C'
-      ELSE
-         TRANST = 'N'
-      END IF
-*
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        Form  H * C  or  H' * C
-*
-*        W( 1:n, 1:k ) = conjg( C( 1:k, 1:n )' )
-*
-         DO 10 J = 1, K
-            CALL ZCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
-   10    CONTINUE
-*
-*        W( 1:n, 1:k ) = W( 1:n, 1:k ) + ...
-*                        conjg( C( m-l+1:m, 1:n )' ) * V( 1:k, 1:l )'
-*
-         IF( L.GT.0 )
-     $      CALL ZGEMM( 'Transpose', 'Conjugate transpose', N, K, L,
-     $                  ONE, C( M-L+1, 1 ), LDC, V, LDV, ONE, WORK,
-     $                  LDWORK )
-*
-*        W( 1:n, 1:k ) = W( 1:n, 1:k ) * T'  or  W( 1:m, 1:k ) * T
-*
-         CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T,
-     $               LDT, WORK, LDWORK )
-*
-*        C( 1:k, 1:n ) = C( 1:k, 1:n ) - conjg( W( 1:n, 1:k )' )
-*
-         DO 30 J = 1, N
-            DO 20 I = 1, K
-               C( I, J ) = C( I, J ) - WORK( J, I )
-   20       CONTINUE
-   30    CONTINUE
-*
-*        C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
-*                    conjg( V( 1:k, 1:l )' ) * conjg( W( 1:n, 1:k )' )
-*
-         IF( L.GT.0 )
-     $      CALL ZGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV,
-     $                  WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC )
-*
-      ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*        Form  C * H  or  C * H'
-*
-*        W( 1:m, 1:k ) = C( 1:m, 1:k )
-*
-         DO 40 J = 1, K
-            CALL ZCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
-   40    CONTINUE
-*
-*        W( 1:m, 1:k ) = W( 1:m, 1:k ) + ...
-*                        C( 1:m, n-l+1:n ) * conjg( V( 1:k, 1:l )' )
-*
-         IF( L.GT.0 )
-     $      CALL ZGEMM( 'No transpose', 'Transpose', M, K, L, ONE,
-     $                  C( 1, N-L+1 ), LDC, V, LDV, ONE, WORK, LDWORK )
-*
-*        W( 1:m, 1:k ) = W( 1:m, 1:k ) * conjg( T )  or
-*                        W( 1:m, 1:k ) * conjg( T' )
-*
-         DO 50 J = 1, K
-            CALL ZLACGV( K-J+1, T( J, J ), 1 )
-   50    CONTINUE
-         CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T,
-     $               LDT, WORK, LDWORK )
-         DO 60 J = 1, K
-            CALL ZLACGV( K-J+1, T( J, J ), 1 )
-   60    CONTINUE
-*
-*        C( 1:m, 1:k ) = C( 1:m, 1:k ) - W( 1:m, 1:k )
-*
-         DO 80 J = 1, K
-            DO 70 I = 1, M
-               C( I, J ) = C( I, J ) - WORK( I, J )
-   70       CONTINUE
-   80    CONTINUE
-*
-*        C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
-*                            W( 1:m, 1:k ) * conjg( V( 1:k, 1:l ) )
-*
-         DO 90 J = 1, L
-            CALL ZLACGV( K, V( 1, J ), 1 )
-   90    CONTINUE
-         IF( L.GT.0 )
-     $      CALL ZGEMM( 'No transpose', 'No transpose', M, L, K, -ONE,
-     $                  WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC )
-         DO 100 J = 1, L
-            CALL ZLACGV( K, V( 1, J ), 1 )
-  100    CONTINUE
-*
-      END IF
-*
-      RETURN
-*
-*     End of ZLARZB
-*
-      END
diff --git a/src/lib/lapack/zlarzt.f b/src/lib/lapack/zlarzt.f
deleted file mode 100644
index 9242ed36..00000000
--- a/src/lib/lapack/zlarzt.f
+++ /dev/null
@@ -1,186 +0,0 @@
-      SUBROUTINE ZLARZT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, STOREV
-      INTEGER            K, LDT, LDV, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         T( LDT, * ), TAU( * ), V( LDV, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLARZT forms the triangular factor T of a complex block reflector
-*  H of order > n, which is defined as a product of k elementary
-*  reflectors.
-*
-*  If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
-*
-*  If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
-*
-*  If STOREV = 'C', the vector which defines the elementary reflector
-*  H(i) is stored in the i-th column of the array V, and
-*
-*     H  =  I - V * T * V'
-*
-*  If STOREV = 'R', the vector which defines the elementary reflector
-*  H(i) is stored in the i-th row of the array V, and
-*
-*     H  =  I - V' * T * V
-*
-*  Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
-*
-*  Arguments
-*  =========
-*
-*  DIRECT  (input) CHARACTER*1
-*          Specifies the order in which the elementary reflectors are
-*          multiplied to form the block reflector:
-*          = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
-*          = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*
-*  STOREV  (input) CHARACTER*1
-*          Specifies how the vectors which define the elementary
-*          reflectors are stored (see also Further Details):
-*          = 'C': columnwise                        (not supported yet)
-*          = 'R': rowwise
-*
-*  N       (input) INTEGER
-*          The order of the block reflector H. N >= 0.
-*
-*  K       (input) INTEGER
-*          The order of the triangular factor T (= the number of
-*          elementary reflectors). K >= 1.
-*
-*  V       (input/output) COMPLEX*16 array, dimension
-*                               (LDV,K) if STOREV = 'C'
-*                               (LDV,N) if STOREV = 'R'
-*          The matrix V. See further details.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V.
-*          If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i).
-*
-*  T       (output) COMPLEX*16 array, dimension (LDT,K)
-*          The k by k triangular factor T of the block reflector.
-*          If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
-*          lower triangular. The rest of the array is not used.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= K.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  The shape of the matrix V and the storage of the vectors which define
-*  the H(i) is best illustrated by the following example with n = 5 and
-*  k = 3. The elements equal to 1 are not stored; the corresponding
-*  array elements are modified but restored on exit. The rest of the
-*  array is not used.
-*
-*  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
-*
-*                                              ______V_____
-*         ( v1 v2 v3 )                        /            \
-*         ( v1 v2 v3 )                      ( v1 v1 v1 v1 v1 . . . . 1 )
-*     V = ( v1 v2 v3 )                      ( v2 v2 v2 v2 v2 . . . 1   )
-*         ( v1 v2 v3 )                      ( v3 v3 v3 v3 v3 . . 1     )
-*         ( v1 v2 v3 )
-*            .  .  .
-*            .  .  .
-*            1  .  .
-*               1  .
-*                  1
-*
-*  DIRECT = 'B' and STOREV = 'C':         DIRECT = 'B' and STOREV = 'R':
-*
-*                                                        ______V_____
-*            1                                          /            \
-*            .  1                           ( 1 . . . . v1 v1 v1 v1 v1 )
-*            .  .  1                        ( . 1 . . . v2 v2 v2 v2 v2 )
-*            .  .  .                        ( . . 1 . . v3 v3 v3 v3 v3 )
-*            .  .  .
-*         ( v1 v2 v3 )
-*         ( v1 v2 v3 )
-*     V = ( v1 v2 v3 )
-*         ( v1 v2 v3 )
-*         ( v1 v2 v3 )
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, INFO, J
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMV, ZLACGV, ZTRMV
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Executable Statements ..
-*
-*     Check for currently supported options
-*
-      INFO = 0
-      IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
-         INFO = -2
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZLARZT', -INFO )
-         RETURN
-      END IF
-*
-      DO 20 I = K, 1, -1
-         IF( TAU( I ).EQ.ZERO ) THEN
-*
-*           H(i)  =  I
-*
-            DO 10 J = I, K
-               T( J, I ) = ZERO
-   10       CONTINUE
-         ELSE
-*
-*           general case
-*
-            IF( I.LT.K ) THEN
-*
-*              T(i+1:k,i) = - tau(i) * V(i+1:k,1:n) * V(i,1:n)'
-*
-               CALL ZLACGV( N, V( I, 1 ), LDV )
-               CALL ZGEMV( 'No transpose', K-I, N, -TAU( I ),
-     $                     V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO,
-     $                     T( I+1, I ), 1 )
-               CALL ZLACGV( N, V( I, 1 ), LDV )
-*
-*              T(i+1:k,i) = T(i+1:k,i+1:k) * T(i+1:k,i)
-*
-               CALL ZTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
-     $                     T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
-            END IF
-            T( I, I ) = TAU( I )
-         END IF
-   20 CONTINUE
-      RETURN
-*
-*     End of ZLARZT
-*
-      END
diff --git a/src/lib/lapack/zlascl.f b/src/lib/lapack/zlascl.f
deleted file mode 100644
index 36bb2445..00000000
--- a/src/lib/lapack/zlascl.f
+++ /dev/null
@@ -1,267 +0,0 @@
-      SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TYPE
-      INTEGER            INFO, KL, KU, LDA, M, N
-      DOUBLE PRECISION   CFROM, CTO
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLASCL multiplies the M by N complex matrix A by the real scalar
-*  CTO/CFROM.  This is done without over/underflow as long as the final
-*  result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
-*  A may be full, upper triangular, lower triangular, upper Hessenberg,
-*  or banded.
-*
-*  Arguments
-*  =========
-*
-*  TYPE    (input) CHARACTER*1
-*          TYPE indices the storage type of the input matrix.
-*          = 'G':  A is a full matrix.
-*          = 'L':  A is a lower triangular matrix.
-*          = 'U':  A is an upper triangular matrix.
-*          = 'H':  A is an upper Hessenberg matrix.
-*          = 'B':  A is a symmetric band matrix with lower bandwidth KL
-*                  and upper bandwidth KU and with the only the lower
-*                  half stored.
-*          = 'Q':  A is a symmetric band matrix with lower bandwidth KL
-*                  and upper bandwidth KU and with the only the upper
-*                  half stored.
-*          = 'Z':  A is a band matrix with lower bandwidth KL and upper
-*                  bandwidth KU.
-*
-*  KL      (input) INTEGER
-*          The lower bandwidth of A.  Referenced only if TYPE = 'B',
-*          'Q' or 'Z'.
-*
-*  KU      (input) INTEGER
-*          The upper bandwidth of A.  Referenced only if TYPE = 'B',
-*          'Q' or 'Z'.
-*
-*  CFROM   (input) DOUBLE PRECISION
-*  CTO     (input) DOUBLE PRECISION
-*          The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
-*          without over/underflow if the final result CTO*A(I,J)/CFROM
-*          can be represented without over/underflow.  CFROM must be
-*          nonzero.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          The matrix to be multiplied by CTO/CFROM.  See TYPE for the
-*          storage type.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  INFO    (output) INTEGER
-*          0  - successful exit
-*          <0 - if INFO = -i, the i-th argument had an illegal value.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            DONE
-      INTEGER            I, ITYPE, J, K1, K2, K3, K4
-      DOUBLE PRECISION   BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           LSAME, DLAMCH
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-*
-      IF( LSAME( TYPE, 'G' ) ) THEN
-         ITYPE = 0
-      ELSE IF( LSAME( TYPE, 'L' ) ) THEN
-         ITYPE = 1
-      ELSE IF( LSAME( TYPE, 'U' ) ) THEN
-         ITYPE = 2
-      ELSE IF( LSAME( TYPE, 'H' ) ) THEN
-         ITYPE = 3
-      ELSE IF( LSAME( TYPE, 'B' ) ) THEN
-         ITYPE = 4
-      ELSE IF( LSAME( TYPE, 'Q' ) ) THEN
-         ITYPE = 5
-      ELSE IF( LSAME( TYPE, 'Z' ) ) THEN
-         ITYPE = 6
-      ELSE
-         ITYPE = -1
-      END IF
-*
-      IF( ITYPE.EQ.-1 ) THEN
-         INFO = -1
-      ELSE IF( CFROM.EQ.ZERO ) THEN
-         INFO = -4
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -6
-      ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR.
-     $         ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN
-         INFO = -7
-      ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -9
-      ELSE IF( ITYPE.GE.4 ) THEN
-         IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN
-            INFO = -2
-         ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR.
-     $            ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) )
-     $             THEN
-            INFO = -3
-         ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR.
-     $            ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR.
-     $            ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN
-            INFO = -9
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZLASCL', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 .OR. M.EQ.0 )
-     $   RETURN
-*
-*     Get machine parameters
-*
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-*
-      CFROMC = CFROM
-      CTOC = CTO
-*
-   10 CONTINUE
-      CFROM1 = CFROMC*SMLNUM
-      CTO1 = CTOC / BIGNUM
-      IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN
-         MUL = SMLNUM
-         DONE = .FALSE.
-         CFROMC = CFROM1
-      ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN
-         MUL = BIGNUM
-         DONE = .FALSE.
-         CTOC = CTO1
-      ELSE
-         MUL = CTOC / CFROMC
-         DONE = .TRUE.
-      END IF
-*
-      IF( ITYPE.EQ.0 ) THEN
-*
-*        Full matrix
-*
-         DO 30 J = 1, N
-            DO 20 I = 1, M
-               A( I, J ) = A( I, J )*MUL
-   20       CONTINUE
-   30    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.1 ) THEN
-*
-*        Lower triangular matrix
-*
-         DO 50 J = 1, N
-            DO 40 I = J, M
-               A( I, J ) = A( I, J )*MUL
-   40       CONTINUE
-   50    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.2 ) THEN
-*
-*        Upper triangular matrix
-*
-         DO 70 J = 1, N
-            DO 60 I = 1, MIN( J, M )
-               A( I, J ) = A( I, J )*MUL
-   60       CONTINUE
-   70    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.3 ) THEN
-*
-*        Upper Hessenberg matrix
-*
-         DO 90 J = 1, N
-            DO 80 I = 1, MIN( J+1, M )
-               A( I, J ) = A( I, J )*MUL
-   80       CONTINUE
-   90    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.4 ) THEN
-*
-*        Lower half of a symmetric band matrix
-*
-         K3 = KL + 1
-         K4 = N + 1
-         DO 110 J = 1, N
-            DO 100 I = 1, MIN( K3, K4-J )
-               A( I, J ) = A( I, J )*MUL
-  100       CONTINUE
-  110    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.5 ) THEN
-*
-*        Upper half of a symmetric band matrix
-*
-         K1 = KU + 2
-         K3 = KU + 1
-         DO 130 J = 1, N
-            DO 120 I = MAX( K1-J, 1 ), K3
-               A( I, J ) = A( I, J )*MUL
-  120       CONTINUE
-  130    CONTINUE
-*
-      ELSE IF( ITYPE.EQ.6 ) THEN
-*
-*        Band matrix
-*
-         K1 = KL + KU + 2
-         K2 = KL + 1
-         K3 = 2*KL + KU + 1
-         K4 = KL + KU + 1 + M
-         DO 150 J = 1, N
-            DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J )
-               A( I, J ) = A( I, J )*MUL
-  140       CONTINUE
-  150    CONTINUE
-*
-      END IF
-*
-      IF( .NOT.DONE )
-     $   GO TO 10
-*
-      RETURN
-*
-*     End of ZLASCL
-*
-      END
diff --git a/src/lib/lapack/zlaset.f b/src/lib/lapack/zlaset.f
deleted file mode 100644
index 88fc21b2..00000000
--- a/src/lib/lapack/zlaset.f
+++ /dev/null
@@ -1,114 +0,0 @@
-      SUBROUTINE ZLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            LDA, M, N
-      COMPLEX*16         ALPHA, BETA
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLASET initializes a 2-D array A to BETA on the diagonal and
-*  ALPHA on the offdiagonals.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies the part of the matrix A to be set.
-*          = 'U':      Upper triangular part is set. The lower triangle
-*                      is unchanged.
-*          = 'L':      Lower triangular part is set. The upper triangle
-*                      is unchanged.
-*          Otherwise:  All of the matrix A is set.
-*
-*  M       (input) INTEGER
-*          On entry, M specifies the number of rows of A.
-*
-*  N       (input) INTEGER
-*          On entry, N specifies the number of columns of A.
-*
-*  ALPHA   (input) COMPLEX*16
-*          All the offdiagonal array elements are set to ALPHA.
-*
-*  BETA    (input) COMPLEX*16
-*          All the diagonal array elements are set to BETA.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the m by n matrix A.
-*          On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j;
-*                   A(i,i) = BETA , 1 <= i <= min(m,n)
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, J
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MIN
-*     ..
-*     .. Executable Statements ..
-*
-      IF( LSAME( UPLO, 'U' ) ) THEN
-*
-*        Set the diagonal to BETA and the strictly upper triangular
-*        part of the array to ALPHA.
-*
-         DO 20 J = 2, N
-            DO 10 I = 1, MIN( J-1, M )
-               A( I, J ) = ALPHA
-   10       CONTINUE
-   20    CONTINUE
-         DO 30 I = 1, MIN( N, M )
-            A( I, I ) = BETA
-   30    CONTINUE
-*
-      ELSE IF( LSAME( UPLO, 'L' ) ) THEN
-*
-*        Set the diagonal to BETA and the strictly lower triangular
-*        part of the array to ALPHA.
-*
-         DO 50 J = 1, MIN( M, N )
-            DO 40 I = J + 1, M
-               A( I, J ) = ALPHA
-   40       CONTINUE
-   50    CONTINUE
-         DO 60 I = 1, MIN( N, M )
-            A( I, I ) = BETA
-   60    CONTINUE
-*
-      ELSE
-*
-*        Set the array to BETA on the diagonal and ALPHA on the
-*        offdiagonal.
-*
-         DO 80 J = 1, N
-            DO 70 I = 1, M
-               A( I, J ) = ALPHA
-   70       CONTINUE
-   80    CONTINUE
-         DO 90 I = 1, MIN( M, N )
-            A( I, I ) = BETA
-   90    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of ZLASET
-*
-      END
diff --git a/src/lib/lapack/zlasr.f b/src/lib/lapack/zlasr.f
deleted file mode 100644
index 507a20c4..00000000
--- a/src/lib/lapack/zlasr.f
+++ /dev/null
@@ -1,363 +0,0 @@
-      SUBROUTINE ZLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, PIVOT, SIDE
-      INTEGER            LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   C( * ), S( * )
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLASR applies a sequence of real plane rotations to a complex matrix
-*  A, from either the left or the right.
-*
-*  When SIDE = 'L', the transformation takes the form
-*
-*     A := P*A
-*
-*  and when SIDE = 'R', the transformation takes the form
-*
-*     A := A*P**T
-*
-*  where P is an orthogonal matrix consisting of a sequence of z plane
-*  rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R',
-*  and P**T is the transpose of P.
-*  
-*  When DIRECT = 'F' (Forward sequence), then
-*  
-*     P = P(z-1) * ... * P(2) * P(1)
-*  
-*  and when DIRECT = 'B' (Backward sequence), then
-*  
-*     P = P(1) * P(2) * ... * P(z-1)
-*  
-*  where P(k) is a plane rotation matrix defined by the 2-by-2 rotation
-*  
-*     R(k) = (  c(k)  s(k) )
-*          = ( -s(k)  c(k) ).
-*  
-*  When PIVOT = 'V' (Variable pivot), the rotation is performed
-*  for the plane (k,k+1), i.e., P(k) has the form
-*  
-*     P(k) = (  1                                            )
-*            (       ...                                     )
-*            (              1                                )
-*            (                   c(k)  s(k)                  )
-*            (                  -s(k)  c(k)                  )
-*            (                                1              )
-*            (                                     ...       )
-*            (                                            1  )
-*  
-*  where R(k) appears as a rank-2 modification to the identity matrix in
-*  rows and columns k and k+1.
-*  
-*  When PIVOT = 'T' (Top pivot), the rotation is performed for the
-*  plane (1,k+1), so P(k) has the form
-*  
-*     P(k) = (  c(k)                    s(k)                 )
-*            (         1                                     )
-*            (              ...                              )
-*            (                     1                         )
-*            ( -s(k)                    c(k)                 )
-*            (                                 1             )
-*            (                                      ...      )
-*            (                                             1 )
-*  
-*  where R(k) appears in rows and columns 1 and k+1.
-*  
-*  Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is
-*  performed for the plane (k,z), giving P(k) the form
-*  
-*     P(k) = ( 1                                             )
-*            (      ...                                      )
-*            (             1                                 )
-*            (                  c(k)                    s(k) )
-*            (                         1                     )
-*            (                              ...              )
-*            (                                     1         )
-*            (                 -s(k)                    c(k) )
-*  
-*  where R(k) appears in rows and columns k and z.  The rotations are
-*  performed without ever forming P(k) explicitly.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          Specifies whether the plane rotation matrix P is applied to
-*          A on the left or the right.
-*          = 'L':  Left, compute A := P*A
-*          = 'R':  Right, compute A:= A*P**T
-*
-*  PIVOT   (input) CHARACTER*1
-*          Specifies the plane for which P(k) is a plane rotation
-*          matrix.
-*          = 'V':  Variable pivot, the plane (k,k+1)
-*          = 'T':  Top pivot, the plane (1,k+1)
-*          = 'B':  Bottom pivot, the plane (k,z)
-*
-*  DIRECT  (input) CHARACTER*1
-*          Specifies whether P is a forward or backward sequence of
-*          plane rotations.
-*          = 'F':  Forward, P = P(z-1)*...*P(2)*P(1)
-*          = 'B':  Backward, P = P(1)*P(2)*...*P(z-1)
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  If m <= 1, an immediate
-*          return is effected.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  If n <= 1, an
-*          immediate return is effected.
-*
-*  C       (input) DOUBLE PRECISION array, dimension
-*                  (M-1) if SIDE = 'L'
-*                  (N-1) if SIDE = 'R'
-*          The cosines c(k) of the plane rotations.
-*
-*  S       (input) DOUBLE PRECISION array, dimension
-*                  (M-1) if SIDE = 'L'
-*                  (N-1) if SIDE = 'R'
-*          The sines s(k) of the plane rotations.  The 2-by-2 plane
-*          rotation part of the matrix P(k), R(k), has the form
-*          R(k) = (  c(k)  s(k) )
-*                 ( -s(k)  c(k) ).
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          The M-by-N matrix A.  On exit, A is overwritten by P*A if
-*          SIDE = 'R' or by A*P**T if SIDE = 'L'.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, INFO, J
-      DOUBLE PRECISION   CTEMP, STEMP
-      COMPLEX*16         TEMP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters
-*
-      INFO = 0
-      IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
-         INFO = 1
-      ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
-     $         'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
-         INFO = 2
-      ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
-     $          THEN
-         INFO = 3
-      ELSE IF( M.LT.0 ) THEN
-         INFO = 4
-      ELSE IF( N.LT.0 ) THEN
-         INFO = 5
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = 9
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZLASR ', INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
-     $   RETURN
-      IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*        Form  P * A
-*
-         IF( LSAME( PIVOT, 'V' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 20 J = 1, M - 1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 10 I = 1, N
-                        TEMP = A( J+1, I )
-                        A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
-                        A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
-   10                CONTINUE
-                  END IF
-   20          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 40 J = M - 1, 1, -1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 30 I = 1, N
-                        TEMP = A( J+1, I )
-                        A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
-                        A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
-   30                CONTINUE
-                  END IF
-   40          CONTINUE
-            END IF
-         ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 60 J = 2, M
-                  CTEMP = C( J-1 )
-                  STEMP = S( J-1 )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 50 I = 1, N
-                        TEMP = A( J, I )
-                        A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
-                        A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
-   50                CONTINUE
-                  END IF
-   60          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 80 J = M, 2, -1
-                  CTEMP = C( J-1 )
-                  STEMP = S( J-1 )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 70 I = 1, N
-                        TEMP = A( J, I )
-                        A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
-                        A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
-   70                CONTINUE
-                  END IF
-   80          CONTINUE
-            END IF
-         ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 100 J = 1, M - 1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 90 I = 1, N
-                        TEMP = A( J, I )
-                        A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
-                        A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
-   90                CONTINUE
-                  END IF
-  100          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 120 J = M - 1, 1, -1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 110 I = 1, N
-                        TEMP = A( J, I )
-                        A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
-                        A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
-  110                CONTINUE
-                  END IF
-  120          CONTINUE
-            END IF
-         END IF
-      ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*        Form A * P'
-*
-         IF( LSAME( PIVOT, 'V' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 140 J = 1, N - 1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 130 I = 1, M
-                        TEMP = A( I, J+1 )
-                        A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
-                        A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
-  130                CONTINUE
-                  END IF
-  140          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 160 J = N - 1, 1, -1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 150 I = 1, M
-                        TEMP = A( I, J+1 )
-                        A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
-                        A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
-  150                CONTINUE
-                  END IF
-  160          CONTINUE
-            END IF
-         ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 180 J = 2, N
-                  CTEMP = C( J-1 )
-                  STEMP = S( J-1 )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 170 I = 1, M
-                        TEMP = A( I, J )
-                        A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
-                        A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
-  170                CONTINUE
-                  END IF
-  180          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 200 J = N, 2, -1
-                  CTEMP = C( J-1 )
-                  STEMP = S( J-1 )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 190 I = 1, M
-                        TEMP = A( I, J )
-                        A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
-                        A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
-  190                CONTINUE
-                  END IF
-  200          CONTINUE
-            END IF
-         ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
-            IF( LSAME( DIRECT, 'F' ) ) THEN
-               DO 220 J = 1, N - 1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 210 I = 1, M
-                        TEMP = A( I, J )
-                        A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
-                        A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
-  210                CONTINUE
-                  END IF
-  220          CONTINUE
-            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
-               DO 240 J = N - 1, 1, -1
-                  CTEMP = C( J )
-                  STEMP = S( J )
-                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
-                     DO 230 I = 1, M
-                        TEMP = A( I, J )
-                        A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
-                        A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
-  230                CONTINUE
-                  END IF
-  240          CONTINUE
-            END IF
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of ZLASR
-*
-      END
diff --git a/src/lib/lapack/zlassq.f b/src/lib/lapack/zlassq.f
deleted file mode 100644
index a209984b..00000000
--- a/src/lib/lapack/zlassq.f
+++ /dev/null
@@ -1,101 +0,0 @@
-      SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, N
-      DOUBLE PRECISION   SCALE, SUMSQ
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLASSQ returns the values scl and ssq such that
-*
-*     ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
-*
-*  where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
-*  assumed to be at least unity and the value of ssq will then satisfy
-*
-*     1.0 .le. ssq .le. ( sumsq + 2*n ).
-*
-*  scale is assumed to be non-negative and scl returns the value
-*
-*     scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
-*            i
-*
-*  scale and sumsq must be supplied in SCALE and SUMSQ respectively.
-*  SCALE and SUMSQ are overwritten by scl and ssq respectively.
-*
-*  The routine makes only one pass through the vector X.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of elements to be used from the vector X.
-*
-*  X       (input) COMPLEX*16 array, dimension (N)
-*          The vector x as described above.
-*             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
-*
-*  INCX    (input) INTEGER
-*          The increment between successive values of the vector X.
-*          INCX > 0.
-*
-*  SCALE   (input/output) DOUBLE PRECISION
-*          On entry, the value  scale  in the equation above.
-*          On exit, SCALE is overwritten with the value  scl .
-*
-*  SUMSQ   (input/output) DOUBLE PRECISION
-*          On entry, the value  sumsq  in the equation above.
-*          On exit, SUMSQ is overwritten with the value  ssq .
-*
-* =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO
-      PARAMETER          ( ZERO = 0.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            IX
-      DOUBLE PRECISION   TEMP1
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DIMAG
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.GT.0 ) THEN
-         DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
-            IF( DBLE( X( IX ) ).NE.ZERO ) THEN
-               TEMP1 = ABS( DBLE( X( IX ) ) )
-               IF( SCALE.LT.TEMP1 ) THEN
-                  SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
-                  SCALE = TEMP1
-               ELSE
-                  SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
-               END IF
-            END IF
-            IF( DIMAG( X( IX ) ).NE.ZERO ) THEN
-               TEMP1 = ABS( DIMAG( X( IX ) ) )
-               IF( SCALE.LT.TEMP1 ) THEN
-                  SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
-                  SCALE = TEMP1
-               ELSE
-                  SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
-               END IF
-            END IF
-   10    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of ZLASSQ
-*
-      END
diff --git a/src/lib/lapack/zlaswp.f b/src/lib/lapack/zlaswp.f
deleted file mode 100644
index 8b07e48b..00000000
--- a/src/lib/lapack/zlaswp.f
+++ /dev/null
@@ -1,119 +0,0 @@
-      SUBROUTINE ZLASWP( N, A, LDA, K1, K2, IPIV, INCX )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, K1, K2, LDA, N
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLASWP performs a series of row interchanges on the matrix A.
-*  One row interchange is initiated for each of rows K1 through K2 of A.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the matrix of column dimension N to which the row
-*          interchanges will be applied.
-*          On exit, the permuted matrix.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*
-*  K1      (input) INTEGER
-*          The first element of IPIV for which a row interchange will
-*          be done.
-*
-*  K2      (input) INTEGER
-*          The last element of IPIV for which a row interchange will
-*          be done.
-*
-*  IPIV    (input) INTEGER array, dimension (K2*abs(INCX))
-*          The vector of pivot indices.  Only the elements in positions
-*          K1 through K2 of IPIV are accessed.
-*          IPIV(K) = L implies rows K and L are to be interchanged.
-*
-*  INCX    (input) INTEGER
-*          The increment between successive values of IPIV.  If IPIV
-*          is negative, the pivots are applied in reverse order.
-*
-*  Further Details
-*  ===============
-*
-*  Modified by
-*   R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
-      COMPLEX*16         TEMP
-*     ..
-*     .. Executable Statements ..
-*
-*     Interchange row I with row IPIV(I) for each of rows K1 through K2.
-*
-      IF( INCX.GT.0 ) THEN
-         IX0 = K1
-         I1 = K1
-         I2 = K2
-         INC = 1
-      ELSE IF( INCX.LT.0 ) THEN
-         IX0 = 1 + ( 1-K2 )*INCX
-         I1 = K2
-         I2 = K1
-         INC = -1
-      ELSE
-         RETURN
-      END IF
-*
-      N32 = ( N / 32 )*32
-      IF( N32.NE.0 ) THEN
-         DO 30 J = 1, N32, 32
-            IX = IX0
-            DO 20 I = I1, I2, INC
-               IP = IPIV( IX )
-               IF( IP.NE.I ) THEN
-                  DO 10 K = J, J + 31
-                     TEMP = A( I, K )
-                     A( I, K ) = A( IP, K )
-                     A( IP, K ) = TEMP
-   10             CONTINUE
-               END IF
-               IX = IX + INCX
-   20       CONTINUE
-   30    CONTINUE
-      END IF
-      IF( N32.NE.N ) THEN
-         N32 = N32 + 1
-         IX = IX0
-         DO 50 I = I1, I2, INC
-            IP = IPIV( IX )
-            IF( IP.NE.I ) THEN
-               DO 40 K = N32, N
-                  TEMP = A( I, K )
-                  A( I, K ) = A( IP, K )
-                  A( IP, K ) = TEMP
-   40          CONTINUE
-            END IF
-            IX = IX + INCX
-   50    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of ZLASWP
-*
-      END
diff --git a/src/lib/lapack/zlatdf.f b/src/lib/lapack/zlatdf.f
deleted file mode 100644
index d637b8f1..00000000
--- a/src/lib/lapack/zlatdf.f
+++ /dev/null
@@ -1,241 +0,0 @@
-      SUBROUTINE ZLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
-     $                   JPIV )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IJOB, LDZ, N
-      DOUBLE PRECISION   RDSCAL, RDSUM
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IPIV( * ), JPIV( * )
-      COMPLEX*16         RHS( * ), Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLATDF computes the contribution to the reciprocal Dif-estimate
-*  by solving for x in Z * x = b, where b is chosen such that the norm
-*  of x is as large as possible. It is assumed that LU decomposition
-*  of Z has been computed by ZGETC2. On entry RHS = f holds the
-*  contribution from earlier solved sub-systems, and on return RHS = x.
-*
-*  The factorization of Z returned by ZGETC2 has the form
-*  Z = P * L * U * Q, where P and Q are permutation matrices. L is lower
-*  triangular with unit diagonal elements and U is upper triangular.
-*
-*  Arguments
-*  =========
-*
-*  IJOB    (input) INTEGER
-*          IJOB = 2: First compute an approximative null-vector e
-*              of Z using ZGECON, e is normalized and solve for
-*              Zx = +-e - f with the sign giving the greater value of
-*              2-norm(x).  About 5 times as expensive as Default.
-*          IJOB .ne. 2: Local look ahead strategy where
-*              all entries of the r.h.s. b is choosen as either +1 or
-*              -1.  Default.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Z.
-*
-*  Z       (input) DOUBLE PRECISION array, dimension (LDZ, N)
-*          On entry, the LU part of the factorization of the n-by-n
-*          matrix Z computed by ZGETC2:  Z = P * L * U * Q
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z.  LDA >= max(1, N).
-*
-*  RHS     (input/output) DOUBLE PRECISION array, dimension (N).
-*          On entry, RHS contains contributions from other subsystems.
-*          On exit, RHS contains the solution of the subsystem with
-*          entries according to the value of IJOB (see above).
-*
-*  RDSUM   (input/output) DOUBLE PRECISION
-*          On entry, the sum of squares of computed contributions to
-*          the Dif-estimate under computation by ZTGSYL, where the
-*          scaling factor RDSCAL (see below) has been factored out.
-*          On exit, the corresponding sum of squares updated with the
-*          contributions from the current sub-system.
-*          If TRANS = 'T' RDSUM is not touched.
-*          NOTE: RDSUM only makes sense when ZTGSY2 is called by CTGSYL.
-*
-*  RDSCAL  (input/output) DOUBLE PRECISION
-*          On entry, scaling factor used to prevent overflow in RDSUM.
-*          On exit, RDSCAL is updated w.r.t. the current contributions
-*          in RDSUM.
-*          If TRANS = 'T', RDSCAL is not touched.
-*          NOTE: RDSCAL only makes sense when ZTGSY2 is called by
-*          ZTGSYL.
-*
-*  IPIV    (input) INTEGER array, dimension (N).
-*          The pivot indices; for 1 <= i <= N, row i of the
-*          matrix has been interchanged with row IPIV(i).
-*
-*  JPIV    (input) INTEGER array, dimension (N).
-*          The pivot indices; for 1 <= j <= N, column j of the
-*          matrix has been interchanged with column JPIV(j).
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  This routine is a further developed implementation of algorithm
-*  BSOLVE in [1] using complete pivoting in the LU factorization.
-*
-*   [1]   Bo Kagstrom and Lars Westin,
-*         Generalized Schur Methods with Condition Estimators for
-*         Solving the Generalized Sylvester Equation, IEEE Transactions
-*         on Automatic Control, Vol. 34, No. 7, July 1989, pp 745-751.
-*
-*   [2]   Peter Poromaa,
-*         On Efficient and Robust Estimators for the Separation
-*         between two Regular Matrix Pairs with Applications in
-*         Condition Estimation. Report UMINF-95.05, Department of
-*         Computing Science, Umea University, S-901 87 Umea, Sweden,
-*         1995.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            MAXDIM
-      PARAMETER          ( MAXDIM = 2 )
-      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 ..
-      INTEGER            I, INFO, J, K
-      DOUBLE PRECISION   RTEMP, SCALE, SMINU, SPLUS
-      COMPLEX*16         BM, BP, PMONE, TEMP
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   RWORK( MAXDIM )
-      COMPLEX*16         WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZAXPY, ZCOPY, ZGECON, ZGESC2, ZLASSQ, ZLASWP,
-     $                   ZSCAL
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DZASUM
-      COMPLEX*16         ZDOTC
-      EXTERNAL           DZASUM, ZDOTC
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      IF( IJOB.NE.2 ) THEN
-*
-*        Apply permutations IPIV to RHS
-*
-         CALL ZLASWP( 1, RHS, LDZ, 1, N-1, IPIV, 1 )
-*
-*        Solve for L-part choosing RHS either to +1 or -1.
-*
-         PMONE = -CONE
-         DO 10 J = 1, N - 1
-            BP = RHS( J ) + CONE
-            BM = RHS( J ) - CONE
-            SPLUS = ONE
-*
-*           Lockahead for L- part RHS(1:N-1) = +-1
-*           SPLUS and SMIN computed more efficiently than in BSOLVE[1].
-*
-            SPLUS = SPLUS + DBLE( ZDOTC( N-J, Z( J+1, J ), 1, Z( J+1,
-     $              J ), 1 ) )
-            SMINU = DBLE( ZDOTC( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 ) )
-            SPLUS = SPLUS*DBLE( RHS( J ) )
-            IF( SPLUS.GT.SMINU ) THEN
-               RHS( J ) = BP
-            ELSE IF( SMINU.GT.SPLUS ) THEN
-               RHS( J ) = BM
-            ELSE
-*
-*              In this case the updating sums are equal and we can
-*              choose RHS(J) +1 or -1. The first time this happens we
-*              choose -1, thereafter +1. This is a simple way to get
-*              good estimates of matrices like Byers well-known example
-*              (see [1]). (Not done in BSOLVE.)
-*
-               RHS( J ) = RHS( J ) + PMONE
-               PMONE = CONE
-            END IF
-*
-*           Compute the remaining r.h.s.
-*
-            TEMP = -RHS( J )
-            CALL ZAXPY( N-J, TEMP, Z( J+1, J ), 1, RHS( J+1 ), 1 )
-   10    CONTINUE
-*
-*        Solve for U- part, lockahead for RHS(N) = +-1. This is not done
-*        In BSOLVE and will hopefully give us a better estimate because
-*        any ill-conditioning of the original matrix is transfered to U
-*        and not to L. U(N, N) is an approximation to sigma_min(LU).
-*
-         CALL ZCOPY( N-1, RHS, 1, WORK, 1 )
-         WORK( N ) = RHS( N ) + CONE
-         RHS( N ) = RHS( N ) - CONE
-         SPLUS = ZERO
-         SMINU = ZERO
-         DO 30 I = N, 1, -1
-            TEMP = CONE / Z( I, I )
-            WORK( I ) = WORK( I )*TEMP
-            RHS( I ) = RHS( I )*TEMP
-            DO 20 K = I + 1, N
-               WORK( I ) = WORK( I ) - WORK( K )*( Z( I, K )*TEMP )
-               RHS( I ) = RHS( I ) - RHS( K )*( Z( I, K )*TEMP )
-   20       CONTINUE
-            SPLUS = SPLUS + ABS( WORK( I ) )
-            SMINU = SMINU + ABS( RHS( I ) )
-   30    CONTINUE
-         IF( SPLUS.GT.SMINU )
-     $      CALL ZCOPY( N, WORK, 1, RHS, 1 )
-*
-*        Apply the permutations JPIV to the computed solution (RHS)
-*
-         CALL ZLASWP( 1, RHS, LDZ, 1, N-1, JPIV, -1 )
-*
-*        Compute the sum of squares
-*
-         CALL ZLASSQ( N, RHS, 1, RDSCAL, RDSUM )
-         RETURN
-      END IF
-*
-*     ENTRY IJOB = 2
-*
-*     Compute approximate nullvector XM of Z
-*
-      CALL ZGECON( 'I', N, Z, LDZ, ONE, RTEMP, WORK, RWORK, INFO )
-      CALL ZCOPY( N, WORK( N+1 ), 1, XM, 1 )
-*
-*     Compute RHS
-*
-      CALL ZLASWP( 1, XM, LDZ, 1, N-1, IPIV, -1 )
-      TEMP = CONE / SQRT( ZDOTC( N, XM, 1, XM, 1 ) )
-      CALL ZSCAL( N, TEMP, XM, 1 )
-      CALL ZCOPY( N, XM, 1, XP, 1 )
-      CALL ZAXPY( N, CONE, RHS, 1, XP, 1 )
-      CALL ZAXPY( N, -CONE, XM, 1, RHS, 1 )
-      CALL ZGESC2( N, Z, LDZ, RHS, IPIV, JPIV, SCALE )
-      CALL ZGESC2( N, Z, LDZ, XP, IPIV, JPIV, SCALE )
-      IF( DZASUM( N, XP, 1 ).GT.DZASUM( N, RHS, 1 ) )
-     $   CALL ZCOPY( N, XP, 1, RHS, 1 )
-*
-*     Compute the sum of squares
-*
-      CALL ZLASSQ( N, RHS, 1, RDSCAL, RDSUM )
-      RETURN
-*
-*     End of ZLATDF
-*
-      END
diff --git a/src/lib/lapack/zlatrd.f b/src/lib/lapack/zlatrd.f
deleted file mode 100644
index 5fef7b5c..00000000
--- a/src/lib/lapack/zlatrd.f
+++ /dev/null
@@ -1,279 +0,0 @@
-      SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            LDA, LDW, N, NB
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   E( * )
-      COMPLEX*16         A( LDA, * ), TAU( * ), W( LDW, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLATRD reduces NB rows and columns of a complex Hermitian matrix A to
-*  Hermitian tridiagonal form by a unitary similarity
-*  transformation Q' * A * Q, and returns the matrices V and W which are
-*  needed to apply the transformation to the unreduced part of A.
-*
-*  If UPLO = 'U', ZLATRD reduces the last NB rows and columns of a
-*  matrix, of which the upper triangle is supplied;
-*  if UPLO = 'L', ZLATRD reduces the first NB rows and columns of a
-*  matrix, of which the lower triangle is supplied.
-*
-*  This is an auxiliary routine called by ZHETRD.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          Hermitian matrix A is stored:
-*          = 'U': Upper triangular
-*          = 'L': Lower triangular
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.
-*
-*  NB      (input) INTEGER
-*          The number of rows and columns to be reduced.
-*
-*  A       (input/output) 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 last NB columns have been reduced to
-*            tridiagonal form, with the diagonal elements overwriting
-*            the diagonal elements of A; the elements above the diagonal
-*            with the array TAU, represent the unitary matrix Q as a
-*            product of elementary reflectors;
-*          if UPLO = 'L', the first NB columns have been reduced to
-*            tridiagonal form, with the diagonal elements overwriting
-*            the diagonal elements of A; the elements below the diagonal
-*            with the array TAU, represent the  unitary matrix Q as a
-*            product of elementary reflectors.
-*          See Further Details.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  E       (output) DOUBLE PRECISION array, dimension (N-1)
-*          If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
-*          elements of the last NB columns of the reduced matrix;
-*          if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
-*          the first NB columns of the reduced matrix.
-*
-*  TAU     (output) COMPLEX*16 array, dimension (N-1)
-*          The scalar factors of the elementary reflectors, stored in
-*          TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
-*          See Further Details.
-*
-*  W       (output) COMPLEX*16 array, dimension (LDW,NB)
-*          The n-by-nb matrix W required to update the unreduced part
-*          of A.
-*
-*  LDW     (input) INTEGER
-*          The leading dimension of the array W. LDW >= max(1,N).
-*
-*  Further Details
-*  ===============
-*
-*  If UPLO = 'U', the matrix Q is represented as a product of elementary
-*  reflectors
-*
-*     Q = H(n) H(n-1) . . . H(n-nb+1).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
-*  and tau in TAU(i-1).
-*
-*  If UPLO = 'L', the matrix Q is represented as a product of elementary
-*  reflectors
-*
-*     Q = H(1) H(2) . . . H(nb).
-*
-*  Each H(i) has the form
-*
-*     H(i) = I - tau * v * v'
-*
-*  where tau is a complex scalar, and v is a complex vector with
-*  v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
-*  and tau in TAU(i).
-*
-*  The elements of the vectors v together form the n-by-nb matrix V
-*  which is needed, with W, to apply the transformation to the unreduced
-*  part of the matrix, using a Hermitian rank-2k update of the form:
-*  A := A - V*W' - W*V'.
-*
-*  The contents of A on exit are illustrated by the following examples
-*  with n = 5 and nb = 2:
-*
-*  if UPLO = 'U':                       if UPLO = 'L':
-*
-*    (  a   a   a   v4  v5 )              (  d                  )
-*    (      a   a   v4  v5 )              (  1   d              )
-*    (          a   1   v5 )              (  v1  1   a          )
-*    (              d   1  )              (  v1  v2  a   a      )
-*    (                  d  )              (  v1  v2  a   a   a  )
-*
-*  where d denotes a diagonal element of the reduced matrix, a denotes
-*  an element of the original matrix that is unchanged, and vi denotes
-*  an element of the vector defining H(i).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE, HALF
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   ONE = ( 1.0D+0, 0.0D+0 ),
-     $                   HALF = ( 0.5D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, IW
-      COMPLEX*16         ALPHA
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZAXPY, ZGEMV, ZHEMV, ZLACGV, ZLARFG, ZSCAL
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      COMPLEX*16         ZDOTC
-      EXTERNAL           LSAME, ZDOTC
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-      IF( LSAME( UPLO, 'U' ) ) THEN
-*
-*        Reduce last NB columns of upper triangle
-*
-         DO 10 I = N, N - NB + 1, -1
-            IW = I - N + NB
-            IF( I.LT.N ) THEN
-*
-*              Update A(1:i,i)
-*
-               A( I, I ) = DBLE( A( I, I ) )
-               CALL ZLACGV( N-I, W( I, IW+1 ), LDW )
-               CALL ZGEMV( 'No transpose', I, N-I, -ONE, A( 1, I+1 ),
-     $                     LDA, W( I, IW+1 ), LDW, ONE, A( 1, I ), 1 )
-               CALL ZLACGV( N-I, W( I, IW+1 ), LDW )
-               CALL ZLACGV( N-I, A( I, I+1 ), LDA )
-               CALL ZGEMV( 'No transpose', I, N-I, -ONE, W( 1, IW+1 ),
-     $                     LDW, A( I, I+1 ), LDA, ONE, A( 1, I ), 1 )
-               CALL ZLACGV( N-I, A( I, I+1 ), LDA )
-               A( I, I ) = DBLE( A( I, I ) )
-            END IF
-            IF( I.GT.1 ) THEN
-*
-*              Generate elementary reflector H(i) to annihilate
-*              A(1:i-2,i)
-*
-               ALPHA = A( I-1, I )
-               CALL ZLARFG( I-1, ALPHA, A( 1, I ), 1, TAU( I-1 ) )
-               E( I-1 ) = ALPHA
-               A( I-1, I ) = ONE
-*
-*              Compute W(1:i-1,i)
-*
-               CALL ZHEMV( 'Upper', I-1, ONE, A, LDA, A( 1, I ), 1,
-     $                     ZERO, W( 1, IW ), 1 )
-               IF( I.LT.N ) THEN
-                  CALL ZGEMV( 'Conjugate transpose', I-1, N-I, ONE,
-     $                        W( 1, IW+1 ), LDW, A( 1, I ), 1, ZERO,
-     $                        W( I+1, IW ), 1 )
-                  CALL ZGEMV( 'No transpose', I-1, N-I, -ONE,
-     $                        A( 1, I+1 ), LDA, W( I+1, IW ), 1, ONE,
-     $                        W( 1, IW ), 1 )
-                  CALL ZGEMV( 'Conjugate transpose', I-1, N-I, ONE,
-     $                        A( 1, I+1 ), LDA, A( 1, I ), 1, ZERO,
-     $                        W( I+1, IW ), 1 )
-                  CALL ZGEMV( 'No transpose', I-1, N-I, -ONE,
-     $                        W( 1, IW+1 ), LDW, W( I+1, IW ), 1, ONE,
-     $                        W( 1, IW ), 1 )
-               END IF
-               CALL ZSCAL( I-1, TAU( I-1 ), W( 1, IW ), 1 )
-               ALPHA = -HALF*TAU( I-1 )*ZDOTC( I-1, W( 1, IW ), 1,
-     $                 A( 1, I ), 1 )
-               CALL ZAXPY( I-1, ALPHA, A( 1, I ), 1, W( 1, IW ), 1 )
-            END IF
-*
-   10    CONTINUE
-      ELSE
-*
-*        Reduce first NB columns of lower triangle
-*
-         DO 20 I = 1, NB
-*
-*           Update A(i:n,i)
-*
-            A( I, I ) = DBLE( A( I, I ) )
-            CALL ZLACGV( I-1, W( I, 1 ), LDW )
-            CALL ZGEMV( 'No transpose', N-I+1, I-1, -ONE, A( I, 1 ),
-     $                  LDA, W( I, 1 ), LDW, ONE, A( I, I ), 1 )
-            CALL ZLACGV( I-1, W( I, 1 ), LDW )
-            CALL ZLACGV( I-1, A( I, 1 ), LDA )
-            CALL ZGEMV( 'No transpose', N-I+1, I-1, -ONE, W( I, 1 ),
-     $                  LDW, A( I, 1 ), LDA, ONE, A( I, I ), 1 )
-            CALL ZLACGV( I-1, A( I, 1 ), LDA )
-            A( I, I ) = DBLE( A( I, I ) )
-            IF( I.LT.N ) THEN
-*
-*              Generate elementary reflector H(i) to annihilate
-*              A(i+2:n,i)
-*
-               ALPHA = A( I+1, I )
-               CALL ZLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1,
-     $                      TAU( I ) )
-               E( I ) = ALPHA
-               A( I+1, I ) = ONE
-*
-*              Compute W(i+1:n,i)
-*
-               CALL ZHEMV( 'Lower', N-I, ONE, A( I+1, I+1 ), LDA,
-     $                     A( I+1, I ), 1, ZERO, W( I+1, I ), 1 )
-               CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE,
-     $                     W( I+1, 1 ), LDW, A( I+1, I ), 1, ZERO,
-     $                     W( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, 1 ),
-     $                     LDA, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
-               CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE,
-     $                     A( I+1, 1 ), LDA, A( I+1, I ), 1, ZERO,
-     $                     W( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, 1 ),
-     $                     LDW, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
-               CALL ZSCAL( N-I, TAU( I ), W( I+1, I ), 1 )
-               ALPHA = -HALF*TAU( I )*ZDOTC( N-I, W( I+1, I ), 1,
-     $                 A( I+1, I ), 1 )
-               CALL ZAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), 1 )
-            END IF
-*
-   20    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of ZLATRD
-*
-      END
diff --git a/src/lib/lapack/zlatrs.f b/src/lib/lapack/zlatrs.f
deleted file mode 100644
index 7466096c..00000000
--- a/src/lib/lapack/zlatrs.f
+++ /dev/null
@@ -1,879 +0,0 @@
-      SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
-     $                   CNORM, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIAG, NORMIN, TRANS, UPLO
-      INTEGER            INFO, LDA, N
-      DOUBLE PRECISION   SCALE
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   CNORM( * )
-      COMPLEX*16         A( LDA, * ), X( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLATRS solves one of the triangular systems
-*
-*     A * x = s*b,  A**T * x = s*b,  or  A**H * x = s*b,
-*
-*  with scaling to prevent overflow.  Here A is an upper or lower
-*  triangular matrix, A**T denotes the transpose of A, A**H denotes the
-*  conjugate transpose of A, x and b are n-element vectors, and s is a
-*  scaling factor, usually less than or equal to 1, chosen so that the
-*  components of x will be less than the overflow threshold.  If the
-*  unscaled problem will not cause overflow, the Level 2 BLAS routine
-*  ZTRSV is called. If the matrix A is singular (A(j,j) = 0 for some j),
-*  then s is set to 0 and a non-trivial solution to A*x = 0 is returned.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the matrix A is upper or lower triangular.
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
-*
-*  TRANS   (input) CHARACTER*1
-*          Specifies the operation applied to A.
-*          = 'N':  Solve A * x = s*b     (No transpose)
-*          = 'T':  Solve A**T * x = s*b  (Transpose)
-*          = 'C':  Solve A**H * x = s*b  (Conjugate transpose)
-*
-*  DIAG    (input) CHARACTER*1
-*          Specifies whether or not the matrix A is unit triangular.
-*          = 'N':  Non-unit triangular
-*          = 'U':  Unit triangular
-*
-*  NORMIN  (input) CHARACTER*1
-*          Specifies whether CNORM has been set or not.
-*          = 'Y':  CNORM contains the column norms on entry
-*          = 'N':  CNORM is not set on entry.  On exit, the norms will
-*                  be computed and stored in CNORM.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA,N)
-*          The triangular matrix A.  If UPLO = 'U', the leading n by n
-*          upper triangular part of the array A contains the upper
-*          triangular matrix, and the strictly lower triangular part of
-*          A is not referenced.  If UPLO = 'L', the leading n by n lower
-*          triangular part of the array A contains the lower triangular
-*          matrix, and the strictly upper triangular part of A is not
-*          referenced.  If DIAG = 'U', the diagonal elements of A are
-*          also not referenced and are assumed to be 1.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max (1,N).
-*
-*  X       (input/output) COMPLEX*16 array, dimension (N)
-*          On entry, the right hand side b of the triangular system.
-*          On exit, X is overwritten by the solution vector x.
-*
-*  SCALE   (output) DOUBLE PRECISION
-*          The scaling factor s for the triangular system
-*             A * x = s*b,  A**T * x = s*b,  or  A**H * x = s*b.
-*          If SCALE = 0, the matrix A is singular or badly scaled, and
-*          the vector x is an exact or approximate solution to A*x = 0.
-*
-*  CNORM   (input or output) DOUBLE PRECISION array, dimension (N)
-*
-*          If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
-*          contains the norm of the off-diagonal part of the j-th column
-*          of A.  If TRANS = 'N', CNORM(j) must be greater than or equal
-*          to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
-*          must be greater than or equal to the 1-norm.
-*
-*          If NORMIN = 'N', CNORM is an output argument and CNORM(j)
-*          returns the 1-norm of the offdiagonal part of the j-th column
-*          of A.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -k, the k-th argument had an illegal value
-*
-*  Further Details
-*  ======= =======
-*
-*  A rough bound on x is computed; if that is less than overflow, ZTRSV
-*  is called, otherwise, specific code is used which checks for possible
-*  overflow or divide-by-zero at every operation.
-*
-*  A columnwise scheme is used for solving A*x = b.  The basic algorithm
-*  if A is lower triangular is
-*
-*       x[1:n] := b[1:n]
-*       for j = 1, ..., n
-*            x(j) := x(j) / A(j,j)
-*            x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
-*       end
-*
-*  Define bounds on the components of x after j iterations of the loop:
-*     M(j) = bound on x[1:j]
-*     G(j) = bound on x[j+1:n]
-*  Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
-*
-*  Then for iteration j+1 we have
-*     M(j+1) <= G(j) / | A(j+1,j+1) |
-*     G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
-*            <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
-*
-*  where CNORM(j+1) is greater than or equal to the infinity-norm of
-*  column j+1 of A, not counting the diagonal.  Hence
-*
-*     G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
-*                  1<=i<=j
-*  and
-*
-*     |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
-*                                   1<=i< j
-*
-*  Since |x(j)| <= M(j), we use the Level 2 BLAS routine ZTRSV if the
-*  reciprocal of the largest M(j), j=1,..,n, is larger than
-*  max(underflow, 1/overflow).
-*
-*  The bound on x(j) is also used to determine when a step in the
-*  columnwise method can be performed without fear of overflow.  If
-*  the computed bound is greater than a large constant, x is scaled to
-*  prevent overflow, but if the bound overflows, x is set to 0, x(j) to
-*  1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
-*
-*  Similarly, a row-wise scheme is used to solve A**T *x = b  or
-*  A**H *x = b.  The basic algorithm for A upper triangular is
-*
-*       for j = 1, ..., n
-*            x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
-*       end
-*
-*  We simultaneously compute two bounds
-*       G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
-*       M(j) = bound on x(i), 1<=i<=j
-*
-*  The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
-*  add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
-*  Then the bound on x(j) is
-*
-*       M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
-*
-*            <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
-*                      1<=i<=j
-*
-*  and we can safely call ZTRSV if 1/M(n) and 1/G(n) are both greater
-*  than max(underflow, 1/overflow).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, HALF, ONE, TWO
-      PARAMETER          ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0,
-     $                   TWO = 2.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOTRAN, NOUNIT, UPPER
-      INTEGER            I, IMAX, J, JFIRST, JINC, JLAST
-      DOUBLE PRECISION   BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL,
-     $                   XBND, XJ, XMAX
-      COMPLEX*16         CSUMJ, TJJS, USCAL, ZDUM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IDAMAX, IZAMAX
-      DOUBLE PRECISION   DLAMCH, DZASUM
-      COMPLEX*16         ZDOTC, ZDOTU, ZLADIV
-      EXTERNAL           LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, ZDOTC,
-     $                   ZDOTU, ZLADIV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTRSV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1, CABS2
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
-      CABS2( ZDUM ) = ABS( DBLE( ZDUM ) / 2.D0 ) +
-     $                ABS( DIMAG( ZDUM ) / 2.D0 )
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-      UPPER = LSAME( UPLO, 'U' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      NOUNIT = LSAME( DIAG, 'N' )
-*
-*     Test the input parameters.
-*
-      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
-     $         LSAME( TRANS, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
-         INFO = -3
-      ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
-     $         LSAME( NORMIN, 'N' ) ) THEN
-         INFO = -4
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZLATRS', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Determine machine dependent parameters to control overflow.
-*
-      SMLNUM = DLAMCH( 'Safe minimum' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SMLNUM / DLAMCH( 'Precision' )
-      BIGNUM = ONE / SMLNUM
-      SCALE = ONE
-*
-      IF( LSAME( NORMIN, 'N' ) ) THEN
-*
-*        Compute the 1-norm of each column, not including the diagonal.
-*
-         IF( UPPER ) THEN
-*
-*           A is upper triangular.
-*
-            DO 10 J = 1, N
-               CNORM( J ) = DZASUM( J-1, A( 1, J ), 1 )
-   10       CONTINUE
-         ELSE
-*
-*           A is lower triangular.
-*
-            DO 20 J = 1, N - 1
-               CNORM( J ) = DZASUM( N-J, A( J+1, J ), 1 )
-   20       CONTINUE
-            CNORM( N ) = ZERO
-         END IF
-      END IF
-*
-*     Scale the column norms by TSCAL if the maximum element in CNORM is
-*     greater than BIGNUM/2.
-*
-      IMAX = IDAMAX( N, CNORM, 1 )
-      TMAX = CNORM( IMAX )
-      IF( TMAX.LE.BIGNUM*HALF ) THEN
-         TSCAL = ONE
-      ELSE
-         TSCAL = HALF / ( SMLNUM*TMAX )
-         CALL DSCAL( N, TSCAL, CNORM, 1 )
-      END IF
-*
-*     Compute a bound on the computed solution vector to see if the
-*     Level 2 BLAS routine ZTRSV can be used.
-*
-      XMAX = ZERO
-      DO 30 J = 1, N
-         XMAX = MAX( XMAX, CABS2( X( J ) ) )
-   30 CONTINUE
-      XBND = XMAX
-*
-      IF( NOTRAN ) THEN
-*
-*        Compute the growth in A * x = b.
-*
-         IF( UPPER ) THEN
-            JFIRST = N
-            JLAST = 1
-            JINC = -1
-         ELSE
-            JFIRST = 1
-            JLAST = N
-            JINC = 1
-         END IF
-*
-         IF( TSCAL.NE.ONE ) THEN
-            GROW = ZERO
-            GO TO 60
-         END IF
-*
-         IF( NOUNIT ) THEN
-*
-*           A is non-unit triangular.
-*
-*           Compute GROW = 1/G(j) and XBND = 1/M(j).
-*           Initially, G(0) = max{x(i), i=1,...,n}.
-*
-            GROW = HALF / MAX( XBND, SMLNUM )
-            XBND = GROW
-            DO 40 J = JFIRST, JLAST, JINC
-*
-*              Exit the loop if the growth factor is too small.
-*
-               IF( GROW.LE.SMLNUM )
-     $            GO TO 60
-*
-               TJJS = A( J, J )
-               TJJ = CABS1( TJJS )
-*
-               IF( TJJ.GE.SMLNUM ) THEN
-*
-*                 M(j) = G(j-1) / abs(A(j,j))
-*
-                  XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
-               ELSE
-*
-*                 M(j) could overflow, set XBND to 0.
-*
-                  XBND = ZERO
-               END IF
-*
-               IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
-*
-*                 G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
-*
-                  GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
-               ELSE
-*
-*                 G(j) could overflow, set GROW to 0.
-*
-                  GROW = ZERO
-               END IF
-   40       CONTINUE
-            GROW = XBND
-         ELSE
-*
-*           A is unit triangular.
-*
-*           Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
-            GROW = MIN( ONE, HALF / MAX( XBND, SMLNUM ) )
-            DO 50 J = JFIRST, JLAST, JINC
-*
-*              Exit the loop if the growth factor is too small.
-*
-               IF( GROW.LE.SMLNUM )
-     $            GO TO 60
-*
-*              G(j) = G(j-1)*( 1 + CNORM(j) )
-*
-               GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
-   50       CONTINUE
-         END IF
-   60    CONTINUE
-*
-      ELSE
-*
-*        Compute the growth in A**T * x = b  or  A**H * x = b.
-*
-         IF( UPPER ) THEN
-            JFIRST = 1
-            JLAST = N
-            JINC = 1
-         ELSE
-            JFIRST = N
-            JLAST = 1
-            JINC = -1
-         END IF
-*
-         IF( TSCAL.NE.ONE ) THEN
-            GROW = ZERO
-            GO TO 90
-         END IF
-*
-         IF( NOUNIT ) THEN
-*
-*           A is non-unit triangular.
-*
-*           Compute GROW = 1/G(j) and XBND = 1/M(j).
-*           Initially, M(0) = max{x(i), i=1,...,n}.
-*
-            GROW = HALF / MAX( XBND, SMLNUM )
-            XBND = GROW
-            DO 70 J = JFIRST, JLAST, JINC
-*
-*              Exit the loop if the growth factor is too small.
-*
-               IF( GROW.LE.SMLNUM )
-     $            GO TO 90
-*
-*              G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
-*
-               XJ = ONE + CNORM( J )
-               GROW = MIN( GROW, XBND / XJ )
-*
-               TJJS = A( J, J )
-               TJJ = CABS1( TJJS )
-*
-               IF( TJJ.GE.SMLNUM ) THEN
-*
-*                 M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
-*
-                  IF( XJ.GT.TJJ )
-     $               XBND = XBND*( TJJ / XJ )
-               ELSE
-*
-*                 M(j) could overflow, set XBND to 0.
-*
-                  XBND = ZERO
-               END IF
-   70       CONTINUE
-            GROW = MIN( GROW, XBND )
-         ELSE
-*
-*           A is unit triangular.
-*
-*           Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
-*
-            GROW = MIN( ONE, HALF / MAX( XBND, SMLNUM ) )
-            DO 80 J = JFIRST, JLAST, JINC
-*
-*              Exit the loop if the growth factor is too small.
-*
-               IF( GROW.LE.SMLNUM )
-     $            GO TO 90
-*
-*              G(j) = ( 1 + CNORM(j) )*G(j-1)
-*
-               XJ = ONE + CNORM( J )
-               GROW = GROW / XJ
-   80       CONTINUE
-         END IF
-   90    CONTINUE
-      END IF
-*
-      IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
-*
-*        Use the Level 2 BLAS solve if the reciprocal of the bound on
-*        elements of X is not too small.
-*
-         CALL ZTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
-      ELSE
-*
-*        Use a Level 1 BLAS solve, scaling intermediate results.
-*
-         IF( XMAX.GT.BIGNUM*HALF ) THEN
-*
-*           Scale X so that its components are less than or equal to
-*           BIGNUM in absolute value.
-*
-            SCALE = ( BIGNUM*HALF ) / XMAX
-            CALL ZDSCAL( N, SCALE, X, 1 )
-            XMAX = BIGNUM
-         ELSE
-            XMAX = XMAX*TWO
-         END IF
-*
-         IF( NOTRAN ) THEN
-*
-*           Solve A * x = b
-*
-            DO 120 J = JFIRST, JLAST, JINC
-*
-*              Compute x(j) = b(j) / A(j,j), scaling x if necessary.
-*
-               XJ = CABS1( X( J ) )
-               IF( NOUNIT ) THEN
-                  TJJS = A( J, J )*TSCAL
-               ELSE
-                  TJJS = TSCAL
-                  IF( TSCAL.EQ.ONE )
-     $               GO TO 110
-               END IF
-               TJJ = CABS1( TJJS )
-               IF( TJJ.GT.SMLNUM ) THEN
-*
-*                    abs(A(j,j)) > SMLNUM:
-*
-                  IF( TJJ.LT.ONE ) THEN
-                     IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-*                          Scale x by 1/b(j).
-*
-                        REC = ONE / XJ
-                        CALL ZDSCAL( N, REC, X, 1 )
-                        SCALE = SCALE*REC
-                        XMAX = XMAX*REC
-                     END IF
-                  END IF
-                  X( J ) = ZLADIV( X( J ), TJJS )
-                  XJ = CABS1( X( J ) )
-               ELSE IF( TJJ.GT.ZERO ) THEN
-*
-*                    0 < abs(A(j,j)) <= SMLNUM:
-*
-                  IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-*                       Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
-*                       to avoid overflow when dividing by A(j,j).
-*
-                     REC = ( TJJ*BIGNUM ) / XJ
-                     IF( CNORM( J ).GT.ONE ) THEN
-*
-*                          Scale by 1/CNORM(j) to avoid overflow when
-*                          multiplying x(j) times column j.
-*
-                        REC = REC / CNORM( J )
-                     END IF
-                     CALL ZDSCAL( N, REC, X, 1 )
-                     SCALE = SCALE*REC
-                     XMAX = XMAX*REC
-                  END IF
-                  X( J ) = ZLADIV( X( J ), TJJS )
-                  XJ = CABS1( X( J ) )
-               ELSE
-*
-*                    A(j,j) = 0:  Set x(1:n) = 0, x(j) = 1, and
-*                    scale = 0, and compute a solution to A*x = 0.
-*
-                  DO 100 I = 1, N
-                     X( I ) = ZERO
-  100             CONTINUE
-                  X( J ) = ONE
-                  XJ = ONE
-                  SCALE = ZERO
-                  XMAX = ZERO
-               END IF
-  110          CONTINUE
-*
-*              Scale x if necessary to avoid overflow when adding a
-*              multiple of column j of A.
-*
-               IF( XJ.GT.ONE ) THEN
-                  REC = ONE / XJ
-                  IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
-*
-*                    Scale x by 1/(2*abs(x(j))).
-*
-                     REC = REC*HALF
-                     CALL ZDSCAL( N, REC, X, 1 )
-                     SCALE = SCALE*REC
-                  END IF
-               ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
-*
-*                 Scale x by 1/2.
-*
-                  CALL ZDSCAL( N, HALF, X, 1 )
-                  SCALE = SCALE*HALF
-               END IF
-*
-               IF( UPPER ) THEN
-                  IF( J.GT.1 ) THEN
-*
-*                    Compute the update
-*                       x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
-*
-                     CALL ZAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X,
-     $                           1 )
-                     I = IZAMAX( J-1, X, 1 )
-                     XMAX = CABS1( X( I ) )
-                  END IF
-               ELSE
-                  IF( J.LT.N ) THEN
-*
-*                    Compute the update
-*                       x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
-*
-                     CALL ZAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1,
-     $                           X( J+1 ), 1 )
-                     I = J + IZAMAX( N-J, X( J+1 ), 1 )
-                     XMAX = CABS1( X( I ) )
-                  END IF
-               END IF
-  120       CONTINUE
-*
-         ELSE IF( LSAME( TRANS, 'T' ) ) THEN
-*
-*           Solve A**T * x = b
-*
-            DO 170 J = JFIRST, JLAST, JINC
-*
-*              Compute x(j) = b(j) - sum A(k,j)*x(k).
-*                                    k<>j
-*
-               XJ = CABS1( X( J ) )
-               USCAL = TSCAL
-               REC = ONE / MAX( XMAX, ONE )
-               IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-*                 If x(j) could overflow, scale x by 1/(2*XMAX).
-*
-                  REC = REC*HALF
-                  IF( NOUNIT ) THEN
-                     TJJS = A( J, J )*TSCAL
-                  ELSE
-                     TJJS = TSCAL
-                  END IF
-                  TJJ = CABS1( TJJS )
-                  IF( TJJ.GT.ONE ) THEN
-*
-*                       Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
-                     REC = MIN( ONE, REC*TJJ )
-                     USCAL = ZLADIV( USCAL, TJJS )
-                  END IF
-                  IF( REC.LT.ONE ) THEN
-                     CALL ZDSCAL( N, REC, X, 1 )
-                     SCALE = SCALE*REC
-                     XMAX = XMAX*REC
-                  END IF
-               END IF
-*
-               CSUMJ = ZERO
-               IF( USCAL.EQ.DCMPLX( ONE ) ) THEN
-*
-*                 If the scaling needed for A in the dot product is 1,
-*                 call ZDOTU to perform the dot product.
-*
-                  IF( UPPER ) THEN
-                     CSUMJ = ZDOTU( J-1, A( 1, J ), 1, X, 1 )
-                  ELSE IF( J.LT.N ) THEN
-                     CSUMJ = ZDOTU( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
-                  END IF
-               ELSE
-*
-*                 Otherwise, use in-line code for the dot product.
-*
-                  IF( UPPER ) THEN
-                     DO 130 I = 1, J - 1
-                        CSUMJ = CSUMJ + ( A( I, J )*USCAL )*X( I )
-  130                CONTINUE
-                  ELSE IF( J.LT.N ) THEN
-                     DO 140 I = J + 1, N
-                        CSUMJ = CSUMJ + ( A( I, J )*USCAL )*X( I )
-  140                CONTINUE
-                  END IF
-               END IF
-*
-               IF( USCAL.EQ.DCMPLX( TSCAL ) ) THEN
-*
-*                 Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j)
-*                 was not used to scale the dotproduct.
-*
-                  X( J ) = X( J ) - CSUMJ
-                  XJ = CABS1( X( J ) )
-                  IF( NOUNIT ) THEN
-                     TJJS = A( J, J )*TSCAL
-                  ELSE
-                     TJJS = TSCAL
-                     IF( TSCAL.EQ.ONE )
-     $                  GO TO 160
-                  END IF
-*
-*                    Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
-                  TJJ = CABS1( TJJS )
-                  IF( TJJ.GT.SMLNUM ) THEN
-*
-*                       abs(A(j,j)) > SMLNUM:
-*
-                     IF( TJJ.LT.ONE ) THEN
-                        IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-*                             Scale X by 1/abs(x(j)).
-*
-                           REC = ONE / XJ
-                           CALL ZDSCAL( N, REC, X, 1 )
-                           SCALE = SCALE*REC
-                           XMAX = XMAX*REC
-                        END IF
-                     END IF
-                     X( J ) = ZLADIV( X( J ), TJJS )
-                  ELSE IF( TJJ.GT.ZERO ) THEN
-*
-*                       0 < abs(A(j,j)) <= SMLNUM:
-*
-                     IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-*                          Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
-                        REC = ( TJJ*BIGNUM ) / XJ
-                        CALL ZDSCAL( N, REC, X, 1 )
-                        SCALE = SCALE*REC
-                        XMAX = XMAX*REC
-                     END IF
-                     X( J ) = ZLADIV( X( J ), TJJS )
-                  ELSE
-*
-*                       A(j,j) = 0:  Set x(1:n) = 0, x(j) = 1, and
-*                       scale = 0 and compute a solution to A**T *x = 0.
-*
-                     DO 150 I = 1, N
-                        X( I ) = ZERO
-  150                CONTINUE
-                     X( J ) = ONE
-                     SCALE = ZERO
-                     XMAX = ZERO
-                  END IF
-  160             CONTINUE
-               ELSE
-*
-*                 Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot
-*                 product has already been divided by 1/A(j,j).
-*
-                  X( J ) = ZLADIV( X( J ), TJJS ) - CSUMJ
-               END IF
-               XMAX = MAX( XMAX, CABS1( X( J ) ) )
-  170       CONTINUE
-*
-         ELSE
-*
-*           Solve A**H * x = b
-*
-            DO 220 J = JFIRST, JLAST, JINC
-*
-*              Compute x(j) = b(j) - sum A(k,j)*x(k).
-*                                    k<>j
-*
-               XJ = CABS1( X( J ) )
-               USCAL = TSCAL
-               REC = ONE / MAX( XMAX, ONE )
-               IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
-*
-*                 If x(j) could overflow, scale x by 1/(2*XMAX).
-*
-                  REC = REC*HALF
-                  IF( NOUNIT ) THEN
-                     TJJS = DCONJG( A( J, J ) )*TSCAL
-                  ELSE
-                     TJJS = TSCAL
-                  END IF
-                  TJJ = CABS1( TJJS )
-                  IF( TJJ.GT.ONE ) THEN
-*
-*                       Divide by A(j,j) when scaling x if A(j,j) > 1.
-*
-                     REC = MIN( ONE, REC*TJJ )
-                     USCAL = ZLADIV( USCAL, TJJS )
-                  END IF
-                  IF( REC.LT.ONE ) THEN
-                     CALL ZDSCAL( N, REC, X, 1 )
-                     SCALE = SCALE*REC
-                     XMAX = XMAX*REC
-                  END IF
-               END IF
-*
-               CSUMJ = ZERO
-               IF( USCAL.EQ.DCMPLX( ONE ) ) THEN
-*
-*                 If the scaling needed for A in the dot product is 1,
-*                 call ZDOTC to perform the dot product.
-*
-                  IF( UPPER ) THEN
-                     CSUMJ = ZDOTC( J-1, A( 1, J ), 1, X, 1 )
-                  ELSE IF( J.LT.N ) THEN
-                     CSUMJ = ZDOTC( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
-                  END IF
-               ELSE
-*
-*                 Otherwise, use in-line code for the dot product.
-*
-                  IF( UPPER ) THEN
-                     DO 180 I = 1, J - 1
-                        CSUMJ = CSUMJ + ( DCONJG( A( I, J ) )*USCAL )*
-     $                          X( I )
-  180                CONTINUE
-                  ELSE IF( J.LT.N ) THEN
-                     DO 190 I = J + 1, N
-                        CSUMJ = CSUMJ + ( DCONJG( A( I, J ) )*USCAL )*
-     $                          X( I )
-  190                CONTINUE
-                  END IF
-               END IF
-*
-               IF( USCAL.EQ.DCMPLX( TSCAL ) ) THEN
-*
-*                 Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j)
-*                 was not used to scale the dotproduct.
-*
-                  X( J ) = X( J ) - CSUMJ
-                  XJ = CABS1( X( J ) )
-                  IF( NOUNIT ) THEN
-                     TJJS = DCONJG( A( J, J ) )*TSCAL
-                  ELSE
-                     TJJS = TSCAL
-                     IF( TSCAL.EQ.ONE )
-     $                  GO TO 210
-                  END IF
-*
-*                    Compute x(j) = x(j) / A(j,j), scaling if necessary.
-*
-                  TJJ = CABS1( TJJS )
-                  IF( TJJ.GT.SMLNUM ) THEN
-*
-*                       abs(A(j,j)) > SMLNUM:
-*
-                     IF( TJJ.LT.ONE ) THEN
-                        IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-*                             Scale X by 1/abs(x(j)).
-*
-                           REC = ONE / XJ
-                           CALL ZDSCAL( N, REC, X, 1 )
-                           SCALE = SCALE*REC
-                           XMAX = XMAX*REC
-                        END IF
-                     END IF
-                     X( J ) = ZLADIV( X( J ), TJJS )
-                  ELSE IF( TJJ.GT.ZERO ) THEN
-*
-*                       0 < abs(A(j,j)) <= SMLNUM:
-*
-                     IF( XJ.GT.TJJ*BIGNUM ) THEN
-*
-*                          Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
-*
-                        REC = ( TJJ*BIGNUM ) / XJ
-                        CALL ZDSCAL( N, REC, X, 1 )
-                        SCALE = SCALE*REC
-                        XMAX = XMAX*REC
-                     END IF
-                     X( J ) = ZLADIV( X( J ), TJJS )
-                  ELSE
-*
-*                       A(j,j) = 0:  Set x(1:n) = 0, x(j) = 1, and
-*                       scale = 0 and compute a solution to A**H *x = 0.
-*
-                     DO 200 I = 1, N
-                        X( I ) = ZERO
-  200                CONTINUE
-                     X( J ) = ONE
-                     SCALE = ZERO
-                     XMAX = ZERO
-                  END IF
-  210             CONTINUE
-               ELSE
-*
-*                 Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot
-*                 product has already been divided by 1/A(j,j).
-*
-                  X( J ) = ZLADIV( X( J ), TJJS ) - CSUMJ
-               END IF
-               XMAX = MAX( XMAX, CABS1( X( J ) ) )
-  220       CONTINUE
-         END IF
-         SCALE = SCALE / TSCAL
-      END IF
-*
-*     Scale the column norms by 1/TSCAL for return.
-*
-      IF( TSCAL.NE.ONE ) THEN
-         CALL DSCAL( N, ONE / TSCAL, CNORM, 1 )
-      END IF
-*
-      RETURN
-*
-*     End of ZLATRS
-*
-      END
diff --git a/src/lib/lapack/zlatrz.f b/src/lib/lapack/zlatrz.f
deleted file mode 100644
index c1c7aab3..00000000
--- a/src/lib/lapack/zlatrz.f
+++ /dev/null
@@ -1,133 +0,0 @@
-      SUBROUTINE ZLATRZ( M, N, L, A, LDA, TAU, WORK )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            L, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZLATRZ factors the M-by-(M+L) complex upper trapezoidal matrix
-*  [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R  0 ) * Z by means
-*  of unitary transformations, where  Z is an (M+L)-by-(M+L) unitary
-*  matrix and, R and A1 are M-by-M upper triangular matrices.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= 0.
-*
-*  L       (input) INTEGER
-*          The number of columns of the matrix A containing the
-*          meaningful part of the Householder vectors. N-M >= L >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the leading M-by-N upper trapezoidal part of the
-*          array A must contain the matrix to be factorized.
-*          On exit, the leading M-by-M upper triangular part of A
-*          contains the upper triangular matrix R, and elements N-L+1 to
-*          N of the first M rows of A, with the array TAU, represent the
-*          unitary matrix Z as a product of M elementary reflectors.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) COMPLEX*16 array, dimension (M)
-*          The scalar factors of the elementary reflectors.
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (M)
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  The factorization is obtained by Householder's method.  The kth
-*  transformation matrix, Z( k ), which is used to introduce zeros into
-*  the ( m - k + 1 )th row of A, is given in the form
-*
-*     Z( k ) = ( I     0   ),
-*              ( 0  T( k ) )
-*
-*  where
-*
-*     T( k ) = I - tau*u( k )*u( k )',   u( k ) = (   1    ),
-*                                                 (   0    )
-*                                                 ( z( k ) )
-*
-*  tau is a scalar and z( k ) is an l element vector. tau and z( k )
-*  are chosen to annihilate the elements of the kth row of A2.
-*
-*  The scalar tau is returned in the kth element of TAU and the vector
-*  u( k ) in the kth row of A2, such that the elements of z( k ) are
-*  in  a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in
-*  the upper triangular part of A1.
-*
-*  Z is given by
-*
-*     Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I
-      COMPLEX*16         ALPHA
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZLACGV, ZLARFG, ZLARZ
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 ) THEN
-         RETURN
-      ELSE IF( M.EQ.N ) THEN
-         DO 10 I = 1, N
-            TAU( I ) = ZERO
-   10    CONTINUE
-         RETURN
-      END IF
-*
-      DO 20 I = M, 1, -1
-*
-*        Generate elementary reflector H(i) to annihilate
-*        [ A(i,i) A(i,n-l+1:n) ]
-*
-         CALL ZLACGV( L, A( I, N-L+1 ), LDA )
-         ALPHA = DCONJG( A( I, I ) )
-         CALL ZLARFG( L+1, ALPHA, A( I, N-L+1 ), LDA, TAU( I ) )
-         TAU( I ) = DCONJG( TAU( I ) )
-*
-*        Apply H(i) to A(1:i-1,i:n) from the right
-*
-         CALL ZLARZ( 'Right', I-1, N-I+1, L, A( I, N-L+1 ), LDA,
-     $               DCONJG( TAU( I ) ), A( 1, I ), LDA, WORK )
-         A( I, I ) = DCONJG( ALPHA )
-*
-   20 CONTINUE
-*
-      RETURN
-*
-*     End of ZLATRZ
-*
-      END
diff --git a/src/lib/lapack/zpotf2.f b/src/lib/lapack/zpotf2.f
deleted file mode 100644
index ca9df447..00000000
--- a/src/lib/lapack/zpotf2.f
+++ /dev/null
@@ -1,174 +0,0 @@
-      SUBROUTINE ZPOTF2( UPLO, N, A, LDA, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZPOTF2 computes the Cholesky factorization of a complex Hermitian
-*  positive definite matrix A.
-*
-*  The factorization has the form
-*     A = U' * U ,  if UPLO = 'U', or
-*     A = L  * L',  if UPLO = 'L',
-*  where U is an upper triangular matrix and L is lower triangular.
-*
-*  This is the unblocked version of the algorithm, calling Level 2 BLAS.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the upper or lower triangular part of the
-*          Hermitian matrix A is stored.
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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, the factor U or L from the Cholesky
-*          factorization A = U'*U  or A = L*L'.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -k, the k-th argument had an illegal value
-*          > 0: if INFO = k, the leading minor of order k is not
-*               positive definite, and the factorization could not be
-*               completed.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
-      COMPLEX*16         CONE
-      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            J
-      DOUBLE PRECISION   AJJ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      COMPLEX*16         ZDOTC
-      EXTERNAL           LSAME, ZDOTC
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZDSCAL, ZGEMV, ZLACGV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, 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( 'ZPOTF2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      IF( UPPER ) THEN
-*
-*        Compute the Cholesky factorization A = U'*U.
-*
-         DO 10 J = 1, N
-*
-*           Compute U(J,J) and test for non-positive-definiteness.
-*
-            AJJ = DBLE( A( J, J ) ) - ZDOTC( J-1, A( 1, J ), 1,
-     $            A( 1, J ), 1 )
-            IF( AJJ.LE.ZERO ) THEN
-               A( J, J ) = AJJ
-               GO TO 30
-            END IF
-            AJJ = SQRT( AJJ )
-            A( J, J ) = AJJ
-*
-*           Compute elements J+1:N of row J.
-*
-            IF( J.LT.N ) THEN
-               CALL ZLACGV( J-1, A( 1, J ), 1 )
-               CALL ZGEMV( 'Transpose', J-1, N-J, -CONE, A( 1, J+1 ),
-     $                     LDA, A( 1, J ), 1, CONE, A( J, J+1 ), LDA )
-               CALL ZLACGV( J-1, A( 1, J ), 1 )
-               CALL ZDSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
-            END IF
-   10    CONTINUE
-      ELSE
-*
-*        Compute the Cholesky factorization A = L*L'.
-*
-         DO 20 J = 1, N
-*
-*           Compute L(J,J) and test for non-positive-definiteness.
-*
-            AJJ = DBLE( A( J, J ) ) - ZDOTC( J-1, A( J, 1 ), LDA,
-     $            A( J, 1 ), LDA )
-            IF( AJJ.LE.ZERO ) THEN
-               A( J, J ) = AJJ
-               GO TO 30
-            END IF
-            AJJ = SQRT( AJJ )
-            A( J, J ) = AJJ
-*
-*           Compute elements J+1:N of column J.
-*
-            IF( J.LT.N ) THEN
-               CALL ZLACGV( J-1, A( J, 1 ), LDA )
-               CALL ZGEMV( 'No transpose', N-J, J-1, -CONE, A( J+1, 1 ),
-     $                     LDA, A( J, 1 ), LDA, CONE, A( J+1, J ), 1 )
-               CALL ZLACGV( J-1, A( J, 1 ), LDA )
-               CALL ZDSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
-            END IF
-   20    CONTINUE
-      END IF
-      GO TO 40
-*
-   30 CONTINUE
-      INFO = J
-*
-   40 CONTINUE
-      RETURN
-*
-*     End of ZPOTF2
-*
-      END
diff --git a/src/lib/lapack/zpotrf.f b/src/lib/lapack/zpotrf.f
deleted file mode 100644
index 86772608..00000000
--- a/src/lib/lapack/zpotrf.f
+++ /dev/null
@@ -1,186 +0,0 @@
-      SUBROUTINE ZPOTRF( UPLO, N, A, LDA, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZPOTRF computes the Cholesky factorization of a complex Hermitian
-*  positive definite matrix A.
-*
-*  The factorization has the form
-*     A = U**H * U,  if UPLO = 'U', or
-*     A = L  * L**H,  if UPLO = 'L',
-*  where U is an upper triangular matrix and L is lower triangular.
-*
-*  This is the block version of the algorithm, calling Level 3 BLAS.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  Upper triangle of A is stored;
-*          = 'L':  Lower triangle of A is stored.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) 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, the factor U or L from the Cholesky
-*          factorization A = U**H*U or A = L*L**H.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  if INFO = i, the leading minor of order i is not
-*                positive definite, and the factorization could not be
-*                completed.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      COMPLEX*16         CONE
-      PARAMETER          ( ONE = 1.0D+0, CONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            UPPER
-      INTEGER            J, JB, NB
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMM, ZHERK, ZPOTF2, ZTRSM
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. 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( 'ZPOTRF', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Determine the block size for this environment.
-*
-      NB = ILAENV( 1, 'ZPOTRF', UPLO, N, -1, -1, -1 )
-      IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-*        Use unblocked code.
-*
-         CALL ZPOTF2( UPLO, N, A, LDA, INFO )
-      ELSE
-*
-*        Use blocked code.
-*
-         IF( UPPER ) THEN
-*
-*           Compute the Cholesky factorization A = U'*U.
-*
-            DO 10 J = 1, N, NB
-*
-*              Update and factorize the current diagonal block and test
-*              for non-positive-definiteness.
-*
-               JB = MIN( NB, N-J+1 )
-               CALL ZHERK( 'Upper', 'Conjugate transpose', JB, J-1,
-     $                     -ONE, A( 1, J ), LDA, ONE, A( J, J ), LDA )
-               CALL ZPOTF2( 'Upper', JB, A( J, J ), LDA, INFO )
-               IF( INFO.NE.0 )
-     $            GO TO 30
-               IF( J+JB.LE.N ) THEN
-*
-*                 Compute the current block row.
-*
-                  CALL ZGEMM( 'Conjugate transpose', 'No transpose', JB,
-     $                        N-J-JB+1, J-1, -CONE, A( 1, J ), LDA,
-     $                        A( 1, J+JB ), LDA, CONE, A( J, J+JB ),
-     $                        LDA )
-                  CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose',
-     $                        'Non-unit', JB, N-J-JB+1, CONE, A( J, J ),
-     $                        LDA, A( J, J+JB ), LDA )
-               END IF
-   10       CONTINUE
-*
-         ELSE
-*
-*           Compute the Cholesky factorization A = L*L'.
-*
-            DO 20 J = 1, N, NB
-*
-*              Update and factorize the current diagonal block and test
-*              for non-positive-definiteness.
-*
-               JB = MIN( NB, N-J+1 )
-               CALL ZHERK( 'Lower', 'No transpose', JB, J-1, -ONE,
-     $                     A( J, 1 ), LDA, ONE, A( J, J ), LDA )
-               CALL ZPOTF2( 'Lower', JB, A( J, J ), LDA, INFO )
-               IF( INFO.NE.0 )
-     $            GO TO 30
-               IF( J+JB.LE.N ) THEN
-*
-*                 Compute the current block column.
-*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
-     $                        N-J-JB+1, JB, J-1, -CONE, A( J+JB, 1 ),
-     $                        LDA, A( J, 1 ), LDA, CONE, A( J+JB, J ),
-     $                        LDA )
-                  CALL ZTRSM( 'Right', 'Lower', 'Conjugate transpose',
-     $                        'Non-unit', N-J-JB+1, JB, CONE, A( J, J ),
-     $                        LDA, A( J+JB, J ), LDA )
-               END IF
-   20       CONTINUE
-         END IF
-      END IF
-      GO TO 40
-*
-   30 CONTINUE
-      INFO = INFO + J - 1
-*
-   40 CONTINUE
-      RETURN
-*
-*     End of ZPOTRF
-*
-      END
diff --git a/src/lib/lapack/zrot.f b/src/lib/lapack/zrot.f
deleted file mode 100644
index 9c548e23..00000000
--- a/src/lib/lapack/zrot.f
+++ /dev/null
@@ -1,91 +0,0 @@
-      SUBROUTINE ZROT( N, CX, INCX, CY, INCY, C, S )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INCX, INCY, N
-      DOUBLE PRECISION   C
-      COMPLEX*16         S
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         CX( * ), CY( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZROT   applies a plane rotation, where the cos (C) is real and the
-*  sin (S) is complex, and the vectors CX and CY are complex.
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The number of elements in the vectors CX and CY.
-*
-*  CX      (input/output) COMPLEX*16 array, dimension (N)
-*          On input, the vector X.
-*          On output, CX is overwritten with C*X + S*Y.
-*
-*  INCX    (input) INTEGER
-*          The increment between successive values of CY.  INCX <> 0.
-*
-*  CY      (input/output) COMPLEX*16 array, dimension (N)
-*          On input, the vector Y.
-*          On output, CY is overwritten with -CONJG(S)*X + C*Y.
-*
-*  INCY    (input) INTEGER
-*          The increment between successive values of CY.  INCX <> 0.
-*
-*  C       (input) DOUBLE PRECISION
-*  S       (input) COMPLEX*16
-*          C and S define a rotation
-*             [  C          S  ]
-*             [ -conjg(S)   C  ]
-*          where C*C + S*CONJG(S) = 1.0.
-*
-* =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            I, IX, IY
-      COMPLEX*16         STEMP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG
-*     ..
-*     .. Executable Statements ..
-*
-      IF( N.LE.0 )
-     $   RETURN
-      IF( INCX.EQ.1 .AND. INCY.EQ.1 )
-     $   GO TO 20
-*
-*     Code for unequal increments or equal increments not equal to 1
-*
-      IX = 1
-      IY = 1
-      IF( INCX.LT.0 )
-     $   IX = ( -N+1 )*INCX + 1
-      IF( INCY.LT.0 )
-     $   IY = ( -N+1 )*INCY + 1
-      DO 10 I = 1, N
-         STEMP = C*CX( IX ) + S*CY( IY )
-         CY( IY ) = C*CY( IY ) - DCONJG( S )*CX( IX )
-         CX( IX ) = STEMP
-         IX = IX + INCX
-         IY = IY + INCY
-   10 CONTINUE
-      RETURN
-*
-*     Code for both increments equal to 1
-*
-   20 CONTINUE
-      DO 30 I = 1, N
-         STEMP = C*CX( I ) + S*CY( I )
-         CY( I ) = C*CY( I ) - DCONJG( S )*CX( I )
-         CX( I ) = STEMP
-   30 CONTINUE
-      RETURN
-      END
diff --git a/src/lib/lapack/zsteqr.f b/src/lib/lapack/zsteqr.f
deleted file mode 100644
index a72fdd96..00000000
--- a/src/lib/lapack/zsteqr.f
+++ /dev/null
@@ -1,503 +0,0 @@
-      SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          COMPZ
-      INTEGER            INFO, LDZ, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   D( * ), E( * ), WORK( * )
-      COMPLEX*16         Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZSTEQR computes all eigenvalues and, optionally, eigenvectors of a
-*  symmetric tridiagonal matrix using the implicit QL or QR method.
-*  The eigenvectors of a full or band complex Hermitian matrix can also
-*  be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this
-*  matrix to tridiagonal form.
-*
-*  Arguments
-*  =========
-*
-*  COMPZ   (input) CHARACTER*1
-*          = 'N':  Compute eigenvalues only.
-*          = 'V':  Compute eigenvalues and eigenvectors of the original
-*                  Hermitian matrix.  On entry, Z must contain the
-*                  unitary matrix used to reduce the original matrix
-*                  to tridiagonal form.
-*          = 'I':  Compute eigenvalues and eigenvectors of the
-*                  tridiagonal matrix.  Z is initialized to the identity
-*                  matrix.
-*
-*  N       (input) INTEGER
-*          The order of the matrix.  N >= 0.
-*
-*  D       (input/output) DOUBLE PRECISION array, dimension (N)
-*          On entry, the diagonal elements of the tridiagonal matrix.
-*          On exit, if INFO = 0, the eigenvalues in ascending order.
-*
-*  E       (input/output) DOUBLE PRECISION array, dimension (N-1)
-*          On entry, the (n-1) subdiagonal elements of the tridiagonal
-*          matrix.
-*          On exit, E has been destroyed.
-*
-*  Z       (input/output) COMPLEX*16 array, dimension (LDZ, N)
-*          On entry, if  COMPZ = 'V', then Z contains the unitary
-*          matrix used in the reduction to tridiagonal form.
-*          On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
-*          orthonormal eigenvectors of the original Hermitian matrix,
-*          and if COMPZ = 'I', Z contains the orthonormal eigenvectors
-*          of the symmetric tridiagonal matrix.
-*          If COMPZ = 'N', then Z is not referenced.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z.  LDZ >= 1, and if
-*          eigenvectors are desired, then  LDZ >= max(1,N).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (max(1,2*N-2))
-*          If COMPZ = 'N', then WORK is not referenced.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*          > 0:  the algorithm has failed to find all the eigenvalues in
-*                a total of 30*N iterations; if INFO = i, then i
-*                elements of E have not converged to zero; on exit, D
-*                and E contain the elements of a symmetric tridiagonal
-*                matrix which is unitarily similar to the original
-*                matrix.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE, TWO, THREE
-      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
-     $                   THREE = 3.0D0 )
-      COMPLEX*16         CZERO, CONE
-      PARAMETER          ( CZERO = ( 0.0D0, 0.0D0 ),
-     $                   CONE = ( 1.0D0, 0.0D0 ) )
-      INTEGER            MAXIT
-      PARAMETER          ( MAXIT = 30 )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, ICOMPZ, II, ISCALE, J, JTOT, K, L, L1, LEND,
-     $                   LENDM1, LENDP1, LENDSV, LM1, LSV, M, MM, MM1,
-     $                   NM1, NMAXIT
-      DOUBLE PRECISION   ANORM, B, C, EPS, EPS2, F, G, P, R, RT1, RT2,
-     $                   S, SAFMAX, SAFMIN, SSFMAX, SSFMIN, TST
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH, DLANST, DLAPY2
-      EXTERNAL           LSAME, DLAMCH, DLANST, DLAPY2
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLAE2, DLAEV2, DLARTG, DLASCL, DLASRT, XERBLA,
-     $                   ZLASET, ZLASR, ZSWAP
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, SIGN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-*
-      IF( LSAME( COMPZ, 'N' ) ) THEN
-         ICOMPZ = 0
-      ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
-         ICOMPZ = 1
-      ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
-         ICOMPZ = 2
-      ELSE
-         ICOMPZ = -1
-      END IF
-      IF( ICOMPZ.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
-     $         N ) ) ) THEN
-         INFO = -6
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZSTEQR', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-      IF( N.EQ.1 ) THEN
-         IF( ICOMPZ.EQ.2 )
-     $      Z( 1, 1 ) = CONE
-         RETURN
-      END IF
-*
-*     Determine the unit roundoff and over/underflow thresholds.
-*
-      EPS = DLAMCH( 'E' )
-      EPS2 = EPS**2
-      SAFMIN = DLAMCH( 'S' )
-      SAFMAX = ONE / SAFMIN
-      SSFMAX = SQRT( SAFMAX ) / THREE
-      SSFMIN = SQRT( SAFMIN ) / EPS2
-*
-*     Compute the eigenvalues and eigenvectors of the tridiagonal
-*     matrix.
-*
-      IF( ICOMPZ.EQ.2 )
-     $   CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDZ )
-*
-      NMAXIT = N*MAXIT
-      JTOT = 0
-*
-*     Determine where the matrix splits and choose QL or QR iteration
-*     for each block, according to whether top or bottom diagonal
-*     element is smaller.
-*
-      L1 = 1
-      NM1 = N - 1
-*
-   10 CONTINUE
-      IF( L1.GT.N )
-     $   GO TO 160
-      IF( L1.GT.1 )
-     $   E( L1-1 ) = ZERO
-      IF( L1.LE.NM1 ) THEN
-         DO 20 M = L1, NM1
-            TST = ABS( E( M ) )
-            IF( TST.EQ.ZERO )
-     $         GO TO 30
-            IF( TST.LE.( SQRT( ABS( D( M ) ) )*SQRT( ABS( D( M+
-     $          1 ) ) ) )*EPS ) THEN
-               E( M ) = ZERO
-               GO TO 30
-            END IF
-   20    CONTINUE
-      END IF
-      M = N
-*
-   30 CONTINUE
-      L = L1
-      LSV = L
-      LEND = M
-      LENDSV = LEND
-      L1 = M + 1
-      IF( LEND.EQ.L )
-     $   GO TO 10
-*
-*     Scale submatrix in rows and columns L to LEND
-*
-      ANORM = DLANST( 'I', LEND-L+1, D( L ), E( L ) )
-      ISCALE = 0
-      IF( ANORM.EQ.ZERO )
-     $   GO TO 10
-      IF( ANORM.GT.SSFMAX ) THEN
-         ISCALE = 1
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N,
-     $                INFO )
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N,
-     $                INFO )
-      ELSE IF( ANORM.LT.SSFMIN ) THEN
-         ISCALE = 2
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N,
-     $                INFO )
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N,
-     $                INFO )
-      END IF
-*
-*     Choose between QL and QR iteration
-*
-      IF( ABS( D( LEND ) ).LT.ABS( D( L ) ) ) THEN
-         LEND = LSV
-         L = LENDSV
-      END IF
-*
-      IF( LEND.GT.L ) THEN
-*
-*        QL Iteration
-*
-*        Look for small subdiagonal element.
-*
-   40    CONTINUE
-         IF( L.NE.LEND ) THEN
-            LENDM1 = LEND - 1
-            DO 50 M = L, LENDM1
-               TST = ABS( E( M ) )**2
-               IF( TST.LE.( EPS2*ABS( D( M ) ) )*ABS( D( M+1 ) )+
-     $             SAFMIN )GO TO 60
-   50       CONTINUE
-         END IF
-*
-         M = LEND
-*
-   60    CONTINUE
-         IF( M.LT.LEND )
-     $      E( M ) = ZERO
-         P = D( L )
-         IF( M.EQ.L )
-     $      GO TO 80
-*
-*        If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
-*        to compute its eigensystem.
-*
-         IF( M.EQ.L+1 ) THEN
-            IF( ICOMPZ.GT.0 ) THEN
-               CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, S )
-               WORK( L ) = C
-               WORK( N-1+L ) = S
-               CALL ZLASR( 'R', 'V', 'B', N, 2, WORK( L ),
-     $                     WORK( N-1+L ), Z( 1, L ), LDZ )
-            ELSE
-               CALL DLAE2( D( L ), E( L ), D( L+1 ), RT1, RT2 )
-            END IF
-            D( L ) = RT1
-            D( L+1 ) = RT2
-            E( L ) = ZERO
-            L = L + 2
-            IF( L.LE.LEND )
-     $         GO TO 40
-            GO TO 140
-         END IF
-*
-         IF( JTOT.EQ.NMAXIT )
-     $      GO TO 140
-         JTOT = JTOT + 1
-*
-*        Form shift.
-*
-         G = ( D( L+1 )-P ) / ( TWO*E( L ) )
-         R = DLAPY2( G, ONE )
-         G = D( M ) - P + ( E( L ) / ( G+SIGN( R, G ) ) )
-*
-         S = ONE
-         C = ONE
-         P = ZERO
-*
-*        Inner loop
-*
-         MM1 = M - 1
-         DO 70 I = MM1, L, -1
-            F = S*E( I )
-            B = C*E( I )
-            CALL DLARTG( G, F, C, S, R )
-            IF( I.NE.M-1 )
-     $         E( I+1 ) = R
-            G = D( I+1 ) - P
-            R = ( D( I )-G )*S + TWO*C*B
-            P = S*R
-            D( I+1 ) = G + P
-            G = C*R - B
-*
-*           If eigenvectors are desired, then save rotations.
-*
-            IF( ICOMPZ.GT.0 ) THEN
-               WORK( I ) = C
-               WORK( N-1+I ) = -S
-            END IF
-*
-   70    CONTINUE
-*
-*        If eigenvectors are desired, then apply saved rotations.
-*
-         IF( ICOMPZ.GT.0 ) THEN
-            MM = M - L + 1
-            CALL ZLASR( 'R', 'V', 'B', N, MM, WORK( L ), WORK( N-1+L ),
-     $                  Z( 1, L ), LDZ )
-         END IF
-*
-         D( L ) = D( L ) - P
-         E( L ) = G
-         GO TO 40
-*
-*        Eigenvalue found.
-*
-   80    CONTINUE
-         D( L ) = P
-*
-         L = L + 1
-         IF( L.LE.LEND )
-     $      GO TO 40
-         GO TO 140
-*
-      ELSE
-*
-*        QR Iteration
-*
-*        Look for small superdiagonal element.
-*
-   90    CONTINUE
-         IF( L.NE.LEND ) THEN
-            LENDP1 = LEND + 1
-            DO 100 M = L, LENDP1, -1
-               TST = ABS( E( M-1 ) )**2
-               IF( TST.LE.( EPS2*ABS( D( M ) ) )*ABS( D( M-1 ) )+
-     $             SAFMIN )GO TO 110
-  100       CONTINUE
-         END IF
-*
-         M = LEND
-*
-  110    CONTINUE
-         IF( M.GT.LEND )
-     $      E( M-1 ) = ZERO
-         P = D( L )
-         IF( M.EQ.L )
-     $      GO TO 130
-*
-*        If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
-*        to compute its eigensystem.
-*
-         IF( M.EQ.L-1 ) THEN
-            IF( ICOMPZ.GT.0 ) THEN
-               CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, S )
-               WORK( M ) = C
-               WORK( N-1+M ) = S
-               CALL ZLASR( 'R', 'V', 'F', N, 2, WORK( M ),
-     $                     WORK( N-1+M ), Z( 1, L-1 ), LDZ )
-            ELSE
-               CALL DLAE2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2 )
-            END IF
-            D( L-1 ) = RT1
-            D( L ) = RT2
-            E( L-1 ) = ZERO
-            L = L - 2
-            IF( L.GE.LEND )
-     $         GO TO 90
-            GO TO 140
-         END IF
-*
-         IF( JTOT.EQ.NMAXIT )
-     $      GO TO 140
-         JTOT = JTOT + 1
-*
-*        Form shift.
-*
-         G = ( D( L-1 )-P ) / ( TWO*E( L-1 ) )
-         R = DLAPY2( G, ONE )
-         G = D( M ) - P + ( E( L-1 ) / ( G+SIGN( R, G ) ) )
-*
-         S = ONE
-         C = ONE
-         P = ZERO
-*
-*        Inner loop
-*
-         LM1 = L - 1
-         DO 120 I = M, LM1
-            F = S*E( I )
-            B = C*E( I )
-            CALL DLARTG( G, F, C, S, R )
-            IF( I.NE.M )
-     $         E( I-1 ) = R
-            G = D( I ) - P
-            R = ( D( I+1 )-G )*S + TWO*C*B
-            P = S*R
-            D( I ) = G + P
-            G = C*R - B
-*
-*           If eigenvectors are desired, then save rotations.
-*
-            IF( ICOMPZ.GT.0 ) THEN
-               WORK( I ) = C
-               WORK( N-1+I ) = S
-            END IF
-*
-  120    CONTINUE
-*
-*        If eigenvectors are desired, then apply saved rotations.
-*
-         IF( ICOMPZ.GT.0 ) THEN
-            MM = L - M + 1
-            CALL ZLASR( 'R', 'V', 'F', N, MM, WORK( M ), WORK( N-1+M ),
-     $                  Z( 1, M ), LDZ )
-         END IF
-*
-         D( L ) = D( L ) - P
-         E( LM1 ) = G
-         GO TO 90
-*
-*        Eigenvalue found.
-*
-  130    CONTINUE
-         D( L ) = P
-*
-         L = L - 1
-         IF( L.GE.LEND )
-     $      GO TO 90
-         GO TO 140
-*
-      END IF
-*
-*     Undo scaling if necessary
-*
-  140 CONTINUE
-      IF( ISCALE.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1,
-     $                D( LSV ), N, INFO )
-         CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E( LSV ),
-     $                N, INFO )
-      ELSE IF( ISCALE.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1,
-     $                D( LSV ), N, INFO )
-         CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E( LSV ),
-     $                N, INFO )
-      END IF
-*
-*     Check for no convergence to an eigenvalue after a total
-*     of N*MAXIT iterations.
-*
-      IF( JTOT.EQ.NMAXIT ) THEN
-         DO 150 I = 1, N - 1
-            IF( E( I ).NE.ZERO )
-     $         INFO = INFO + 1
-  150    CONTINUE
-         RETURN
-      END IF
-      GO TO 10
-*
-*     Order eigenvalues and eigenvectors.
-*
-  160 CONTINUE
-      IF( ICOMPZ.EQ.0 ) THEN
-*
-*        Use Quick Sort
-*
-         CALL DLASRT( 'I', N, D, INFO )
-*
-      ELSE
-*
-*        Use Selection Sort to minimize swaps of eigenvectors
-*
-         DO 180 II = 2, N
-            I = II - 1
-            K = I
-            P = D( I )
-            DO 170 J = II, N
-               IF( D( J ).LT.P ) THEN
-                  K = J
-                  P = D( J )
-               END IF
-  170       CONTINUE
-            IF( K.NE.I ) THEN
-               D( K ) = D( I )
-               D( I ) = P
-               CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 )
-            END IF
-  180    CONTINUE
-      END IF
-      RETURN
-*
-*     End of ZSTEQR
-*
-      END
diff --git a/src/lib/lapack/ztgevc.f b/src/lib/lapack/ztgevc.f
deleted file mode 100644
index b8da962d..00000000
--- a/src/lib/lapack/ztgevc.f
+++ /dev/null
@@ -1,633 +0,0 @@
-      SUBROUTINE ZTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL,
-     $                   LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          HOWMNY, SIDE
-      INTEGER            INFO, LDP, LDS, LDVL, LDVR, M, MM, N
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            SELECT( * )
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         P( LDP, * ), S( LDS, * ), VL( LDVL, * ),
-     $                   VR( LDVR, * ), WORK( * )
-*     ..
-*
-*
-*  Purpose
-*  =======
-*
-*  ZTGEVC computes some or all of the right and/or left eigenvectors of
-*  a pair of complex matrices (S,P), where S and P are upper triangular.
-*  Matrix pairs of this type are produced by the generalized Schur
-*  factorization of a complex matrix pair (A,B):
-*  
-*     A = Q*S*Z**H,  B = Q*P*Z**H
-*  
-*  as computed by ZGGHRD + ZHGEQZ.
-*  
-*  The right eigenvector x and the left eigenvector y of (S,P)
-*  corresponding to an eigenvalue w are defined by:
-*  
-*     S*x = w*P*x,  (y**H)*S = w*(y**H)*P,
-*  
-*  where y**H denotes the conjugate tranpose of y.
-*  The eigenvalues are not input to this routine, but are computed
-*  directly from the diagonal elements of S and P.
-*  
-*  This routine returns the matrices X and/or Y of right and left
-*  eigenvectors of (S,P), or the products Z*X and/or Q*Y,
-*  where Z and Q are input matrices.
-*  If Q and Z are the unitary factors from the generalized Schur
-*  factorization of a matrix pair (A,B), then Z*X and Q*Y
-*  are the matrices of right and left eigenvectors of (A,B).
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'R': compute right eigenvectors only;
-*          = 'L': compute left eigenvectors only;
-*          = 'B': compute both right and left eigenvectors.
-*
-*  HOWMNY  (input) CHARACTER*1
-*          = 'A': compute all right and/or left eigenvectors;
-*          = 'B': compute all right and/or left eigenvectors,
-*                 backtransformed by the matrices in VR and/or VL;
-*          = 'S': compute selected right and/or left eigenvectors,
-*                 specified by the logical array SELECT.
-*
-*  SELECT  (input) LOGICAL array, dimension (N)
-*          If HOWMNY='S', SELECT specifies the eigenvectors to be
-*          computed.  The eigenvector corresponding to the j-th
-*          eigenvalue is computed if SELECT(j) = .TRUE..
-*          Not referenced if HOWMNY = 'A' or 'B'.
-*
-*  N       (input) INTEGER
-*          The order of the matrices S and P.  N >= 0.
-*
-*  S       (input) COMPLEX*16 array, dimension (LDS,N)
-*          The upper triangular matrix S from a generalized Schur
-*          factorization, as computed by ZHGEQZ.
-*
-*  LDS     (input) INTEGER
-*          The leading dimension of array S.  LDS >= max(1,N).
-*
-*  P       (input) COMPLEX*16 array, dimension (LDP,N)
-*          The upper triangular matrix P from a generalized Schur
-*          factorization, as computed by ZHGEQZ.  P must have real
-*          diagonal elements.
-*
-*  LDP     (input) INTEGER
-*          The leading dimension of array P.  LDP >= max(1,N).
-*
-*  VL      (input/output) COMPLEX*16 array, dimension (LDVL,MM)
-*          On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
-*          contain an N-by-N matrix Q (usually the unitary matrix Q
-*          of left Schur vectors returned by ZHGEQZ).
-*          On exit, if SIDE = 'L' or 'B', VL contains:
-*          if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);
-*          if HOWMNY = 'B', the matrix Q*Y;
-*          if HOWMNY = 'S', the left eigenvectors of (S,P) specified by
-*                      SELECT, stored consecutively in the columns of
-*                      VL, in the same order as their eigenvalues.
-*          Not referenced if SIDE = 'R'.
-*
-*  LDVL    (input) INTEGER
-*          The leading dimension of array VL.  LDVL >= 1, and if
-*          SIDE = 'L' or 'l' or 'B' or 'b', LDVL >= N.
-*
-*  VR      (input/output) COMPLEX*16 array, dimension (LDVR,MM)
-*          On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-*          contain an N-by-N matrix Q (usually the unitary matrix Z
-*          of right Schur vectors returned by ZHGEQZ).
-*          On exit, if SIDE = 'R' or 'B', VR contains:
-*          if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);
-*          if HOWMNY = 'B', the matrix Z*X;
-*          if HOWMNY = 'S', the right eigenvectors of (S,P) specified by
-*                      SELECT, stored consecutively in the columns of
-*                      VR, in the same order as their eigenvalues.
-*          Not referenced if SIDE = 'L'.
-*
-*  LDVR    (input) INTEGER
-*          The leading dimension of the array VR.  LDVR >= 1, and if
-*          SIDE = 'R' or 'B', LDVR >= N.
-*
-*  MM      (input) INTEGER
-*          The number of columns in the arrays VL and/or VR. MM >= M.
-*
-*  M       (output) INTEGER
-*          The number of columns in the arrays VL and/or VR actually
-*          used to store the eigenvectors.  If HOWMNY = 'A' or 'B', M
-*          is set to N.  Each selected eigenvector occupies one column.
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (2*N)
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit.
-*          < 0:  if INFO = -i, the i-th argument had an illegal value.
-*
-*  =====================================================================
-*
-*     .. 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 ..
-      LOGICAL            COMPL, COMPR, ILALL, ILBACK, ILBBAD, ILCOMP,
-     $                   LSA, LSB
-      INTEGER            I, IBEG, IEIG, IEND, IHWMNY, IM, ISIDE, ISRC,
-     $                   J, JE, JR
-      DOUBLE PRECISION   ACOEFA, ACOEFF, ANORM, ASCALE, BCOEFA, BIG,
-     $                   BIGNUM, BNORM, BSCALE, DMIN, SAFMIN, SBETA,
-     $                   SCALE, SMALL, TEMP, ULP, XMAX
-      COMPLEX*16         BCOEFF, CA, CB, D, SALPHA, SUM, SUMA, SUMB, X
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH
-      COMPLEX*16         ZLADIV
-      EXTERNAL           LSAME, DLAMCH, ZLADIV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZGEMV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   ABS1
-*     ..
-*     .. Statement Function definitions ..
-      ABS1( X ) = ABS( DBLE( X ) ) + ABS( DIMAG( X ) )
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and Test the input parameters
-*
-      IF( LSAME( HOWMNY, 'A' ) ) THEN
-         IHWMNY = 1
-         ILALL = .TRUE.
-         ILBACK = .FALSE.
-      ELSE IF( LSAME( HOWMNY, 'S' ) ) THEN
-         IHWMNY = 2
-         ILALL = .FALSE.
-         ILBACK = .FALSE.
-      ELSE IF( LSAME( HOWMNY, 'B' ) ) THEN
-         IHWMNY = 3
-         ILALL = .TRUE.
-         ILBACK = .TRUE.
-      ELSE
-         IHWMNY = -1
-      END IF
-*
-      IF( LSAME( SIDE, 'R' ) ) THEN
-         ISIDE = 1
-         COMPL = .FALSE.
-         COMPR = .TRUE.
-      ELSE IF( LSAME( SIDE, 'L' ) ) THEN
-         ISIDE = 2
-         COMPL = .TRUE.
-         COMPR = .FALSE.
-      ELSE IF( LSAME( SIDE, 'B' ) ) THEN
-         ISIDE = 3
-         COMPL = .TRUE.
-         COMPR = .TRUE.
-      ELSE
-         ISIDE = -1
-      END IF
-*
-      INFO = 0
-      IF( ISIDE.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( IHWMNY.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      ELSE IF( LDP.LT.MAX( 1, N ) ) THEN
-         INFO = -8
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTGEVC', -INFO )
-         RETURN
-      END IF
-*
-*     Count the number of eigenvectors
-*
-      IF( .NOT.ILALL ) THEN
-         IM = 0
-         DO 10 J = 1, N
-            IF( SELECT( J ) )
-     $         IM = IM + 1
-   10    CONTINUE
-      ELSE
-         IM = N
-      END IF
-*
-*     Check diagonal of B
-*
-      ILBBAD = .FALSE.
-      DO 20 J = 1, N
-         IF( DIMAG( P( J, J ) ).NE.ZERO )
-     $      ILBBAD = .TRUE.
-   20 CONTINUE
-*
-      IF( ILBBAD ) THEN
-         INFO = -7
-      ELSE IF( COMPL .AND. LDVL.LT.N .OR. LDVL.LT.1 ) THEN
-         INFO = -10
-      ELSE IF( COMPR .AND. LDVR.LT.N .OR. LDVR.LT.1 ) THEN
-         INFO = -12
-      ELSE IF( MM.LT.IM ) THEN
-         INFO = -13
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTGEVC', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      M = IM
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Machine Constants
-*
-      SAFMIN = DLAMCH( 'Safe minimum' )
-      BIG = ONE / SAFMIN
-      CALL DLABAD( SAFMIN, BIG )
-      ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
-      SMALL = SAFMIN*N / ULP
-      BIG = ONE / SMALL
-      BIGNUM = ONE / ( SAFMIN*N )
-*
-*     Compute the 1-norm of each column of the strictly upper triangular
-*     part of A and B to check for possible overflow in the triangular
-*     solver.
-*
-      ANORM = ABS1( S( 1, 1 ) )
-      BNORM = ABS1( P( 1, 1 ) )
-      RWORK( 1 ) = ZERO
-      RWORK( N+1 ) = ZERO
-      DO 40 J = 2, N
-         RWORK( J ) = ZERO
-         RWORK( N+J ) = ZERO
-         DO 30 I = 1, J - 1
-            RWORK( J ) = RWORK( J ) + ABS1( S( I, J ) )
-            RWORK( N+J ) = RWORK( N+J ) + ABS1( P( I, J ) )
-   30    CONTINUE
-         ANORM = MAX( ANORM, RWORK( J )+ABS1( S( J, J ) ) )
-         BNORM = MAX( BNORM, RWORK( N+J )+ABS1( P( J, J ) ) )
-   40 CONTINUE
-*
-      ASCALE = ONE / MAX( ANORM, SAFMIN )
-      BSCALE = ONE / MAX( BNORM, SAFMIN )
-*
-*     Left eigenvectors
-*
-      IF( COMPL ) THEN
-         IEIG = 0
-*
-*        Main loop over eigenvalues
-*
-         DO 140 JE = 1, N
-            IF( ILALL ) THEN
-               ILCOMP = .TRUE.
-            ELSE
-               ILCOMP = SELECT( JE )
-            END IF
-            IF( ILCOMP ) THEN
-               IEIG = IEIG + 1
-*
-               IF( ABS1( S( JE, JE ) ).LE.SAFMIN .AND.
-     $             ABS( DBLE( P( JE, JE ) ) ).LE.SAFMIN ) THEN
-*
-*                 Singular matrix pencil -- return unit eigenvector
-*
-                  DO 50 JR = 1, N
-                     VL( JR, IEIG ) = CZERO
-   50             CONTINUE
-                  VL( IEIG, IEIG ) = CONE
-                  GO TO 140
-               END IF
-*
-*              Non-singular eigenvalue:
-*              Compute coefficients  a  and  b  in
-*                   H
-*                 y  ( a A - b B ) = 0
-*
-               TEMP = ONE / MAX( ABS1( S( JE, JE ) )*ASCALE,
-     $                ABS( DBLE( P( JE, JE ) ) )*BSCALE, SAFMIN )
-               SALPHA = ( TEMP*S( JE, JE ) )*ASCALE
-               SBETA = ( TEMP*DBLE( P( JE, JE ) ) )*BSCALE
-               ACOEFF = SBETA*ASCALE
-               BCOEFF = SALPHA*BSCALE
-*
-*              Scale to avoid underflow
-*
-               LSA = ABS( SBETA ).GE.SAFMIN .AND. ABS( ACOEFF ).LT.SMALL
-               LSB = ABS1( SALPHA ).GE.SAFMIN .AND. ABS1( BCOEFF ).LT.
-     $               SMALL
-*
-               SCALE = ONE
-               IF( LSA )
-     $            SCALE = ( SMALL / ABS( SBETA ) )*MIN( ANORM, BIG )
-               IF( LSB )
-     $            SCALE = MAX( SCALE, ( SMALL / ABS1( SALPHA ) )*
-     $                    MIN( BNORM, BIG ) )
-               IF( LSA .OR. LSB ) THEN
-                  SCALE = MIN( SCALE, ONE /
-     $                    ( SAFMIN*MAX( ONE, ABS( ACOEFF ),
-     $                    ABS1( BCOEFF ) ) ) )
-                  IF( LSA ) THEN
-                     ACOEFF = ASCALE*( SCALE*SBETA )
-                  ELSE
-                     ACOEFF = SCALE*ACOEFF
-                  END IF
-                  IF( LSB ) THEN
-                     BCOEFF = BSCALE*( SCALE*SALPHA )
-                  ELSE
-                     BCOEFF = SCALE*BCOEFF
-                  END IF
-               END IF
-*
-               ACOEFA = ABS( ACOEFF )
-               BCOEFA = ABS1( BCOEFF )
-               XMAX = ONE
-               DO 60 JR = 1, N
-                  WORK( JR ) = CZERO
-   60          CONTINUE
-               WORK( JE ) = CONE
-               DMIN = MAX( ULP*ACOEFA*ANORM, ULP*BCOEFA*BNORM, SAFMIN )
-*
-*                                              H
-*              Triangular solve of  (a A - b B)  y = 0
-*
-*                                      H
-*              (rowwise in  (a A - b B) , or columnwise in a A - b B)
-*
-               DO 100 J = JE + 1, N
-*
-*                 Compute
-*                       j-1
-*                 SUM = sum  conjg( a*S(k,j) - b*P(k,j) )*x(k)
-*                       k=je
-*                 (Scale if necessary)
-*
-                  TEMP = ONE / XMAX
-                  IF( ACOEFA*RWORK( J )+BCOEFA*RWORK( N+J ).GT.BIGNUM*
-     $                TEMP ) THEN
-                     DO 70 JR = JE, J - 1
-                        WORK( JR ) = TEMP*WORK( JR )
-   70                CONTINUE
-                     XMAX = ONE
-                  END IF
-                  SUMA = CZERO
-                  SUMB = CZERO
-*
-                  DO 80 JR = JE, J - 1
-                     SUMA = SUMA + DCONJG( S( JR, J ) )*WORK( JR )
-                     SUMB = SUMB + DCONJG( P( JR, J ) )*WORK( JR )
-   80             CONTINUE
-                  SUM = ACOEFF*SUMA - DCONJG( BCOEFF )*SUMB
-*
-*                 Form x(j) = - SUM / conjg( a*S(j,j) - b*P(j,j) )
-*
-*                 with scaling and perturbation of the denominator
-*
-                  D = DCONJG( ACOEFF*S( J, J )-BCOEFF*P( J, J ) )
-                  IF( ABS1( D ).LE.DMIN )
-     $               D = DCMPLX( DMIN )
-*
-                  IF( ABS1( D ).LT.ONE ) THEN
-                     IF( ABS1( SUM ).GE.BIGNUM*ABS1( D ) ) THEN
-                        TEMP = ONE / ABS1( SUM )
-                        DO 90 JR = JE, J - 1
-                           WORK( JR ) = TEMP*WORK( JR )
-   90                   CONTINUE
-                        XMAX = TEMP*XMAX
-                        SUM = TEMP*SUM
-                     END IF
-                  END IF
-                  WORK( J ) = ZLADIV( -SUM, D )
-                  XMAX = MAX( XMAX, ABS1( WORK( J ) ) )
-  100          CONTINUE
-*
-*              Back transform eigenvector if HOWMNY='B'.
-*
-               IF( ILBACK ) THEN
-                  CALL ZGEMV( 'N', N, N+1-JE, CONE, VL( 1, JE ), LDVL,
-     $                        WORK( JE ), 1, CZERO, WORK( N+1 ), 1 )
-                  ISRC = 2
-                  IBEG = 1
-               ELSE
-                  ISRC = 1
-                  IBEG = JE
-               END IF
-*
-*              Copy and scale eigenvector into column of VL
-*
-               XMAX = ZERO
-               DO 110 JR = IBEG, N
-                  XMAX = MAX( XMAX, ABS1( WORK( ( ISRC-1 )*N+JR ) ) )
-  110          CONTINUE
-*
-               IF( XMAX.GT.SAFMIN ) THEN
-                  TEMP = ONE / XMAX
-                  DO 120 JR = IBEG, N
-                     VL( JR, IEIG ) = TEMP*WORK( ( ISRC-1 )*N+JR )
-  120             CONTINUE
-               ELSE
-                  IBEG = N + 1
-               END IF
-*
-               DO 130 JR = 1, IBEG - 1
-                  VL( JR, IEIG ) = CZERO
-  130          CONTINUE
-*
-            END IF
-  140    CONTINUE
-      END IF
-*
-*     Right eigenvectors
-*
-      IF( COMPR ) THEN
-         IEIG = IM + 1
-*
-*        Main loop over eigenvalues
-*
-         DO 250 JE = N, 1, -1
-            IF( ILALL ) THEN
-               ILCOMP = .TRUE.
-            ELSE
-               ILCOMP = SELECT( JE )
-            END IF
-            IF( ILCOMP ) THEN
-               IEIG = IEIG - 1
-*
-               IF( ABS1( S( JE, JE ) ).LE.SAFMIN .AND.
-     $             ABS( DBLE( P( JE, JE ) ) ).LE.SAFMIN ) THEN
-*
-*                 Singular matrix pencil -- return unit eigenvector
-*
-                  DO 150 JR = 1, N
-                     VR( JR, IEIG ) = CZERO
-  150             CONTINUE
-                  VR( IEIG, IEIG ) = CONE
-                  GO TO 250
-               END IF
-*
-*              Non-singular eigenvalue:
-*              Compute coefficients  a  and  b  in
-*
-*              ( a A - b B ) x  = 0
-*
-               TEMP = ONE / MAX( ABS1( S( JE, JE ) )*ASCALE,
-     $                ABS( DBLE( P( JE, JE ) ) )*BSCALE, SAFMIN )
-               SALPHA = ( TEMP*S( JE, JE ) )*ASCALE
-               SBETA = ( TEMP*DBLE( P( JE, JE ) ) )*BSCALE
-               ACOEFF = SBETA*ASCALE
-               BCOEFF = SALPHA*BSCALE
-*
-*              Scale to avoid underflow
-*
-               LSA = ABS( SBETA ).GE.SAFMIN .AND. ABS( ACOEFF ).LT.SMALL
-               LSB = ABS1( SALPHA ).GE.SAFMIN .AND. ABS1( BCOEFF ).LT.
-     $               SMALL
-*
-               SCALE = ONE
-               IF( LSA )
-     $            SCALE = ( SMALL / ABS( SBETA ) )*MIN( ANORM, BIG )
-               IF( LSB )
-     $            SCALE = MAX( SCALE, ( SMALL / ABS1( SALPHA ) )*
-     $                    MIN( BNORM, BIG ) )
-               IF( LSA .OR. LSB ) THEN
-                  SCALE = MIN( SCALE, ONE /
-     $                    ( SAFMIN*MAX( ONE, ABS( ACOEFF ),
-     $                    ABS1( BCOEFF ) ) ) )
-                  IF( LSA ) THEN
-                     ACOEFF = ASCALE*( SCALE*SBETA )
-                  ELSE
-                     ACOEFF = SCALE*ACOEFF
-                  END IF
-                  IF( LSB ) THEN
-                     BCOEFF = BSCALE*( SCALE*SALPHA )
-                  ELSE
-                     BCOEFF = SCALE*BCOEFF
-                  END IF
-               END IF
-*
-               ACOEFA = ABS( ACOEFF )
-               BCOEFA = ABS1( BCOEFF )
-               XMAX = ONE
-               DO 160 JR = 1, N
-                  WORK( JR ) = CZERO
-  160          CONTINUE
-               WORK( JE ) = CONE
-               DMIN = MAX( ULP*ACOEFA*ANORM, ULP*BCOEFA*BNORM, SAFMIN )
-*
-*              Triangular solve of  (a A - b B) x = 0  (columnwise)
-*
-*              WORK(1:j-1) contains sums w,
-*              WORK(j+1:JE) contains x
-*
-               DO 170 JR = 1, JE - 1
-                  WORK( JR ) = ACOEFF*S( JR, JE ) - BCOEFF*P( JR, JE )
-  170          CONTINUE
-               WORK( JE ) = CONE
-*
-               DO 210 J = JE - 1, 1, -1
-*
-*                 Form x(j) := - w(j) / d
-*                 with scaling and perturbation of the denominator
-*
-                  D = ACOEFF*S( J, J ) - BCOEFF*P( J, J )
-                  IF( ABS1( D ).LE.DMIN )
-     $               D = DCMPLX( DMIN )
-*
-                  IF( ABS1( D ).LT.ONE ) THEN
-                     IF( ABS1( WORK( J ) ).GE.BIGNUM*ABS1( D ) ) THEN
-                        TEMP = ONE / ABS1( WORK( J ) )
-                        DO 180 JR = 1, JE
-                           WORK( JR ) = TEMP*WORK( JR )
-  180                   CONTINUE
-                     END IF
-                  END IF
-*
-                  WORK( J ) = ZLADIV( -WORK( J ), D )
-*
-                  IF( J.GT.1 ) THEN
-*
-*                    w = w + x(j)*(a S(*,j) - b P(*,j) ) with scaling
-*
-                     IF( ABS1( WORK( J ) ).GT.ONE ) THEN
-                        TEMP = ONE / ABS1( WORK( J ) )
-                        IF( ACOEFA*RWORK( J )+BCOEFA*RWORK( N+J ).GE.
-     $                      BIGNUM*TEMP ) THEN
-                           DO 190 JR = 1, JE
-                              WORK( JR ) = TEMP*WORK( JR )
-  190                      CONTINUE
-                        END IF
-                     END IF
-*
-                     CA = ACOEFF*WORK( J )
-                     CB = BCOEFF*WORK( J )
-                     DO 200 JR = 1, J - 1
-                        WORK( JR ) = WORK( JR ) + CA*S( JR, J ) -
-     $                               CB*P( JR, J )
-  200                CONTINUE
-                  END IF
-  210          CONTINUE
-*
-*              Back transform eigenvector if HOWMNY='B'.
-*
-               IF( ILBACK ) THEN
-                  CALL ZGEMV( 'N', N, JE, CONE, VR, LDVR, WORK, 1,
-     $                        CZERO, WORK( N+1 ), 1 )
-                  ISRC = 2
-                  IEND = N
-               ELSE
-                  ISRC = 1
-                  IEND = JE
-               END IF
-*
-*              Copy and scale eigenvector into column of VR
-*
-               XMAX = ZERO
-               DO 220 JR = 1, IEND
-                  XMAX = MAX( XMAX, ABS1( WORK( ( ISRC-1 )*N+JR ) ) )
-  220          CONTINUE
-*
-               IF( XMAX.GT.SAFMIN ) THEN
-                  TEMP = ONE / XMAX
-                  DO 230 JR = 1, IEND
-                     VR( JR, IEIG ) = TEMP*WORK( ( ISRC-1 )*N+JR )
-  230             CONTINUE
-               ELSE
-                  IEND = 0
-               END IF
-*
-               DO 240 JR = IEND + 1, N
-                  VR( JR, IEIG ) = CZERO
-  240          CONTINUE
-*
-            END IF
-  250    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of ZTGEVC
-*
-      END
diff --git a/src/lib/lapack/ztgex2.f b/src/lib/lapack/ztgex2.f
deleted file mode 100644
index a0c42aad..00000000
--- a/src/lib/lapack/ztgex2.f
+++ /dev/null
@@ -1,265 +0,0 @@
-      SUBROUTINE ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                   LDZ, J1, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            WANTQ, WANTZ
-      INTEGER            INFO, J1, LDA, LDB, LDQ, LDZ, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTGEX2 swaps adjacent diagonal 1 by 1 blocks (A11,B11) and (A22,B22)
-*  in an upper triangular matrix pair (A, B) by an unitary equivalence
-*  transformation.
-*
-*  (A, B) must be in generalized Schur canonical form, that is, A and
-*  B are both upper triangular.
-*
-*  Optionally, the matrices Q and Z of generalized Schur vectors are
-*  updated.
-*
-*         Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
-*         Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
-*
-*
-*  Arguments
-*  =========
-*
-*  WANTQ   (input) LOGICAL
-*          .TRUE. : update the left transformation matrix Q;
-*          .FALSE.: do not update Q.
-*
-*  WANTZ   (input) LOGICAL
-*          .TRUE. : update the right transformation matrix Z;
-*          .FALSE.: do not update Z.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B. N >= 0.
-*
-*  A       (input/output) COMPLEX*16 arrays, dimensions (LDA,N)
-*          On entry, the matrix A in the pair (A, B).
-*          On exit, the updated matrix A.
-*
-*  LDA     (input)  INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  B       (input/output) COMPLEX*16 arrays, dimensions (LDB,N)
-*          On entry, the matrix B in the pair (A, B).
-*          On exit, the updated matrix B.
-*
-*  LDB     (input)  INTEGER
-*          The leading dimension of the array B. LDB >= max(1,N).
-*
-*  Q       (input/output) COMPLEX*16 array, dimension (LDZ,N)
-*          If WANTQ = .TRUE, on entry, the unitary matrix Q. On exit,
-*          the updated matrix Q.
-*          Not referenced if WANTQ = .FALSE..
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q. LDQ >= 1;
-*          If WANTQ = .TRUE., LDQ >= N.
-*
-*  Z       (input/output) COMPLEX*16 array, dimension (LDZ,N)
-*          If WANTZ = .TRUE, on entry, the unitary matrix Z. On exit,
-*          the updated matrix Z.
-*          Not referenced if WANTZ = .FALSE..
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z. LDZ >= 1;
-*          If WANTZ = .TRUE., LDZ >= N.
-*
-*  J1      (input) INTEGER
-*          The index to the first block (A11, B11).
-*
-*  INFO    (output) INTEGER
-*           =0:  Successful exit.
-*           =1:  The transformed matrix pair (A, B) would be too far
-*                from generalized Schur form; the problem is ill-
-*                conditioned. 
-*
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  In the current code both weak and strong stability tests are
-*  performed. The user can omit the strong stability test by changing
-*  the internal logical parameter WANDS to .FALSE.. See ref. [2] for
-*  details.
-*
-*  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*
-*  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*      Estimation: Theory, Algorithms and Software, Report UMINF-94.04,
-*      Department of Computing Science, Umea University, S-901 87 Umea,
-*      Sweden, 1994. Also as LAPACK Working Note 87. To appear in
-*      Numerical Algorithms, 1996.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         CZERO, CONE
-      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   CONE = ( 1.0D+0, 0.0D+0 ) )
-      DOUBLE PRECISION   TEN
-      PARAMETER          ( TEN = 10.0D+0 )
-      INTEGER            LDST
-      PARAMETER          ( LDST = 2 )
-      LOGICAL            WANDS
-      PARAMETER          ( WANDS = .TRUE. )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            DTRONG, WEAK
-      INTEGER            I, M
-      DOUBLE PRECISION   CQ, CZ, EPS, SA, SB, SCALE, SMLNUM, SS, SUM,
-     $                   THRESH, WS
-      COMPLEX*16         CDUM, F, G, SQ, SZ
-*     ..
-*     .. Local Arrays ..
-      COMPLEX*16         S( LDST, LDST ), T( LDST, LDST ), WORK( 8 )
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           ZLACPY, ZLARTG, ZLASSQ, ZROT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCONJG, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-*
-      M = LDST
-      WEAK = .FALSE.
-      DTRONG = .FALSE.
-*
-*     Make a local copy of selected block in (A, B)
-*
-      CALL ZLACPY( 'Full', M, M, A( J1, J1 ), LDA, S, LDST )
-      CALL ZLACPY( 'Full', M, M, B( J1, J1 ), LDB, T, LDST )
-*
-*     Compute the threshold for testing the acceptance of swapping.
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' ) / EPS
-      SCALE = DBLE( CZERO )
-      SUM = DBLE( CONE )
-      CALL ZLACPY( 'Full', M, M, S, LDST, WORK, M )
-      CALL ZLACPY( 'Full', M, M, T, LDST, WORK( M*M+1 ), M )
-      CALL ZLASSQ( 2*M*M, WORK, 1, SCALE, SUM )
-      SA = SCALE*SQRT( SUM )
-      THRESH = MAX( TEN*EPS*SA, SMLNUM )
-*
-*     Compute unitary QL and RQ that swap 1-by-1 and 1-by-1 blocks
-*     using Givens rotations and perform the swap tentatively.
-*
-      F = S( 2, 2 )*T( 1, 1 ) - T( 2, 2 )*S( 1, 1 )
-      G = S( 2, 2 )*T( 1, 2 ) - T( 2, 2 )*S( 1, 2 )
-      SA = ABS( S( 2, 2 ) )
-      SB = ABS( T( 2, 2 ) )
-      CALL ZLARTG( G, F, CZ, SZ, CDUM )
-      SZ = -SZ
-      CALL ZROT( 2, S( 1, 1 ), 1, S( 1, 2 ), 1, CZ, DCONJG( SZ ) )
-      CALL ZROT( 2, T( 1, 1 ), 1, T( 1, 2 ), 1, CZ, DCONJG( SZ ) )
-      IF( SA.GE.SB ) THEN
-         CALL ZLARTG( S( 1, 1 ), S( 2, 1 ), CQ, SQ, CDUM )
-      ELSE
-         CALL ZLARTG( T( 1, 1 ), T( 2, 1 ), CQ, SQ, CDUM )
-      END IF
-      CALL ZROT( 2, S( 1, 1 ), LDST, S( 2, 1 ), LDST, CQ, SQ )
-      CALL ZROT( 2, T( 1, 1 ), LDST, T( 2, 1 ), LDST, CQ, SQ )
-*
-*     Weak stability test: |S21| + |T21| <= O(EPS F-norm((S, T)))
-*
-      WS = ABS( S( 2, 1 ) ) + ABS( T( 2, 1 ) )
-      WEAK = WS.LE.THRESH
-      IF( .NOT.WEAK )
-     $   GO TO 20
-*
-      IF( WANDS ) THEN
-*
-*        Strong stability test:
-*           F-norm((A-QL'*S*QR, B-QL'*T*QR)) <= O(EPS*F-norm((A, B)))
-*
-         CALL ZLACPY( 'Full', M, M, S, LDST, WORK, M )
-         CALL ZLACPY( 'Full', M, M, T, LDST, WORK( M*M+1 ), M )
-         CALL ZROT( 2, WORK, 1, WORK( 3 ), 1, CZ, -DCONJG( SZ ) )
-         CALL ZROT( 2, WORK( 5 ), 1, WORK( 7 ), 1, CZ, -DCONJG( SZ ) )
-         CALL ZROT( 2, WORK, 2, WORK( 2 ), 2, CQ, -SQ )
-         CALL ZROT( 2, WORK( 5 ), 2, WORK( 6 ), 2, CQ, -SQ )
-         DO 10 I = 1, 2
-            WORK( I ) = WORK( I ) - A( J1+I-1, J1 )
-            WORK( I+2 ) = WORK( I+2 ) - A( J1+I-1, J1+1 )
-            WORK( I+4 ) = WORK( I+4 ) - B( J1+I-1, J1 )
-            WORK( I+6 ) = WORK( I+6 ) - B( J1+I-1, J1+1 )
-   10    CONTINUE
-         SCALE = DBLE( CZERO )
-         SUM = DBLE( CONE )
-         CALL ZLASSQ( 2*M*M, WORK, 1, SCALE, SUM )
-         SS = SCALE*SQRT( SUM )
-         DTRONG = SS.LE.THRESH
-         IF( .NOT.DTRONG )
-     $      GO TO 20
-      END IF
-*
-*     If the swap is accepted ("weakly" and "strongly"), apply the
-*     equivalence transformations to the original matrix pair (A,B)
-*
-      CALL ZROT( J1+1, A( 1, J1 ), 1, A( 1, J1+1 ), 1, CZ,
-     $           DCONJG( SZ ) )
-      CALL ZROT( J1+1, B( 1, J1 ), 1, B( 1, J1+1 ), 1, CZ,
-     $           DCONJG( SZ ) )
-      CALL ZROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA, CQ, SQ )
-      CALL ZROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB, CQ, SQ )
-*
-*     Set  N1 by N2 (2,1) blocks to 0
-*
-      A( J1+1, J1 ) = CZERO
-      B( J1+1, J1 ) = CZERO
-*
-*     Accumulate transformations into Q and Z if requested.
-*
-      IF( WANTZ )
-     $   CALL ZROT( N, Z( 1, J1 ), 1, Z( 1, J1+1 ), 1, CZ,
-     $              DCONJG( SZ ) )
-      IF( WANTQ )
-     $   CALL ZROT( N, Q( 1, J1 ), 1, Q( 1, J1+1 ), 1, CQ,
-     $              DCONJG( SQ ) )
-*
-*     Exit with INFO = 0 if swap was successfully performed.
-*
-      RETURN
-*
-*     Exit with INFO = 1 if swap was rejected.
-*
-   20 CONTINUE
-      INFO = 1
-      RETURN
-*
-*     End of ZTGEX2
-*
-      END
diff --git a/src/lib/lapack/ztgexc.f b/src/lib/lapack/ztgexc.f
deleted file mode 100644
index 0f57939c..00000000
--- a/src/lib/lapack/ztgexc.f
+++ /dev/null
@@ -1,206 +0,0 @@
-      SUBROUTINE ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                   LDZ, IFST, ILST, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      LOGICAL            WANTQ, WANTZ
-      INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
-     $                   Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTGEXC reorders the generalized Schur decomposition of a complex
-*  matrix pair (A,B), using an unitary equivalence transformation
-*  (A, B) := Q * (A, B) * Z', so that the diagonal block of (A, B) with
-*  row index IFST is moved to row ILST.
-*
-*  (A, B) must be in generalized Schur canonical form, that is, A and
-*  B are both upper triangular.
-*
-*  Optionally, the matrices Q and Z of generalized Schur vectors are
-*  updated.
-*
-*         Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
-*         Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
-*
-*  Arguments
-*  =========
-*
-*  WANTQ   (input) LOGICAL
-*          .TRUE. : update the left transformation matrix Q;
-*          .FALSE.: do not update Q.
-*
-*  WANTZ   (input) LOGICAL
-*          .TRUE. : update the right transformation matrix Z;
-*          .FALSE.: do not update Z.
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B. N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the upper triangular matrix A in the pair (A, B).
-*          On exit, the updated matrix A.
-*
-*  LDA     (input)  INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  B       (input/output) COMPLEX*16 array, dimension (LDB,N)
-*          On entry, the upper triangular matrix B in the pair (A, B).
-*          On exit, the updated matrix B.
-*
-*  LDB     (input)  INTEGER
-*          The leading dimension of the array B. LDB >= max(1,N).
-*
-*  Q       (input/output) COMPLEX*16 array, dimension (LDZ,N)
-*          On entry, if WANTQ = .TRUE., the unitary matrix Q.
-*          On exit, the updated matrix Q.
-*          If WANTQ = .FALSE., Q is not referenced.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q. LDQ >= 1;
-*          If WANTQ = .TRUE., LDQ >= N.
-*
-*  Z       (input/output) COMPLEX*16 array, dimension (LDZ,N)
-*          On entry, if WANTZ = .TRUE., the unitary matrix Z.
-*          On exit, the updated matrix Z.
-*          If WANTZ = .FALSE., Z is not referenced.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z. LDZ >= 1;
-*          If WANTZ = .TRUE., LDZ >= N.
-*
-*  IFST    (input) INTEGER
-*  ILST    (input/output) INTEGER
-*          Specify the reordering of the diagonal blocks of (A, B).
-*          The block with row index IFST is moved to row ILST, by a
-*          sequence of swapping between adjacent blocks.
-*
-*  INFO    (output) INTEGER
-*           =0:  Successful exit.
-*           <0:  if INFO = -i, the i-th argument had an illegal value.
-*           =1:  The transformed matrix pair (A, B) would be too far
-*                from generalized Schur form; the problem is ill-
-*                conditioned. (A, B) may have been partially reordered,
-*                and ILST points to the first row of the current
-*                position of the block being moved.
-*
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*
-*  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*      Estimation: Theory, Algorithms and Software, Report
-*      UMINF - 94.04, Department of Computing Science, Umea University,
-*      S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87.
-*      To appear in Numerical Algorithms, 1996.
-*
-*  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*      for Solving the Generalized Sylvester Equation and Estimating the
-*      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*      Department of Computing Science, Umea University, S-901 87 Umea,
-*      Sweden, December 1993, Revised April 1994, Also as LAPACK working
-*      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
-*      1996.
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      INTEGER            HERE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZTGEX2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test input arguments.
-      INFO = 0
-      IF( N.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN
-         INFO = -9
-      ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN
-         INFO = -11
-      ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
-         INFO = -12
-      ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
-         INFO = -13
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTGEXC', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.1 )
-     $   RETURN
-      IF( IFST.EQ.ILST )
-     $   RETURN
-*
-      IF( IFST.LT.ILST ) THEN
-*
-         HERE = IFST
-*
-   10    CONTINUE
-*
-*        Swap with next one below
-*
-         CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
-     $                HERE, INFO )
-         IF( INFO.NE.0 ) THEN
-            ILST = HERE
-            RETURN
-         END IF
-         HERE = HERE + 1
-         IF( HERE.LT.ILST )
-     $      GO TO 10
-         HERE = HERE - 1
-      ELSE
-         HERE = IFST - 1
-*
-   20    CONTINUE
-*
-*        Swap with next one above
-*
-         CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
-     $                HERE, INFO )
-         IF( INFO.NE.0 ) THEN
-            ILST = HERE
-            RETURN
-         END IF
-         HERE = HERE - 1
-         IF( HERE.GE.ILST )
-     $      GO TO 20
-         HERE = HERE + 1
-      END IF
-      ILST = HERE
-      RETURN
-*
-*     End of ZTGEXC
-*
-      END
diff --git a/src/lib/lapack/ztgsen.f b/src/lib/lapack/ztgsen.f
deleted file mode 100644
index 71ee4cd0..00000000
--- a/src/lib/lapack/ztgsen.f
+++ /dev/null
@@ -1,652 +0,0 @@
-      SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB,
-     $                   ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF,
-     $                   WORK, LWORK, IWORK, LIWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     Modified to call ZLACN2 in place of ZLACON, 10 Feb 03, SJH.
-*
-*     .. Scalar Arguments ..
-      LOGICAL            WANTQ, WANTZ
-      INTEGER            IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
-     $                   M, N
-      DOUBLE PRECISION   PL, PR
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            SELECT( * )
-      INTEGER            IWORK( * )
-      DOUBLE PRECISION   DIF( * )
-      COMPLEX*16         A( LDA, * ), ALPHA( * ), B( LDB, * ),
-     $                   BETA( * ), Q( LDQ, * ), WORK( * ), Z( LDZ, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTGSEN reorders the generalized Schur decomposition of a complex
-*  matrix pair (A, B) (in terms of an unitary equivalence trans-
-*  formation Q' * (A, B) * Z), so that a selected cluster of eigenvalues
-*  appears in the leading diagonal blocks of the pair (A,B). The leading
-*  columns of Q and Z form unitary bases of the corresponding left and
-*  right eigenspaces (deflating subspaces). (A, B) must be in
-*  generalized Schur canonical form, that is, A and B are both upper
-*  triangular.
-*
-*  ZTGSEN also computes the generalized eigenvalues
-*
-*           w(j)= ALPHA(j) / BETA(j)
-*
-*  of the reordered matrix pair (A, B).
-*
-*  Optionally, the routine computes estimates of reciprocal condition
-*  numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
-*  (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
-*  between the matrix pairs (A11, B11) and (A22,B22) that correspond to
-*  the selected cluster and the eigenvalues outside the cluster, resp.,
-*  and norms of "projections" onto left and right eigenspaces w.r.t.
-*  the selected cluster in the (1,1)-block.
-*
-*
-*  Arguments
-*  =========
-*
-*  IJOB    (input) integer
-*          Specifies whether condition numbers are required for the
-*          cluster of eigenvalues (PL and PR) or the deflating subspaces
-*          (Difu and Difl):
-*           =0: Only reorder w.r.t. SELECT. No extras.
-*           =1: Reciprocal of norms of "projections" onto left and right
-*               eigenspaces w.r.t. the selected cluster (PL and PR).
-*           =2: Upper bounds on Difu and Difl. F-norm-based estimate
-*               (DIF(1:2)).
-*           =3: Estimate of Difu and Difl. 1-norm-based estimate
-*               (DIF(1:2)).
-*               About 5 times as expensive as IJOB = 2.
-*           =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
-*               version to get it all.
-*           =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
-*
-*  WANTQ   (input) LOGICAL
-*          .TRUE. : update the left transformation matrix Q;
-*          .FALSE.: do not update Q.
-*
-*  WANTZ   (input) LOGICAL
-*          .TRUE. : update the right transformation matrix Z;
-*          .FALSE.: do not update Z.
-*
-*  SELECT  (input) LOGICAL array, dimension (N)
-*          SELECT specifies the eigenvalues in the selected cluster. To
-*          select an eigenvalue w(j), SELECT(j) must be set to
-*          .TRUE..
-*
-*  N       (input) INTEGER
-*          The order of the matrices A and B. N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension(LDA,N)
-*          On entry, the upper triangular matrix A, in generalized
-*          Schur canonical form.
-*          On exit, A is overwritten by the reordered matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  B       (input/output) COMPLEX*16 array, dimension(LDB,N)
-*          On entry, the upper triangular matrix B, in generalized
-*          Schur canonical form.
-*          On exit, B is overwritten by the reordered matrix B.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1,N).
-*
-*  ALPHA   (output) COMPLEX*16 array, dimension (N)
-*  BETA    (output) COMPLEX*16 array, dimension (N)
-*          The diagonal elements of A and B, respectively,
-*          when the pair (A,B) has been reduced to generalized Schur
-*          form.  ALPHA(i)/BETA(i) i=1,...,N are the generalized
-*          eigenvalues.
-*
-*  Q       (input/output) COMPLEX*16 array, dimension (LDQ,N)
-*          On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
-*          On exit, Q has been postmultiplied by the left unitary
-*          transformation matrix which reorder (A, B); The leading M
-*          columns of Q form orthonormal bases for the specified pair of
-*          left eigenspaces (deflating subspaces).
-*          If WANTQ = .FALSE., Q is not referenced.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q. LDQ >= 1.
-*          If WANTQ = .TRUE., LDQ >= N.
-*
-*  Z       (input/output) COMPLEX*16 array, dimension (LDZ,N)
-*          On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
-*          On exit, Z has been postmultiplied by the left unitary
-*          transformation matrix which reorder (A, B); The leading M
-*          columns of Z form orthonormal bases for the specified pair of
-*          left eigenspaces (deflating subspaces).
-*          If WANTZ = .FALSE., Z is not referenced.
-*
-*  LDZ     (input) INTEGER
-*          The leading dimension of the array Z. LDZ >= 1.
-*          If WANTZ = .TRUE., LDZ >= N.
-*
-*  M       (output) INTEGER
-*          The dimension of the specified pair of left and right
-*          eigenspaces, (deflating subspaces) 0 <= M <= N.
-*
-*  PL      (output) DOUBLE PRECISION
-*  PR      (output) DOUBLE PRECISION
-*          If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
-*          reciprocal  of the norm of "projections" onto left and right
-*          eigenspace with respect to the selected cluster.
-*          0 < PL, PR <= 1.
-*          If M = 0 or M = N, PL = PR  = 1.
-*          If IJOB = 0, 2 or 3 PL, PR are not referenced.
-*
-*  DIF     (output) DOUBLE PRECISION array, dimension (2).
-*          If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl.
-*          If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
-*          Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
-*          estimates of Difu and Difl, computed using reversed
-*          communication with ZLACN2.
-*          If M = 0 or N, DIF(1:2) = F-norm([A, B]).
-*          If IJOB = 0 or 1, DIF is not referenced.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          IF IJOB = 0, WORK is not referenced.  Otherwise,
-*          on exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >=  1
-*          If IJOB = 1, 2 or 4, LWORK >=  2*M*(N-M)
-*          If IJOB = 3 or 5, LWORK >=  4*M*(N-M)
-*
-*          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.
-*
-*  IWORK   (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
-*          IF IJOB = 0, IWORK is not referenced.  Otherwise,
-*          on exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
-*
-*  LIWORK  (input) INTEGER
-*          The dimension of the array IWORK. LIWORK >= 1.
-*          If IJOB = 1, 2 or 4, LIWORK >=  N+2;
-*          If IJOB = 3 or 5, LIWORK >= MAX(N+2, 2*M*(N-M));
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*            =0: Successful exit.
-*            <0: If INFO = -i, the i-th argument had an illegal value.
-*            =1: Reordering of (A, B) failed because the transformed
-*                matrix pair (A, B) would be too far from generalized
-*                Schur form; the problem is very ill-conditioned.
-*                (A, B) may have been partially reordered.
-*                If requested, 0 is returned in DIF(*), PL and PR.
-*
-*
-*  Further Details
-*  ===============
-*
-*  ZTGSEN first collects the selected eigenvalues by computing unitary
-*  U and W that move them to the top left corner of (A, B). In other
-*  words, the selected eigenvalues are the eigenvalues of (A11, B11) in
-*
-*                U'*(A, B)*W = (A11 A12) (B11 B12) n1
-*                              ( 0  A22),( 0  B22) n2
-*                                n1  n2    n1  n2
-*
-*  where N = n1+n2 and U' means the conjugate transpose of U. The first
-*  n1 columns of U and W span the specified pair of left and right
-*  eigenspaces (deflating subspaces) of (A, B).
-*
-*  If (A, B) has been obtained from the generalized real Schur
-*  decomposition of a matrix pair (C, D) = Q*(A, B)*Z', then the
-*  reordered generalized Schur form of (C, D) is given by
-*
-*           (C, D) = (Q*U)*(U'*(A, B)*W)*(Z*W)',
-*
-*  and the first n1 columns of Q*U and Z*W span the corresponding
-*  deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
-*
-*  Note that if the selected eigenvalue is sufficiently ill-conditioned,
-*  then its value may differ significantly from its value before
-*  reordering.
-*
-*  The reciprocal condition numbers of the left and right eigenspaces
-*  spanned by the first n1 columns of U and W (or Q*U and Z*W) may
-*  be returned in DIF(1:2), corresponding to Difu and Difl, resp.
-*
-*  The Difu and Difl are defined as:
-*
-*       Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
-*  and
-*       Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
-*
-*  where sigma-min(Zu) is the smallest singular value of the
-*  (2*n1*n2)-by-(2*n1*n2) matrix
-*
-*       Zu = [ kron(In2, A11)  -kron(A22', In1) ]
-*            [ kron(In2, B11)  -kron(B22', In1) ].
-*
-*  Here, Inx is the identity matrix of size nx and A22' is the
-*  transpose of A22. kron(X, Y) is the Kronecker product between
-*  the matrices X and Y.
-*
-*  When DIF(2) is small, small changes in (A, B) can cause large changes
-*  in the deflating subspace. An approximate (asymptotic) bound on the
-*  maximum angular error in the computed deflating subspaces is
-*
-*       EPS * norm((A, B)) / DIF(2),
-*
-*  where EPS is the machine precision.
-*
-*  The reciprocal norm of the projectors on the left and right
-*  eigenspaces associated with (A11, B11) may be returned in PL and PR.
-*  They are computed as follows. First we compute L and R so that
-*  P*(A, B)*Q is block diagonal, where
-*
-*       P = ( I -L ) n1           Q = ( I R ) n1
-*           ( 0  I ) n2    and        ( 0 I ) n2
-*             n1 n2                    n1 n2
-*
-*  and (L, R) is the solution to the generalized Sylvester equation
-*
-*       A11*R - L*A22 = -A12
-*       B11*R - L*B22 = -B12
-*
-*  Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
-*  An approximate (asymptotic) bound on the average absolute error of
-*  the selected eigenvalues is
-*
-*       EPS * norm((A, B)) / PL.
-*
-*  There are also global error bounds which valid for perturbations up
-*  to a certain restriction:  A lower bound (x) on the smallest
-*  F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
-*  coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
-*  (i.e. (A + E, B + F), is
-*
-*   x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
-*
-*  An approximate bound on x can be computed from DIF(1:2), PL and PR.
-*
-*  If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed
-*  (L', R') and unperturbed (L, R) left and right deflating subspaces
-*  associated with the selected cluster in the (1,1)-blocks can be
-*  bounded as
-*
-*   max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
-*   max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
-*
-*  See LAPACK User's Guide section 4.11 or the following references
-*  for more information.
-*
-*  Note that if the default method for computing the Frobenius-norm-
-*  based estimate DIF is not wanted (see ZLATDF), then the parameter
-*  IDIFJB (see below) should be changed from 3 to 4 (routine ZLATDF
-*  (IJOB = 2 will be used)). See ZTGSYL for more details.
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  References
-*  ==========
-*
-*  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
-*      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
-*      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
-*      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
-*
-*  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
-*      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
-*      Estimation: Theory, Algorithms and Software, Report
-*      UMINF - 94.04, Department of Computing Science, Umea University,
-*      S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87.
-*      To appear in Numerical Algorithms, 1996.
-*
-*  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*      for Solving the Generalized Sylvester Equation and Estimating the
-*      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*      Department of Computing Science, Umea University, S-901 87 Umea,
-*      Sweden, December 1993, Revised April 1994, Also as LAPACK working
-*      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
-*      1996.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            IDIFJB
-      PARAMETER          ( IDIFJB = 3 )
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, SWAP, WANTD, WANTD1, WANTD2, WANTP
-      INTEGER            I, IERR, IJB, K, KASE, KS, LIWMIN, LWMIN, MN2,
-     $                   N1, N2
-      DOUBLE PRECISION   DSCALE, DSUM, RDSCAL, SAFMIN
-*     ..
-*     .. Local Arrays ..
-      INTEGER            ISAVE( 3 )
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACN2, ZLACPY, ZLASSQ, ZSCAL, ZTGEXC,
-     $                   ZTGSYL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DCMPLX, DCONJG, MAX, SQRT
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test the input parameters
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
-*
-      IF( IJOB.LT.0 .OR. IJOB.GT.5 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
-         INFO = -13
-      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
-         INFO = -15
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTGSEN', -INFO )
-         RETURN
-      END IF
-*
-      IERR = 0
-*
-      WANTP = IJOB.EQ.1 .OR. IJOB.GE.4
-      WANTD1 = IJOB.EQ.2 .OR. IJOB.EQ.4
-      WANTD2 = IJOB.EQ.3 .OR. IJOB.EQ.5
-      WANTD = WANTD1 .OR. WANTD2
-*
-*     Set M to the dimension of the specified pair of deflating
-*     subspaces.
-*
-      M = 0
-      DO 10 K = 1, N
-         ALPHA( K ) = A( K, K )
-         BETA( K ) = B( K, K )
-         IF( K.LT.N ) THEN
-            IF( SELECT( K ) )
-     $         M = M + 1
-         ELSE
-            IF( SELECT( N ) )
-     $         M = M + 1
-         END IF
-   10 CONTINUE
-*
-      IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN
-         LWMIN = MAX( 1, 2*M*( N-M ) )
-         LIWMIN = MAX( 1, N+2 )
-      ELSE IF( IJOB.EQ.3 .OR. IJOB.EQ.5 ) THEN
-         LWMIN = MAX( 1, 4*M*( N-M ) )
-         LIWMIN = MAX( 1, 2*M*( N-M ), N+2 )
-      ELSE
-         LWMIN = 1
-         LIWMIN = 1
-      END IF
-*
-      WORK( 1 ) = LWMIN
-      IWORK( 1 ) = LIWMIN
-*
-      IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
-         INFO = -21
-      ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
-         INFO = -23
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTGSEN', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( M.EQ.N .OR. M.EQ.0 ) THEN
-         IF( WANTP ) THEN
-            PL = ONE
-            PR = ONE
-         END IF
-         IF( WANTD ) THEN
-            DSCALE = ZERO
-            DSUM = ONE
-            DO 20 I = 1, N
-               CALL ZLASSQ( N, A( 1, I ), 1, DSCALE, DSUM )
-               CALL ZLASSQ( N, B( 1, I ), 1, DSCALE, DSUM )
-   20       CONTINUE
-            DIF( 1 ) = DSCALE*SQRT( DSUM )
-            DIF( 2 ) = DIF( 1 )
-         END IF
-         GO TO 70
-      END IF
-*
-*     Get machine constant
-*
-      SAFMIN = DLAMCH( 'S' )
-*
-*     Collect the selected blocks at the top-left corner of (A, B).
-*
-      KS = 0
-      DO 30 K = 1, N
-         SWAP = SELECT( K )
-         IF( SWAP ) THEN
-            KS = KS + 1
-*
-*           Swap the K-th block to position KS. Compute unitary Q
-*           and Z that will swap adjacent diagonal blocks in (A, B).
-*
-            IF( K.NE.KS )
-     $         CALL ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
-     $                      LDZ, K, KS, IERR )
-*
-            IF( IERR.GT.0 ) THEN
-*
-*              Swap is rejected: exit.
-*
-               INFO = 1
-               IF( WANTP ) THEN
-                  PL = ZERO
-                  PR = ZERO
-               END IF
-               IF( WANTD ) THEN
-                  DIF( 1 ) = ZERO
-                  DIF( 2 ) = ZERO
-               END IF
-               GO TO 70
-            END IF
-         END IF
-   30 CONTINUE
-      IF( WANTP ) THEN
-*
-*        Solve generalized Sylvester equation for R and L:
-*                   A11 * R - L * A22 = A12
-*                   B11 * R - L * B22 = B12
-*
-         N1 = M
-         N2 = N - M
-         I = N1 + 1
-         CALL ZLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 )
-         CALL ZLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ),
-     $                N1 )
-         IJB = 0
-         CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
-     $                N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1,
-     $                DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ),
-     $                LWORK-2*N1*N2, IWORK, IERR )
-*
-*        Estimate the reciprocal of norms of "projections" onto
-*        left and right eigenspaces
-*
-         RDSCAL = ZERO
-         DSUM = ONE
-         CALL ZLASSQ( N1*N2, WORK, 1, RDSCAL, DSUM )
-         PL = RDSCAL*SQRT( DSUM )
-         IF( PL.EQ.ZERO ) THEN
-            PL = ONE
-         ELSE
-            PL = DSCALE / ( SQRT( DSCALE*DSCALE / PL+PL )*SQRT( PL ) )
-         END IF
-         RDSCAL = ZERO
-         DSUM = ONE
-         CALL ZLASSQ( N1*N2, WORK( N1*N2+1 ), 1, RDSCAL, DSUM )
-         PR = RDSCAL*SQRT( DSUM )
-         IF( PR.EQ.ZERO ) THEN
-            PR = ONE
-         ELSE
-            PR = DSCALE / ( SQRT( DSCALE*DSCALE / PR+PR )*SQRT( PR ) )
-         END IF
-      END IF
-      IF( WANTD ) THEN
-*
-*        Compute estimates Difu and Difl.
-*
-         IF( WANTD1 ) THEN
-            N1 = M
-            N2 = N - M
-            I = N1 + 1
-            IJB = IDIFJB
-*
-*           Frobenius norm-based Difu estimate.
-*
-            CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
-     $                   N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ),
-     $                   N1, DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ),
-     $                   LWORK-2*N1*N2, IWORK, IERR )
-*
-*           Frobenius norm-based Difl estimate.
-*
-            CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK,
-     $                   N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ),
-     $                   N2, DSCALE, DIF( 2 ), WORK( N1*N2*2+1 ),
-     $                   LWORK-2*N1*N2, IWORK, IERR )
-         ELSE
-*
-*           Compute 1-norm-based estimates of Difu and Difl using
-*           reversed communication with ZLACN2. In each step a
-*           generalized Sylvester equation or a transposed variant
-*           is solved.
-*
-            KASE = 0
-            N1 = M
-            N2 = N - M
-            I = N1 + 1
-            IJB = 0
-            MN2 = 2*N1*N2
-*
-*           1-norm-based estimate of Difu.
-*
-   40       CONTINUE
-            CALL ZLACN2( MN2, WORK( MN2+1 ), WORK, DIF( 1 ), KASE,
-     $                   ISAVE )
-            IF( KASE.NE.0 ) THEN
-               IF( KASE.EQ.1 ) THEN
-*
-*                 Solve generalized Sylvester equation
-*
-                  CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA,
-     $                         WORK, N1, B, LDB, B( I, I ), LDB,
-     $                         WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
-     $                         WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK,
-     $                         IERR )
-               ELSE
-*
-*                 Solve the transposed variant.
-*
-                  CALL ZTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ), LDA,
-     $                         WORK, N1, B, LDB, B( I, I ), LDB,
-     $                         WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
-     $                         WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK,
-     $                         IERR )
-               END IF
-               GO TO 40
-            END IF
-            DIF( 1 ) = DSCALE / DIF( 1 )
-*
-*           1-norm-based estimate of Difl.
-*
-   50       CONTINUE
-            CALL ZLACN2( MN2, WORK( MN2+1 ), WORK, DIF( 2 ), KASE,
-     $                   ISAVE )
-            IF( KASE.NE.0 ) THEN
-               IF( KASE.EQ.1 ) THEN
-*
-*                 Solve generalized Sylvester equation
-*
-                  CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA,
-     $                         WORK, N2, B( I, I ), LDB, B, LDB,
-     $                         WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
-     $                         WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK,
-     $                         IERR )
-               ELSE
-*
-*                 Solve the transposed variant.
-*
-                  CALL ZTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A, LDA,
-     $                         WORK, N2, B, LDB, B( I, I ), LDB,
-     $                         WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
-     $                         WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK,
-     $                         IERR )
-               END IF
-               GO TO 50
-            END IF
-            DIF( 2 ) = DSCALE / DIF( 2 )
-         END IF
-      END IF
-*
-*     If B(K,K) is complex, make it real and positive (normalization
-*     of the generalized Schur form) and Store the generalized
-*     eigenvalues of reordered pair (A, B)
-*
-      DO 60 K = 1, N
-         DSCALE = ABS( B( K, K ) )
-         IF( DSCALE.GT.SAFMIN ) THEN
-            WORK( 1 ) = DCONJG( B( K, K ) / DSCALE )
-            WORK( 2 ) = B( K, K ) / DSCALE
-            B( K, K ) = DSCALE
-            CALL ZSCAL( N-K, WORK( 1 ), B( K, K+1 ), LDB )
-            CALL ZSCAL( N-K+1, WORK( 1 ), A( K, K ), LDA )
-            IF( WANTQ )
-     $         CALL ZSCAL( N, WORK( 2 ), Q( 1, K ), 1 )
-         ELSE
-            B( K, K ) = DCMPLX( ZERO, ZERO )
-         END IF
-*
-         ALPHA( K ) = A( K, K )
-         BETA( K ) = B( K, K )
-*
-   60 CONTINUE
-*
-   70 CONTINUE
-*
-      WORK( 1 ) = LWMIN
-      IWORK( 1 ) = LIWMIN
-*
-      RETURN
-*
-*     End of ZTGSEN
-*
-      END
diff --git a/src/lib/lapack/ztgsy2.f b/src/lib/lapack/ztgsy2.f
deleted file mode 100644
index 82ec5eb1..00000000
--- a/src/lib/lapack/ztgsy2.f
+++ /dev/null
@@ -1,361 +0,0 @@
-      SUBROUTINE ZTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
-     $                   LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL,
-     $                   INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TRANS
-      INTEGER            IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF, M, N
-      DOUBLE PRECISION   RDSCAL, RDSUM, SCALE
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * ),
-     $                   D( LDD, * ), E( LDE, * ), F( LDF, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTGSY2 solves the generalized Sylvester equation
-*
-*              A * R - L * B = scale *   C               (1)
-*              D * R - L * E = scale * F
-*
-*  using Level 1 and 2 BLAS, where R and L are unknown M-by-N matrices,
-*  (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M,
-*  N-by-N and M-by-N, respectively. A, B, D and E are upper triangular
-*  (i.e., (A,D) and (B,E) in generalized Schur form).
-*
-*  The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output
-*  scaling factor chosen to avoid overflow.
-*
-*  In matrix notation solving equation (1) corresponds to solve
-*  Zx = scale * b, where Z is defined as
-*
-*         Z = [ kron(In, A)  -kron(B', Im) ]             (2)
-*             [ kron(In, D)  -kron(E', Im) ],
-*
-*  Ik is the identity matrix of size k and X' is the transpose of X.
-*  kron(X, Y) is the Kronecker product between the matrices X and Y.
-*
-*  If TRANS = 'C', y in the conjugate transposed system Z'y = scale*b
-*  is solved for, which is equivalent to solve for R and L in
-*
-*              A' * R  + D' * L   = scale *  C           (3)
-*              R  * B' + L  * E'  = scale * -F
-*
-*  This case is used to compute an estimate of Dif[(A, D), (B, E)] =
-*  = sigma_min(Z) using reverse communicaton with ZLACON.
-*
-*  ZTGSY2 also (IJOB >= 1) contributes to the computation in ZTGSYL
-*  of an upper bound on the separation between to matrix pairs. Then
-*  the input (A, D), (B, E) are sub-pencils of two matrix pairs in
-*  ZTGSYL.
-*
-*  Arguments
-*  =========
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N', solve the generalized Sylvester equation (1).
-*          = 'T': solve the 'transposed' system (3).
-*
-*  IJOB    (input) INTEGER
-*          Specifies what kind of functionality to be performed.
-*          =0: solve (1) only.
-*          =1: A contribution from this subsystem to a Frobenius
-*              norm-based estimate of the separation between two matrix
-*              pairs is computed. (look ahead strategy is used).
-*          =2: A contribution from this subsystem to a Frobenius
-*              norm-based estimate of the separation between two matrix
-*              pairs is computed. (DGECON on sub-systems is used.)
-*          Not referenced if TRANS = 'T'.
-*
-*  M       (input) INTEGER
-*          On entry, M specifies the order of A and D, and the row
-*          dimension of C, F, R and L.
-*
-*  N       (input) INTEGER
-*          On entry, N specifies the order of B and E, and the column
-*          dimension of C, F, R and L.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA, M)
-*          On entry, A contains an upper triangular matrix.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the matrix A. LDA >= max(1, M).
-*
-*  B       (input) COMPLEX*16 array, dimension (LDB, N)
-*          On entry, B contains an upper triangular matrix.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the matrix B. LDB >= max(1, N).
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC, N)
-*          On entry, C contains the right-hand-side of the first matrix
-*          equation in (1).
-*          On exit, if IJOB = 0, C has been overwritten by the solution
-*          R.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the matrix C. LDC >= max(1, M).
-*
-*  D       (input) COMPLEX*16 array, dimension (LDD, M)
-*          On entry, D contains an upper triangular matrix.
-*
-*  LDD     (input) INTEGER
-*          The leading dimension of the matrix D. LDD >= max(1, M).
-*
-*  E       (input) COMPLEX*16 array, dimension (LDE, N)
-*          On entry, E contains an upper triangular matrix.
-*
-*  LDE     (input) INTEGER
-*          The leading dimension of the matrix E. LDE >= max(1, N).
-*
-*  F       (input/output) COMPLEX*16 array, dimension (LDF, N)
-*          On entry, F contains the right-hand-side of the second matrix
-*          equation in (1).
-*          On exit, if IJOB = 0, F has been overwritten by the solution
-*          L.
-*
-*  LDF     (input) INTEGER
-*          The leading dimension of the matrix F. LDF >= max(1, M).
-*
-*  SCALE   (output) DOUBLE PRECISION
-*          On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions
-*          R and L (C and F on entry) will hold the solutions to a
-*          slightly perturbed system but the input matrices A, B, D and
-*          E have not been changed. If SCALE = 0, R and L will hold the
-*          solutions to the homogeneous system with C = F = 0.
-*          Normally, SCALE = 1.
-*
-*  RDSUM   (input/output) DOUBLE PRECISION
-*          On entry, the sum of squares of computed contributions to
-*          the Dif-estimate under computation by ZTGSYL, where the
-*          scaling factor RDSCAL (see below) has been factored out.
-*          On exit, the corresponding sum of squares updated with the
-*          contributions from the current sub-system.
-*          If TRANS = 'T' RDSUM is not touched.
-*          NOTE: RDSUM only makes sense when ZTGSY2 is called by
-*          ZTGSYL.
-*
-*  RDSCAL  (input/output) DOUBLE PRECISION
-*          On entry, scaling factor used to prevent overflow in RDSUM.
-*          On exit, RDSCAL is updated w.r.t. the current contributions
-*          in RDSUM.
-*          If TRANS = 'T', RDSCAL is not touched.
-*          NOTE: RDSCAL only makes sense when ZTGSY2 is called by
-*          ZTGSYL.
-*
-*  INFO    (output) INTEGER
-*          On exit, if INFO is set to
-*            =0: Successful exit
-*            <0: If INFO = -i, input argument number i is illegal.
-*            >0: The matrix pairs (A, D) and (B, E) have common or very
-*                close eigenvalues.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      INTEGER            LDZ
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, LDZ = 2 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOTRAN
-      INTEGER            I, IERR, J, K
-      DOUBLE PRECISION   SCALOC
-      COMPLEX*16         ALPHA
-*     ..
-*     .. Local Arrays ..
-      INTEGER            IPIV( LDZ ), JPIV( LDZ )
-      COMPLEX*16         RHS( LDZ ), Z( LDZ, LDZ )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZAXPY, ZGESC2, ZGETC2, ZLATDF, ZSCAL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCMPLX, DCONJG, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test input parameters
-*
-      INFO = 0
-      IERR = 0
-      NOTRAN = LSAME( TRANS, 'N' )
-      IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
-         INFO = -1
-      ELSE IF( NOTRAN ) THEN
-         IF( ( IJOB.LT.0 ) .OR. ( IJOB.GT.2 ) ) THEN
-            INFO = -2
-         END IF
-      END IF
-      IF( INFO.EQ.0 ) THEN
-         IF( M.LE.0 ) THEN
-            INFO = -3
-         ELSE IF( N.LE.0 ) THEN
-            INFO = -4
-         ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-            INFO = -5
-         ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-            INFO = -8
-         ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-            INFO = -10
-         ELSE IF( LDD.LT.MAX( 1, M ) ) THEN
-            INFO = -12
-         ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
-            INFO = -14
-         ELSE IF( LDF.LT.MAX( 1, M ) ) THEN
-            INFO = -16
-         END IF
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTGSY2', -INFO )
-         RETURN
-      END IF
-*
-      IF( NOTRAN ) THEN
-*
-*        Solve (I, J) - system
-*           A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J)
-*           D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J)
-*        for I = M, M - 1, ..., 1; J = 1, 2, ..., N
-*
-         SCALE = ONE
-         SCALOC = ONE
-         DO 30 J = 1, N
-            DO 20 I = M, 1, -1
-*
-*              Build 2 by 2 system
-*
-               Z( 1, 1 ) = A( I, I )
-               Z( 2, 1 ) = D( I, I )
-               Z( 1, 2 ) = -B( J, J )
-               Z( 2, 2 ) = -E( J, J )
-*
-*              Set up right hand side(s)
-*
-               RHS( 1 ) = C( I, J )
-               RHS( 2 ) = F( I, J )
-*
-*              Solve Z * x = RHS
-*
-               CALL ZGETC2( LDZ, Z, LDZ, IPIV, JPIV, IERR )
-               IF( IERR.GT.0 )
-     $            INFO = IERR
-               IF( IJOB.EQ.0 ) THEN
-                  CALL ZGESC2( LDZ, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 10 K = 1, N
-                        CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ),
-     $                              C( 1, K ), 1 )
-                        CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ),
-     $                              F( 1, K ), 1 )
-   10                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-               ELSE
-                  CALL ZLATDF( IJOB, LDZ, Z, LDZ, RHS, RDSUM, RDSCAL,
-     $                         IPIV, JPIV )
-               END IF
-*
-*              Unpack solution vector(s)
-*
-               C( I, J ) = RHS( 1 )
-               F( I, J ) = RHS( 2 )
-*
-*              Substitute R(I, J) and L(I, J) into remaining equation.
-*
-               IF( I.GT.1 ) THEN
-                  ALPHA = -RHS( 1 )
-                  CALL ZAXPY( I-1, ALPHA, A( 1, I ), 1, C( 1, J ), 1 )
-                  CALL ZAXPY( I-1, ALPHA, D( 1, I ), 1, F( 1, J ), 1 )
-               END IF
-               IF( J.LT.N ) THEN
-                  CALL ZAXPY( N-J, RHS( 2 ), B( J, J+1 ), LDB,
-     $                        C( I, J+1 ), LDC )
-                  CALL ZAXPY( N-J, RHS( 2 ), E( J, J+1 ), LDE,
-     $                        F( I, J+1 ), LDF )
-               END IF
-*
-   20       CONTINUE
-   30    CONTINUE
-      ELSE
-*
-*        Solve transposed (I, J) - system:
-*           A(I, I)' * R(I, J) + D(I, I)' * L(J, J) = C(I, J)
-*           R(I, I) * B(J, J) + L(I, J) * E(J, J)   = -F(I, J)
-*        for I = 1, 2, ..., M, J = N, N - 1, ..., 1
-*
-         SCALE = ONE
-         SCALOC = ONE
-         DO 80 I = 1, M
-            DO 70 J = N, 1, -1
-*
-*              Build 2 by 2 system Z'
-*
-               Z( 1, 1 ) = DCONJG( A( I, I ) )
-               Z( 2, 1 ) = -DCONJG( B( J, J ) )
-               Z( 1, 2 ) = DCONJG( D( I, I ) )
-               Z( 2, 2 ) = -DCONJG( E( J, J ) )
-*
-*
-*              Set up right hand side(s)
-*
-               RHS( 1 ) = C( I, J )
-               RHS( 2 ) = F( I, J )
-*
-*              Solve Z' * x = RHS
-*
-               CALL ZGETC2( LDZ, Z, LDZ, IPIV, JPIV, IERR )
-               IF( IERR.GT.0 )
-     $            INFO = IERR
-               CALL ZGESC2( LDZ, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
-               IF( SCALOC.NE.ONE ) THEN
-                  DO 40 K = 1, N
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, K ),
-     $                           1 )
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, K ),
-     $                           1 )
-   40             CONTINUE
-                  SCALE = SCALE*SCALOC
-               END IF
-*
-*              Unpack solution vector(s)
-*
-               C( I, J ) = RHS( 1 )
-               F( I, J ) = RHS( 2 )
-*
-*              Substitute R(I, J) and L(I, J) into remaining equation.
-*
-               DO 50 K = 1, J - 1
-                  F( I, K ) = F( I, K ) + RHS( 1 )*DCONJG( B( K, J ) ) +
-     $                        RHS( 2 )*DCONJG( E( K, J ) )
-   50          CONTINUE
-               DO 60 K = I + 1, M
-                  C( K, J ) = C( K, J ) - DCONJG( A( I, K ) )*RHS( 1 ) -
-     $                        DCONJG( D( I, K ) )*RHS( 2 )
-   60          CONTINUE
-*
-   70       CONTINUE
-   80    CONTINUE
-      END IF
-      RETURN
-*
-*     End of ZTGSY2
-*
-      END
diff --git a/src/lib/lapack/ztgsyl.f b/src/lib/lapack/ztgsyl.f
deleted file mode 100644
index af808a31..00000000
--- a/src/lib/lapack/ztgsyl.f
+++ /dev/null
@@ -1,575 +0,0 @@
-      SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
-     $                   LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK,
-     $                   IWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TRANS
-      INTEGER            IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF,
-     $                   LWORK, M, N
-      DOUBLE PRECISION   DIF, SCALE
-*     ..
-*     .. Array Arguments ..
-      INTEGER            IWORK( * )
-      COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * ),
-     $                   D( LDD, * ), E( LDE, * ), F( LDF, * ),
-     $                   WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTGSYL solves the generalized Sylvester equation:
-*
-*              A * R - L * B = scale * C            (1)
-*              D * R - L * E = scale * F
-*
-*  where R and L are unknown m-by-n matrices, (A, D), (B, E) and
-*  (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n,
-*  respectively, with complex entries. A, B, D and E are upper
-*  triangular (i.e., (A,D) and (B,E) in generalized Schur form).
-*
-*  The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1
-*  is an output scaling factor chosen to avoid overflow.
-*
-*  In matrix notation (1) is equivalent to solve Zx = scale*b, where Z
-*  is defined as
-*
-*         Z = [ kron(In, A)  -kron(B', Im) ]        (2)
-*             [ kron(In, D)  -kron(E', Im) ],
-*
-*  Here Ix is the identity matrix of size x and X' is the conjugate
-*  transpose of X. Kron(X, Y) is the Kronecker product between the
-*  matrices X and Y.
-*
-*  If TRANS = 'C', y in the conjugate transposed system Z'*y = scale*b
-*  is solved for, which is equivalent to solve for R and L in
-*
-*              A' * R + D' * L = scale * C           (3)
-*              R * B' + L * E' = scale * -F
-*
-*  This case (TRANS = 'C') is used to compute an one-norm-based estimate
-*  of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D)
-*  and (B,E), using ZLACON.
-*
-*  If IJOB >= 1, ZTGSYL computes a Frobenius norm-based estimate of
-*  Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the
-*  reciprocal of the smallest singular value of Z.
-*
-*  This is a level-3 BLAS algorithm.
-*
-*  Arguments
-*  =========
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': solve the generalized sylvester equation (1).
-*          = 'C': solve the "conjugate transposed" system (3).
-*
-*  IJOB    (input) INTEGER
-*          Specifies what kind of functionality to be performed.
-*          =0: solve (1) only.
-*          =1: The functionality of 0 and 3.
-*          =2: The functionality of 0 and 4.
-*          =3: Only an estimate of Dif[(A,D), (B,E)] is computed.
-*              (look ahead strategy is used).
-*          =4: Only an estimate of Dif[(A,D), (B,E)] is computed.
-*              (ZGECON on sub-systems is used).
-*          Not referenced if TRANS = 'C'.
-*
-*  M       (input) INTEGER
-*          The order of the matrices A and D, and the row dimension of
-*          the matrices C, F, R and L.
-*
-*  N       (input) INTEGER
-*          The order of the matrices B and E, and the column dimension
-*          of the matrices C, F, R and L.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA, M)
-*          The upper triangular matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1, M).
-*
-*  B       (input) COMPLEX*16 array, dimension (LDB, N)
-*          The upper triangular matrix B.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1, N).
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC, N)
-*          On entry, C contains the right-hand-side of the first matrix
-*          equation in (1) or (3).
-*          On exit, if IJOB = 0, 1 or 2, C has been overwritten by
-*          the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R,
-*          the solution achieved during the computation of the
-*          Dif-estimate.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1, M).
-*
-*  D       (input) COMPLEX*16 array, dimension (LDD, M)
-*          The upper triangular matrix D.
-*
-*  LDD     (input) INTEGER
-*          The leading dimension of the array D. LDD >= max(1, M).
-*
-*  E       (input) COMPLEX*16 array, dimension (LDE, N)
-*          The upper triangular matrix E.
-*
-*  LDE     (input) INTEGER
-*          The leading dimension of the array E. LDE >= max(1, N).
-*
-*  F       (input/output) COMPLEX*16 array, dimension (LDF, N)
-*          On entry, F contains the right-hand-side of the second matrix
-*          equation in (1) or (3).
-*          On exit, if IJOB = 0, 1 or 2, F has been overwritten by
-*          the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L,
-*          the solution achieved during the computation of the
-*          Dif-estimate.
-*
-*  LDF     (input) INTEGER
-*          The leading dimension of the array F. LDF >= max(1, M).
-*
-*  DIF     (output) DOUBLE PRECISION
-*          On exit DIF is the reciprocal of a lower bound of the
-*          reciprocal of the Dif-function, i.e. DIF is an upper bound of
-*          Dif[(A,D), (B,E)] = sigma-min(Z), where Z as in (2).
-*          IF IJOB = 0 or TRANS = 'C', DIF is not referenced.
-*
-*  SCALE   (output) DOUBLE PRECISION
-*          On exit SCALE is the scaling factor in (1) or (3).
-*          If 0 < SCALE < 1, C and F hold the solutions R and L, resp.,
-*          to a slightly perturbed system but the input matrices A, B,
-*          D and E have not been changed. If SCALE = 0, R and L will
-*          hold the solutions to the homogenious system with C = F = 0.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK > = 1.
-*          If IJOB = 1 or 2 and TRANS = 'N', LWORK >= max(1,2*M*N).
-*
-*          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.
-*
-*  IWORK   (workspace) INTEGER array, dimension (M+N+2)
-*          If IJOB = 0, IWORK is not referenced.
-*
-*  INFO    (output) INTEGER
-*            =0: successful exit
-*            <0: If INFO = -i, the i-th argument had an illegal value.
-*            >0: (A, D) and (B, E) have common or very close
-*                eigenvalues.
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-*     Umea University, S-901 87 Umea, Sweden.
-*
-*  [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
-*      for Solving the Generalized Sylvester Equation and Estimating the
-*      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
-*      Department of Computing Science, Umea University, S-901 87 Umea,
-*      Sweden, December 1993, Revised April 1994, Also as LAPACK Working
-*      Note 75.  To appear in ACM Trans. on Math. Software, Vol 22,
-*      No 1, 1996.
-*
-*  [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester
-*      Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal.
-*      Appl., 15(4):1045-1060, 1994.
-*
-*  [3] B. Kagstrom and L. Westin, Generalized Schur Methods with
-*      Condition Estimators for Solving the Generalized Sylvester
-*      Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,
-*      July 1989, pp 745-751.
-*
-*  =====================================================================
-*  Replaced various illegal calls to CCOPY by calls to CLASET.
-*  Sven Hammarling, 1/5/02.
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-      COMPLEX*16         CZERO
-      PARAMETER          ( CZERO = (0.0D+0, 0.0D+0) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, NOTRAN
-      INTEGER            I, IE, IFUNC, IROUND, IS, ISOLVE, J, JE, JS, K,
-     $                   LINFO, LWMIN, MB, NB, P, PQ, Q
-      DOUBLE PRECISION   DSCALE, DSUM, SCALE2, SCALOC
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMM, ZLACPY, ZLASET, ZSCAL, ZTGSY2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DBLE, DCMPLX, MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test input parameters
-*
-      INFO = 0
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-      IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
-         INFO = -1
-      ELSE IF( NOTRAN ) THEN
-         IF( ( IJOB.LT.0 ) .OR. ( IJOB.GT.4 ) ) THEN
-            INFO = -2
-         END IF
-      END IF
-      IF( INFO.EQ.0 ) THEN
-         IF( M.LE.0 ) THEN
-            INFO = -3
-         ELSE IF( N.LE.0 ) THEN
-            INFO = -4
-         ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-            INFO = -6
-         ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-            INFO = -8
-         ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-            INFO = -10
-         ELSE IF( LDD.LT.MAX( 1, M ) ) THEN
-            INFO = -12
-         ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
-            INFO = -14
-         ELSE IF( LDF.LT.MAX( 1, M ) ) THEN
-            INFO = -16
-         END IF
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( NOTRAN ) THEN
-            IF( IJOB.EQ.1 .OR. IJOB.EQ.2 ) THEN
-               LWMIN = MAX( 1, 2*M*N )
-            ELSE
-               LWMIN = 1
-            END IF
-         ELSE
-            LWMIN = 1
-         END IF
-         WORK( 1 ) = LWMIN
-*
-         IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
-            INFO = -20
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTGSYL', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         SCALE = 1
-         IF( NOTRAN ) THEN
-            IF( IJOB.NE.0 ) THEN
-               DIF = 0
-            END IF
-         END IF
-         RETURN
-      END IF
-*
-*     Determine  optimal block sizes MB and NB
-*
-      MB = ILAENV( 2, 'ZTGSYL', TRANS, M, N, -1, -1 )
-      NB = ILAENV( 5, 'ZTGSYL', TRANS, M, N, -1, -1 )
-*
-      ISOLVE = 1
-      IFUNC = 0
-      IF( NOTRAN ) THEN
-         IF( IJOB.GE.3 ) THEN
-            IFUNC = IJOB - 2
-            CALL ZLASET( 'F', M, N, CZERO, CZERO, C, LDC )
-            CALL ZLASET( 'F', M, N, CZERO, CZERO, F, LDF )
-         ELSE IF( IJOB.GE.1 .AND. NOTRAN ) THEN
-            ISOLVE = 2
-         END IF
-      END IF
-*
-      IF( ( MB.LE.1 .AND. NB.LE.1 ) .OR. ( MB.GE.M .AND. NB.GE.N ) )
-     $     THEN
-*
-*        Use unblocked Level 2 solver
-*
-         DO 30 IROUND = 1, ISOLVE
-*
-            SCALE = ONE
-            DSCALE = ZERO
-            DSUM = ONE
-            PQ = M*N
-            CALL ZTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, D,
-     $                   LDD, E, LDE, F, LDF, SCALE, DSUM, DSCALE,
-     $                   INFO )
-            IF( DSCALE.NE.ZERO ) THEN
-               IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
-                  DIF = SQRT( DBLE( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
-               ELSE
-                  DIF = SQRT( DBLE( PQ ) ) / ( DSCALE*SQRT( DSUM ) )
-               END IF
-            END IF
-            IF( ISOLVE.EQ.2 .AND. IROUND.EQ.1 ) THEN
-               IF( NOTRAN ) THEN
-                  IFUNC = IJOB
-               END IF
-               SCALE2 = SCALE
-               CALL ZLACPY( 'F', M, N, C, LDC, WORK, M )
-               CALL ZLACPY( 'F', M, N, F, LDF, WORK( M*N+1 ), M )
-               CALL ZLASET( 'F', M, N, CZERO, CZERO, C, LDC )
-               CALL ZLASET( 'F', M, N, CZERO, CZERO, F, LDF )
-            ELSE IF( ISOLVE.EQ.2 .AND. IROUND.EQ.2 ) THEN
-               CALL ZLACPY( 'F', M, N, WORK, M, C, LDC )
-               CALL ZLACPY( 'F', M, N, WORK( M*N+1 ), M, F, LDF )
-               SCALE = SCALE2
-            END IF
-   30    CONTINUE
-*
-         RETURN
-*
-      END IF
-*
-*     Determine block structure of A
-*
-      P = 0
-      I = 1
-   40 CONTINUE
-      IF( I.GT.M )
-     $   GO TO 50
-      P = P + 1
-      IWORK( P ) = I
-      I = I + MB
-      IF( I.GE.M )
-     $   GO TO 50
-      GO TO 40
-   50 CONTINUE
-      IWORK( P+1 ) = M + 1
-      IF( IWORK( P ).EQ.IWORK( P+1 ) )
-     $   P = P - 1
-*
-*     Determine block structure of B
-*
-      Q = P + 1
-      J = 1
-   60 CONTINUE
-      IF( J.GT.N )
-     $   GO TO 70
-*
-      Q = Q + 1
-      IWORK( Q ) = J
-      J = J + NB
-      IF( J.GE.N )
-     $   GO TO 70
-      GO TO 60
-*
-   70 CONTINUE
-      IWORK( Q+1 ) = N + 1
-      IF( IWORK( Q ).EQ.IWORK( Q+1 ) )
-     $   Q = Q - 1
-*
-      IF( NOTRAN ) THEN
-         DO 150 IROUND = 1, ISOLVE
-*
-*           Solve (I, J) - subsystem
-*               A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J)
-*               D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J)
-*           for I = P, P - 1, ..., 1; J = 1, 2, ..., Q
-*
-            PQ = 0
-            SCALE = ONE
-            DSCALE = ZERO
-            DSUM = ONE
-            DO 130 J = P + 2, Q
-               JS = IWORK( J )
-               JE = IWORK( J+1 ) - 1
-               NB = JE - JS + 1
-               DO 120 I = P, 1, -1
-                  IS = IWORK( I )
-                  IE = IWORK( I+1 ) - 1
-                  MB = IE - IS + 1
-                  CALL ZTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
-     $                         B( JS, JS ), LDB, C( IS, JS ), LDC,
-     $                         D( IS, IS ), LDD, E( JS, JS ), LDE,
-     $                         F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
-     $                         LINFO )
-                  IF( LINFO.GT.0 )
-     $               INFO = LINFO
-                  PQ = PQ + MB*NB
-                  IF( SCALOC.NE.ONE ) THEN
-                     DO 80 K = 1, JS - 1
-                        CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ),
-     $                              C( 1, K ), 1 )
-                        CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ),
-     $                              F( 1, K ), 1 )
-   80                CONTINUE
-                     DO 90 K = JS, JE
-                        CALL ZSCAL( IS-1, DCMPLX( SCALOC, ZERO ),
-     $                              C( 1, K ), 1 )
-                        CALL ZSCAL( IS-1, DCMPLX( SCALOC, ZERO ),
-     $                              F( 1, K ), 1 )
-   90                CONTINUE
-                     DO 100 K = JS, JE
-                        CALL ZSCAL( M-IE, DCMPLX( SCALOC, ZERO ),
-     $                              C( IE+1, K ), 1 )
-                        CALL ZSCAL( M-IE, DCMPLX( SCALOC, ZERO ),
-     $                              F( IE+1, K ), 1 )
-  100                CONTINUE
-                     DO 110 K = JE + 1, N
-                        CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ),
-     $                              C( 1, K ), 1 )
-                        CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ),
-     $                              F( 1, K ), 1 )
-  110                CONTINUE
-                     SCALE = SCALE*SCALOC
-                  END IF
-*
-*                 Substitute R(I,J) and L(I,J) into remaining equation.
-*
-                  IF( I.GT.1 ) THEN
-                     CALL ZGEMM( 'N', 'N', IS-1, NB, MB,
-     $                           DCMPLX( -ONE, ZERO ), A( 1, IS ), LDA,
-     $                           C( IS, JS ), LDC, DCMPLX( ONE, ZERO ),
-     $                           C( 1, JS ), LDC )
-                     CALL ZGEMM( 'N', 'N', IS-1, NB, MB,
-     $                           DCMPLX( -ONE, ZERO ), D( 1, IS ), LDD,
-     $                           C( IS, JS ), LDC, DCMPLX( ONE, ZERO ),
-     $                           F( 1, JS ), LDF )
-                  END IF
-                  IF( J.LT.Q ) THEN
-                     CALL ZGEMM( 'N', 'N', MB, N-JE, NB,
-     $                           DCMPLX( ONE, ZERO ), F( IS, JS ), LDF,
-     $                           B( JS, JE+1 ), LDB,
-     $                           DCMPLX( ONE, ZERO ), C( IS, JE+1 ),
-     $                           LDC )
-                     CALL ZGEMM( 'N', 'N', MB, N-JE, NB,
-     $                           DCMPLX( ONE, ZERO ), F( IS, JS ), LDF,
-     $                           E( JS, JE+1 ), LDE,
-     $                           DCMPLX( ONE, ZERO ), F( IS, JE+1 ),
-     $                           LDF )
-                  END IF
-  120          CONTINUE
-  130       CONTINUE
-            IF( DSCALE.NE.ZERO ) THEN
-               IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
-                  DIF = SQRT( DBLE( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
-               ELSE
-                  DIF = SQRT( DBLE( PQ ) ) / ( DSCALE*SQRT( DSUM ) )
-               END IF
-            END IF
-            IF( ISOLVE.EQ.2 .AND. IROUND.EQ.1 ) THEN
-               IF( NOTRAN ) THEN
-                  IFUNC = IJOB
-               END IF
-               SCALE2 = SCALE
-               CALL ZLACPY( 'F', M, N, C, LDC, WORK, M )
-               CALL ZLACPY( 'F', M, N, F, LDF, WORK( M*N+1 ), M )
-               CALL ZLASET( 'F', M, N, CZERO, CZERO, C, LDC )
-               CALL ZLASET( 'F', M, N, CZERO, CZERO, F, LDF )
-            ELSE IF( ISOLVE.EQ.2 .AND. IROUND.EQ.2 ) THEN
-               CALL ZLACPY( 'F', M, N, WORK, M, C, LDC )
-               CALL ZLACPY( 'F', M, N, WORK( M*N+1 ), M, F, LDF )
-               SCALE = SCALE2
-            END IF
-  150    CONTINUE
-      ELSE
-*
-*        Solve transposed (I, J)-subsystem
-*            A(I, I)' * R(I, J) + D(I, I)' * L(I, J) = C(I, J)
-*            R(I, J) * B(J, J)  + L(I, J) * E(J, J) = -F(I, J)
-*        for I = 1,2,..., P; J = Q, Q-1,..., 1
-*
-         SCALE = ONE
-         DO 210 I = 1, P
-            IS = IWORK( I )
-            IE = IWORK( I+1 ) - 1
-            MB = IE - IS + 1
-            DO 200 J = Q, P + 2, -1
-               JS = IWORK( J )
-               JE = IWORK( J+1 ) - 1
-               NB = JE - JS + 1
-               CALL ZTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
-     $                      B( JS, JS ), LDB, C( IS, JS ), LDC,
-     $                      D( IS, IS ), LDD, E( JS, JS ), LDE,
-     $                      F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
-     $                      LINFO )
-               IF( LINFO.GT.0 )
-     $            INFO = LINFO
-               IF( SCALOC.NE.ONE ) THEN
-                  DO 160 K = 1, JS - 1
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, K ),
-     $                           1 )
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, K ),
-     $                           1 )
-  160             CONTINUE
-                  DO 170 K = JS, JE
-                     CALL ZSCAL( IS-1, DCMPLX( SCALOC, ZERO ),
-     $                           C( 1, K ), 1 )
-                     CALL ZSCAL( IS-1, DCMPLX( SCALOC, ZERO ),
-     $                           F( 1, K ), 1 )
-  170             CONTINUE
-                  DO 180 K = JS, JE
-                     CALL ZSCAL( M-IE, DCMPLX( SCALOC, ZERO ),
-     $                           C( IE+1, K ), 1 )
-                     CALL ZSCAL( M-IE, DCMPLX( SCALOC, ZERO ),
-     $                           F( IE+1, K ), 1 )
-  180             CONTINUE
-                  DO 190 K = JE + 1, N
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, K ),
-     $                           1 )
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, K ),
-     $                           1 )
-  190             CONTINUE
-                  SCALE = SCALE*SCALOC
-               END IF
-*
-*              Substitute R(I,J) and L(I,J) into remaining equation.
-*
-               IF( J.GT.P+2 ) THEN
-                  CALL ZGEMM( 'N', 'C', MB, JS-1, NB,
-     $                        DCMPLX( ONE, ZERO ), C( IS, JS ), LDC,
-     $                        B( 1, JS ), LDB, DCMPLX( ONE, ZERO ),
-     $                        F( IS, 1 ), LDF )
-                  CALL ZGEMM( 'N', 'C', MB, JS-1, NB,
-     $                        DCMPLX( ONE, ZERO ), F( IS, JS ), LDF,
-     $                        E( 1, JS ), LDE, DCMPLX( ONE, ZERO ),
-     $                        F( IS, 1 ), LDF )
-               END IF
-               IF( I.LT.P ) THEN
-                  CALL ZGEMM( 'C', 'N', M-IE, NB, MB,
-     $                        DCMPLX( -ONE, ZERO ), A( IS, IE+1 ), LDA,
-     $                        C( IS, JS ), LDC, DCMPLX( ONE, ZERO ),
-     $                        C( IE+1, JS ), LDC )
-                  CALL ZGEMM( 'C', 'N', M-IE, NB, MB,
-     $                        DCMPLX( -ONE, ZERO ), D( IS, IE+1 ), LDD,
-     $                        F( IS, JS ), LDF, DCMPLX( ONE, ZERO ),
-     $                        C( IE+1, JS ), LDC )
-               END IF
-  200       CONTINUE
-  210    CONTINUE
-      END IF
-*
-      WORK( 1 ) = LWMIN
-*
-      RETURN
-*
-*     End of ZTGSYL
-*
-      END
diff --git a/src/lib/lapack/ztrevc.f b/src/lib/lapack/ztrevc.f
deleted file mode 100644
index 21142f42..00000000
--- a/src/lib/lapack/ztrevc.f
+++ /dev/null
@@ -1,386 +0,0 @@
-      SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
-     $                   LDVR, MM, M, WORK, RWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          HOWMNY, SIDE
-      INTEGER            INFO, LDT, LDVL, LDVR, M, MM, N
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            SELECT( * )
-      DOUBLE PRECISION   RWORK( * )
-      COMPLEX*16         T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
-     $                   WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTREVC computes some or all of the right and/or left eigenvectors of
-*  a complex upper triangular matrix T.
-*  Matrices of this type are produced by the Schur factorization of
-*  a complex general matrix:  A = Q*T*Q**H, as computed by ZHSEQR.
-*  
-*  The right eigenvector x and the left eigenvector y of T corresponding
-*  to an eigenvalue w are defined by:
-*  
-*               T*x = w*x,     (y**H)*T = w*(y**H)
-*  
-*  where y**H denotes the conjugate transpose of the vector y.
-*  The eigenvalues are not input to this routine, but are read directly
-*  from the diagonal of T.
-*  
-*  This routine returns the matrices X and/or Y of right and left
-*  eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
-*  input matrix.  If Q is the unitary factor that reduces a matrix A to
-*  Schur form T, then Q*X and Q*Y are the matrices of right and left
-*  eigenvectors of A.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'R':  compute right eigenvectors only;
-*          = 'L':  compute left eigenvectors only;
-*          = 'B':  compute both right and left eigenvectors.
-*
-*  HOWMNY  (input) CHARACTER*1
-*          = 'A':  compute all right and/or left eigenvectors;
-*          = 'B':  compute all right and/or left eigenvectors,
-*                  backtransformed using the matrices supplied in
-*                  VR and/or VL;
-*          = 'S':  compute selected right and/or left eigenvectors,
-*                  as indicated by the logical array SELECT.
-*
-*  SELECT  (input) LOGICAL array, dimension (N)
-*          If HOWMNY = 'S', SELECT specifies the eigenvectors to be
-*          computed.
-*          The eigenvector corresponding to the j-th eigenvalue is
-*          computed if SELECT(j) = .TRUE..
-*          Not referenced if HOWMNY = 'A' or 'B'.
-*
-*  N       (input) INTEGER
-*          The order of the matrix T. N >= 0.
-*
-*  T       (input/output) COMPLEX*16 array, dimension (LDT,N)
-*          The upper triangular matrix T.  T is modified, but restored
-*          on exit.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= max(1,N).
-*
-*  VL      (input/output) COMPLEX*16 array, dimension (LDVL,MM)
-*          On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
-*          contain an N-by-N matrix Q (usually the unitary matrix Q of
-*          Schur vectors returned by ZHSEQR).
-*          On exit, if SIDE = 'L' or 'B', VL contains:
-*          if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
-*          if HOWMNY = 'B', the matrix Q*Y;
-*          if HOWMNY = 'S', the left eigenvectors of T specified by
-*                           SELECT, stored consecutively in the columns
-*                           of VL, in the same order as their
-*                           eigenvalues.
-*          Not referenced if SIDE = 'R'.
-*
-*  LDVL    (input) INTEGER
-*          The leading dimension of the array VL.  LDVL >= 1, and if
-*          SIDE = 'L' or 'B', LDVL >= N.
-*
-*  VR      (input/output) COMPLEX*16 array, dimension (LDVR,MM)
-*          On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
-*          contain an N-by-N matrix Q (usually the unitary matrix Q of
-*          Schur vectors returned by ZHSEQR).
-*          On exit, if SIDE = 'R' or 'B', VR contains:
-*          if HOWMNY = 'A', the matrix X of right eigenvectors of T;
-*          if HOWMNY = 'B', the matrix Q*X;
-*          if HOWMNY = 'S', the right eigenvectors of T specified by
-*                           SELECT, stored consecutively in the columns
-*                           of VR, in the same order as their
-*                           eigenvalues.
-*          Not referenced if SIDE = 'L'.
-*
-*  LDVR    (input) INTEGER
-*          The leading dimension of the array VR.  LDVR >= 1, and if
-*          SIDE = 'R' or 'B'; LDVR >= N.
-*
-*  MM      (input) INTEGER
-*          The number of columns in the arrays VL and/or VR. MM >= M.
-*
-*  M       (output) INTEGER
-*          The number of columns in the arrays VL and/or VR actually
-*          used to store the eigenvectors.  If HOWMNY = 'A' or 'B', M
-*          is set to N.  Each selected eigenvector occupies one
-*          column.
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (2*N)
-*
-*  RWORK   (workspace) DOUBLE PRECISION array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  The algorithm used in this program is basically backward (forward)
-*  substitution, with scaling to make the the code robust against
-*  possible overflow.
-*
-*  Each eigenvector is normalized so that the element of largest
-*  magnitude has magnitude 1; here the magnitude of a complex number
-*  (x,y) is taken to be |x| + |y|.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-      COMPLEX*16         CMZERO, CMONE
-      PARAMETER          ( CMZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   CMONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            ALLV, BOTHV, LEFTV, OVER, RIGHTV, SOMEV
-      INTEGER            I, II, IS, J, K, KI
-      DOUBLE PRECISION   OVFL, REMAX, SCALE, SMIN, SMLNUM, ULP, UNFL
-      COMPLEX*16         CDUM
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            IZAMAX
-      DOUBLE PRECISION   DLAMCH, DZASUM
-      EXTERNAL           LSAME, IZAMAX, DLAMCH, DZASUM
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX
-*     ..
-*     .. Statement Functions ..
-      DOUBLE PRECISION   CABS1
-*     ..
-*     .. Statement Function definitions ..
-      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test the input parameters
-*
-      BOTHV = LSAME( SIDE, 'B' )
-      RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV
-      LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV
-*
-      ALLV = LSAME( HOWMNY, 'A' )
-      OVER = LSAME( HOWMNY, 'B' )
-      SOMEV = LSAME( HOWMNY, 'S' )
-*
-*     Set M to the number of columns required to store the selected
-*     eigenvectors.
-*
-      IF( SOMEV ) THEN
-         M = 0
-         DO 10 J = 1, N
-            IF( SELECT( J ) )
-     $         M = M + 1
-   10    CONTINUE
-      ELSE
-         M = N
-      END IF
-*
-      INFO = 0
-      IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
-         INFO = -1
-      ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN
-         INFO = -8
-      ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN
-         INFO = -10
-      ELSE IF( MM.LT.M ) THEN
-         INFO = -11
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTREVC', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible.
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Set the constants to control overflow.
-*
-      UNFL = DLAMCH( 'Safe minimum' )
-      OVFL = ONE / UNFL
-      CALL DLABAD( UNFL, OVFL )
-      ULP = DLAMCH( 'Precision' )
-      SMLNUM = UNFL*( N / ULP )
-*
-*     Store the diagonal elements of T in working array WORK.
-*
-      DO 20 I = 1, N
-         WORK( I+N ) = T( I, I )
-   20 CONTINUE
-*
-*     Compute 1-norm of each column of strictly upper triangular
-*     part of T to control overflow in triangular solver.
-*
-      RWORK( 1 ) = ZERO
-      DO 30 J = 2, N
-         RWORK( J ) = DZASUM( J-1, T( 1, J ), 1 )
-   30 CONTINUE
-*
-      IF( RIGHTV ) THEN
-*
-*        Compute right eigenvectors.
-*
-         IS = M
-         DO 80 KI = N, 1, -1
-*
-            IF( SOMEV ) THEN
-               IF( .NOT.SELECT( KI ) )
-     $            GO TO 80
-            END IF
-            SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM )
-*
-            WORK( 1 ) = CMONE
-*
-*           Form right-hand side.
-*
-            DO 40 K = 1, KI - 1
-               WORK( K ) = -T( K, KI )
-   40       CONTINUE
-*
-*           Solve the triangular system:
-*              (T(1:KI-1,1:KI-1) - T(KI,KI))*X = SCALE*WORK.
-*
-            DO 50 K = 1, KI - 1
-               T( K, K ) = T( K, K ) - T( KI, KI )
-               IF( CABS1( T( K, K ) ).LT.SMIN )
-     $            T( K, K ) = SMIN
-   50       CONTINUE
-*
-            IF( KI.GT.1 ) THEN
-               CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', 'Y',
-     $                      KI-1, T, LDT, WORK( 1 ), SCALE, RWORK,
-     $                      INFO )
-               WORK( KI ) = SCALE
-            END IF
-*
-*           Copy the vector x or Q*x to VR and normalize.
-*
-            IF( .NOT.OVER ) THEN
-               CALL ZCOPY( KI, WORK( 1 ), 1, VR( 1, IS ), 1 )
-*
-               II = IZAMAX( KI, VR( 1, IS ), 1 )
-               REMAX = ONE / CABS1( VR( II, IS ) )
-               CALL ZDSCAL( KI, REMAX, VR( 1, IS ), 1 )
-*
-               DO 60 K = KI + 1, N
-                  VR( K, IS ) = CMZERO
-   60          CONTINUE
-            ELSE
-               IF( KI.GT.1 )
-     $            CALL ZGEMV( 'N', N, KI-1, CMONE, VR, LDVR, WORK( 1 ),
-     $                        1, DCMPLX( SCALE ), VR( 1, KI ), 1 )
-*
-               II = IZAMAX( N, VR( 1, KI ), 1 )
-               REMAX = ONE / CABS1( VR( II, KI ) )
-               CALL ZDSCAL( N, REMAX, VR( 1, KI ), 1 )
-            END IF
-*
-*           Set back the original diagonal elements of T.
-*
-            DO 70 K = 1, KI - 1
-               T( K, K ) = WORK( K+N )
-   70       CONTINUE
-*
-            IS = IS - 1
-   80    CONTINUE
-      END IF
-*
-      IF( LEFTV ) THEN
-*
-*        Compute left eigenvectors.
-*
-         IS = 1
-         DO 130 KI = 1, N
-*
-            IF( SOMEV ) THEN
-               IF( .NOT.SELECT( KI ) )
-     $            GO TO 130
-            END IF
-            SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM )
-*
-            WORK( N ) = CMONE
-*
-*           Form right-hand side.
-*
-            DO 90 K = KI + 1, N
-               WORK( K ) = -DCONJG( T( KI, K ) )
-   90       CONTINUE
-*
-*           Solve the triangular system:
-*              (T(KI+1:N,KI+1:N) - T(KI,KI))'*X = SCALE*WORK.
-*
-            DO 100 K = KI + 1, N
-               T( K, K ) = T( K, K ) - T( KI, KI )
-               IF( CABS1( T( K, K ) ).LT.SMIN )
-     $            T( K, K ) = SMIN
-  100       CONTINUE
-*
-            IF( KI.LT.N ) THEN
-               CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit',
-     $                      'Y', N-KI, T( KI+1, KI+1 ), LDT,
-     $                      WORK( KI+1 ), SCALE, RWORK, INFO )
-               WORK( KI ) = SCALE
-            END IF
-*
-*           Copy the vector x or Q*x to VL and normalize.
-*
-            IF( .NOT.OVER ) THEN
-               CALL ZCOPY( N-KI+1, WORK( KI ), 1, VL( KI, IS ), 1 )
-*
-               II = IZAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1
-               REMAX = ONE / CABS1( VL( II, IS ) )
-               CALL ZDSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
-*
-               DO 110 K = 1, KI - 1
-                  VL( K, IS ) = CMZERO
-  110          CONTINUE
-            ELSE
-               IF( KI.LT.N )
-     $            CALL ZGEMV( 'N', N, N-KI, CMONE, VL( 1, KI+1 ), LDVL,
-     $                        WORK( KI+1 ), 1, DCMPLX( SCALE ),
-     $                        VL( 1, KI ), 1 )
-*
-               II = IZAMAX( N, VL( 1, KI ), 1 )
-               REMAX = ONE / CABS1( VL( II, KI ) )
-               CALL ZDSCAL( N, REMAX, VL( 1, KI ), 1 )
-            END IF
-*
-*           Set back the original diagonal elements of T.
-*
-            DO 120 K = KI + 1, N
-               T( K, K ) = WORK( K+N )
-  120       CONTINUE
-*
-            IS = IS + 1
-  130    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of ZTREVC
-*
-      END
diff --git a/src/lib/lapack/ztrexc.f b/src/lib/lapack/ztrexc.f
deleted file mode 100644
index 69313696..00000000
--- a/src/lib/lapack/ztrexc.f
+++ /dev/null
@@ -1,162 +0,0 @@
-      SUBROUTINE ZTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          COMPQ
-      INTEGER            IFST, ILST, INFO, LDQ, LDT, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         Q( LDQ, * ), T( LDT, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTREXC reorders the Schur factorization of a complex matrix
-*  A = Q*T*Q**H, so that the diagonal element of T with row index IFST
-*  is moved to row ILST.
-*
-*  The Schur form T is reordered by a unitary similarity transformation
-*  Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by
-*  postmultplying it with Z.
-*
-*  Arguments
-*  =========
-*
-*  COMPQ   (input) CHARACTER*1
-*          = 'V':  update the matrix Q of Schur vectors;
-*          = 'N':  do not update Q.
-*
-*  N       (input) INTEGER
-*          The order of the matrix T. N >= 0.
-*
-*  T       (input/output) COMPLEX*16 array, dimension (LDT,N)
-*          On entry, the upper triangular matrix T.
-*          On exit, the reordered upper triangular matrix.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= max(1,N).
-*
-*  Q       (input/output) COMPLEX*16 array, dimension (LDQ,N)
-*          On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
-*          On exit, if COMPQ = 'V', Q has been postmultiplied by the
-*          unitary transformation matrix Z which reorders T.
-*          If COMPQ = 'N', Q is not referenced.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q.  LDQ >= max(1,N).
-*
-*  IFST    (input) INTEGER
-*  ILST    (input) INTEGER
-*          Specify the reordering of the diagonal elements of T:
-*          The element with row index IFST is moved to row ILST by a
-*          sequence of transpositions between adjacent elements.
-*          1 <= IFST <= N; 1 <= ILST <= N.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            WANTQ
-      INTEGER            K, M1, M2, M3
-      DOUBLE PRECISION   CS
-      COMPLEX*16         SN, T11, T22, TEMP
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARTG, ZROT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test the input parameters.
-*
-      INFO = 0
-      WANTQ = LSAME( COMPQ, 'V' )
-      IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
-         INFO = -4
-      ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN
-         INFO = -6
-      ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
-         INFO = -7
-      ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
-         INFO = -8
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTREXC', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.1 .OR. IFST.EQ.ILST )
-     $   RETURN
-*
-      IF( IFST.LT.ILST ) THEN
-*
-*        Move the IFST-th diagonal element forward down the diagonal.
-*
-         M1 = 0
-         M2 = -1
-         M3 = 1
-      ELSE
-*
-*        Move the IFST-th diagonal element backward up the diagonal.
-*
-         M1 = -1
-         M2 = 0
-         M3 = -1
-      END IF
-*
-      DO 10 K = IFST + M1, ILST + M2, M3
-*
-*        Interchange the k-th and (k+1)-th diagonal elements.
-*
-         T11 = T( K, K )
-         T22 = T( K+1, K+1 )
-*
-*        Determine the transformation to perform the interchange.
-*
-         CALL ZLARTG( T( K, K+1 ), T22-T11, CS, SN, TEMP )
-*
-*        Apply transformation to the matrix T.
-*
-         IF( K+2.LE.N )
-     $      CALL ZROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS,
-     $                 SN )
-         CALL ZROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS,
-     $              DCONJG( SN ) )
-*
-         T( K, K ) = T22
-         T( K+1, K+1 ) = T11
-*
-         IF( WANTQ ) THEN
-*
-*           Accumulate transformation in the matrix Q.
-*
-            CALL ZROT( N, Q( 1, K ), 1, Q( 1, K+1 ), 1, CS,
-     $                 DCONJG( SN ) )
-         END IF
-*
-   10 CONTINUE
-*
-      RETURN
-*
-*     End of ZTREXC
-*
-      END
diff --git a/src/lib/lapack/ztrsen.f b/src/lib/lapack/ztrsen.f
deleted file mode 100644
index a07a22f6..00000000
--- a/src/lib/lapack/ztrsen.f
+++ /dev/null
@@ -1,359 +0,0 @@
-      SUBROUTINE ZTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S,
-     $                   SEP, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     Modified to call ZLACN2 in place of ZLACON, 10 Feb 03, SJH.
-*
-*     .. Scalar Arguments ..
-      CHARACTER          COMPQ, JOB
-      INTEGER            INFO, LDQ, LDT, LWORK, M, N
-      DOUBLE PRECISION   S, SEP
-*     ..
-*     .. Array Arguments ..
-      LOGICAL            SELECT( * )
-      COMPLEX*16         Q( LDQ, * ), T( LDT, * ), W( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTRSEN reorders the Schur factorization of a complex matrix
-*  A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in
-*  the leading positions on the diagonal of the upper triangular matrix
-*  T, and the leading columns of Q form an orthonormal basis of the
-*  corresponding right invariant subspace.
-*
-*  Optionally the routine computes the reciprocal condition numbers of
-*  the cluster of eigenvalues and/or the invariant subspace.
-*
-*  Arguments
-*  =========
-*
-*  JOB     (input) CHARACTER*1
-*          Specifies whether condition numbers are required for the
-*          cluster of eigenvalues (S) or the invariant subspace (SEP):
-*          = 'N': none;
-*          = 'E': for eigenvalues only (S);
-*          = 'V': for invariant subspace only (SEP);
-*          = 'B': for both eigenvalues and invariant subspace (S and
-*                 SEP).
-*
-*  COMPQ   (input) CHARACTER*1
-*          = 'V': update the matrix Q of Schur vectors;
-*          = 'N': do not update Q.
-*
-*  SELECT  (input) LOGICAL array, dimension (N)
-*          SELECT specifies the eigenvalues in the selected cluster. To
-*          select the j-th eigenvalue, SELECT(j) must be set to .TRUE..
-*
-*  N       (input) INTEGER
-*          The order of the matrix T. N >= 0.
-*
-*  T       (input/output) COMPLEX*16 array, dimension (LDT,N)
-*          On entry, the upper triangular matrix T.
-*          On exit, T is overwritten by the reordered matrix T, with the
-*          selected eigenvalues as the leading diagonal elements.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= max(1,N).
-*
-*  Q       (input/output) COMPLEX*16 array, dimension (LDQ,N)
-*          On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
-*          On exit, if COMPQ = 'V', Q has been postmultiplied by the
-*          unitary transformation matrix which reorders T; the leading M
-*          columns of Q form an orthonormal basis for the specified
-*          invariant subspace.
-*          If COMPQ = 'N', Q is not referenced.
-*
-*  LDQ     (input) INTEGER
-*          The leading dimension of the array Q.
-*          LDQ >= 1; and if COMPQ = 'V', LDQ >= N.
-*
-*  W       (output) COMPLEX*16 array, dimension (N)
-*          The reordered eigenvalues of T, in the same order as they
-*          appear on the diagonal of T.
-*
-*  M       (output) INTEGER
-*          The dimension of the specified invariant subspace.
-*          0 <= M <= N.
-*
-*  S       (output) DOUBLE PRECISION
-*          If JOB = 'E' or 'B', S is a lower bound on the reciprocal
-*          condition number for the selected cluster of eigenvalues.
-*          S cannot underestimate the true reciprocal condition number
-*          by more than a factor of sqrt(N). If M = 0 or N, S = 1.
-*          If JOB = 'N' or 'V', S is not referenced.
-*
-*  SEP     (output) DOUBLE PRECISION
-*          If JOB = 'V' or 'B', SEP is the estimated reciprocal
-*          condition number of the specified invariant subspace. If
-*          M = 0 or N, SEP = norm(T).
-*          If JOB = 'N' or 'E', SEP is not referenced.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If JOB = 'N', LWORK >= 1;
-*          if JOB = 'E', LWORK = max(1,M*(N-M));
-*          if JOB = 'V' or 'B', LWORK >= max(1,2*M*(N-M)).
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  ZTRSEN first collects the selected eigenvalues by computing a unitary
-*  transformation Z to move them to the top left corner of T. In other
-*  words, the selected eigenvalues are the eigenvalues of T11 in:
-*
-*                Z'*T*Z = ( T11 T12 ) n1
-*                         (  0  T22 ) n2
-*                            n1  n2
-*
-*  where N = n1+n2 and Z' means the conjugate transpose of Z. The first
-*  n1 columns of Z span the specified invariant subspace of T.
-*
-*  If T has been obtained from the Schur factorization of a matrix
-*  A = Q*T*Q', then the reordered Schur factorization of A is given by
-*  A = (Q*Z)*(Z'*T*Z)*(Q*Z)', and the first n1 columns of Q*Z span the
-*  corresponding invariant subspace of A.
-*
-*  The reciprocal condition number of the average of the eigenvalues of
-*  T11 may be returned in S. S lies between 0 (very badly conditioned)
-*  and 1 (very well conditioned). It is computed as follows. First we
-*  compute R so that
-*
-*                         P = ( I  R ) n1
-*                             ( 0  0 ) n2
-*                               n1 n2
-*
-*  is the projector on the invariant subspace associated with T11.
-*  R is the solution of the Sylvester equation:
-*
-*                        T11*R - R*T22 = T12.
-*
-*  Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M) denote
-*  the two-norm of M. Then S is computed as the lower bound
-*
-*                      (1 + F-norm(R)**2)**(-1/2)
-*
-*  on the reciprocal of 2-norm(P), the true reciprocal condition number.
-*  S cannot underestimate 1 / 2-norm(P) by more than a factor of
-*  sqrt(N).
-*
-*  An approximate error bound for the computed average of the
-*  eigenvalues of T11 is
-*
-*                         EPS * norm(T) / S
-*
-*  where EPS is the machine precision.
-*
-*  The reciprocal condition number of the right invariant subspace
-*  spanned by the first n1 columns of Z (or of Q*Z) is returned in SEP.
-*  SEP is defined as the separation of T11 and T22:
-*
-*                     sep( T11, T22 ) = sigma-min( C )
-*
-*  where sigma-min(C) is the smallest singular value of the
-*  n1*n2-by-n1*n2 matrix
-*
-*     C  = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) )
-*
-*  I(m) is an m by m identity matrix, and kprod denotes the Kronecker
-*  product. We estimate sigma-min(C) by the reciprocal of an estimate of
-*  the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C)
-*  cannot differ from sigma-min(C) by more than a factor of sqrt(n1*n2).
-*
-*  When SEP is small, small changes in T can cause large changes in
-*  the invariant subspace. An approximate bound on the maximum angular
-*  error in the computed right invariant subspace is
-*
-*                      EPS * norm(T) / SEP
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ZERO, ONE
-      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, WANTBH, WANTQ, WANTS, WANTSP
-      INTEGER            IERR, K, KASE, KS, LWMIN, N1, N2, NN
-      DOUBLE PRECISION   EST, RNORM, SCALE
-*     ..
-*     .. Local Arrays ..
-      INTEGER            ISAVE( 3 )
-      DOUBLE PRECISION   RWORK( 1 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   ZLANGE
-      EXTERNAL           LSAME, ZLANGE
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACN2, ZLACPY, ZTREXC, ZTRSYL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and test the input parameters.
-*
-      WANTBH = LSAME( JOB, 'B' )
-      WANTS = LSAME( JOB, 'E' ) .OR. WANTBH
-      WANTSP = LSAME( JOB, 'V' ) .OR. WANTBH
-      WANTQ = LSAME( COMPQ, 'V' )
-*
-*     Set M to the number of selected eigenvalues.
-*
-      M = 0
-      DO 10 K = 1, N
-         IF( SELECT( K ) )
-     $      M = M + 1
-   10 CONTINUE
-*
-      N1 = M
-      N2 = N - M
-      NN = N1*N2
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-*
-      IF( WANTSP ) THEN
-         LWMIN = MAX( 1, 2*NN )
-      ELSE IF( LSAME( JOB, 'N' ) ) THEN
-         LWMIN = 1
-      ELSE IF( LSAME( JOB, 'E' ) ) THEN
-         LWMIN = MAX( 1, NN )
-      END IF
-*
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.WANTS .AND. .NOT.WANTSP )
-     $     THEN
-         INFO = -1
-      ELSE IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
-         INFO = -6
-      ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
-         INFO = -8
-      ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
-         INFO = -14
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         WORK( 1 ) = LWMIN
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTRSEN', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.N .OR. M.EQ.0 ) THEN
-         IF( WANTS )
-     $      S = ONE
-         IF( WANTSP )
-     $      SEP = ZLANGE( '1', N, N, T, LDT, RWORK )
-         GO TO 40
-      END IF
-*
-*     Collect the selected eigenvalues at the top left corner of T.
-*
-      KS = 0
-      DO 20 K = 1, N
-         IF( SELECT( K ) ) THEN
-            KS = KS + 1
-*
-*           Swap the K-th eigenvalue to position KS.
-*
-            IF( K.NE.KS )
-     $         CALL ZTREXC( COMPQ, N, T, LDT, Q, LDQ, K, KS, IERR )
-         END IF
-   20 CONTINUE
-*
-      IF( WANTS ) THEN
-*
-*        Solve the Sylvester equation for R:
-*
-*           T11*R - R*T22 = scale*T12
-*
-         CALL ZLACPY( 'F', N1, N2, T( 1, N1+1 ), LDT, WORK, N1 )
-         CALL ZTRSYL( 'N', 'N', -1, N1, N2, T, LDT, T( N1+1, N1+1 ),
-     $                LDT, WORK, N1, SCALE, IERR )
-*
-*        Estimate the reciprocal of the condition number of the cluster
-*        of eigenvalues.
-*
-         RNORM = ZLANGE( 'F', N1, N2, WORK, N1, RWORK )
-         IF( RNORM.EQ.ZERO ) THEN
-            S = ONE
-         ELSE
-            S = SCALE / ( SQRT( SCALE*SCALE / RNORM+RNORM )*
-     $          SQRT( RNORM ) )
-         END IF
-      END IF
-*
-      IF( WANTSP ) THEN
-*
-*        Estimate sep(T11,T22).
-*
-         EST = ZERO
-         KASE = 0
-   30    CONTINUE
-         CALL ZLACN2( NN, WORK( NN+1 ), WORK, EST, KASE, ISAVE )
-         IF( KASE.NE.0 ) THEN
-            IF( KASE.EQ.1 ) THEN
-*
-*              Solve T11*R - R*T22 = scale*X.
-*
-               CALL ZTRSYL( 'N', 'N', -1, N1, N2, T, LDT,
-     $                      T( N1+1, N1+1 ), LDT, WORK, N1, SCALE,
-     $                      IERR )
-            ELSE
-*
-*              Solve T11'*R - R*T22' = scale*X.
-*
-               CALL ZTRSYL( 'C', 'C', -1, N1, N2, T, LDT,
-     $                      T( N1+1, N1+1 ), LDT, WORK, N1, SCALE,
-     $                      IERR )
-            END IF
-            GO TO 30
-         END IF
-*
-         SEP = SCALE / EST
-      END IF
-*
-   40 CONTINUE
-*
-*     Copy reordered eigenvalues to W.
-*
-      DO 50 K = 1, N
-         W( K ) = T( K, K )
-   50 CONTINUE
-*
-      WORK( 1 ) = LWMIN
-*
-      RETURN
-*
-*     End of ZTRSEN
-*
-      END
diff --git a/src/lib/lapack/ztrsyl.f b/src/lib/lapack/ztrsyl.f
deleted file mode 100644
index d2e0ecc7..00000000
--- a/src/lib/lapack/ztrsyl.f
+++ /dev/null
@@ -1,365 +0,0 @@
-      SUBROUTINE ZTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
-     $                   LDC, SCALE, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          TRANA, TRANB
-      INTEGER            INFO, ISGN, LDA, LDB, LDC, M, N
-      DOUBLE PRECISION   SCALE
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTRSYL solves the complex Sylvester matrix equation:
-*
-*     op(A)*X + X*op(B) = scale*C or
-*     op(A)*X - X*op(B) = scale*C,
-*
-*  where op(A) = A or A**H, and A and B are both upper triangular. A is
-*  M-by-M and B is N-by-N; the right hand side C and the solution X are
-*  M-by-N; and scale is an output scale factor, set <= 1 to avoid
-*  overflow in X.
-*
-*  Arguments
-*  =========
-*
-*  TRANA   (input) CHARACTER*1
-*          Specifies the option op(A):
-*          = 'N': op(A) = A    (No transpose)
-*          = 'C': op(A) = A**H (Conjugate transpose)
-*
-*  TRANB   (input) CHARACTER*1
-*          Specifies the option op(B):
-*          = 'N': op(B) = B    (No transpose)
-*          = 'C': op(B) = B**H (Conjugate transpose)
-*
-*  ISGN    (input) INTEGER
-*          Specifies the sign in the equation:
-*          = +1: solve op(A)*X + X*op(B) = scale*C
-*          = -1: solve op(A)*X - X*op(B) = scale*C
-*
-*  M       (input) INTEGER
-*          The order of the matrix A, and the number of rows in the
-*          matrices X and C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The order of the matrix B, and the number of columns in the
-*          matrices X and C. N >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA,M)
-*          The upper triangular matrix A.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,M).
-*
-*  B       (input) COMPLEX*16 array, dimension (LDB,N)
-*          The upper triangular matrix B.
-*
-*  LDB     (input) INTEGER
-*          The leading dimension of the array B. LDB >= max(1,N).
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the M-by-N right hand side matrix C.
-*          On exit, C is overwritten by the solution matrix X.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M)
-*
-*  SCALE   (output) DOUBLE PRECISION
-*          The scale factor, scale, set <= 1 to avoid overflow in X.
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*          = 1: A and B have common or very close eigenvalues; perturbed
-*               values were used to solve the equation (but the matrices
-*               A and B are unchanged).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOTRNA, NOTRNB
-      INTEGER            J, K, L
-      DOUBLE PRECISION   BIGNUM, DA11, DB, EPS, SCALOC, SGN, SMIN,
-     $                   SMLNUM
-      COMPLEX*16         A11, SUML, SUMR, VEC, X11
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   DUM( 1 )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      DOUBLE PRECISION   DLAMCH, ZLANGE
-      COMPLEX*16         ZDOTC, ZDOTU, ZLADIV
-      EXTERNAL           LSAME, DLAMCH, ZLANGE, ZDOTC, ZDOTU, ZLADIV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZDSCAL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Decode and Test input parameters
-*
-      NOTRNA = LSAME( TRANA, 'N' )
-      NOTRNB = LSAME( TRANB, 'N' )
-*
-      INFO = 0
-      IF( .NOT.NOTRNA .AND. .NOT.LSAME( TRANA, 'C' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRNB .AND. .NOT.LSAME( TRANB, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( ISGN.NE.1 .AND. ISGN.NE.-1 ) THEN
-         INFO = -3
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -7
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
-         INFO = -9
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -11
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTRSYL', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 )
-     $   RETURN
-*
-*     Set constants to control overflow
-*
-      EPS = DLAMCH( 'P' )
-      SMLNUM = DLAMCH( 'S' )
-      BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
-      SMLNUM = SMLNUM*DBLE( M*N ) / EPS
-      BIGNUM = ONE / SMLNUM
-      SMIN = MAX( SMLNUM, EPS*ZLANGE( 'M', M, M, A, LDA, DUM ),
-     $       EPS*ZLANGE( 'M', N, N, B, LDB, DUM ) )
-      SCALE = ONE
-      SGN = ISGN
-*
-      IF( NOTRNA .AND. NOTRNB ) THEN
-*
-*        Solve    A*X + ISGN*X*B = scale*C.
-*
-*        The (K,L)th block of X is determined starting from
-*        bottom-left corner column by column by
-*
-*            A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
-*
-*        Where
-*                    M                        L-1
-*          R(K,L) = SUM [A(K,I)*X(I,L)] +ISGN*SUM [X(K,J)*B(J,L)].
-*                  I=K+1                      J=1
-*
-         DO 30 L = 1, N
-            DO 20 K = M, 1, -1
-*
-               SUML = ZDOTU( M-K, A( K, MIN( K+1, M ) ), LDA,
-     $                C( MIN( K+1, M ), L ), 1 )
-               SUMR = ZDOTU( L-1, C( K, 1 ), LDC, B( 1, L ), 1 )
-               VEC = C( K, L ) - ( SUML+SGN*SUMR )
-*
-               SCALOC = ONE
-               A11 = A( K, K ) + SGN*B( L, L )
-               DA11 = ABS( DBLE( A11 ) ) + ABS( DIMAG( A11 ) )
-               IF( DA11.LE.SMIN ) THEN
-                  A11 = SMIN
-                  DA11 = SMIN
-                  INFO = 1
-               END IF
-               DB = ABS( DBLE( VEC ) ) + ABS( DIMAG( VEC ) )
-               IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
-                  IF( DB.GT.BIGNUM*DA11 )
-     $               SCALOC = ONE / DB
-               END IF
-               X11 = ZLADIV( VEC*DCMPLX( SCALOC ), A11 )
-*
-               IF( SCALOC.NE.ONE ) THEN
-                  DO 10 J = 1, N
-                     CALL ZDSCAL( M, SCALOC, C( 1, J ), 1 )
-   10             CONTINUE
-                  SCALE = SCALE*SCALOC
-               END IF
-               C( K, L ) = X11
-*
-   20       CONTINUE
-   30    CONTINUE
-*
-      ELSE IF( .NOT.NOTRNA .AND. NOTRNB ) THEN
-*
-*        Solve    A' *X + ISGN*X*B = scale*C.
-*
-*        The (K,L)th block of X is determined starting from
-*        upper-left corner column by column by
-*
-*            A'(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
-*
-*        Where
-*                   K-1                         L-1
-*          R(K,L) = SUM [A'(I,K)*X(I,L)] + ISGN*SUM [X(K,J)*B(J,L)]
-*                   I=1                         J=1
-*
-         DO 60 L = 1, N
-            DO 50 K = 1, M
-*
-               SUML = ZDOTC( K-1, A( 1, K ), 1, C( 1, L ), 1 )
-               SUMR = ZDOTU( L-1, C( K, 1 ), LDC, B( 1, L ), 1 )
-               VEC = C( K, L ) - ( SUML+SGN*SUMR )
-*
-               SCALOC = ONE
-               A11 = DCONJG( A( K, K ) ) + SGN*B( L, L )
-               DA11 = ABS( DBLE( A11 ) ) + ABS( DIMAG( A11 ) )
-               IF( DA11.LE.SMIN ) THEN
-                  A11 = SMIN
-                  DA11 = SMIN
-                  INFO = 1
-               END IF
-               DB = ABS( DBLE( VEC ) ) + ABS( DIMAG( VEC ) )
-               IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
-                  IF( DB.GT.BIGNUM*DA11 )
-     $               SCALOC = ONE / DB
-               END IF
-*
-               X11 = ZLADIV( VEC*DCMPLX( SCALOC ), A11 )
-*
-               IF( SCALOC.NE.ONE ) THEN
-                  DO 40 J = 1, N
-                     CALL ZDSCAL( M, SCALOC, C( 1, J ), 1 )
-   40             CONTINUE
-                  SCALE = SCALE*SCALOC
-               END IF
-               C( K, L ) = X11
-*
-   50       CONTINUE
-   60    CONTINUE
-*
-      ELSE IF( .NOT.NOTRNA .AND. .NOT.NOTRNB ) THEN
-*
-*        Solve    A'*X + ISGN*X*B' = C.
-*
-*        The (K,L)th block of X is determined starting from
-*        upper-right corner column by column by
-*
-*            A'(K,K)*X(K,L) + ISGN*X(K,L)*B'(L,L) = C(K,L) - R(K,L)
-*
-*        Where
-*                    K-1
-*           R(K,L) = SUM [A'(I,K)*X(I,L)] +
-*                    I=1
-*                           N
-*                     ISGN*SUM [X(K,J)*B'(L,J)].
-*                          J=L+1
-*
-         DO 90 L = N, 1, -1
-            DO 80 K = 1, M
-*
-               SUML = ZDOTC( K-1, A( 1, K ), 1, C( 1, L ), 1 )
-               SUMR = ZDOTC( N-L, C( K, MIN( L+1, N ) ), LDC,
-     $                B( L, MIN( L+1, N ) ), LDB )
-               VEC = C( K, L ) - ( SUML+SGN*DCONJG( SUMR ) )
-*
-               SCALOC = ONE
-               A11 = DCONJG( A( K, K )+SGN*B( L, L ) )
-               DA11 = ABS( DBLE( A11 ) ) + ABS( DIMAG( A11 ) )
-               IF( DA11.LE.SMIN ) THEN
-                  A11 = SMIN
-                  DA11 = SMIN
-                  INFO = 1
-               END IF
-               DB = ABS( DBLE( VEC ) ) + ABS( DIMAG( VEC ) )
-               IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
-                  IF( DB.GT.BIGNUM*DA11 )
-     $               SCALOC = ONE / DB
-               END IF
-*
-               X11 = ZLADIV( VEC*DCMPLX( SCALOC ), A11 )
-*
-               IF( SCALOC.NE.ONE ) THEN
-                  DO 70 J = 1, N
-                     CALL ZDSCAL( M, SCALOC, C( 1, J ), 1 )
-   70             CONTINUE
-                  SCALE = SCALE*SCALOC
-               END IF
-               C( K, L ) = X11
-*
-   80       CONTINUE
-   90    CONTINUE
-*
-      ELSE IF( NOTRNA .AND. .NOT.NOTRNB ) THEN
-*
-*        Solve    A*X + ISGN*X*B' = C.
-*
-*        The (K,L)th block of X is determined starting from
-*        bottom-left corner column by column by
-*
-*           A(K,K)*X(K,L) + ISGN*X(K,L)*B'(L,L) = C(K,L) - R(K,L)
-*
-*        Where
-*                    M                          N
-*          R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B'(L,J)]
-*                  I=K+1                      J=L+1
-*
-         DO 120 L = N, 1, -1
-            DO 110 K = M, 1, -1
-*
-               SUML = ZDOTU( M-K, A( K, MIN( K+1, M ) ), LDA,
-     $                C( MIN( K+1, M ), L ), 1 )
-               SUMR = ZDOTC( N-L, C( K, MIN( L+1, N ) ), LDC,
-     $                B( L, MIN( L+1, N ) ), LDB )
-               VEC = C( K, L ) - ( SUML+SGN*DCONJG( SUMR ) )
-*
-               SCALOC = ONE
-               A11 = A( K, K ) + SGN*DCONJG( B( L, L ) )
-               DA11 = ABS( DBLE( A11 ) ) + ABS( DIMAG( A11 ) )
-               IF( DA11.LE.SMIN ) THEN
-                  A11 = SMIN
-                  DA11 = SMIN
-                  INFO = 1
-               END IF
-               DB = ABS( DBLE( VEC ) ) + ABS( DIMAG( VEC ) )
-               IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
-                  IF( DB.GT.BIGNUM*DA11 )
-     $               SCALOC = ONE / DB
-               END IF
-*
-               X11 = ZLADIV( VEC*DCMPLX( SCALOC ), A11 )
-*
-               IF( SCALOC.NE.ONE ) THEN
-                  DO 100 J = 1, N
-                     CALL ZDSCAL( M, SCALOC, C( 1, J ), 1 )
-  100             CONTINUE
-                  SCALE = SCALE*SCALOC
-               END IF
-               C( K, L ) = X11
-*
-  110       CONTINUE
-  120    CONTINUE
-*
-      END IF
-*
-      RETURN
-*
-*     End of ZTRSYL
-*
-      END
diff --git a/src/lib/lapack/ztrti2.f b/src/lib/lapack/ztrti2.f
deleted file mode 100644
index 73c7bbc3..00000000
--- a/src/lib/lapack/ztrti2.f
+++ /dev/null
@@ -1,146 +0,0 @@
-      SUBROUTINE ZTRTI2( UPLO, DIAG, N, A, LDA, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIAG, UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTRTI2 computes the inverse of a complex upper or lower triangular
-*  matrix.
-*
-*  This is the Level 2 BLAS version of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          Specifies whether the matrix A is upper or lower triangular.
-*          = 'U':  Upper triangular
-*          = 'L':  Lower triangular
-*
-*  DIAG    (input) CHARACTER*1
-*          Specifies whether or not the matrix A is unit triangular.
-*          = 'N':  Non-unit triangular
-*          = 'U':  Unit triangular
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the triangular matrix A.  If UPLO = 'U', the
-*          leading n by n upper triangular part of the array A contains
-*          the upper triangular matrix, and the strictly lower
-*          triangular part of A is not referenced.  If UPLO = 'L', the
-*          leading n by n lower triangular part of the array A contains
-*          the lower triangular matrix, and the strictly upper
-*          triangular part of A is not referenced.  If DIAG = 'U', the
-*          diagonal elements of A are also not referenced and are
-*          assumed to be 1.
-*
-*          On exit, the (triangular) inverse of the original matrix, in
-*          the same storage format.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -k, the k-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOUNIT, UPPER
-      INTEGER            J
-      COMPLEX*16         AJJ
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZSCAL, ZTRMV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      UPPER = LSAME( UPLO, 'U' )
-      NOUNIT = LSAME( DIAG, 'N' )
-      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, '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.NE.0 ) THEN
-         CALL XERBLA( 'ZTRTI2', -INFO )
-         RETURN
-      END IF
-*
-      IF( UPPER ) THEN
-*
-*        Compute inverse of upper triangular matrix.
-*
-         DO 10 J = 1, N
-            IF( NOUNIT ) THEN
-               A( J, J ) = ONE / A( J, J )
-               AJJ = -A( J, J )
-            ELSE
-               AJJ = -ONE
-            END IF
-*
-*           Compute elements 1:j-1 of j-th column.
-*
-            CALL ZTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
-     $                  A( 1, J ), 1 )
-            CALL ZSCAL( J-1, AJJ, A( 1, J ), 1 )
-   10    CONTINUE
-      ELSE
-*
-*        Compute inverse of lower triangular matrix.
-*
-         DO 20 J = N, 1, -1
-            IF( NOUNIT ) THEN
-               A( J, J ) = ONE / A( J, J )
-               AJJ = -A( J, J )
-            ELSE
-               AJJ = -ONE
-            END IF
-            IF( J.LT.N ) THEN
-*
-*              Compute elements j+1:n of j-th column.
-*
-               CALL ZTRMV( 'Lower', 'No transpose', DIAG, N-J,
-     $                     A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
-               CALL ZSCAL( N-J, AJJ, A( J+1, J ), 1 )
-            END IF
-   20    CONTINUE
-      END IF
-*
-      RETURN
-*
-*     End of ZTRTI2
-*
-      END
diff --git a/src/lib/lapack/ztrtri.f b/src/lib/lapack/ztrtri.f
deleted file mode 100644
index 7caa9771..00000000
--- a/src/lib/lapack/ztrtri.f
+++ /dev/null
@@ -1,177 +0,0 @@
-      SUBROUTINE ZTRTRI( UPLO, DIAG, N, A, LDA, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIAG, UPLO
-      INTEGER            INFO, LDA, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTRTRI computes the inverse of a complex upper or lower triangular
-*  matrix A.
-*
-*  This is the Level 3 BLAS version of the algorithm.
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U':  A is upper triangular;
-*          = 'L':  A is lower triangular.
-*
-*  DIAG    (input) CHARACTER*1
-*          = 'N':  A is non-unit triangular;
-*          = 'U':  A is unit triangular.
-*
-*  N       (input) INTEGER
-*          The order of the matrix A.  N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the triangular matrix A.  If UPLO = 'U', the
-*          leading N-by-N upper triangular part of the array A contains
-*          the upper triangular matrix, and the strictly lower
-*          triangular part of A is not referenced.  If UPLO = 'L', the
-*          leading N-by-N lower triangular part of the array A contains
-*          the lower triangular matrix, and the strictly upper
-*          triangular part of A is not referenced.  If DIAG = 'U', the
-*          diagonal elements of A are also not referenced and are
-*          assumed to be 1.
-*          On exit, the (triangular) inverse of the original matrix, in
-*          the same storage format.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,N).
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*          > 0: if INFO = i, A(i,i) is exactly zero.  The triangular
-*               matrix is singular and its inverse can not be computed.
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE, ZERO
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
-     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            NOUNIT, UPPER
-      INTEGER            J, JB, NB, NN
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZTRMM, ZTRSM, ZTRTI2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input parameters.
-*
-      INFO = 0
-      UPPER = LSAME( UPLO, 'U' )
-      NOUNIT = LSAME( DIAG, 'N' )
-      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, '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.NE.0 ) THEN
-         CALL XERBLA( 'ZTRTRI', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-*
-*     Check for singularity if non-unit.
-*
-      IF( NOUNIT ) THEN
-         DO 10 INFO = 1, N
-            IF( A( INFO, INFO ).EQ.ZERO )
-     $         RETURN
-   10    CONTINUE
-         INFO = 0
-      END IF
-*
-*     Determine the block size for this environment.
-*
-      NB = ILAENV( 1, 'ZTRTRI', UPLO // DIAG, N, -1, -1, -1 )
-      IF( NB.LE.1 .OR. NB.GE.N ) THEN
-*
-*        Use unblocked code
-*
-         CALL ZTRTI2( UPLO, DIAG, N, A, LDA, INFO )
-      ELSE
-*
-*        Use blocked code
-*
-         IF( UPPER ) THEN
-*
-*           Compute inverse of upper triangular matrix
-*
-            DO 20 J = 1, N, NB
-               JB = MIN( NB, N-J+1 )
-*
-*              Compute rows 1:j-1 of current block column
-*
-               CALL ZTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1,
-     $                     JB, ONE, A, LDA, A( 1, J ), LDA )
-               CALL ZTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1,
-     $                     JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA )
-*
-*              Compute inverse of current diagonal block
-*
-               CALL ZTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO )
-   20       CONTINUE
-         ELSE
-*
-*           Compute inverse of lower triangular matrix
-*
-            NN = ( ( N-1 ) / NB )*NB + 1
-            DO 30 J = NN, 1, -NB
-               JB = MIN( NB, N-J+1 )
-               IF( J+JB.LE.N ) THEN
-*
-*                 Compute rows j+jb:n of current block column
-*
-                  CALL ZTRMM( 'Left', 'Lower', 'No transpose', DIAG,
-     $                        N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA,
-     $                        A( J+JB, J ), LDA )
-                  CALL ZTRSM( 'Right', 'Lower', 'No transpose', DIAG,
-     $                        N-J-JB+1, JB, -ONE, A( J, J ), LDA,
-     $                        A( J+JB, J ), LDA )
-               END IF
-*
-*              Compute inverse of current diagonal block
-*
-               CALL ZTRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO )
-   30       CONTINUE
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of ZTRTRI
-*
-      END
diff --git a/src/lib/lapack/ztzrzf.f b/src/lib/lapack/ztzrzf.f
deleted file mode 100644
index 5c9c6543..00000000
--- a/src/lib/lapack/ztzrzf.f
+++ /dev/null
@@ -1,244 +0,0 @@
-      SUBROUTINE ZTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZTZRZF reduces the M-by-N ( M<=N ) complex upper trapezoidal matrix A
-*  to upper triangular form by means of unitary transformations.
-*
-*  The upper trapezoidal matrix A is factored as
-*
-*     A = ( R  0 ) * Z,
-*
-*  where Z is an N-by-N unitary matrix and R is an M-by-M upper
-*  triangular matrix.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix A.  M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix A.  N >= M.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the leading M-by-N upper trapezoidal part of the
-*          array A must contain the matrix to be factorized.
-*          On exit, the leading M-by-M upper triangular part of A
-*          contains the upper triangular matrix R, and elements M+1 to
-*          N of the first M rows of A, with the array TAU, represent the
-*          unitary matrix Z as a product of M elementary reflectors.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.  LDA >= max(1,M).
-*
-*  TAU     (output) COMPLEX*16 array, dimension (M)
-*          The scalar factors of the elementary reflectors.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.  LWORK >= max(1,M).
-*          For optimum performance LWORK >= M*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  The factorization is obtained by Householder's method.  The kth
-*  transformation matrix, Z( k ), which is used to introduce zeros into
-*  the ( m - k + 1 )th row of A, is given in the form
-*
-*     Z( k ) = ( I     0   ),
-*              ( 0  T( k ) )
-*
-*  where
-*
-*     T( k ) = I - tau*u( k )*u( k )',   u( k ) = (   1    ),
-*                                                 (   0    )
-*                                                 ( z( k ) )
-*
-*  tau is a scalar and z( k ) is an ( n - m ) element vector.
-*  tau and z( k ) are chosen to annihilate the elements of the kth row
-*  of X.
-*
-*  The scalar tau is returned in the kth element of TAU and the vector
-*  u( k ) in the kth row of A, such that the elements of z( k ) are
-*  in  a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
-*  the upper triangular part of A.
-*
-*  Z is given by
-*
-*     Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IWS, KI, KK, LDWORK, LWKOPT, M1, MU, NB,
-     $                   NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARZB, ZLARZT, ZLATRZ
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.M ) THEN
-         INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -4
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( M.EQ.0 .OR. M.EQ.N ) THEN
-            LWKOPT = 1
-         ELSE
-*
-*           Determine the block size.
-*
-            NB = ILAENV( 1, 'ZGERQF', ' ', M, N, -1, -1 )
-            LWKOPT = M*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
-            INFO = -7
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZTZRZF', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 ) THEN
-         RETURN
-      ELSE IF( M.EQ.N ) THEN
-         DO 10 I = 1, N
-            TAU( I ) = ZERO
-   10    CONTINUE
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 1
-      IWS = M
-      IF( NB.GT.1 .AND. NB.LT.M ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'ZGERQF', ' ', M, N, -1, -1 ) )
-         IF( NX.LT.M ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = M
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'ZGERQF', ' ', M, N, -1,
-     $                 -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.M .AND. NX.LT.M ) THEN
-*
-*        Use blocked code initially.
-*        The last kk rows are handled by the block method.
-*
-         M1 = MIN( M+1, N )
-         KI = ( ( M-NX-1 ) / NB )*NB
-         KK = MIN( M, KI+NB )
-*
-         DO 20 I = M - KK + KI + 1, M - KK + 1, -NB
-            IB = MIN( M-I+1, NB )
-*
-*           Compute the TZ factorization of the current block
-*           A(i:i+ib-1,i:n)
-*
-            CALL ZLATRZ( IB, N-I+1, N-M, A( I, I ), LDA, TAU( I ),
-     $                   WORK )
-            IF( I.GT.1 ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i+ib-1) . . . H(i+1) H(i)
-*
-               CALL ZLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, M1 ),
-     $                      LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H to A(1:i-1,i:n) from the right
-*
-               CALL ZLARZB( 'Right', 'No transpose', 'Backward',
-     $                      'Rowwise', I-1, N-I+1, IB, N-M, A( I, M1 ),
-     $                      LDA, WORK, LDWORK, A( 1, I ), LDA,
-     $                      WORK( IB+1 ), LDWORK )
-            END IF
-   20    CONTINUE
-         MU = I + NB - 1
-      ELSE
-         MU = M
-      END IF
-*
-*     Use unblocked code to factor the last or only block
-*
-      IF( MU.GT.0 )
-     $   CALL ZLATRZ( MU, N, N-M, A, LDA, TAU, WORK )
-*
-      WORK( 1 ) = LWKOPT
-*
-      RETURN
-*
-*     End of ZTZRZF
-*
-      END
diff --git a/src/lib/lapack/zung2l.f b/src/lib/lapack/zung2l.f
deleted file mode 100644
index 29178b90..00000000
--- a/src/lib/lapack/zung2l.f
+++ /dev/null
@@ -1,128 +0,0 @@
-      SUBROUTINE ZUNG2L( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNG2L generates an m by n complex matrix Q with orthonormal columns,
-*  which is defined as the last n columns of a product of k elementary
-*  reflectors of order m
-*
-*        Q  =  H(k) . . . H(2) H(1)
-*
-*  as returned by ZGEQLF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. M >= N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. N >= K >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the (n-k+i)-th column must contain the vector which
-*          defines the elementary reflector H(i), for i = 1,2,...,k, as
-*          returned by ZGEQLF in the last k columns of its array
-*          argument A.
-*          On exit, the m-by-n matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGEQLF.
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE, ZERO
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
-     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, II, J, L
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF, ZSCAL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNG2L', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-*     Initialise columns 1:n-k to columns of the unit matrix
-*
-      DO 20 J = 1, N - K
-         DO 10 L = 1, M
-            A( L, J ) = ZERO
-   10    CONTINUE
-         A( M-N+J, J ) = ONE
-   20 CONTINUE
-*
-      DO 40 I = 1, K
-         II = N - K + I
-*
-*        Apply H(i) to A(1:m-k+i,1:n-k+i) from the left
-*
-         A( M-N+II, II ) = ONE
-         CALL ZLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A,
-     $               LDA, WORK )
-         CALL ZSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 )
-         A( M-N+II, II ) = ONE - TAU( I )
-*
-*        Set A(m-k+i+1:m,n-k+i) to zero
-*
-         DO 30 L = M - N + II + 1, M
-            A( L, II ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-      RETURN
-*
-*     End of ZUNG2L
-*
-      END
diff --git a/src/lib/lapack/zung2r.f b/src/lib/lapack/zung2r.f
deleted file mode 100644
index cd89f26e..00000000
--- a/src/lib/lapack/zung2r.f
+++ /dev/null
@@ -1,130 +0,0 @@
-      SUBROUTINE ZUNG2R( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNG2R generates an m by n complex matrix Q with orthonormal columns,
-*  which is defined as the first n columns of a product of k elementary
-*  reflectors of order m
-*
-*        Q  =  H(1) H(2) . . . H(k)
-*
-*  as returned by ZGEQRF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. M >= N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. N >= K >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the i-th column must contain the vector which
-*          defines the elementary reflector H(i), for i = 1,2,...,k, as
-*          returned by ZGEQRF in the first k columns of its array
-*          argument A.
-*          On exit, the m by n matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGEQRF.
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (N)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE, ZERO
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
-     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J, L
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF, ZSCAL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNG2R', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 )
-     $   RETURN
-*
-*     Initialise columns k+1:n to columns of the unit matrix
-*
-      DO 20 J = K + 1, N
-         DO 10 L = 1, M
-            A( L, J ) = ZERO
-   10    CONTINUE
-         A( J, J ) = ONE
-   20 CONTINUE
-*
-      DO 40 I = K, 1, -1
-*
-*        Apply H(i) to A(i:m,i:n) from the left
-*
-         IF( I.LT.N ) THEN
-            A( I, I ) = ONE
-            CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
-     $                  A( I, I+1 ), LDA, WORK )
-         END IF
-         IF( I.LT.M )
-     $      CALL ZSCAL( M-I, -TAU( I ), A( I+1, I ), 1 )
-         A( I, I ) = ONE - TAU( I )
-*
-*        Set A(1:i-1,i) to zero
-*
-         DO 30 L = 1, I - 1
-            A( L, I ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-      RETURN
-*
-*     End of ZUNG2R
-*
-      END
diff --git a/src/lib/lapack/zungbr.f b/src/lib/lapack/zungbr.f
deleted file mode 100644
index 94f74820..00000000
--- a/src/lib/lapack/zungbr.f
+++ /dev/null
@@ -1,245 +0,0 @@
-      SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          VECT
-      INTEGER            INFO, K, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNGBR generates one of the complex unitary matrices Q or P**H
-*  determined by ZGEBRD when reducing a complex matrix A to bidiagonal
-*  form: A = Q * B * P**H.  Q and P**H are defined as products of
-*  elementary reflectors H(i) or G(i) respectively.
-*
-*  If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
-*  is of order M:
-*  if m >= k, Q = H(1) H(2) . . . H(k) and ZUNGBR returns the first n
-*  columns of Q, where m >= n >= k;
-*  if m < k, Q = H(1) H(2) . . . H(m-1) and ZUNGBR returns Q as an
-*  M-by-M matrix.
-*
-*  If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H
-*  is of order N:
-*  if k < n, P**H = G(k) . . . G(2) G(1) and ZUNGBR returns the first m
-*  rows of P**H, where n >= m >= k;
-*  if k >= n, P**H = G(n-1) . . . G(2) G(1) and ZUNGBR returns P**H as
-*  an N-by-N matrix.
-*
-*  Arguments
-*  =========
-*
-*  VECT    (input) CHARACTER*1
-*          Specifies whether the matrix Q or the matrix P**H is
-*          required, as defined in the transformation applied by ZGEBRD:
-*          = 'Q':  generate Q;
-*          = 'P':  generate P**H.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q or P**H to be returned.
-*          M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q or P**H to be returned.
-*          N >= 0.
-*          If VECT = 'Q', M >= N >= min(M,K);
-*          if VECT = 'P', N >= M >= min(N,K).
-*
-*  K       (input) INTEGER
-*          If VECT = 'Q', the number of columns in the original M-by-K
-*          matrix reduced by ZGEBRD.
-*          If VECT = 'P', the number of rows in the original K-by-N
-*          matrix reduced by ZGEBRD.
-*          K >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the vectors which define the elementary reflectors,
-*          as returned by ZGEBRD.
-*          On exit, the M-by-N matrix Q or P**H.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= M.
-*
-*  TAU     (input) COMPLEX*16 array, dimension
-*                                (min(M,K)) if VECT = 'Q'
-*                                (min(N,K)) if VECT = 'P'
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i) or G(i), which determines Q or P**H, as
-*          returned by ZGEBRD in its array argument TAUQ or TAUP.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= max(1,min(M,N)).
-*          For optimum performance LWORK >= min(M,N)*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, WANTQ
-      INTEGER            I, IINFO, J, LWKOPT, MN, NB
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZUNGLQ, ZUNGQR
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      WANTQ = LSAME( VECT, 'Q' )
-      MN = MIN( M, N )
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
-         INFO = -1
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -2
-      ELSE IF( N.LT.0 .OR. ( WANTQ .AND. ( N.GT.M .OR. N.LT.MIN( M,
-     $         K ) ) ) .OR. ( .NOT.WANTQ .AND. ( M.GT.N .OR. M.LT.
-     $         MIN( N, K ) ) ) ) THEN
-         INFO = -3
-      ELSE IF( K.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -6
-      ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
-         INFO = -9
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( WANTQ ) THEN
-            NB = ILAENV( 1, 'ZUNGQR', ' ', M, N, K, -1 )
-         ELSE
-            NB = ILAENV( 1, 'ZUNGLQ', ' ', M, N, K, -1 )
-         END IF
-         LWKOPT = MAX( 1, MN )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNGBR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      IF( WANTQ ) THEN
-*
-*        Form Q, determined by a call to ZGEBRD to reduce an m-by-k
-*        matrix
-*
-         IF( M.GE.K ) THEN
-*
-*           If m >= k, assume m >= n >= k
-*
-            CALL ZUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
-*
-         ELSE
-*
-*           If m < k, assume m = n
-*
-*           Shift the vectors which define the elementary reflectors one
-*           column to the right, and set the first row and column of Q
-*           to those of the unit matrix
-*
-            DO 20 J = M, 2, -1
-               A( 1, J ) = ZERO
-               DO 10 I = J + 1, M
-                  A( I, J ) = A( I, J-1 )
-   10          CONTINUE
-   20       CONTINUE
-            A( 1, 1 ) = ONE
-            DO 30 I = 2, M
-               A( I, 1 ) = ZERO
-   30       CONTINUE
-            IF( M.GT.1 ) THEN
-*
-*              Form Q(2:m,2:m)
-*
-               CALL ZUNGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
-     $                      LWORK, IINFO )
-            END IF
-         END IF
-      ELSE
-*
-*        Form P', determined by a call to ZGEBRD to reduce a k-by-n
-*        matrix
-*
-         IF( K.LT.N ) THEN
-*
-*           If k < n, assume k <= m <= n
-*
-            CALL ZUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
-*
-         ELSE
-*
-*           If k >= n, assume m = n
-*
-*           Shift the vectors which define the elementary reflectors one
-*           row downward, and set the first row and column of P' to
-*           those of the unit matrix
-*
-            A( 1, 1 ) = ONE
-            DO 40 I = 2, N
-               A( I, 1 ) = ZERO
-   40       CONTINUE
-            DO 60 J = 2, N
-               DO 50 I = J - 1, 2, -1
-                  A( I, J ) = A( I-1, J )
-   50          CONTINUE
-               A( 1, J ) = ZERO
-   60       CONTINUE
-            IF( N.GT.1 ) THEN
-*
-*              Form P'(2:n,2:n)
-*
-               CALL ZUNGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
-     $                      LWORK, IINFO )
-            END IF
-         END IF
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of ZUNGBR
-*
-      END
diff --git a/src/lib/lapack/zunghr.f b/src/lib/lapack/zunghr.f
deleted file mode 100644
index fcf32abf..00000000
--- a/src/lib/lapack/zunghr.f
+++ /dev/null
@@ -1,165 +0,0 @@
-      SUBROUTINE ZUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, ILO, INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNGHR generates a complex unitary matrix Q which is defined as the
-*  product of IHI-ILO elementary reflectors of order N, as returned by
-*  ZGEHRD:
-*
-*  Q = H(ilo) H(ilo+1) . . . H(ihi-1).
-*
-*  Arguments
-*  =========
-*
-*  N       (input) INTEGER
-*          The order of the matrix Q. N >= 0.
-*
-*  ILO     (input) INTEGER
-*  IHI     (input) INTEGER
-*          ILO and IHI must have the same values as in the previous call
-*          of ZGEHRD. Q is equal to the unit matrix except in the
-*          submatrix Q(ilo+1:ihi,ilo+1:ihi).
-*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the vectors which define the elementary reflectors,
-*          as returned by ZGEHRD.
-*          On exit, the N-by-N unitary matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,N).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (N-1)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGEHRD.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= IHI-ILO.
-*          For optimum performance LWORK >= (IHI-ILO)*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IINFO, J, LWKOPT, NB, NH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZUNGQR
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NH = IHI - ILO
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( N.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
-         INFO = -2
-      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
-         INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
-         INFO = -8
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         NB = ILAENV( 1, 'ZUNGQR', ' ', NH, NH, NH, -1 )
-         LWKOPT = MAX( 1, NH )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNGHR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-*     Shift the vectors which define the elementary reflectors one
-*     column to the right, and set the first ilo and the last n-ihi
-*     rows and columns to those of the unit matrix
-*
-      DO 40 J = IHI, ILO + 1, -1
-         DO 10 I = 1, J - 1
-            A( I, J ) = ZERO
-   10    CONTINUE
-         DO 20 I = J + 1, IHI
-            A( I, J ) = A( I, J-1 )
-   20    CONTINUE
-         DO 30 I = IHI + 1, N
-            A( I, J ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-      DO 60 J = 1, ILO
-         DO 50 I = 1, N
-            A( I, J ) = ZERO
-   50    CONTINUE
-         A( J, J ) = ONE
-   60 CONTINUE
-      DO 80 J = IHI + 1, N
-         DO 70 I = 1, N
-            A( I, J ) = ZERO
-   70    CONTINUE
-         A( J, J ) = ONE
-   80 CONTINUE
-*
-      IF( NH.GT.0 ) THEN
-*
-*        Generate Q(ilo+1:ihi,ilo+1:ihi)
-*
-         CALL ZUNGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
-     $                WORK, LWORK, IINFO )
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of ZUNGHR
-*
-      END
diff --git a/src/lib/lapack/zungl2.f b/src/lib/lapack/zungl2.f
deleted file mode 100644
index 502411b4..00000000
--- a/src/lib/lapack/zungl2.f
+++ /dev/null
@@ -1,136 +0,0 @@
-      SUBROUTINE ZUNGL2( M, N, K, A, LDA, TAU, WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNGL2 generates an m-by-n complex matrix Q with orthonormal rows,
-*  which is defined as the first m rows of a product of k elementary
-*  reflectors of order n
-*
-*        Q  =  H(k)' . . . H(2)' H(1)'
-*
-*  as returned by ZGELQF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. N >= M.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. M >= K >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the i-th row must contain the vector which defines
-*          the elementary reflector H(i), for i = 1,2,...,k, as returned
-*          by ZGELQF in the first k rows of its array argument A.
-*          On exit, the m by n matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGELQF.
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension (M)
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE, ZERO
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
-     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      INTEGER            I, J, L
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACGV, ZLARF, ZSCAL
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNGL2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 )
-     $   RETURN
-*
-      IF( K.LT.M ) THEN
-*
-*        Initialise rows k+1:m to rows of the unit matrix
-*
-         DO 20 J = 1, N
-            DO 10 L = K + 1, M
-               A( L, J ) = ZERO
-   10       CONTINUE
-            IF( J.GT.K .AND. J.LE.M )
-     $         A( J, J ) = ONE
-   20    CONTINUE
-      END IF
-*
-      DO 40 I = K, 1, -1
-*
-*        Apply H(i)' to A(i:m,i:n) from the right
-*
-         IF( I.LT.N ) THEN
-            CALL ZLACGV( N-I, A( I, I+1 ), LDA )
-            IF( I.LT.M ) THEN
-               A( I, I ) = ONE
-               CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
-     $                     DCONJG( TAU( I ) ), A( I+1, I ), LDA, WORK )
-            END IF
-            CALL ZSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA )
-            CALL ZLACGV( N-I, A( I, I+1 ), LDA )
-         END IF
-         A( I, I ) = ONE - DCONJG( TAU( I ) )
-*
-*        Set A(i,1:i-1) to zero
-*
-         DO 30 L = 1, I - 1
-            A( I, L ) = ZERO
-   30    CONTINUE
-   40 CONTINUE
-      RETURN
-*
-*     End of ZUNGL2
-*
-      END
diff --git a/src/lib/lapack/zunglq.f b/src/lib/lapack/zunglq.f
deleted file mode 100644
index ab4a018f..00000000
--- a/src/lib/lapack/zunglq.f
+++ /dev/null
@@ -1,215 +0,0 @@
-      SUBROUTINE ZUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNGLQ generates an M-by-N complex matrix Q with orthonormal rows,
-*  which is defined as the first M rows of a product of K elementary
-*  reflectors of order N
-*
-*        Q  =  H(k)' . . . H(2)' H(1)'
-*
-*  as returned by ZGELQF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. N >= M.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. M >= K >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the i-th row must contain the vector which defines
-*          the elementary reflector H(i), for i = 1,2,...,k, as returned
-*          by ZGELQF in the first k rows of its array argument A.
-*          On exit, the M-by-N matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGELQF.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= max(1,M).
-*          For optimum performance LWORK >= M*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit;
-*          < 0:  if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
-     $                   LWKOPT, NB, NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNGL2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NB = ILAENV( 1, 'ZUNGLQ', ' ', M, N, K, -1 )
-      LWKOPT = MAX( 1, M )*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
-         INFO = -8
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNGLQ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = M
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'ZUNGLQ', ' ', M, N, K, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = M
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGLQ', ' ', M, N, K, -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code after the last block.
-*        The first kk rows are handled by the block method.
-*
-         KI = ( ( K-NX-1 ) / NB )*NB
-         KK = MIN( K, KI+NB )
-*
-*        Set A(kk+1:m,1:kk) to zero.
-*
-         DO 20 J = 1, KK
-            DO 10 I = KK + 1, M
-               A( I, J ) = ZERO
-   10       CONTINUE
-   20    CONTINUE
-      ELSE
-         KK = 0
-      END IF
-*
-*     Use unblocked code for the last or only block.
-*
-      IF( KK.LT.M )
-     $   CALL ZUNGL2( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
-     $                TAU( KK+1 ), WORK, IINFO )
-*
-      IF( KK.GT.0 ) THEN
-*
-*        Use blocked code
-*
-         DO 50 I = KI + 1, 1, -NB
-            IB = MIN( NB, K-I+1 )
-            IF( I+IB.LE.M ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i) H(i+1) . . . H(i+ib-1)
-*
-               CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
-     $                      LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H' to A(i+ib:m,i:n) from the right
-*
-               CALL ZLARFB( 'Right', 'Conjugate transpose', 'Forward',
-     $                      'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ),
-     $                      LDA, WORK, LDWORK, A( I+IB, I ), LDA,
-     $                      WORK( IB+1 ), LDWORK )
-            END IF
-*
-*           Apply H' to columns i:n of current block
-*
-            CALL ZUNGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
-     $                   IINFO )
-*
-*           Set columns 1:i-1 of current block to zero
-*
-            DO 40 J = 1, I - 1
-               DO 30 L = I, I + IB - 1
-                  A( L, J ) = ZERO
-   30          CONTINUE
-   40       CONTINUE
-   50    CONTINUE
-      END IF
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of ZUNGLQ
-*
-      END
diff --git a/src/lib/lapack/zungql.f b/src/lib/lapack/zungql.f
deleted file mode 100644
index 4232abea..00000000
--- a/src/lib/lapack/zungql.f
+++ /dev/null
@@ -1,222 +0,0 @@
-      SUBROUTINE ZUNGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNGQL generates an M-by-N complex matrix Q with orthonormal columns,
-*  which is defined as the last N columns of a product of K elementary
-*  reflectors of order M
-*
-*        Q  =  H(k) . . . H(2) H(1)
-*
-*  as returned by ZGEQLF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. M >= N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. N >= K >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the (n-k+i)-th column must contain the vector which
-*          defines the elementary reflector H(i), for i = 1,2,...,k, as
-*          returned by ZGEQLF in the last k columns of its array
-*          argument A.
-*          On exit, the M-by-N matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGEQLF.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= max(1,N).
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
-     $                   NB, NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNG2L
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( N.EQ.0 ) THEN
-            LWKOPT = 1
-         ELSE
-            NB = ILAENV( 1, 'ZUNGQL', ' ', M, N, K, -1 )
-            LWKOPT = N*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-            INFO = -8
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNGQL', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 ) THEN
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = N
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'ZUNGQL', ' ', M, N, K, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = N
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQL', ' ', M, N, K, -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code after the first block.
-*        The last kk columns are handled by the block method.
-*
-         KK = MIN( K, ( ( K-NX+NB-1 ) / NB )*NB )
-*
-*        Set A(m-kk+1:m,1:n-kk) to zero.
-*
-         DO 20 J = 1, N - KK
-            DO 10 I = M - KK + 1, M
-               A( I, J ) = ZERO
-   10       CONTINUE
-   20    CONTINUE
-      ELSE
-         KK = 0
-      END IF
-*
-*     Use unblocked code for the first or only block.
-*
-      CALL ZUNG2L( M-KK, N-KK, K-KK, A, LDA, TAU, WORK, IINFO )
-*
-      IF( KK.GT.0 ) THEN
-*
-*        Use blocked code
-*
-         DO 50 I = K - KK + 1, K, NB
-            IB = MIN( NB, K-I+1 )
-            IF( N-K+I.GT.1 ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i+ib-1) . . . H(i+1) H(i)
-*
-               CALL ZLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
-     $                      A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
-*
-               CALL ZLARFB( 'Left', 'No transpose', 'Backward',
-     $                      'Columnwise', M-K+I+IB-1, N-K+I-1, IB,
-     $                      A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA,
-     $                      WORK( IB+1 ), LDWORK )
-            END IF
-*
-*           Apply H to rows 1:m-k+i+ib-1 of current block
-*
-            CALL ZUNG2L( M-K+I+IB-1, IB, IB, A( 1, N-K+I ), LDA,
-     $                   TAU( I ), WORK, IINFO )
-*
-*           Set rows m-k+i+ib:m of current block to zero
-*
-            DO 40 J = N - K + I, N - K + I + IB - 1
-               DO 30 L = M - K + I + IB, M
-                  A( L, J ) = ZERO
-   30          CONTINUE
-   40       CONTINUE
-   50    CONTINUE
-      END IF
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of ZUNGQL
-*
-      END
diff --git a/src/lib/lapack/zungqr.f b/src/lib/lapack/zungqr.f
deleted file mode 100644
index bf5c6997..00000000
--- a/src/lib/lapack/zungqr.f
+++ /dev/null
@@ -1,216 +0,0 @@
-      SUBROUTINE ZUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            INFO, K, LDA, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNGQR generates an M-by-N complex matrix Q with orthonormal columns,
-*  which is defined as the first N columns of a product of K elementary
-*  reflectors of order M
-*
-*        Q  =  H(1) H(2) . . . H(k)
-*
-*  as returned by ZGEQRF.
-*
-*  Arguments
-*  =========
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix Q. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix Q. M >= N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines the
-*          matrix Q. N >= K >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the i-th column must contain the vector which
-*          defines the elementary reflector H(i), for i = 1,2,...,k, as
-*          returned by ZGEQRF in the first k columns of its array
-*          argument A.
-*          On exit, the M-by-N matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The first dimension of the array A. LDA >= max(1,M).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGEQRF.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= max(1,N).
-*          For optimum performance LWORK >= N*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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument has an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY
-      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
-     $                   LWKOPT, NB, NBMIN, NX
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNG2R
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. External Functions ..
-      INTEGER            ILAENV
-      EXTERNAL           ILAENV
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      NB = ILAENV( 1, 'ZUNGQR', ' ', M, N, K, -1 )
-      LWKOPT = MAX( 1, N )*NB
-      WORK( 1 ) = LWKOPT
-      LQUERY = ( LWORK.EQ.-1 )
-      IF( M.LT.0 ) THEN
-         INFO = -1
-      ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
-         INFO = -2
-      ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
-         INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
-         INFO = -5
-      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
-         INFO = -8
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNGQR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.LE.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      NX = 0
-      IWS = N
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-*
-*        Determine when to cross over from blocked to unblocked code.
-*
-         NX = MAX( 0, ILAENV( 3, 'ZUNGQR', ' ', M, N, K, -1 ) )
-         IF( NX.LT.K ) THEN
-*
-*           Determine if workspace is large enough for blocked code.
-*
-            LDWORK = N
-            IWS = LDWORK*NB
-            IF( LWORK.LT.IWS ) THEN
-*
-*              Not enough workspace to use optimal NB:  reduce NB and
-*              determine the minimum value of NB.
-*
-               NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQR', ' ', M, N, K, -1 ) )
-            END IF
-         END IF
-      END IF
-*
-      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
-*
-*        Use blocked code after the last block.
-*        The first kk columns are handled by the block method.
-*
-         KI = ( ( K-NX-1 ) / NB )*NB
-         KK = MIN( K, KI+NB )
-*
-*        Set A(1:kk,kk+1:n) to zero.
-*
-         DO 20 J = KK + 1, N
-            DO 10 I = 1, KK
-               A( I, J ) = ZERO
-   10       CONTINUE
-   20    CONTINUE
-      ELSE
-         KK = 0
-      END IF
-*
-*     Use unblocked code for the last or only block.
-*
-      IF( KK.LT.N )
-     $   CALL ZUNG2R( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
-     $                TAU( KK+1 ), WORK, IINFO )
-*
-      IF( KK.GT.0 ) THEN
-*
-*        Use blocked code
-*
-         DO 50 I = KI + 1, 1, -NB
-            IB = MIN( NB, K-I+1 )
-            IF( I+IB.LE.N ) THEN
-*
-*              Form the triangular factor of the block reflector
-*              H = H(i) H(i+1) . . . H(i+ib-1)
-*
-               CALL ZLARFT( 'Forward', 'Columnwise', M-I+1, IB,
-     $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
-*
-*              Apply H to A(i:m,i+ib:n) from the left
-*
-               CALL ZLARFB( 'Left', 'No transpose', 'Forward',
-     $                      'Columnwise', M-I+1, N-I-IB+1, IB,
-     $                      A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
-     $                      LDA, WORK( IB+1 ), LDWORK )
-            END IF
-*
-*           Apply H to rows i:m of current block
-*
-            CALL ZUNG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK,
-     $                   IINFO )
-*
-*           Set rows 1:i-1 of current block to zero
-*
-            DO 40 J = I, I + IB - 1
-               DO 30 L = 1, I - 1
-                  A( L, J ) = ZERO
-   30          CONTINUE
-   40       CONTINUE
-   50    CONTINUE
-      END IF
-*
-      WORK( 1 ) = IWS
-      RETURN
-*
-*     End of ZUNGQR
-*
-      END
diff --git a/src/lib/lapack/zungtr.f b/src/lib/lapack/zungtr.f
deleted file mode 100644
index 5de7c109..00000000
--- a/src/lib/lapack/zungtr.f
+++ /dev/null
@@ -1,184 +0,0 @@
-      SUBROUTINE ZUNGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          UPLO
-      INTEGER            INFO, LDA, LWORK, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNGTR generates a complex unitary matrix Q which is defined as the
-*  product of n-1 elementary reflectors of order N, as returned by
-*  ZHETRD:
-*
-*  if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
-*
-*  if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
-*
-*  Arguments
-*  =========
-*
-*  UPLO    (input) CHARACTER*1
-*          = 'U': Upper triangle of A contains elementary reflectors
-*                 from ZHETRD;
-*          = 'L': Lower triangle of A contains elementary reflectors
-*                 from ZHETRD.
-*
-*  N       (input) INTEGER
-*          The order of the matrix Q. N >= 0.
-*
-*  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
-*          On entry, the vectors which define the elementary reflectors,
-*          as returned by ZHETRD.
-*          On exit, the N-by-N unitary matrix Q.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= N.
-*
-*  TAU     (input) COMPLEX*16 array, dimension (N-1)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZHETRD.
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK. LWORK >= N-1.
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
-     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LQUERY, UPPER
-      INTEGER            I, IINFO, J, LWKOPT, NB
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZUNGQL, ZUNGQR
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LQUERY = ( LWORK.EQ.-1 )
-      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( LWORK.LT.MAX( 1, N-1 ) .AND. .NOT.LQUERY ) THEN
-         INFO = -7
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( UPPER ) THEN
-            NB = ILAENV( 1, 'ZUNGQL', ' ', N-1, N-1, N-1, -1 )
-         ELSE
-            NB = ILAENV( 1, 'ZUNGQR', ' ', N-1, N-1, N-1, -1 )
-         END IF
-         LWKOPT = MAX( 1, N-1 )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNGTR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      IF( UPPER ) THEN
-*
-*        Q was determined by a call to ZHETRD with UPLO = 'U'
-*
-*        Shift the vectors which define the elementary reflectors one
-*        column to the left, and set the last row and column of Q to
-*        those of the unit matrix
-*
-         DO 20 J = 1, N - 1
-            DO 10 I = 1, J - 1
-               A( I, J ) = A( I, J+1 )
-   10       CONTINUE
-            A( N, J ) = ZERO
-   20    CONTINUE
-         DO 30 I = 1, N - 1
-            A( I, N ) = ZERO
-   30    CONTINUE
-         A( N, N ) = ONE
-*
-*        Generate Q(1:n-1,1:n-1)
-*
-         CALL ZUNGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO )
-*
-      ELSE
-*
-*        Q was determined by a call to ZHETRD with UPLO = 'L'.
-*
-*        Shift the vectors which define the elementary reflectors one
-*        column to the right, and set the first row and column of Q to
-*        those of the unit matrix
-*
-         DO 50 J = N, 2, -1
-            A( 1, J ) = ZERO
-            DO 40 I = J + 1, N
-               A( I, J ) = A( I, J-1 )
-   40       CONTINUE
-   50    CONTINUE
-         A( 1, 1 ) = ONE
-         DO 60 I = 2, N
-            A( I, 1 ) = ZERO
-   60    CONTINUE
-         IF( N.GT.1 ) THEN
-*
-*           Generate Q(2:n,2:n)
-*
-            CALL ZUNGQR( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
-     $                   LWORK, IINFO )
-         END IF
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of ZUNGTR
-*
-      END
diff --git a/src/lib/lapack/zunm2r.f b/src/lib/lapack/zunm2r.f
deleted file mode 100644
index 7d4c067a..00000000
--- a/src/lib/lapack/zunm2r.f
+++ /dev/null
@@ -1,201 +0,0 @@
-      SUBROUTINE ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNM2R overwrites the general complex m-by-n matrix C with
-*
-*        Q * C  if SIDE = 'L' and TRANS = 'N', or
-*
-*        Q'* C  if SIDE = 'L' and TRANS = 'C', or
-*
-*        C * Q  if SIDE = 'R' and TRANS = 'N', or
-*
-*        C * Q' if SIDE = 'R' and TRANS = 'C',
-*
-*  where Q is a complex unitary matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(1) H(2) . . . H(k)
-*
-*  as returned by ZGEQRF. Q is of order m if SIDE = 'L' and of order n
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q' from the Left
-*          = 'R': apply Q or Q' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply Q  (No transpose)
-*          = 'C': apply Q' (Conjugate transpose)
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA,K)
-*          The i-th column must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          ZGEQRF in the first k columns of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*          If SIDE = 'L', LDA >= max(1,M);
-*          if SIDE = 'R', LDA >= max(1,N).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGEQRF.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the m-by-n matrix C.
-*          On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension
-*                                   (N) if SIDE = 'L',
-*                                   (M) if SIDE = 'R'
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
-      INTEGER            I, I1, I2, I3, IC, JC, MI, NI, NQ
-      COMPLEX*16         AII, TAUI
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-*
-*     NQ is the order of Q
-*
-      IF( LEFT ) THEN
-         NQ = M
-      ELSE
-         NQ = N
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNM2R', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
-     $   RETURN
-*
-      IF( ( LEFT .AND. .NOT.NOTRAN .OR. .NOT.LEFT .AND. NOTRAN ) ) THEN
-         I1 = 1
-         I2 = K
-         I3 = 1
-      ELSE
-         I1 = K
-         I2 = 1
-         I3 = -1
-      END IF
-*
-      IF( LEFT ) THEN
-         NI = N
-         JC = 1
-      ELSE
-         MI = M
-         IC = 1
-      END IF
-*
-      DO 10 I = I1, I2, I3
-         IF( LEFT ) THEN
-*
-*           H(i) or H(i)' is applied to C(i:m,1:n)
-*
-            MI = M - I + 1
-            IC = I
-         ELSE
-*
-*           H(i) or H(i)' is applied to C(1:m,i:n)
-*
-            NI = N - I + 1
-            JC = I
-         END IF
-*
-*        Apply H(i) or H(i)'
-*
-         IF( NOTRAN ) THEN
-            TAUI = TAU( I )
-         ELSE
-            TAUI = DCONJG( TAU( I ) )
-         END IF
-         AII = A( I, I )
-         A( I, I ) = ONE
-         CALL ZLARF( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), LDC,
-     $               WORK )
-         A( I, I ) = AII
-   10 CONTINUE
-      RETURN
-*
-*     End of ZUNM2R
-*
-      END
diff --git a/src/lib/lapack/zunmbr.f b/src/lib/lapack/zunmbr.f
deleted file mode 100644
index b32ce338..00000000
--- a/src/lib/lapack/zunmbr.f
+++ /dev/null
@@ -1,288 +0,0 @@
-      SUBROUTINE ZUNMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
-     $                   LDC, WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS, VECT
-      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  If VECT = 'Q', ZUNMBR overwrites the general complex M-by-N matrix C
-*  with
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'C':      Q**H * C       C * Q**H
-*
-*  If VECT = 'P', ZUNMBR overwrites the general complex M-by-N matrix C
-*  with
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      P * C          C * P
-*  TRANS = 'C':      P**H * C       C * P**H
-*
-*  Here Q and P**H are the unitary matrices determined by ZGEBRD when
-*  reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q
-*  and P**H are defined as products of elementary reflectors H(i) and
-*  G(i) respectively.
-*
-*  Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
-*  order of the unitary matrix Q or P**H that is applied.
-*
-*  If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
-*  if nq >= k, Q = H(1) H(2) . . . H(k);
-*  if nq < k, Q = H(1) H(2) . . . H(nq-1).
-*
-*  If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
-*  if k < nq, P = G(1) G(2) . . . G(k);
-*  if k >= nq, P = G(1) G(2) . . . G(nq-1).
-*
-*  Arguments
-*  =========
-*
-*  VECT    (input) CHARACTER*1
-*          = 'Q': apply Q or Q**H;
-*          = 'P': apply P or P**H.
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q, Q**H, P or P**H from the Left;
-*          = 'R': apply Q, Q**H, P or P**H from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q or P;
-*          = 'C':  Conjugate transpose, apply Q**H or P**H.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          If VECT = 'Q', the number of columns in the original
-*          matrix reduced by ZGEBRD.
-*          If VECT = 'P', the number of rows in the original
-*          matrix reduced by ZGEBRD.
-*          K >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension
-*                                (LDA,min(nq,K)) if VECT = 'Q'
-*                                (LDA,nq)        if VECT = 'P'
-*          The vectors which define the elementary reflectors H(i) and
-*          G(i), whose products determine the matrices Q and P, as
-*          returned by ZGEBRD.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*          If VECT = 'Q', LDA >= max(1,nq);
-*          if VECT = 'P', LDA >= max(1,min(nq,K)).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (min(nq,K))
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i) or G(i) which determines Q or P, as returned
-*          by ZGEBRD in the array argument TAUQ or TAUP.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q
-*          or P*C or P**H*C or C*P or C*P**H.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M);
-*          if N = 0 or M = 0, LWORK >= 1.
-*          For optimum performance LWORK >= max(1,N*NB) if SIDE = 'L',
-*          and LWORK >= max(1,M*NB) if SIDE = 'R', where NB is the
-*          optimal blocksize. (NB = 0 if M = 0 or N = 0.)
-*
-*          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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            APPLYQ, LEFT, LQUERY, NOTRAN
-      CHARACTER          TRANST
-      INTEGER            I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZUNMLQ, ZUNMQR
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      APPLYQ = LSAME( VECT, 'Q' )
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q or P and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = N
-      ELSE
-         NQ = N
-         NW = M
-      END IF
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         NW = 0
-      END IF
-      IF( .NOT.APPLYQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -2
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
-         INFO = -3
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -5
-      ELSE IF( K.LT.0 ) THEN
-         INFO = -6
-      ELSE IF( ( APPLYQ .AND. LDA.LT.MAX( 1, NQ ) ) .OR.
-     $         ( .NOT.APPLYQ .AND. LDA.LT.MAX( 1, MIN( NQ, K ) ) ) )
-     $          THEN
-         INFO = -8
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -11
-      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
-         INFO = -13
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( NW.GT.0 ) THEN
-            IF( APPLYQ ) THEN
-               IF( LEFT ) THEN
-                  NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M-1, N, M-1,
-     $                 -1 )
-               ELSE
-                  NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N-1, N-1,
-     $                 -1 )
-               END IF
-            ELSE
-               IF( LEFT ) THEN
-                  NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M-1, N, M-1,
-     $                 -1 )
-               ELSE
-                  NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N-1, N-1,
-     $                 -1 )
-               END IF
-            END IF
-            LWKOPT = MAX( 1, NW*NB )
-         ELSE
-            LWKOPT = 1
-         END IF
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNMBR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 )
-     $   RETURN
-*
-      IF( APPLYQ ) THEN
-*
-*        Apply Q
-*
-         IF( NQ.GE.K ) THEN
-*
-*           Q was determined by a call to ZGEBRD with nq >= k
-*
-            CALL ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, IINFO )
-         ELSE IF( NQ.GT.1 ) THEN
-*
-*           Q was determined by a call to ZGEBRD with nq < k
-*
-            IF( LEFT ) THEN
-               MI = M - 1
-               NI = N
-               I1 = 2
-               I2 = 1
-            ELSE
-               MI = M
-               NI = N - 1
-               I1 = 1
-               I2 = 2
-            END IF
-            CALL ZUNMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU,
-     $                   C( I1, I2 ), LDC, WORK, LWORK, IINFO )
-         END IF
-      ELSE
-*
-*        Apply P
-*
-         IF( NOTRAN ) THEN
-            TRANST = 'C'
-         ELSE
-            TRANST = 'N'
-         END IF
-         IF( NQ.GT.K ) THEN
-*
-*           P was determined by a call to ZGEBRD with nq > k
-*
-            CALL ZUNMLQ( SIDE, TRANST, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, IINFO )
-         ELSE IF( NQ.GT.1 ) THEN
-*
-*           P was determined by a call to ZGEBRD with nq <= k
-*
-            IF( LEFT ) THEN
-               MI = M - 1
-               NI = N
-               I1 = 2
-               I2 = 1
-            ELSE
-               MI = M
-               NI = N - 1
-               I1 = 1
-               I2 = 2
-            END IF
-            CALL ZUNMLQ( SIDE, TRANST, MI, NI, NQ-1, A( 1, 2 ), LDA,
-     $                   TAU, C( I1, I2 ), LDC, WORK, LWORK, IINFO )
-         END IF
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of ZUNMBR
-*
-      END
diff --git a/src/lib/lapack/zunml2.f b/src/lib/lapack/zunml2.f
deleted file mode 100644
index cced4a77..00000000
--- a/src/lib/lapack/zunml2.f
+++ /dev/null
@@ -1,205 +0,0 @@
-      SUBROUTINE ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNML2 overwrites the general complex m-by-n matrix C with
-*
-*        Q * C  if SIDE = 'L' and TRANS = 'N', or
-*
-*        Q'* C  if SIDE = 'L' and TRANS = 'C', or
-*
-*        C * Q  if SIDE = 'R' and TRANS = 'N', or
-*
-*        C * Q' if SIDE = 'R' and TRANS = 'C',
-*
-*  where Q is a complex unitary matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(k)' . . . H(2)' H(1)'
-*
-*  as returned by ZGELQF. Q is of order m if SIDE = 'L' and of order n
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q' from the Left
-*          = 'R': apply Q or Q' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply Q  (No transpose)
-*          = 'C': apply Q' (Conjugate transpose)
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension
-*                               (LDA,M) if SIDE = 'L',
-*                               (LDA,N) if SIDE = 'R'
-*          The i-th row must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          ZGELQF in the first k rows of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,K).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGELQF.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the m-by-n matrix C.
-*          On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension
-*                                   (N) if SIDE = 'L',
-*                                   (M) if SIDE = 'R'
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      COMPLEX*16         ONE
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
-      INTEGER            I, I1, I2, I3, IC, JC, MI, NI, NQ
-      COMPLEX*16         AII, TAUI
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACGV, ZLARF
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-*
-*     NQ is the order of Q
-*
-      IF( LEFT ) THEN
-         NQ = M
-      ELSE
-         NQ = N
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNML2', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
-     $   RETURN
-*
-      IF( ( LEFT .AND. NOTRAN .OR. .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
-         I1 = 1
-         I2 = K
-         I3 = 1
-      ELSE
-         I1 = K
-         I2 = 1
-         I3 = -1
-      END IF
-*
-      IF( LEFT ) THEN
-         NI = N
-         JC = 1
-      ELSE
-         MI = M
-         IC = 1
-      END IF
-*
-      DO 10 I = I1, I2, I3
-         IF( LEFT ) THEN
-*
-*           H(i) or H(i)' is applied to C(i:m,1:n)
-*
-            MI = M - I + 1
-            IC = I
-         ELSE
-*
-*           H(i) or H(i)' is applied to C(1:m,i:n)
-*
-            NI = N - I + 1
-            JC = I
-         END IF
-*
-*        Apply H(i) or H(i)'
-*
-         IF( NOTRAN ) THEN
-            TAUI = DCONJG( TAU( I ) )
-         ELSE
-            TAUI = TAU( I )
-         END IF
-         IF( I.LT.NQ )
-     $      CALL ZLACGV( NQ-I, A( I, I+1 ), LDA )
-         AII = A( I, I )
-         A( I, I ) = ONE
-         CALL ZLARF( SIDE, MI, NI, A( I, I ), LDA, TAUI, C( IC, JC ),
-     $               LDC, WORK )
-         A( I, I ) = AII
-         IF( I.LT.NQ )
-     $      CALL ZLACGV( NQ-I, A( I, I+1 ), LDA )
-   10 CONTINUE
-      RETURN
-*
-*     End of ZUNML2
-*
-      END
diff --git a/src/lib/lapack/zunmlq.f b/src/lib/lapack/zunmlq.f
deleted file mode 100644
index b1708757..00000000
--- a/src/lib/lapack/zunmlq.f
+++ /dev/null
@@ -1,267 +0,0 @@
-      SUBROUTINE ZUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNMLQ overwrites the general complex M-by-N matrix C with
-*
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'C':      Q**H * C       C * Q**H
-*
-*  where Q is a complex unitary matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(k)' . . . H(2)' H(1)'
-*
-*  as returned by ZGELQF. Q is of order M if SIDE = 'L' and of order N
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q**H from the Left;
-*          = 'R': apply Q or Q**H from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q;
-*          = 'C':  Conjugate transpose, apply Q**H.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension
-*                               (LDA,M) if SIDE = 'L',
-*                               (LDA,N) if SIDE = 'R'
-*          The i-th row must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          ZGELQF in the first k rows of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,K).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGELQF.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M).
-*          For optimum performance LWORK >= N*NB if SIDE 'L', and
-*          LWORK >= M*NB if SIDE = 'R', 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            NBMAX, LDT
-      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, LQUERY, NOTRAN
-      CHARACTER          TRANST
-      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
-     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-*     ..
-*     .. Local Arrays ..
-      COMPLEX*16         T( LDT, NBMAX )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNML2
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = N
-      ELSE
-         NQ = N
-         NW = M
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
-         INFO = -12
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-*
-*        Determine the block size.  NB may be at most NBMAX, where NBMAX
-*        is used to define the local array T.
-*
-         NB = MIN( NBMAX, ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N, K,
-     $        -1 ) )
-         LWKOPT = MAX( 1, NW )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNMLQ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      LDWORK = NW
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-         IWS = NW*NB
-         IF( LWORK.LT.IWS ) THEN
-            NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'ZUNMLQ', SIDE // TRANS, M, N, K,
-     $              -1 ) )
-         END IF
-      ELSE
-         IWS = NW
-      END IF
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-*        Use unblocked code
-*
-         CALL ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
-     $                IINFO )
-      ELSE
-*
-*        Use blocked code
-*
-         IF( ( LEFT .AND. NOTRAN ) .OR.
-     $       ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
-            I1 = 1
-            I2 = K
-            I3 = NB
-         ELSE
-            I1 = ( ( K-1 ) / NB )*NB + 1
-            I2 = 1
-            I3 = -NB
-         END IF
-*
-         IF( LEFT ) THEN
-            NI = N
-            JC = 1
-         ELSE
-            MI = M
-            IC = 1
-         END IF
-*
-         IF( NOTRAN ) THEN
-            TRANST = 'C'
-         ELSE
-            TRANST = 'N'
-         END IF
-*
-         DO 10 I = I1, I2, I3
-            IB = MIN( NB, K-I+1 )
-*
-*           Form the triangular factor of the block reflector
-*           H = H(i) H(i+1) . . . H(i+ib-1)
-*
-            CALL ZLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ),
-     $                   LDA, TAU( I ), T, LDT )
-            IF( LEFT ) THEN
-*
-*              H or H' is applied to C(i:m,1:n)
-*
-               MI = M - I + 1
-               IC = I
-            ELSE
-*
-*              H or H' is applied to C(1:m,i:n)
-*
-               NI = N - I + 1
-               JC = I
-            END IF
-*
-*           Apply H or H'
-*
-            CALL ZLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB,
-     $                   A( I, I ), LDA, T, LDT, C( IC, JC ), LDC, WORK,
-     $                   LDWORK )
-   10    CONTINUE
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of ZUNMLQ
-*
-      END
diff --git a/src/lib/lapack/zunmqr.f b/src/lib/lapack/zunmqr.f
deleted file mode 100644
index f9b1e98f..00000000
--- a/src/lib/lapack/zunmqr.f
+++ /dev/null
@@ -1,260 +0,0 @@
-      SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNMQR overwrites the general complex M-by-N matrix C with
-*
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'C':      Q**H * C       C * Q**H
-*
-*  where Q is a complex unitary matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(1) H(2) . . . H(k)
-*
-*  as returned by ZGEQRF. Q is of order M if SIDE = 'L' and of order N
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q**H from the Left;
-*          = 'R': apply Q or Q**H from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q;
-*          = 'C':  Conjugate transpose, apply Q**H.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension (LDA,K)
-*          The i-th column must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          ZGEQRF in the first k columns of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A.
-*          If SIDE = 'L', LDA >= max(1,M);
-*          if SIDE = 'R', LDA >= max(1,N).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZGEQRF.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M).
-*          For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*          LWORK >= M*NB if SIDE = 'R', 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            NBMAX, LDT
-      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, LQUERY, NOTRAN
-      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
-     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-*     ..
-*     .. Local Arrays ..
-      COMPLEX*16         T( LDT, NBMAX )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARFB, ZLARFT, ZUNM2R
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = N
-      ELSE
-         NQ = N
-         NW = M
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
-         INFO = -7
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -10
-      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
-         INFO = -12
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-*
-*        Determine the block size.  NB may be at most NBMAX, where NBMAX
-*        is used to define the local array T.
-*
-         NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N, K,
-     $        -1 ) )
-         LWKOPT = MAX( 1, NW )*NB
-         WORK( 1 ) = LWKOPT
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNMQR', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
-         WORK( 1 ) = 1
-         RETURN
-      END IF
-*
-      NBMIN = 2
-      LDWORK = NW
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-         IWS = NW*NB
-         IF( LWORK.LT.IWS ) THEN
-            NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQR', SIDE // TRANS, M, N, K,
-     $              -1 ) )
-         END IF
-      ELSE
-         IWS = NW
-      END IF
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-*        Use unblocked code
-*
-         CALL ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
-     $                IINFO )
-      ELSE
-*
-*        Use blocked code
-*
-         IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
-     $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN
-            I1 = 1
-            I2 = K
-            I3 = NB
-         ELSE
-            I1 = ( ( K-1 ) / NB )*NB + 1
-            I2 = 1
-            I3 = -NB
-         END IF
-*
-         IF( LEFT ) THEN
-            NI = N
-            JC = 1
-         ELSE
-            MI = M
-            IC = 1
-         END IF
-*
-         DO 10 I = I1, I2, I3
-            IB = MIN( NB, K-I+1 )
-*
-*           Form the triangular factor of the block reflector
-*           H = H(i) H(i+1) . . . H(i+ib-1)
-*
-            CALL ZLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ),
-     $                   LDA, TAU( I ), T, LDT )
-            IF( LEFT ) THEN
-*
-*              H or H' is applied to C(i:m,1:n)
-*
-               MI = M - I + 1
-               IC = I
-            ELSE
-*
-*              H or H' is applied to C(1:m,i:n)
-*
-               NI = N - I + 1
-               JC = I
-            END IF
-*
-*           Apply H or H'
-*
-            CALL ZLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI,
-     $                   IB, A( I, I ), LDA, T, LDT, C( IC, JC ), LDC,
-     $                   WORK, LDWORK )
-   10    CONTINUE
-      END IF
-      WORK( 1 ) = LWKOPT
-      RETURN
-*
-*     End of ZUNMQR
-*
-      END
diff --git a/src/lib/lapack/zunmr3.f b/src/lib/lapack/zunmr3.f
deleted file mode 100644
index 111c1c95..00000000
--- a/src/lib/lapack/zunmr3.f
+++ /dev/null
@@ -1,212 +0,0 @@
-      SUBROUTINE ZUNMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
-     $                   WORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, L, LDA, LDC, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNMR3 overwrites the general complex m by n matrix C with
-*
-*        Q * C  if SIDE = 'L' and TRANS = 'N', or
-*
-*        Q'* C  if SIDE = 'L' and TRANS = 'C', or
-*
-*        C * Q  if SIDE = 'R' and TRANS = 'N', or
-*
-*        C * Q' if SIDE = 'R' and TRANS = 'C',
-*
-*  where Q is a complex unitary matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(1) H(2) . . . H(k)
-*
-*  as returned by ZTZRZF. Q is of order m if SIDE = 'L' and of order n
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q' from the Left
-*          = 'R': apply Q or Q' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply Q  (No transpose)
-*          = 'C': apply Q' (Conjugate transpose)
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  L       (input) INTEGER
-*          The number of columns of the matrix A containing
-*          the meaningful part of the Householder reflectors.
-*          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension
-*                               (LDA,M) if SIDE = 'L',
-*                               (LDA,N) if SIDE = 'R'
-*          The i-th row must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          ZTZRZF in the last k rows of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,K).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZTZRZF.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the m-by-n matrix C.
-*          On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace) COMPLEX*16 array, dimension
-*                                   (N) if SIDE = 'L',
-*                                   (M) if SIDE = 'R'
-*
-*  INFO    (output) INTEGER
-*          = 0: successful exit
-*          < 0: if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  =====================================================================
-*
-*     .. Local Scalars ..
-      LOGICAL            LEFT, NOTRAN
-      INTEGER            I, I1, I2, I3, IC, JA, JC, MI, NI, NQ
-      COMPLEX*16         TAUI
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARZ
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          DCONJG, MAX
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-*
-*     NQ is the order of Q
-*
-      IF( LEFT ) THEN
-         NQ = M
-      ELSE
-         NQ = N
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
-     $         ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
-         INFO = -6
-      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
-         INFO = -8
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -11
-      END IF
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNMR3', -INFO )
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
-     $   RETURN
-*
-      IF( ( LEFT .AND. .NOT.NOTRAN .OR. .NOT.LEFT .AND. NOTRAN ) ) THEN
-         I1 = 1
-         I2 = K
-         I3 = 1
-      ELSE
-         I1 = K
-         I2 = 1
-         I3 = -1
-      END IF
-*
-      IF( LEFT ) THEN
-         NI = N
-         JA = M - L + 1
-         JC = 1
-      ELSE
-         MI = M
-         JA = N - L + 1
-         IC = 1
-      END IF
-*
-      DO 10 I = I1, I2, I3
-         IF( LEFT ) THEN
-*
-*           H(i) or H(i)' is applied to C(i:m,1:n)
-*
-            MI = M - I + 1
-            IC = I
-         ELSE
-*
-*           H(i) or H(i)' is applied to C(1:m,i:n)
-*
-            NI = N - I + 1
-            JC = I
-         END IF
-*
-*        Apply H(i) or H(i)'
-*
-         IF( NOTRAN ) THEN
-            TAUI = TAU( I )
-         ELSE
-            TAUI = DCONJG( TAU( I ) )
-         END IF
-         CALL ZLARZ( SIDE, MI, NI, L, A( I, JA ), LDA, TAUI,
-     $               C( IC, JC ), LDC, WORK )
-*
-   10 CONTINUE
-*
-      RETURN
-*
-*     End of ZUNMR3
-*
-      END
diff --git a/src/lib/lapack/zunmrz.f b/src/lib/lapack/zunmrz.f
deleted file mode 100644
index c7637050..00000000
--- a/src/lib/lapack/zunmrz.f
+++ /dev/null
@@ -1,296 +0,0 @@
-      SUBROUTINE ZUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
-     $                   WORK, LWORK, INFO )
-*
-*  -- LAPACK routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          SIDE, TRANS
-      INTEGER            INFO, K, L, LDA, LDC, LWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  ZUNMRZ overwrites the general complex M-by-N matrix C with
-*
-*                  SIDE = 'L'     SIDE = 'R'
-*  TRANS = 'N':      Q * C          C * Q
-*  TRANS = 'C':      Q**H * C       C * Q**H
-*
-*  where Q is a complex unitary matrix defined as the product of k
-*  elementary reflectors
-*
-*        Q = H(1) H(2) . . . H(k)
-*
-*  as returned by ZTZRZF. Q is of order M if SIDE = 'L' and of order N
-*  if SIDE = 'R'.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply Q or Q**H from the Left;
-*          = 'R': apply Q or Q**H from the Right.
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N':  No transpose, apply Q;
-*          = 'C':  Conjugate transpose, apply Q**H.
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C. M >= 0.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C. N >= 0.
-*
-*  K       (input) INTEGER
-*          The number of elementary reflectors whose product defines
-*          the matrix Q.
-*          If SIDE = 'L', M >= K >= 0;
-*          if SIDE = 'R', N >= K >= 0.
-*
-*  L       (input) INTEGER
-*          The number of columns of the matrix A containing
-*          the meaningful part of the Householder reflectors.
-*          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
-*
-*  A       (input) COMPLEX*16 array, dimension
-*                               (LDA,M) if SIDE = 'L',
-*                               (LDA,N) if SIDE = 'R'
-*          The i-th row must contain the vector which defines the
-*          elementary reflector H(i), for i = 1,2,...,k, as returned by
-*          ZTZRZF in the last k rows of its array argument A.
-*          A is modified by the routine but restored on exit.
-*
-*  LDA     (input) INTEGER
-*          The leading dimension of the array A. LDA >= max(1,K).
-*
-*  TAU     (input) COMPLEX*16 array, dimension (K)
-*          TAU(i) must contain the scalar factor of the elementary
-*          reflector H(i), as returned by ZTZRZF.
-*
-*  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
-*          On entry, the M-by-N matrix C.
-*          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDC >= max(1,M).
-*
-*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
-*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
-*
-*  LWORK   (input) INTEGER
-*          The dimension of the array WORK.
-*          If SIDE = 'L', LWORK >= max(1,N);
-*          if SIDE = 'R', LWORK >= max(1,M).
-*          For optimum performance LWORK >= N*NB if SIDE = 'L', and
-*          LWORK >= M*NB if SIDE = 'R', 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.
-*
-*  INFO    (output) INTEGER
-*          = 0:  successful exit
-*          < 0:  if INFO = -i, the i-th argument had an illegal value
-*
-*  Further Details
-*  ===============
-*
-*  Based on contributions by
-*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      INTEGER            NBMAX, LDT
-      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
-*     ..
-*     .. Local Scalars ..
-      LOGICAL            LEFT, LQUERY, NOTRAN
-      CHARACTER          TRANST
-      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JA, JC,
-     $                   LDWORK, LWKOPT, MI, NB, NBMIN, NI, NQ, NW
-*     ..
-*     .. Local Arrays ..
-      COMPLEX*16         T( LDT, NBMAX )
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      INTEGER            ILAENV
-      EXTERNAL           LSAME, ILAENV
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARZB, ZLARZT, ZUNMR3
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          MAX, MIN
-*     ..
-*     .. Executable Statements ..
-*
-*     Test the input arguments
-*
-      INFO = 0
-      LEFT = LSAME( SIDE, 'L' )
-      NOTRAN = LSAME( TRANS, 'N' )
-      LQUERY = ( LWORK.EQ.-1 )
-*
-*     NQ is the order of Q and NW is the minimum dimension of WORK
-*
-      IF( LEFT ) THEN
-         NQ = M
-         NW = MAX( 1, N )
-      ELSE
-         NQ = N
-         NW = MAX( 1, M )
-      END IF
-      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
-         INFO = -1
-      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
-         INFO = -2
-      ELSE IF( M.LT.0 ) THEN
-         INFO = -3
-      ELSE IF( N.LT.0 ) THEN
-         INFO = -4
-      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
-         INFO = -5
-      ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
-     $         ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
-         INFO = -6
-      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
-         INFO = -8
-      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
-         INFO = -11
-      END IF
-*
-      IF( INFO.EQ.0 ) THEN
-         IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-            LWKOPT = 1
-*
-*           Determine the block size.  NB may be at most NBMAX, where
-*           NBMAX is used to define the local array T.
-*
-            NB = MIN( NBMAX, ILAENV( 1, 'ZUNMRQ', SIDE // TRANS, M, N,
-     $                               K, -1 ) )
-            LWKOPT = NW*NB
-         END IF
-         WORK( 1 ) = LWKOPT
-*
-         IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
-            INFO = -13
-         END IF
-      END IF
-*
-      IF( INFO.NE.0 ) THEN
-         CALL XERBLA( 'ZUNMRZ', -INFO )
-         RETURN
-      ELSE IF( LQUERY ) THEN
-         RETURN
-      END IF
-*
-*     Quick return if possible
-*
-      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
-         RETURN
-      END IF
-*
-*     Determine the block size.  NB may be at most NBMAX, where NBMAX
-*     is used to define the local array T.
-*
-      NB = MIN( NBMAX, ILAENV( 1, 'ZUNMRQ', SIDE // TRANS, M, N, K,
-     $     -1 ) )
-      NBMIN = 2
-      LDWORK = NW
-      IF( NB.GT.1 .AND. NB.LT.K ) THEN
-         IWS = NW*NB
-         IF( LWORK.LT.IWS ) THEN
-            NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'ZUNMRQ', SIDE // TRANS, M, N, K,
-     $              -1 ) )
-         END IF
-      ELSE
-         IWS = NW
-      END IF
-*
-      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
-*
-*        Use unblocked code
-*
-         CALL ZUNMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
-     $                WORK, IINFO )
-      ELSE
-*
-*        Use blocked code
-*
-         IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
-     $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN
-            I1 = 1
-            I2 = K
-            I3 = NB
-         ELSE
-            I1 = ( ( K-1 ) / NB )*NB + 1
-            I2 = 1
-            I3 = -NB
-         END IF
-*
-         IF( LEFT ) THEN
-            NI = N
-            JC = 1
-            JA = M - L + 1
-         ELSE
-            MI = M
-            IC = 1
-            JA = N - L + 1
-         END IF
-*
-         IF( NOTRAN ) THEN
-            TRANST = 'C'
-         ELSE
-            TRANST = 'N'
-         END IF
-*
-         DO 10 I = I1, I2, I3
-            IB = MIN( NB, K-I+1 )
-*
-*           Form the triangular factor of the block reflector
-*           H = H(i+ib-1) . . . H(i+1) H(i)
-*
-            CALL ZLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), LDA,
-     $                   TAU( I ), T, LDT )
-*
-            IF( LEFT ) THEN
-*
-*              H or H' is applied to C(i:m,1:n)
-*
-               MI = M - I + 1
-               IC = I
-            ELSE
-*
-*              H or H' is applied to C(1:m,i:n)
-*
-               NI = N - I + 1
-               JC = I
-            END IF
-*
-*           Apply H or H'
-*
-            CALL ZLARZB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,
-     $                   IB, L, A( I, JA ), LDA, T, LDT, C( IC, JC ),
-     $                   LDC, WORK, LDWORK )
-   10    CONTINUE
-*
-      END IF
-*
-      WORK( 1 ) = LWKOPT
-*
-      RETURN
-*
-*     End of ZUNMRZ
-*
-      END